-- |The module mirrors "Crypto.Classes" except that errors are thrown as
-- exceptions instead of having returning types of @Either error result@
-- or @Maybe result@.
--
-- NB This module is experimental and might go away or be re-arranged.
{-# LANGUAGE DeriveDataTypeable #-}
module Crypto.Classes.Exceptions 
    ( -- * Classes
      C.Hash(..), C.AsymCipher, R.CryptoRandomGen, C.BlockCipher
      -- * Hashing Operations
    , C.hashFunc', C.hashFunc
      -- * Symmetric Cryptographic Operations
      -- ** Helpers
    , C.blockSize, C.blockSizeBytes
    , C.keyLength, C.keyLengthBytes
    , C.incIV
      -- ** Primitives
    , C.encryptBlock, C.decryptBlock
    -- * Key and IV construction
    , buildKey, C.buildKeyIO, buildKeyGen
    , getIV ,C.getIVIO, C.zeroIV
    -- ** Block Cipher Modes of Operation
    , C.ecb, C.unEcb, C.cbc, C.unCbc, C.ctr, C.unCtr, C.ctrLazy, C.unCtrLazy
    , C.cfb, C.unCfb, C.ofb, C.unOfb, C.cbcLazy, C.unCbcLazy, C.sivLazy, C.unSivLazy
    , C.siv, C.unSiv, C.ecbLazy, C.unEcbLazy, C.cfbLazy, C.unCfbLazy, C.ofbLazy
    , C.unOfbLazy
    -- * RNG Operations
    , newGen, genBytes, genBytesWithEntropy, reseed, splitGen
    , R.genSeedLength, R.reseedInfo, R.reseedPeriod, R.newGenIO
    --  * Info Types
    , R.GenError(..), R.ReseedInfo(..), CipherError(..)
    -- * Asymmetric cryptographic operations
    , buildKeyPair, encryptAsym, decryptAsym
    , C.Signing, C.signingKeyLength, C.verifyingKeyLength, C.verify
    , C.publicKeyLength, C.privateKeyLength, C.buildKeyPairIO
    ) where

import qualified Crypto.Random     as R
import           Crypto.Random     (CryptoRandomGen)
import           Crypto.Types
import qualified Crypto.Classes    as C
import qualified Control.Exception as X
import qualified Data.ByteString   as B
import           Data.Data
import           Data.Typeable

data CipherError = GenError R.GenError
                 | KeyGenFailure
        deriving (Int -> CipherError -> ShowS
[CipherError] -> ShowS
CipherError -> String
(Int -> CipherError -> ShowS)
-> (CipherError -> String)
-> ([CipherError] -> ShowS)
-> Show CipherError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CipherError -> ShowS
showsPrec :: Int -> CipherError -> ShowS
$cshow :: CipherError -> String
show :: CipherError -> String
$cshowList :: [CipherError] -> ShowS
showList :: [CipherError] -> ShowS
Show, ReadPrec [CipherError]
ReadPrec CipherError
Int -> ReadS CipherError
ReadS [CipherError]
(Int -> ReadS CipherError)
-> ReadS [CipherError]
-> ReadPrec CipherError
-> ReadPrec [CipherError]
-> Read CipherError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CipherError
readsPrec :: Int -> ReadS CipherError
$creadList :: ReadS [CipherError]
readList :: ReadS [CipherError]
$creadPrec :: ReadPrec CipherError
readPrec :: ReadPrec CipherError
$creadListPrec :: ReadPrec [CipherError]
readListPrec :: ReadPrec [CipherError]
Read, CipherError -> CipherError -> Bool
(CipherError -> CipherError -> Bool)
-> (CipherError -> CipherError -> Bool) -> Eq CipherError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CipherError -> CipherError -> Bool
== :: CipherError -> CipherError -> Bool
$c/= :: CipherError -> CipherError -> Bool
/= :: CipherError -> CipherError -> Bool
Eq, Eq CipherError
Eq CipherError =>
(CipherError -> CipherError -> Ordering)
-> (CipherError -> CipherError -> Bool)
-> (CipherError -> CipherError -> Bool)
-> (CipherError -> CipherError -> Bool)
-> (CipherError -> CipherError -> Bool)
-> (CipherError -> CipherError -> CipherError)
-> (CipherError -> CipherError -> CipherError)
-> Ord CipherError
CipherError -> CipherError -> Bool
CipherError -> CipherError -> Ordering
CipherError -> CipherError -> CipherError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CipherError -> CipherError -> Ordering
compare :: CipherError -> CipherError -> Ordering
$c< :: CipherError -> CipherError -> Bool
< :: CipherError -> CipherError -> Bool
$c<= :: CipherError -> CipherError -> Bool
<= :: CipherError -> CipherError -> Bool
$c> :: CipherError -> CipherError -> Bool
> :: CipherError -> CipherError -> Bool
$c>= :: CipherError -> CipherError -> Bool
>= :: CipherError -> CipherError -> Bool
$cmax :: CipherError -> CipherError -> CipherError
max :: CipherError -> CipherError -> CipherError
$cmin :: CipherError -> CipherError -> CipherError
min :: CipherError -> CipherError -> CipherError
Ord, Typeable CipherError
Typeable CipherError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CipherError -> c CipherError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CipherError)
-> (CipherError -> Constr)
-> (CipherError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CipherError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CipherError))
-> ((forall b. Data b => b -> b) -> CipherError -> CipherError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CipherError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CipherError -> r)
-> (forall u. (forall d. Data d => d -> u) -> CipherError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CipherError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CipherError -> m CipherError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CipherError -> m CipherError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CipherError -> m CipherError)
-> Data CipherError
CipherError -> Constr
CipherError -> DataType
(forall b. Data b => b -> b) -> CipherError -> CipherError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CipherError -> u
forall u. (forall d. Data d => d -> u) -> CipherError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CipherError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CipherError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CipherError -> m CipherError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CipherError -> m CipherError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CipherError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CipherError -> c CipherError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CipherError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CipherError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CipherError -> c CipherError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CipherError -> c CipherError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CipherError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CipherError
$ctoConstr :: CipherError -> Constr
toConstr :: CipherError -> Constr
$cdataTypeOf :: CipherError -> DataType
dataTypeOf :: CipherError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CipherError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CipherError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CipherError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CipherError)
$cgmapT :: (forall b. Data b => b -> b) -> CipherError -> CipherError
gmapT :: (forall b. Data b => b -> b) -> CipherError -> CipherError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CipherError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CipherError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CipherError -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CipherError -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CipherError -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CipherError -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CipherError -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CipherError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CipherError -> m CipherError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CipherError -> m CipherError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CipherError -> m CipherError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CipherError -> m CipherError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CipherError -> m CipherError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CipherError -> m CipherError
Data, Typeable)

