Initial commit

bundled/Crypto/Error/Types.hs

@@ -0,0 +1,119 @@
+-- |
+-- Module      : Crypto.Error.Types
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : stable
+-- Portability : Good
+--
+-- Cryptographic Error enumeration and handling
+--
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE TypeFamilies       #-}
+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