crypto-api-0.13.3: A generic interface for cryptographic operations

Safe HaskellNone
LanguageHaskell98

Crypto.Classes.Exceptions

Contents

Description

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.

Synopsis

Classes

class (Serialize d, Eq d, Ord d) => Hash ctx d | d -> ctx, ctx -> d where Source #

The Hash class is intended as the generic interface targeted by maintainers of Haskell digest implementations. Using this generic interface, higher level functions such as hash and hash' provide a useful API for comsumers of hash implementations.

Any instantiated implementation must handle unaligned data.

Minimum complete definition: outputLength, blockLength, initialCtx, updateCtx, and finalize.

Minimal complete definition

outputLength, blockLength, initialCtx, updateCtx, finalize

Methods

outputLength Source #

Arguments

:: Tagged d BitLength

The size of the digest when encoded

blockLength Source #

Arguments

:: Tagged d BitLength

The amount of data operated on in each round of the digest computation

initialCtx Source #

Arguments

:: ctx

An initial context, provided with the first call to updateCtx

updateCtx Source #

Arguments

:: ctx 
-> ByteString 
-> ctx

Used to update a context, repeatedly called until all data is exhausted must operate correctly for imputs of n*blockLength bytes for n elem [0..]

finalize Source #

Arguments

:: ctx 
-> ByteString 
-> d

Finializing a context, plus any message data less than the block size, into a digest

hash :: Hash ctx d => ByteString -> d Source #

Hash a lazy ByteString, creating a digest

hash' :: Hash ctx d => ByteString -> d Source #

Hash a strict ByteString, creating a digest

class AsymCipher p v | p -> v, v -> p where Source #

Asymetric ciphers (common ones being RSA or EC based)

class CryptoRandomGen g where Source #

A class of random bit generators that allows for the possibility of failure, reseeding, providing entropy at the same time as requesting bytes

Minimum complete definition: newGen, genSeedLength, genBytes, reseed, reseedInfo, reseedPeriod.

Minimal complete definition

newGen, genSeedLength, genBytes, reseedInfo, reseedPeriod, reseed

Methods

genSeedLength :: Tagged g ByteLength Source #

Length of input entropy necessary to instantiate or reseed a generator

reseedInfo :: g -> ReseedInfo Source #

Indicates how soon a reseed is needed

reseedPeriod :: g -> ReseedInfo Source #

Indicates the period between reseeds (constant for most generators).

newGenIO :: IO g Source #

By default this uses System.Entropy to obtain entropy for newGen. WARNING: The default implementation opens a file handle which will never be closed!

class Serialize k => BlockCipher k where Source #

The BlockCipher class is intended as the generic interface targeted by maintainers of Haskell cipher implementations.

Minimum complete definition: blockSize, encryptBlock, decryptBlock, buildKey, and keyLength.

Instances must handle unaligned data

Minimal complete definition

blockSize, encryptBlock, decryptBlock, buildKey, keyLength

Methods

blockSize Source #

Arguments

:: Tagged k BitLength

The size of a single block; the smallest unit on which the cipher operates.

encryptBlock Source #

Arguments

:: k 
-> ByteString 
-> ByteString

encrypt data of size n*blockSize where n elem [0..] (ecb encryption)

decryptBlock Source #

Arguments

:: k 
-> ByteString 
-> ByteString

decrypt data of size n*blockSize where n elem [0..] (ecb decryption)

keyLength Source #

Arguments

:: Tagged k BitLength

length of the cryptographic key

ecb :: k -> ByteString -> ByteString Source #

Electronic Cookbook (encryption)

unEcb :: k -> ByteString -> ByteString Source #

Electronic Cookbook (decryption)

cbc :: k -> IV k -> ByteString -> (ByteString, IV k) Source #

Cipherblock Chaining (encryption)

unCbc :: k -> IV k -> ByteString -> (ByteString, IV k) Source #

Cipherblock Chaining (decryption)

ctr :: k -> IV k -> ByteString -> (ByteString, IV k) Source #

Counter (encryption)

unCtr :: k -> IV k -> ByteString -> (ByteString, IV k) Source #

Counter (decryption)

ctrLazy :: k -> IV k -> ByteString -> (ByteString, IV k) Source #

Counter (encryption)

unCtrLazy :: k -> IV k -> ByteString -> (ByteString, IV k) Source #

Counter (decryption)

cfb :: k -> IV k -> ByteString -> (ByteString, IV k) Source #

Ciphertext feedback (encryption)

unCfb :: k -> IV k -> ByteString -> (ByteString, IV k) Source #

Ciphertext feedback (decryption)

ofb :: k -> IV k -> ByteString -> (ByteString, IV k) Source #

Output feedback (encryption)

unOfb :: k -> IV k -> ByteString -> (ByteString, IV k) Source #

