{-# LANGUAGE DeriveDataTypeable #-}

{- |
   Maintainer:  simons@cryp.to
   Stability:   provisional
   Portability: portable

   Low-level bindings to OpenSSL's EVP interface. Most users do not need this
   code. Check out "OpenSSL.Digest" for a more comfortable interface.
-}

module OpenSSL.EVP.Digest.Error where

import Control.Exception
import Data.Typeable ( Typeable )
import Foreign
import Foreign.C

-- | Most OpenSSL functions return an approximation of @Bool@ to signify
-- failure. This wrapper makes it easier to move the error handling to the
-- exception layer where appropriate.

throwIfZero :: String -> IO CInt -> IO ()
throwIfZero :: String -> IO CInt -> IO ()
throwIfZero String
fname =
  forall a. (a -> Bool) -> (a -> String) -> IO a -> IO ()
throwIf_ (forall a. Eq a => a -> a -> Bool
==CInt
0) (forall a b. a -> b -> a
const (String -> ShowS
showString String
fname String
" failed with error code 0"))

-- | A custom exception type which is thrown by 'digestByName' in case the
-- requested digest algorithm is not available in the OpenSSL system library.

newtype UnknownAlgorithm = UnknownAlgorithm String
  deriving (Int -> UnknownAlgorithm -> ShowS
[UnknownAlgorithm] -> ShowS
UnknownAlgorithm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnknownAlgorithm] -> ShowS
$cshowList :: [UnknownAlgorithm] -> ShowS
show :: UnknownAlgorithm -> String
$cshow :: UnknownAlgorithm -> String
showsPrec :: Int -> UnknownAlgorithm -> ShowS
$cshowsPrec :: Int -> UnknownAlgorithm -> ShowS
Show, Typeable)

instance Exception UnknownAlgorithm