{-|
Module      : Z.Botan.Exception
Description : Errno provided by botan
Copyright   : (c) Dong Han, 2020 - 2021
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

Provides botan exception hierarchy.

-}

module Z.Botan.Exception (
  -- * Botan exceptions
    SomeBotanException(..)
  , botanExceptionToException
  , botanExceptionFromException
  -- * Concrete botan exception types
  , InvalidVerifier(..)
  , InvalidInput(..)
  , BadMac(..)
  , InsufficientBufferSpace(..)
  , ExceptionThrown(..)
  , OutOfMemory(..)
  , BadFlag(..)
  , NullPointer(..)
  , BadParameter(..)
  , KeyNotSet(..)
  , InvalidKeyLength(..)
  , NotImplemented(..)
  , InvalidObject(..)
  , UnknownError(..)
  -- * Throw botan exceptions
  , throwBotanIfMinus
  , throwBotanIfMinus_
  , throwBotanError
  -- * re-export
  , module Z.Botan.Errno
  , module Z.IO.Exception
 ) where

import Control.Monad
import Foreign.C.Types
import Data.Typeable
import Z.Botan.Errno
import Z.IO.Exception

-- | The root type of all botan exceptions, you can catch all botan exception by catching this root type.
--
data SomeBotanException = forall e . Exception e => SomeBotanException e

instance Show SomeBotanException where
    show :: SomeBotanException -> String
show (SomeBotanException e
e) = e -> String
forall a. Show a => a -> String
show e
e

instance Exception SomeBotanException

botanExceptionToException :: Exception e => e -> SomeException
botanExceptionToException :: e -> SomeException
botanExceptionToException = SomeBotanException -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeBotanException -> SomeException)
-> (e -> SomeBotanException) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeBotanException
forall e. Exception e => e -> SomeBotanException
SomeBotanException

botanExceptionFromException :: Exception e => SomeException -> Maybe e
botanExceptionFromException :: SomeException -> Maybe e
botanExceptionFromException SomeException
x = do
    SomeBotanException e
a <- SomeException -> Maybe SomeBotanException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
    e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a

#define BotanE(e) data e = e CInt CallStack deriving Show;  \
           instance Exception e where                     \
               { toException = botanExceptionToException     \
               ; fromException = botanExceptionFromException \
               }

BotanE(InvalidVerifier)
BotanE(InvalidInput)
BotanE(BadMac)
BotanE(InsufficientBufferSpace)
BotanE(ExceptionThrown)
BotanE(OutOfMemory)
BotanE(BadFlag)
BotanE(NullPointer)
BotanE(BadParameter)
BotanE(KeyNotSet)
BotanE(InvalidKeyLength)
BotanE(NotImplemented)
BotanE(InvalidObject)
BotanE(UnknownError)


throwBotanIfMinus :: (HasCallStack, Integral a) => IO a -> IO a
throwBotanIfMinus :: IO a -> IO a
throwBotanIfMinus IO a
f = do
    a
r <- IO a
f
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0) (CInt -> CallStack -> IO ()
forall x. CInt -> CallStack -> IO x
throwBotanError_ (a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r) CallStack
HasCallStack => CallStack
callStack)
    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

throwBotanIfMinus_ :: (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ :: IO a -> IO ()
throwBotanIfMinus_ IO a
f = do
    a
r <- IO a
f
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0) (CInt -> CallStack -> IO ()
forall x. CInt -> CallStack -> IO x
throwBotanError_ (a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r) CallStack
HasCallStack => CallStack
callStack)

throwBotanError :: HasCallStack => CInt -> IO x
throwBotanError :: CInt -> IO x
throwBotanError CInt
r = CInt -> CallStack -> IO x
forall x. CInt -> CallStack -> IO x
throwBotanError_ CInt
r CallStack
HasCallStack => CallStack
callStack

throwBotanError_ :: CInt -> CallStack -> IO x
throwBotanError_ :: CInt -> CallStack -> IO x
throwBotanError_ CInt
r CallStack
cs =  case CInt
r of
    CInt
BOTAN_FFI_ERROR_INVALID_INPUT             -> InvalidInput -> IO x
forall e a. Exception e => e -> IO a
throwIO (CInt -> CallStack -> InvalidInput
InvalidInput CInt
r CallStack
cs)
    CInt
BOTAN_FFI_ERROR_BAD_MAC                   -> BadMac -> IO x
forall e a. Exception e => e -> IO a
throwIO (CInt -> CallStack -> BadMac
BadMac CInt
r CallStack
cs)
    CInt
BOTAN_FFI_ERROR_INSUFFICIENT_BUFFER_SPACE -> InsufficientBufferSpace -> IO x
forall e a. Exception e => e -> IO a
throwIO (CInt -> CallStack -> InsufficientBufferSpace
InsufficientBufferSpace CInt
r CallStack
cs)
    CInt
BOTAN_FFI_ERROR_EXCEPTION_THROWN          -> ExceptionThrown -> IO x
forall e a. Exception e => e -> IO a
throwIO (CInt -> CallStack -> ExceptionThrown
ExceptionThrown CInt
r CallStack
cs)
    CInt
BOTAN_FFI_ERROR_OUT_OF_MEMORY             -> OutOfMemory -> IO x
forall e a. Exception e => e -> IO a
throwIO (CInt -> CallStack -> OutOfMemory
OutOfMemory CInt
r CallStack
cs)
    CInt
BOTAN_FFI_ERROR_BAD_FLAG                  -> BadFlag -> IO x
forall e a. Exception e => e -> IO a
throwIO (CInt -> CallStack -> BadFlag
BadFlag CInt
r CallStack
cs)
    CInt
BOTAN_FFI_ERROR_NULL_POINTER              -> NullPointer -> IO x
forall e a. Exception e => e -> IO a
throwIO (CInt -> CallStack -> NullPointer
NullPointer CInt
r CallStack
cs)
    CInt
BOTAN_FFI_ERROR_BAD_PARAMETER             -> BadParameter -> IO x
forall e a. Exception e => e -> IO a
throwIO (CInt -> CallStack -> BadParameter
BadParameter CInt
r CallStack
cs)
    CInt
BOTAN_FFI_ERROR_KEY_NOT_SET               -> KeyNotSet -> IO x
forall e a. Exception e => e -> IO a
throwIO (CInt -> CallStack -> KeyNotSet
KeyNotSet CInt
r CallStack
cs)
    CInt
BOTAN_FFI_ERROR_INVALID_KEY_LENGTH        -> InvalidKeyLength -> IO x
forall e a. Exception e => e -> IO a
throwIO (CInt -> CallStack -> InvalidKeyLength
InvalidKeyLength CInt
r CallStack
cs)
    CInt
BOTAN_FFI_ERROR_NOT_IMPLEMENTED           -> NotImplemented -> IO x
forall e a. Exception e => e -> IO a
throwIO (CInt -> CallStack -> NotImplemented
NotImplemented CInt
r CallStack
cs)
    CInt
BOTAN_FFI_ERROR_INVALID_OBJECT            -> InvalidObject -> IO x
forall e a. Exception e => e -> IO a
throwIO (CInt -> CallStack -> InvalidObject
InvalidObject CInt
r CallStack
cs)
    CInt
_                                         -> UnknownError -> IO x
forall e a. Exception e => e -> IO a
throwIO (CInt -> CallStack -> UnknownError
UnknownError CInt
r CallStack
cs)