Output feedback (decryption)

cbcLazy :: k -> IV k -> ByteString -> (ByteString, IV k) Source #

Cipher block chaining encryption for lazy bytestrings

unCbcLazy :: k -> IV k -> ByteString -> (ByteString, IV k) Source #

Cipher block chaining decryption for lazy bytestrings

sivLazy :: k -> k -> [ByteString] -> ByteString -> Maybe ByteString Source #

SIV (Synthetic IV) mode for lazy bytestrings. The third argument is the optional list of bytestrings to be authenticated but not encrypted As required by the specification this algorithm may return nothing when certain constraints aren't met.

unSivLazy :: k -> k -> [ByteString] -> ByteString -> Maybe ByteString Source #

SIV (Synthetic IV) for lazy bytestrings. The third argument is the optional list of bytestrings to be authenticated but not encrypted. As required by the specification this algorithm may return nothing when authentication fails.

siv :: k -> k -> [ByteString] -> ByteString -> Maybe ByteString Source #

SIV (Synthetic IV) mode for strict bytestrings. First argument is the optional list of bytestrings to be authenticated but not encrypted. As required by the specification this algorithm may return nothing when certain constraints aren't met.

unSiv :: k -> k -> [ByteString] -> ByteString -> Maybe ByteString Source #

SIV (Synthetic IV) for strict bytestrings First argument is the optional list of bytestrings to be authenticated but not encrypted As required by the specification this algorithm may return nothing when authentication fails.

ecbLazy :: k -> ByteString -> ByteString Source #

Cook book mode - not really a mode at all. If you don't know what you're doing, don't use this mode^H^H^H^H library.

unEcbLazy :: k -> ByteString -> ByteString Source #

ECB decrypt, complementary to ecb.

cfbLazy :: k -> IV k -> ByteString -> (ByteString, IV k) Source #

Ciphertext feed-back encryption mode for lazy bytestrings (with s == blockSize)

unCfbLazy :: k -> IV k -> ByteString -> (ByteString, IV k) Source #

Ciphertext feed-back decryption mode for lazy bytestrings (with s == blockSize)

ofbLazy :: k -> IV k -> ByteString -> (ByteString, IV k) Source #

Output feedback mode for lazy bytestrings

unOfbLazy :: k -> IV k -> ByteString -> (ByteString, IV k) Source #

Output feedback mode for lazy bytestrings

Hashing Operations

hashFunc' :: Hash c d => d -> ByteString -> d Source #

Obtain a strict hash function whose result is the same type as the given digest, which is discarded. If the type is already inferred then consider using the hash' function instead.

hashFunc :: Hash c d => d -> ByteString -> d Source #

Obtain a lazy hash function whose result is the same type as the given digest, which is discarded. If the type is already inferred then consider using the hash function instead.

Symmetric Cryptographic Operations

Helpers

blockSize Source #

Arguments

:: BlockCipher k 
=> Tagged k BitLength

The size of a single block; the smallest unit on which the cipher operates.

blockSizeBytes :: BlockCipher k => Tagged k ByteLength Source #

The number of bytes in a block cipher block

keyLength Source #

Arguments

:: BlockCipher k 
=> Tagged k BitLength

length of the cryptographic key

keyLengthBytes :: BlockCipher k => Tagged k ByteLength Source #

The number of bytes in a block cipher key (assuming it is an even multiple of 8 bits)

incIV :: BlockCipher k => IV k -> IV k Source #

Increase an IV by one. This is way faster than decoding, increasing, encoding

Primitives

encryptBlock Source #

Arguments

:: BlockCipher k 
=> k 
-> ByteString 
-> ByteString

encrypt data of size n*blockSize where n elem [0..] (ecb encryption)

decryptBlock Source #

Arguments

:: BlockCipher k 
=> k 
-> ByteString 
-> ByteString

decrypt data of size n*blockSize where n elem [0..] (ecb decryption)

Key and IV construction

buildKey :: BlockCipher k => ByteString -> k Source #

Key construction from raw material (typically including key expansion)

This is a wrapper that can throw a CipherError on exception.

buildKeyIO :: BlockCipher k => IO k Source #

Build a symmetric key using the system entropy (see Entropy)

buildKeyGen :: (CryptoRandomGen g, BlockCipher k) => g -> (k, g) Source #

Symmetric key generation

This is a wrapper that can throw a GenError on exception.

getIV :: (BlockCipher k, CryptoRandomGen g) => g -> (IV k, g) Source #

Random IV generation

This is a wrapper that can throw a GenError on exception.

getIVIO :: BlockCipher k => IO (IV k) Source #

Obtain an IV using the system entropy (see Entropy)

zeroIV :: BlockCipher k => IV k Source #

Obtain an IV made only of zeroes

