{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Crypto.Error.Types
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : stable
-- Portability : Good
--
-- Cryptographic Error enumeration and handling
module Crypto.Error.Types (
    CryptoError (..),
    CryptoFailable (..),
    throwCryptoErrorIO,
    throwCryptoError,
    onCryptoFailure,
    eitherCryptoError,
    maybeCryptoError,
) where

import qualified Control.Exception as E
import Data.Data

import Basement.Monad (MonadFailure (..))

-- | Enumeration of all possible errors that can be found in this library
data CryptoError
    = -- symmetric cipher errors
      CryptoError_KeySizeInvalid
    | CryptoError_IvSizeInvalid
    | CryptoError_SeedSizeInvalid
    | CryptoError_AEADModeNotSupported
    | -- public key cryptography error
      CryptoError_SecretKeySizeInvalid
    | CryptoError_SecretKeyStructureInvalid
    | CryptoError_PublicKeySizeInvalid
    | CryptoError_SharedSecretSizeInvalid
    | -- elliptic cryptography error
      CryptoError_EcScalarOutOfBounds
    | CryptoError_PointSizeInvalid
    | CryptoError_PointFormatInvalid
    | CryptoError_PointFormatUnsupported
    | CryptoError_PointCoordinatesInvalid
    | CryptoError_ScalarMultiplicationInvalid
    | -- Message authentification error
      CryptoError_MacKeyInvalid
    | CryptoError_AuthenticationTagSizeInvalid
    | -- Prime generation error
      CryptoError_PrimeSizeInvalid
    | -- Parameter errors
      CryptoError_SaltTooSmall
    | CryptoError_OutputLengthTooSmall
    | CryptoError_OutputLengthTooBig
    deriving (Show, Eq, Enum, Data)

instance E.Exception CryptoError

-- | A simple Either like type to represent a computation that can fail
--
-- 2 possibles values are:
--
-- * 'CryptoPassed' : The computation succeeded, and contains the result of the computation
--
-- * 'CryptoFailed' : The computation failed, and contains the cryptographic error associated
data CryptoFailable a
    = CryptoPassed a
    | CryptoFailed CryptoError
    deriving (Show)

instance Eq a => Eq (CryptoFailable a) where
    (==) (CryptoPassed a) (CryptoPassed b) = a == b
    (==) (CryptoFailed e1) (CryptoFailed e2) = e1 == e2
    (==) _ _ = False

instance Functor CryptoFailable where
    fmap f (CryptoPassed a) = CryptoPassed (f a)
    fmap _ (CryptoFailed r) = CryptoFailed r

instance Applicative CryptoFailable where
    pure a = CryptoPassed a
    (<*>) fm m = fm >>= \p -> m >>= \r2 -> return (p r2)
instance Monad CryptoFailable where
    return = pure
    (>>=) m1 m2 = do
        case m1 of
            CryptoPassed a -> m2 a
            CryptoFailed e -> CryptoFailed e

instance MonadFailure CryptoFailable where
    type Failure CryptoFailable = CryptoError
    mFail = CryptoFailed

-- | Throw an CryptoError as exception on CryptoFailed result,
-- otherwise return the computed value
throwCryptoErrorIO :: CryptoFailable a -> IO a
throwCryptoErrorIO (CryptoFailed e) = E.throwIO e
throwCryptoErrorIO (CryptoPassed r) = return r

-- | Same as 'throwCryptoErrorIO' but throw the error asynchronously.
throwCryptoError :: CryptoFailable a -> a
throwCryptoError (CryptoFailed e) = E.throw e
throwCryptoError (CryptoPassed r) = r

-- | Simple 'either' like combinator for CryptoFailable type
onCryptoFailure :: (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
onCryptoFailure onError _ (CryptoFailed e) = onError e
onCryptoFailure _ onSuccess (CryptoPassed r) = onSuccess r

-- | Transform a CryptoFailable to an Either
eitherCryptoError :: CryptoFailable a -> Either CryptoError a
eitherCryptoError (CryptoFailed e) = Left e
eitherCryptoError (CryptoPassed a) = Right a

-- | Transform a CryptoFailable to a Maybe
maybeCryptoError :: CryptoFailable a -> Maybe a
maybeCryptoError (CryptoFailed _) = Nothing
maybeCryptoError (CryptoPassed r) = Just r
