1-- |
2-- Module      : Crypto.Error.Types
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : stable
6-- Portability : Good
7--
8-- Cryptographic Error enumeration and handling
9--
10{-# LANGUAGE DeriveDataTypeable #-}
11{-# LANGUAGE TypeFamilies       #-}
12module Crypto.Error.Types
13    ( CryptoError(..)
14    , CryptoFailable(..)
15    , throwCryptoErrorIO
16    , throwCryptoError
17    , onCryptoFailure
18    , eitherCryptoError
19    , maybeCryptoError
20    ) where
21
22import qualified Control.Exception as E
23import           Data.Data
24
25import           Basement.Monad (MonadFailure(..))
26
27-- | Enumeration of all possible errors that can be found in this library
28data CryptoError =
29    -- symmetric cipher errors
30      CryptoError_KeySizeInvalid
31    | CryptoError_IvSizeInvalid
32    | CryptoError_SeedSizeInvalid
33    | CryptoError_AEADModeNotSupported
34    -- public key cryptography error
35    | CryptoError_SecretKeySizeInvalid
36    | CryptoError_SecretKeyStructureInvalid
37    | CryptoError_PublicKeySizeInvalid
38    | CryptoError_SharedSecretSizeInvalid
39    -- elliptic cryptography error
40    | CryptoError_EcScalarOutOfBounds
41    | CryptoError_PointSizeInvalid
42    | CryptoError_PointFormatInvalid
43    | CryptoError_PointFormatUnsupported
44    | CryptoError_PointCoordinatesInvalid
45    | CryptoError_ScalarMultiplicationInvalid
46    -- Message authentification error
47    | CryptoError_MacKeyInvalid
48    | CryptoError_AuthenticationTagSizeInvalid
49    -- Prime generation error
50    | CryptoError_PrimeSizeInvalid
51    -- Parameter errors
52    | CryptoError_SaltTooSmall
53    | CryptoError_OutputLengthTooSmall
54    | CryptoError_OutputLengthTooBig
55    deriving (Show,Eq,Enum,Data)
56
57instance E.Exception CryptoError
58
59-- | A simple Either like type to represent a computation that can fail
60--
61-- 2 possibles values are:
62--
63-- * 'CryptoPassed' : The computation succeeded, and contains the result of the computation
64--
65-- * 'CryptoFailed' : The computation failed, and contains the cryptographic error associated
66--
67data CryptoFailable a =
68      CryptoPassed a
69    | CryptoFailed CryptoError
70    deriving (Show)
71
72instance Eq a => Eq (CryptoFailable a) where
73    (==) (CryptoPassed a)  (CryptoPassed b)  = a == b
74    (==) (CryptoFailed e1) (CryptoFailed e2) = e1 == e2
75    (==) _                 _                 = False
76
77instance Functor CryptoFailable where
78    fmap f (CryptoPassed a) = CryptoPassed (f a)
79    fmap _ (CryptoFailed r) = CryptoFailed r
80
81instance Applicative CryptoFailable where
82    pure a     = CryptoPassed a
83    (<*>) fm m = fm >>= \p -> m >>= \r2 -> return (p r2)
84instance Monad CryptoFailable where
85    return = pure
86    (>>=) m1 m2 = do
87        case m1 of
88            CryptoPassed a -> m2 a
89            CryptoFailed e -> CryptoFailed e
90
91instance MonadFailure CryptoFailable where
92    type Failure CryptoFailable = CryptoError
93    mFail = CryptoFailed
94
95-- | Throw an CryptoError as exception on CryptoFailed result,
96-- otherwise return the computed value
97throwCryptoErrorIO :: CryptoFailable a -> IO a
98throwCryptoErrorIO (CryptoFailed e) = E.throwIO e
99throwCryptoErrorIO (CryptoPassed r) = return r
100
101-- | Same as 'throwCryptoErrorIO' but throw the error asynchronously.
102throwCryptoError :: CryptoFailable a -> a
103throwCryptoError (CryptoFailed e) = E.throw e
104throwCryptoError (CryptoPassed r) = r
105
106-- | Simple 'either' like combinator for CryptoFailable type
107onCryptoFailure :: (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
108onCryptoFailure onError _         (CryptoFailed e) = onError e
109onCryptoFailure _       onSuccess (CryptoPassed r) = onSuccess r
110
111-- | Transform a CryptoFailable to an Either
112eitherCryptoError :: CryptoFailable a -> Either CryptoError a
113eitherCryptoError (CryptoFailed e) = Left e
114eitherCryptoError (CryptoPassed a) = Right a
115
116-- | Transform a CryptoFailable to a Maybe
117maybeCryptoError :: CryptoFailable a -> Maybe a
118maybeCryptoError (CryptoFailed _) = Nothing
119maybeCryptoError (CryptoPassed r) = Just r
120