Block Cipher Modes of Operation

ecb :: BlockCipher k => k -> ByteString -> ByteString Source #

Electronic Cookbook (encryption)

unEcb :: BlockCipher k => k -> ByteString -> ByteString Source #

Electronic Cookbook (decryption)

cbc :: BlockCipher k => k -> IV k -> ByteString -> (ByteString, IV k) Source #

Cipherblock Chaining (encryption)

unCbc :: BlockCipher k => k -> IV k -> ByteString -> (ByteString, IV k) Source #

Cipherblock Chaining (decryption)

ctr :: BlockCipher k => k -> IV k -> ByteString -> (ByteString, IV k) Source #

Counter (encryption)

unCtr :: BlockCipher k => k -> IV k -> ByteString -> (ByteString, IV k) Source #

Counter (decryption)

ctrLazy :: BlockCipher k => k -> IV k -> ByteString -> (ByteString, IV k) Source #

Counter (encryption)

unCtrLazy :: BlockCipher k => k -> IV k -> ByteString -> (ByteString, IV k) Source #

Counter (decryption)

cfb :: BlockCipher k => k -> IV k -> ByteString -> (ByteString, IV k) Source #

Ciphertext feedback (encryption)

unCfb :: BlockCipher k => k -> IV k -> ByteString -> (ByteString, IV k) Source #

Ciphertext feedback (decryption)

ofb :: BlockCipher k => k -> IV k -> ByteString -> (ByteString, IV k) Source #

Output feedback (encryption)

unOfb :: BlockCipher k => k -> IV k -> ByteString -> (ByteString, IV k) Source #

Output feedback (decryption)

cbcLazy :: BlockCipher k => k -> IV k -> ByteString -> (ByteString, IV k) Source #

Cipher block chaining encryption for lazy bytestrings

unCbcLazy :: BlockCipher k => k -> IV k -> ByteString -> (ByteString, IV k) Source #

Cipher block chaining decryption for lazy bytestrings

sivLazy :: BlockCipher k => k -> k -> [ByteString] -> ByteString -> Maybe ByteString Source #

SIV (Synthetic IV) mode for lazy bytestrings. The third argument is the optional list of bytestrings to be authenticated but not encrypted As required by the specification this algorithm may return nothing when certain constraints aren't met.

unSivLazy :: BlockCipher k => k -> k -> [ByteString] -> ByteString -> Maybe ByteString Source #

SIV (Synthetic IV) for lazy bytestrings. The third argument is the optional list of bytestrings to be authenticated but not encrypted. As required by the specification this algorithm may return nothing when authentication fails.

siv :: BlockCipher k => k -> k -> [ByteString] -> ByteString -> Maybe ByteString Source #

SIV (Synthetic IV) mode for strict bytestrings. First argument is the optional list of bytestrings to be authenticated but not encrypted. As required by the specification this algorithm may return nothing when certain constraints aren't met.

unSiv :: BlockCipher k => k -> k -> [ByteString] -> ByteString -> Maybe ByteString Source #

SIV (Synthetic IV) for strict bytestrings First argument is the optional list of bytestrings to be authenticated but not encrypted As required by the specification this algorithm may return nothing when authentication fails.

ecbLazy :: BlockCipher k => k -> ByteString -> ByteString Source #

Cook book mode - not really a mode at all. If you don't know what you're doing, don't use this mode^H^H^H^H library.

unEcbLazy :: BlockCipher k => k -> ByteString -> ByteString Source #

ECB decrypt, complementary to ecb.

cfbLazy :: BlockCipher k => k -> IV k -> ByteString -> (ByteString, IV k) Source #

Ciphertext feed-back encryption mode for lazy bytestrings (with s == blockSize)

unCfbLazy :: BlockCipher k => k -> IV k -> ByteString -> (ByteString, IV k) Source #

Ciphertext feed-back decryption mode for lazy bytestrings (with s == blockSize)

ofbLazy :: BlockCipher k => k -> IV k -> ByteString -> (ByteString, IV k) Source #

Output feedback mode for lazy bytestrings

unOfbLazy :: BlockCipher k => k -> IV k -> ByteString -> (ByteString, IV k) Source #

Output feedback mode for lazy bytestrings

RNG Operations

newGen :: CryptoRandomGen g => ByteString -> g Source #

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.

genBytes :: CryptoRandomGen g => ByteLength -> g -> (ByteString, g) Source #

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.

genBytesWithEntropy :: CryptoRandomGen g => ByteLength -> ByteString -> g -> (ByteString, g) Source #

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.

reseed :: CryptoRandomGen g => ByteString -> g -> g Source #

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).

splitGen :: CryptoRandomGen g => g -> (g, g) Source #

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 splitGen which throws errors as exceptions.