instance X.Exception CipherError

mExcept :: (X.Exception e) => e -> Maybe a -> a
mExcept :: forall e a. Exception e => e -> Maybe a -> a
mExcept e
e = a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> a
forall a e. Exception e => e -> a
X.throw e
e) a -> a
forall a. a -> a
id

eExcept :: (X.Exception e) => Either e a -> a
eExcept :: forall e a. Exception e => Either e a -> a
eExcept = (e -> a) -> (a -> a) -> Either e a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> a
forall a e. Exception e => e -> a
X.throw a -> a
forall a. a -> a
id

-- |Key construction from raw material (typically including key expansion)
--
-- This is a wrapper that can throw a 'CipherError' on exception.
buildKey :: C.BlockCipher k => B.ByteString -> k
buildKey :: forall k. BlockCipher k => ByteString -> k
buildKey = CipherError -> Maybe k -> k
forall e a. Exception e => e -> Maybe a -> a
mExcept CipherError
KeyGenFailure (Maybe k -> k) -> (ByteString -> Maybe k) -> ByteString -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe k
forall k. BlockCipher k => ByteString -> Maybe k
C.buildKey

-- |Random 'IV' generation
--
-- This is a wrapper that can throw a 'GenError' on exception.
getIV :: (C.BlockCipher k, CryptoRandomGen g) => g -> (IV k, g)
getIV :: forall k g. (BlockCipher k, CryptoRandomGen g) => g -> (IV k, g)
getIV = Either GenError (IV k, g) -> (IV k, g)
forall e a. Exception e => Either e a -> a
eExcept (Either GenError (IV k, g) -> (IV k, g))
-> (g -> Either GenError (IV k, g)) -> g -> (IV k, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> Either GenError (IV k, g)
forall k g.
(BlockCipher k, CryptoRandomGen g) =>
g -> Either GenError (IV k, g)
C.getIV

-- |Symmetric key generation
--
-- This is a wrapper that can throw a 'GenError' on exception.
buildKeyGen :: (CryptoRandomGen g, C.BlockCipher k) => g -> (k, g)
buildKeyGen :: forall g k. (CryptoRandomGen g, BlockCipher k) => g -> (k, g)
buildKeyGen = Either GenError (k, g) -> (k, g)
forall e a. Exception e => Either e a -> a
eExcept (Either GenError (k, g) -> (k, g))
-> (g -> Either GenError (k, g)) -> g -> (k, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> Either GenError (k, g)
forall k g.
(BlockCipher k, CryptoRandomGen g) =>
g -> Either GenError (k, g)
C.buildKeyGen

-- |Asymetric key generation
--
-- This is a wrapper that can throw a 'GenError' on exception.
buildKeyPair :: (CryptoRandomGen g, C.AsymCipher p v) => g -> BitLength -> ((p,v), g)
buildKeyPair :: forall g p v.
(CryptoRandomGen g, AsymCipher p v) =>
g -> Int -> ((p, v), g)
buildKeyPair g
g = Either GenError ((p, v), g) -> ((p, v), g)
forall e a. Exception e => Either e a -> a
eExcept (Either GenError ((p, v), g) -> ((p, v), g))
-> (Int -> Either GenError ((p, v), g)) -> Int -> ((p, v), g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> Int -> Either GenError ((p, v), g)
forall g.
CryptoRandomGen g =>
g -> Int -> Either GenError ((p, v), g)
forall p v g.
(AsymCipher p v, CryptoRandomGen g) =>
g -> Int -> Either GenError ((p, v), g)
C.buildKeyPair g
g

-- |Asymmetric encryption
--
-- This is a wrapper that can throw a 'GenError' on exception.
encryptAsym :: (CryptoRandomGen g, C.AsymCipher p v) => g -> p -> B.ByteString -> (B.ByteString, g)
encryptAsym :: forall g p v.
(CryptoRandomGen g, AsymCipher p v) =>
g -> p -> ByteString -> (ByteString, g)
encryptAsym g
g p
p = Either GenError (ByteString, g) -> (ByteString, g)
forall e a. Exception e => Either e a -> a
eExcept (Either GenError (ByteString, g) -> (ByteString, g))
-> (ByteString -> Either GenError (ByteString, g))
-> ByteString
-> (ByteString, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> p -> ByteString -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
g -> p -> ByteString -> Either GenError (ByteString, g)
forall p v g.
(AsymCipher p v, CryptoRandomGen g) =>
g -> p -> ByteString -> Either GenError (ByteString, g)
C.encryptAsym g
g p
p

-- |Asymmetric decryption
--
-- This is a wrapper that can throw a GenError on exception.
decryptAsym :: (CryptoRandomGen g, C.AsymCipher p v) => g -> v -> B.ByteString -> (B.ByteString, g)
decryptAsym :: forall g p v.
(CryptoRandomGen g, AsymCipher p v) =>
g -> v -> ByteString -> (ByteString, g)
decryptAsym g
g v
v = Either GenError (ByteString, g) -> (ByteString, g)
forall e a. Exception e => Either e a -> a
eExcept (Either GenError (ByteString, g) -> (ByteString, g))
-> (ByteString -> Either GenError (ByteString, g))
-> ByteString
-> (ByteString, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> v -> ByteString -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
g -> v -> ByteString -> Either GenError (ByteString, g)
forall p v g.
(AsymCipher p v, CryptoRandomGen g) =>
g -> v -> ByteString -> Either GenError (ByteString, g)
C.decryptAsym g
g v
v

-- |Instantiate a new random bit generator.  The provided
-- bytestring should be of length >= genSeedLength.  If the
-- bytestring is shorter then the call may fail (suggested
-- error: `NotEnoughEntropy`).  If the bytestring is of
-- sufficent length the call should always succeed.
--
-- This is a wrapper that can throw 'GenError' types as exceptions.
newGen :: CryptoRandomGen g => B.ByteString -> g
newGen :: forall g. CryptoRandomGen g => ByteString -> g
newGen = Either GenError g -> g
forall e a. Exception e => Either e a -> a
eExcept (Either GenError g -> g)
-> (ByteString -> Either GenError g) -> ByteString -> g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either GenError g
forall g. CryptoRandomGen g => ByteString -> Either GenError g
R.newGen

-- | @genBytes len g@ generates a random ByteString of length
-- @len@ and new generator.  The 'MonadCryptoRandom' package
-- has routines useful for converting the ByteString to
-- commonly needed values (but 'cereal' or other
-- deserialization libraries would also work).
--
-- This is a wrapper that can throw 'GenError' types as exceptions.
genBytes :: CryptoRandomGen g => ByteLength -> g -> (B.ByteString, g)
genBytes :: forall g. CryptoRandomGen g => Int -> g -> (ByteString, g)
genBytes Int
l = Either GenError (ByteString, g) -> (ByteString, g)
forall e a. Exception e => Either e a -> a
eExcept (Either GenError (ByteString, g) -> (ByteString, g))
-> (g -> Either GenError (ByteString, g)) -> g -> (ByteString, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
R.genBytes Int
l

-- |@genBytesWithEntropy g i entropy@ generates @i@ random bytes and use
-- the additional input @entropy@ in the generation of the requested data
-- to increase the confidence our generated data is a secure random stream.
--
-- This is a wrapper that can throw 'GenError' types as exceptions.
genBytesWithEntropy :: CryptoRandomGen g => ByteLength -> B.ByteString -> g -> (B.ByteString, g)
genBytesWithEntropy :: forall g.
CryptoRandomGen g =>
Int -> ByteString -> g -> (ByteString, g)
genBytesWithEntropy Int
l ByteString
b = Either GenError (ByteString, g) -> (ByteString, g)
forall e a. Exception e => Either e a -> a
eExcept (Either GenError (ByteString, g) -> (ByteString, g))
-> (g -> Either GenError (ByteString, g)) -> g -> (ByteString, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> ByteString -> g -> Either GenError (ByteString, g)
R.genBytesWithEntropy Int
l ByteString
b

-- |If the generator has produced too many random bytes on its existing
-- seed it will throw a `NeedReseed` exception.  In that case, reseed the
-- generator using this function and a new high-entropy seed of length >=
-- `genSeedLength`.  Using bytestrings that are too short can result in an
-- exception (`NotEnoughEntropy`).
reseed :: CryptoRandomGen g => B.ByteString -> g -> g
reseed :: forall g. CryptoRandomGen g => ByteString -> g -> g
reseed ByteString
l = Either GenError g -> g
forall e a. Exception e => Either e a -> a
eExcept (Either GenError g -> g) -> (g -> Either GenError g) -> g -> g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> g -> Either GenError g
forall g. CryptoRandomGen g => ByteString -> g -> Either GenError g
R.reseed ByteString
l

-- | While the safety and wisdom of a splitting function depends on the
-- properties of the generator being split, several arguments from
-- informed people indicate such a function is safe for NIST SP 800-90
-- generators.  (see libraries\@haskell.org discussion around Sept, Oct
-- 2010).  You can find implementations of such generators in the 'DRBG'
-- package.
--
-- This is a wrapper for 'Crypto.Random.splitGen' which throws errors as
-- exceptions.
splitGen :: CryptoRandomGen g => g -> (g,g)
splitGen :: forall g. CryptoRandomGen g => g -> (g, g)
splitGen = Either GenError (g, g) -> (g, g)
forall e a. Exception e => Either e a -> a
eExcept (Either GenError (g, g) -> (g, g))
-> (g -> Either GenError (g, g)) -> g -> (g, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> Either GenError (g, g)
forall g. CryptoRandomGen g => g -> Either GenError (g, g)
R.splitGen