genSeedLength :: CryptoRandomGen g => Tagged g ByteLength Source #

Length of input entropy necessary to instantiate or reseed a generator

reseedInfo :: CryptoRandomGen g => g -> ReseedInfo Source #

Indicates how soon a reseed is needed

reseedPeriod :: CryptoRandomGen g => g -> ReseedInfo Source #

Indicates the period between reseeds (constant for most generators).

newGenIO :: CryptoRandomGen g => IO g Source #

By default this uses System.Entropy to obtain entropy for newGen. WARNING: The default implementation opens a file handle which will never be closed!

data GenError Source #

Generator failures should always return the appropriate GenError. Note GenError in an instance of exception but wether or not an exception is thrown depends on if the selected generator (read: if you don't want execptions from code that uses throw then pass in a generator that never has an error for the used functions)

Constructors

GenErrorOther String

Misc

RequestedTooManyBytes

Requested more bytes than a single pass can generate (The maximum request is generator dependent)

RangeInvalid

When using genInteger g (l,h) and logBase 2 (h - l) > (maxBound :: Int).

NeedReseed

Some generators cease operation after too high a count without a reseed (ex: NIST SP 800-90)

NotEnoughEntropy

For instantiating new generators (or reseeding)

NeedsInfiniteSeed

This generator can not be instantiated or reseeded with a finite seed (ex: SystemRandom)

Instances

Eq GenError Source # 
Data GenError Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> GenError -> c GenError #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c GenError #

toConstr :: GenError -> Constr #

dataTypeOf :: GenError -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c GenError) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GenError) #

gmapT :: (forall b. Data b => b -> b) -> GenError -> GenError #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> GenError -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> GenError -> r #

gmapQ :: (forall d. Data d => d -> u) -> GenError -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> GenError -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> GenError -> m GenError #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> GenError -> m GenError #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> GenError -> m GenError #

Ord GenError Source # 
Read GenError Source # 
Show GenError Source # 
Exception GenError Source # 

data ReseedInfo Source #

Constructors

InXBytes !Word64

Generator needs reseeded in X bytes

InXCalls !Word64

Generator needs reseeded in X calls

NotSoon

The bound is over 2^64 bytes or calls

Never

This generator never reseeds (ex: SystemRandom)

Instances

Eq ReseedInfo Source # 
Data ReseedInfo Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ReseedInfo -> c ReseedInfo #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ReseedInfo #

toConstr :: ReseedInfo -> Constr #

dataTypeOf :: ReseedInfo -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c ReseedInfo) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ReseedInfo) #

gmapT :: (forall b. Data b => b -> b) -> ReseedInfo -> ReseedInfo #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ReseedInfo -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ReseedInfo -> r #

gmapQ :: (forall d. Data d => d -> u) -> ReseedInfo -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> ReseedInfo -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> ReseedInfo -> m ReseedInfo #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ReseedInfo -> m ReseedInfo #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ReseedInfo -> m ReseedInfo #

Ord ReseedInfo Source # 
Read ReseedInfo Source # 
Show ReseedInfo Source # 

data CipherError Source #

Instances

Eq CipherError Source # 
Data CipherError Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> CipherError -> c CipherError #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c CipherError #

toConstr :: CipherError -> Constr #

dataTypeOf :: CipherError -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c CipherError) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CipherError) #

gmapT :: (forall b. Data b => b -> b) -> CipherError -> CipherError #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CipherError -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CipherError -> r #

gmapQ :: (forall d. Data d => d -> u) -> CipherError -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> CipherError -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> CipherError -> m CipherError #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> CipherError -> m CipherError #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> CipherError -> m CipherError #

Ord CipherError Source # 
Read CipherError Source # 
Show CipherError Source # 
Exception CipherError Source # 

Asymmetric cryptographic operations

buildKeyPair :: (CryptoRandomGen g, AsymCipher p v) => g -> BitLength -> ((p, v), g) Source #

Asymetric key generation

This is a wrapper that can throw a GenError on exception.

encryptAsym :: (CryptoRandomGen g, AsymCipher p v) => g -> p -> ByteString -> (ByteString, g) Source #

Asymmetric encryption

This is a wrapper that can throw a GenError on exception.

decryptAsym :: (CryptoRandomGen g, AsymCipher p v) => g -> v -> ByteString -> (ByteString, g) Source #

Asymmetric decryption

This is a wrapper that can throw a GenError on exception.

class (Serialize p, Serialize v) => Signing p v | p -> v, v -> p where Source #

A class for signing operations which inherently can not be as generic as asymetric ciphers (ex: DSA).

buildKeyPairIO :: AsymCipher p v => BitLength -> IO (Either GenError (p, v)) Source #

Build a pair of asymmetric keys using the system random generator. WARNING: This function opens a file handle which will never be closed!