-- |
-- Module      : Crypto.Store.CMS.Algorithms
-- License     : BSD-style
-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
-- Cryptographic Message Syntax algorithms
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Crypto.Store.CMS.Algorithms
    ( DigestAlgorithm(..)
    , DigestProxy(..)
    , digest
    , MessageAuthenticationCode
    , MACAlgorithm(..)
    , mac
    , HasStrength
    , securityAcceptable
    , HasKeySize(..)
    , getMaximumKeySize
    , validateKeySize
    , generateKey
    , ContentEncryptionCipher(..)
    , ContentEncryptionAlg(..)
    , ContentEncryptionParams(..)
    , generateEncryptionParams
    , generateRC2EncryptionParams
    , getContentEncryptionAlg
    , proxyBlockSize
    , contentEncrypt
    , contentDecrypt
    , AuthContentEncryptionAlg(..)
    , AuthContentEncryptionParams
    , generateAuthEnc128Params
    , generateAuthEnc256Params
    , generateChaChaPoly1305Params
    , generateCCMParams
    , generateGCMParams
    , authContentEncrypt
    , authContentDecrypt
    , PBKDF2_PRF(..)
    , prf
    , Salt
    , generateSalt
    , KeyDerivationFunc(..)
    , kdfKeyLength
    , kdfDerive
    , KeyEncryptionParams(..)
    , keyEncrypt
    , keyDecrypt
    , OAEPParams(..)
    , KeyTransportParams(..)
    , transportEncrypt
    , transportDecrypt
    , KeyAgreementParams(..)
    , ECDHPair
    , ecdhGenerate
    , ecdhPublic
    , ecdhEncrypt
    , ecdhDecrypt
    , MaskGenerationFunc(..)
    , mgf
    , SignatureValue
    , PSSParams(..)
    , SignatureAlg(..)
    , signatureResolveHash
    , signatureCheckHash
    , signatureGenerate
    , signatureVerify
    ) where

import Control.Applicative
import Control.Monad (guard, when)

import           Data.ASN1.BinaryEncoding
import           Data.ASN1.OID
import           Data.ASN1.Encoding
import           Data.ASN1.Types
import           Data.Bits
import           Data.ByteArray (ByteArray, ByteArrayAccess)
import qualified Data.ByteArray as B
import           Data.ByteString (ByteString)
import           Data.Maybe (fromMaybe)
import           Data.Proxy
import           Data.Word
import qualified Data.X509 as X509
import           Data.X509.EC

import GHC.TypeLits

import qualified Crypto.Cipher.AES as Cipher
import qualified Crypto.Cipher.CAST5 as Cipher
import qualified Crypto.Cipher.Camellia as Cipher
import qualified Crypto.Cipher.ChaChaPoly1305 as ChaChaPoly1305
import qualified Crypto.Cipher.DES as Cipher
import qualified Crypto.Cipher.TripleDES as Cipher
import           Crypto.Cipher.Types
import           Crypto.Data.Padding
import           Crypto.ECC (Curve_X25519, Curve_X448, ecdh)
import           Crypto.Error
import qualified Crypto.Hash as Hash
import qualified Crypto.KDF.PBKDF2 as PBKDF2
import qualified Crypto.KDF.Scrypt as Scrypt
import qualified Crypto.MAC.HMAC as HMAC
import qualified Crypto.MAC.Poly1305 as Poly1305
import           Crypto.Number.Serialize
import qualified Crypto.PubKey.Curve25519 as X25519
import qualified Crypto.PubKey.Curve448 as X448
import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.ECC.DH as ECDH
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.ECC.Types as ECC
import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Crypto.PubKey.Ed448 as Ed448
import qualified Crypto.PubKey.MaskGenFunction as MGF
import qualified Crypto.PubKey.RSA.PSS as RSAPSS
import qualified Crypto.PubKey.RSA.OAEP as RSAOAEP
import qualified Crypto.PubKey.RSA.PKCS15 as RSA
import           Crypto.Random

import Foreign.Ptr (Ptr)
import Foreign.Storable

import           Crypto.Store.ASN1.Generate
import           Crypto.Store.ASN1.Parse
import           Crypto.Store.CMS.Util
import           Crypto.Store.Cipher.RC2
import           Crypto.Store.Error
import qualified Crypto.Store.KeyWrap.AES as AES_KW
import qualified Crypto.Store.KeyWrap.TripleDES as TripleDES_KW
import qualified Crypto.Store.KeyWrap.RC2 as RC2_KW
import           Crypto.Store.PKCS8.EC
import           Crypto.Store.Util


-- Hash functions

-- | CMS digest proxy.  Acts like 'Data.Proxy.Proxy', i.e. provides a hash
-- algorithm as type parameter.  The GADT constructors map to known algorithms.
data DigestProxy hashAlg where
    -- | MD2
    MD2    :: DigestProxy Hash.MD2
    -- | MD4
    MD4    :: DigestProxy Hash.MD4
    -- | MD5
    MD5    :: DigestProxy Hash.MD5
    -- | SHA-1
    SHA1   :: DigestProxy Hash.SHA1
    -- | SHA-224
    SHA224 :: DigestProxy Hash.SHA224
    -- | SHA-256
    SHA256 :: DigestProxy Hash.SHA256
    -- | SHA-384
    SHA384 :: DigestProxy Hash.SHA384
    -- | SHA-512
    SHA512 :: DigestProxy Hash.SHA512
    -- | SHAKE128 (256 bits)
    SHAKE128_256 :: DigestProxy (Hash.SHAKE128 256)
    -- | SHAKE256 (512 bits)
    SHAKE256_512 :: DigestProxy (Hash.SHAKE256 512)
    -- | SHAKE128 (variable size)
    SHAKE128 :: KnownNat n => Proxy n -> DigestProxy (Hash.SHAKE128 n)
    -- | SHAKE256 (variable size)
    SHAKE256 :: KnownNat n => Proxy n -> DigestProxy (Hash.SHAKE256 n)

deriving instance Show (DigestProxy hashAlg)
deriving instance Eq (DigestProxy hashAlg)

instance HasStrength (DigestProxy hashAlg) where
    getSecurityBits :: DigestProxy hashAlg -> Int
getSecurityBits DigestProxy hashAlg
MD2          = Int
64
    getSecurityBits DigestProxy hashAlg
MD4          = Int
64
    getSecurityBits DigestProxy hashAlg
MD5          = Int
64
    getSecurityBits DigestProxy hashAlg
SHA1         = Int
80
    getSecurityBits DigestProxy hashAlg
SHA224       = Int
112
    getSecurityBits DigestProxy hashAlg
SHA256       = Int
128
    getSecurityBits DigestProxy hashAlg
SHA384       = Int
192
    getSecurityBits DigestProxy hashAlg
SHA512       = Int
256
    getSecurityBits DigestProxy hashAlg
SHAKE128_256 = Int
128
    getSecurityBits DigestProxy hashAlg
SHAKE256_512 = Int
256
    getSecurityBits (SHAKE128 Proxy n
a) = forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
Int -> proxy n -> Int
shakeSecurityBits Int
128 Proxy n
a
    getSecurityBits (SHAKE256 Proxy n
a) = forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
Int -> proxy n -> Int
shakeSecurityBits Int
256 Proxy n
a

shakeSecurityBits :: KnownNat n => Int -> proxy n -> Int
shakeSecurityBits :: forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
Int -> proxy n -> Int
shakeSecurityBits Int
m proxy n
a = forall a. Ord a => a -> a -> a
min Int
m (forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal proxy n
a) forall a. Integral a => a -> a -> a
`div` Int
2)

-- | CMS digest algorithm.
data DigestAlgorithm =
    forall hashAlg . Hash.HashAlgorithm hashAlg
        => DigestAlgorithm (DigestProxy hashAlg)

instance Show DigestAlgorithm where
    show :: DigestAlgorithm -> String
show (DigestAlgorithm DigestProxy hashAlg
a) = forall a. Show a => a -> String
show DigestProxy hashAlg
a

instance Eq DigestAlgorithm where
    DigestAlgorithm DigestProxy hashAlg
MD2          == :: DigestAlgorithm -> DigestAlgorithm -> Bool
== DigestAlgorithm DigestProxy hashAlg
MD2          = Bool
True
    DigestAlgorithm DigestProxy hashAlg
MD4          == DigestAlgorithm DigestProxy hashAlg
MD4          = Bool
True
    DigestAlgorithm DigestProxy hashAlg
MD5          == DigestAlgorithm DigestProxy hashAlg
MD5          = Bool
True
    DigestAlgorithm DigestProxy hashAlg
SHA1         == DigestAlgorithm DigestProxy hashAlg
SHA1         = Bool
True
    DigestAlgorithm DigestProxy hashAlg
SHA224       == DigestAlgorithm DigestProxy hashAlg
SHA224       = Bool
True
    DigestAlgorithm DigestProxy hashAlg
SHA256       == DigestAlgorithm DigestProxy hashAlg
SHA256       = Bool
True
    DigestAlgorithm DigestProxy hashAlg
SHA384       == DigestAlgorithm DigestProxy hashAlg
SHA384       = Bool
True
    DigestAlgorithm DigestProxy hashAlg
SHA512       == DigestAlgorithm DigestProxy hashAlg
SHA512       = Bool
True
    DigestAlgorithm DigestProxy hashAlg
SHAKE128_256 == DigestAlgorithm DigestProxy hashAlg
SHAKE128_256 = Bool
True
    DigestAlgorithm DigestProxy hashAlg
SHAKE256_512 == DigestAlgorithm DigestProxy hashAlg
SHAKE256_512 = Bool
True
    DigestAlgorithm (SHAKE128 Proxy n
a) == DigestAlgorithm (SHAKE128 Proxy n
b) = forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy n
a forall a. Eq a => a -> a -> Bool
== forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy n
b
    DigestAlgorithm (SHAKE256 Proxy n
a) == DigestAlgorithm (SHAKE256 Proxy n
b) = forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy n
a forall a. Eq a => a -> a -> Bool
== forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy n
b
    DigestAlgorithm
_                            == DigestAlgorithm
_                            = Bool
False

instance HasStrength DigestAlgorithm where
    getSecurityBits :: DigestAlgorithm -> Int
getSecurityBits (DigestAlgorithm DigestProxy hashAlg
a) = forall params. HasStrength params => params -> Int
getSecurityBits DigestProxy hashAlg
a

data DigestType
    = Type_MD2
    | Type_MD4
    | Type_MD5
    | Type_SHA1
    | Type_SHA224
    | Type_SHA256
    | Type_SHA384
    | Type_SHA512
    | Type_SHAKE128_256
    | Type_SHAKE256_512
    | Type_SHAKE128_Len
    | Type_SHAKE256_Len

instance Enumerable DigestType where
    values :: [DigestType]
values = [ DigestType
Type_MD2
             , DigestType
Type_MD4
             , DigestType
Type_MD5
             , DigestType
Type_SHA1
             , DigestType
Type_SHA224
             , DigestType
Type_SHA256
             , DigestType
Type_SHA384
             , DigestType
Type_SHA512
             , DigestType
Type_SHAKE128_256
             , DigestType
Type_SHAKE256_512
             , DigestType
Type_SHAKE128_Len
             , DigestType
Type_SHAKE256_Len
             ]

instance OIDable DigestType where
    getObjectID :: DigestType -> OID
getObjectID DigestType
Type_MD2          = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
2,Integer
2]
    getObjectID DigestType
Type_MD4          = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
2,Integer
4]
    getObjectID DigestType
Type_MD5          = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
2,Integer
5]
    getObjectID DigestType
Type_SHA1         = [Integer
1,Integer
3,Integer
14,Integer
3,Integer
2,Integer
26]
    getObjectID DigestType
Type_SHA224       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
2,Integer
4]
    getObjectID DigestType
Type_SHA256       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
2,Integer
1]
    getObjectID DigestType
Type_SHA384       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
2,Integer
2]
    getObjectID DigestType
Type_SHA512       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
2,Integer
3]
    getObjectID DigestType
Type_SHAKE128_256 = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
2,Integer
11]
    getObjectID DigestType
Type_SHAKE256_512 = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
2,Integer
12]
    getObjectID DigestType
Type_SHAKE128_Len = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
2,Integer
17]
    getObjectID DigestType
Type_SHAKE256_Len = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
2,Integer
18]

instance OIDNameable DigestType where
    fromObjectID :: OID -> Maybe DigestType
fromObjectID OID
oid = forall a. OIDNameableWrapper a -> a
unOIDNW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid

instance AlgorithmId DigestAlgorithm where
    type AlgorithmType DigestAlgorithm = DigestType
    algorithmName :: DigestAlgorithm -> String
algorithmName DigestAlgorithm
_  = String
"digest algorithm"

    algorithmType :: DigestAlgorithm -> AlgorithmType DigestAlgorithm
algorithmType (DigestAlgorithm DigestProxy hashAlg
MD2)          = DigestType
Type_MD2
    algorithmType (DigestAlgorithm DigestProxy hashAlg
MD4)          = DigestType
Type_MD4
    algorithmType (DigestAlgorithm DigestProxy hashAlg
MD5)          = DigestType
Type_MD5
    algorithmType (DigestAlgorithm DigestProxy hashAlg
SHA1)         = DigestType
Type_SHA1
    algorithmType (DigestAlgorithm DigestProxy hashAlg
SHA224)       = DigestType
Type_SHA224
    algorithmType (DigestAlgorithm DigestProxy hashAlg
SHA256)       = DigestType
Type_SHA256
    algorithmType (DigestAlgorithm DigestProxy hashAlg
SHA384)       = DigestType
Type_SHA384
    algorithmType (DigestAlgorithm DigestProxy hashAlg
SHA512)       = DigestType
Type_SHA512
    algorithmType (DigestAlgorithm DigestProxy hashAlg
SHAKE128_256) = DigestType
Type_SHAKE128_256
    algorithmType (DigestAlgorithm DigestProxy hashAlg
SHAKE256_512) = DigestType
Type_SHAKE256_512
    algorithmType (DigestAlgorithm (SHAKE128 Proxy n
_)) = DigestType
Type_SHAKE128_Len
    algorithmType (DigestAlgorithm (SHAKE256 Proxy n
_)) = DigestType
Type_SHAKE256_Len

    -- MD5 has NULL parameter, SHAKE128 and SHAKE256 have the bitsize as
    -- parameter, other algorithms have no parameter
    parameterASN1S :: forall e. ASN1Elem e => DigestAlgorithm -> ASN1Stream e
parameterASN1S (DigestAlgorithm DigestProxy hashAlg
MD5)          = forall e. ASN1Elem e => ASN1Stream e
gNull
    parameterASN1S (DigestAlgorithm (SHAKE128 Proxy n
n)) = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy n
n)
    parameterASN1S (DigestAlgorithm (SHAKE256 Proxy n
n)) = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy n
n)
    parameterASN1S DigestAlgorithm
_                              = forall a. a -> a
id

    parseParameter :: forall e.
Monoid e =>
AlgorithmType DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseParameter AlgorithmType DigestAlgorithm
DigestType
Type_MD2          = forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy MD2
MD2)
    parseParameter AlgorithmType DigestAlgorithm
DigestType
Type_MD4          = forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy MD4
MD4)
    parseParameter AlgorithmType DigestAlgorithm
DigestType
Type_MD5          = forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy MD5
MD5)
    parseParameter AlgorithmType DigestAlgorithm
DigestType
Type_SHA1         = forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1)
    parseParameter AlgorithmType DigestAlgorithm
DigestType
Type_SHA224       = forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA224
SHA224)
    parseParameter AlgorithmType DigestAlgorithm
DigestType
Type_SHA256       = forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA256
SHA256)
    parseParameter AlgorithmType DigestAlgorithm
DigestType
Type_SHA384       = forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA384
SHA384)
    parseParameter AlgorithmType DigestAlgorithm
DigestType
Type_SHA512       = forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA512
SHA512)
    parseParameter AlgorithmType DigestAlgorithm
DigestType
Type_SHAKE128_256 = forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy (SHAKE128 256)
SHAKE128_256)
    parseParameter AlgorithmType DigestAlgorithm
DigestType
Type_SHAKE256_512 = forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy (SHAKE256 512)
SHAKE256_512)
    parseParameter AlgorithmType DigestAlgorithm
DigestType
Type_SHAKE128_Len = forall e a. Monoid e => (SomeNat -> a) -> ParseASN1 e a
parseBitLen forall a b. (a -> b) -> a -> b
$
        \(SomeNat Proxy n
p) -> forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm (forall (n :: Nat).
KnownNat n =>
Proxy n -> DigestProxy (SHAKE128 n)
SHAKE128 Proxy n
p)
    parseParameter AlgorithmType DigestAlgorithm
DigestType
Type_SHAKE256_Len = forall e a. Monoid e => (SomeNat -> a) -> ParseASN1 e a
parseBitLen forall a b. (a -> b) -> a -> b
$
        \(SomeNat Proxy n
p) -> forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm (forall (n :: Nat).
KnownNat n =>
Proxy n -> DigestProxy (SHAKE256 n)
SHAKE256 Proxy n
p)

-- | Compute the digest of a message.
digest :: ByteArrayAccess message => DigestAlgorithm -> message -> ByteString
digest :: forall message.
ByteArrayAccess message =>
DigestAlgorithm -> message -> ByteString
digest (DigestAlgorithm DigestProxy hashAlg
hashAlg) message
message = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (forall hashAlg ba (proxy :: * -> *).
(HashAlgorithm hashAlg, ByteArrayAccess ba) =>
proxy hashAlg -> ba -> Digest hashAlg
doHash DigestProxy hashAlg
hashAlg message
message)

doHash :: (Hash.HashAlgorithm hashAlg, ByteArrayAccess ba)
       => proxy hashAlg -> ba -> Hash.Digest hashAlg
doHash :: forall hashAlg ba (proxy :: * -> *).
(HashAlgorithm hashAlg, ByteArrayAccess ba) =>
proxy hashAlg -> ba -> Digest hashAlg
doHash proxy hashAlg
_ = forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Hash.hash

hashFromProxy :: proxy a -> a
hashFromProxy :: forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy proxy a
_ = forall a. HasCallStack => a
undefined

parseDigestParam :: Monoid e => DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam :: forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam DigestAlgorithm
p = forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe ()
nullOrNothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return DigestAlgorithm
p

parseBitLen :: Monoid e => (SomeNat -> a) -> ParseASN1 e a
parseBitLen :: forall e a. Monoid e => (SomeNat -> a) -> ParseASN1 e a
parseBitLen SomeNat -> a
build = do
    IntVal Integer
n <- forall e. Monoid e => ParseASN1 e ASN1
getNext
    case Integer -> Maybe SomeNat
someNatVal Integer
n of
        Maybe SomeNat
Nothing -> forall e a. String -> ParseASN1 e a
throwParseError (String
"Invalid bit length: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
n)
        Just SomeNat
sn -> forall (m :: * -> *) a. Monad m => a -> m a
return (SomeNat -> a
build SomeNat
sn)

p512 :: Proxy 512
p512 :: Proxy 512
p512 = forall {k} (t :: k). Proxy t
Proxy


-- Security strength

-- | Algorithms with known security strength.
class HasStrength params where
    -- | Get security strength in bits.
    --
    -- This returns the strength for which the algorithm was designed.
    -- Algorithms with weaknesses have an effective strength lower than the
    -- returned value.
    getSecurityBits :: params -> Int

-- | Whether the algorithm has acceptable security.  The goal is to eliminate
-- variable-length algorithms, like SHAKE with 1-byte output, that would make
-- strength lower than the weakest fixed-length algorithm.
securityAcceptable :: HasStrength params => params -> Bool
securityAcceptable :: forall params. HasStrength params => params -> Bool
securityAcceptable = (forall a. Ord a => a -> a -> Bool
>= Int
64) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall params. HasStrength params => params -> Int
getSecurityBits


-- Cipher-like things

-- | Algorithms that are based on a secret key.  This includes ciphers but also
-- MAC algorithms.
class HasKeySize params where
    -- | Get a specification of the key sizes allowed by the algorithm.
    getKeySizeSpecifier :: params -> KeySizeSpecifier

-- | Return the maximum key size for the specified algorithm.
getMaximumKeySize :: HasKeySize params => params -> Int
getMaximumKeySize :: forall params. HasKeySize params => params -> Int
getMaximumKeySize params
params =
    case forall params. HasKeySize params => params -> KeySizeSpecifier
getKeySizeSpecifier params
params of
        KeySizeRange Int
_ Int
n -> Int
n
        KeySizeEnum  [Int]
l   -> forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
l
        KeySizeFixed Int
n   -> Int
n

-- | Return 'True' if the specified key size is valid for the specified
-- algorithm.
validateKeySize :: HasKeySize params => params -> Int -> Bool
validateKeySize :: forall params. HasKeySize params => params -> Int -> Bool
validateKeySize params
params Int
len =
    case forall params. HasKeySize params => params -> KeySizeSpecifier
getKeySizeSpecifier params
params of
        KeySizeRange Int
a Int
b -> Int
a forall a. Ord a => a -> a -> Bool
<= Int
len Bool -> Bool -> Bool
&& Int
len forall a. Ord a => a -> a -> Bool
<= Int
b
        KeySizeEnum  [Int]
l   -> Int
len forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
l
        KeySizeFixed Int
n   -> Int
len forall a. Eq a => a -> a -> Bool
== Int
n

-- | Generate a random key suitable for the specified algorithm.  This uses the
-- maximum size allowed by the parameters.
generateKey :: (HasKeySize params, MonadRandom m, ByteArray key)
            => params -> m key
generateKey :: forall params (m :: * -> *) key.
(HasKeySize params, MonadRandom m, ByteArray key) =>
params -> m key
generateKey params
params = forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes (forall params. HasKeySize params => params -> Int
getMaximumKeySize params
params)


-- MAC

-- | Message authentication code.  Equality is time constant.
type MessageAuthenticationCode = AuthTag

-- | Message Authentication Code (MAC) Algorithm.
data MACAlgorithm
    = forall hashAlg . Hash.HashAlgorithm hashAlg
        => HMAC (DigestProxy hashAlg)

deriving instance Show MACAlgorithm

instance Eq MACAlgorithm where
    HMAC DigestProxy hashAlg
a1 == :: MACAlgorithm -> MACAlgorithm -> Bool
== HMAC DigestProxy hashAlg
a2 = forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy hashAlg
a1 forall a. Eq a => a -> a -> Bool
== forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy hashAlg
a2

instance HasStrength MACAlgorithm where
    getSecurityBits :: MACAlgorithm -> Int
getSecurityBits (HMAC DigestProxy hashAlg
a) = forall params. HasStrength params => params -> Int
getSecurityBits (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy hashAlg
a)

instance Enumerable MACAlgorithm where
    values :: [MACAlgorithm]
values = [ forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> MACAlgorithm
HMAC DigestProxy MD5
MD5
             , forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> MACAlgorithm
HMAC DigestProxy SHA1
SHA1
             , forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> MACAlgorithm
HMAC DigestProxy SHA224
SHA224
             , forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> MACAlgorithm
HMAC DigestProxy SHA256
SHA256
             , forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> MACAlgorithm
HMAC DigestProxy SHA384
SHA384
             , forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> MACAlgorithm
HMAC DigestProxy SHA512
SHA512
             ]

instance OIDable MACAlgorithm where
    getObjectID :: MACAlgorithm -> OID
getObjectID (HMAC DigestProxy hashAlg
MD5)    = [Integer
1,Integer
3,Integer
6,Integer
1,Integer
5,Integer
5,Integer
8,Integer
1,Integer
1]
    getObjectID (HMAC DigestProxy hashAlg
SHA1)   = [Integer
1,Integer
3,Integer
6,Integer
1,Integer
5,Integer
5,Integer
8,Integer
1,Integer
2]
    getObjectID (HMAC DigestProxy hashAlg
SHA224) = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
2,Integer
8]
    getObjectID (HMAC DigestProxy hashAlg
SHA256) = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
2,Integer
9]
    getObjectID (HMAC DigestProxy hashAlg
SHA384) = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
2,Integer
10]
    getObjectID (HMAC DigestProxy hashAlg
SHA512) = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
2,Integer
11]

    getObjectID MACAlgorithm
ty = forall a. HasCallStack => String -> a
error (String
"Unsupported MACAlgorithm: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show MACAlgorithm
ty)

instance OIDNameable MACAlgorithm where
    fromObjectID :: OID -> Maybe MACAlgorithm
fromObjectID OID
oid = forall a. OIDNameableWrapper a -> a
unOIDNW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid

instance AlgorithmId MACAlgorithm where
    type AlgorithmType MACAlgorithm = MACAlgorithm
    algorithmName :: MACAlgorithm -> String
algorithmName MACAlgorithm
_  = String
"mac algorithm"
    algorithmType :: MACAlgorithm -> AlgorithmType MACAlgorithm
algorithmType    = forall a. a -> a
id
    parameterASN1S :: forall e. ASN1Elem e => MACAlgorithm -> ASN1Stream e
parameterASN1S MACAlgorithm
_ = forall a. a -> a
id
    parseParameter :: forall e.
Monoid e =>
AlgorithmType MACAlgorithm -> ParseASN1 e MACAlgorithm
parseParameter AlgorithmType MACAlgorithm
p = forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe ()
nullOrNothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return AlgorithmType MACAlgorithm
p

instance HasKeySize MACAlgorithm where
    getKeySizeSpecifier :: MACAlgorithm -> KeySizeSpecifier
getKeySizeSpecifier (HMAC DigestProxy hashAlg
a) = Int -> KeySizeSpecifier
KeySizeFixed (forall {proxy :: * -> *}. proxy hashAlg -> Int
digestSizeFromProxy DigestProxy hashAlg
a)
      where digestSizeFromProxy :: proxy hashAlg -> Int
digestSizeFromProxy = forall a. HashAlgorithm a => a -> Int
Hash.hashDigestSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy

-- | Invoke the MAC function.
mac :: (ByteArrayAccess key, ByteArrayAccess message)
     => MACAlgorithm -> key -> message -> MessageAuthenticationCode
mac :: forall key message.
(ByteArrayAccess key, ByteArrayAccess message) =>
MACAlgorithm -> key -> message -> MessageAuthenticationCode
mac (HMAC DigestProxy hashAlg
alg) = forall {a} {k} {a} {proxy :: * -> *}.
(HashAlgorithm a, ByteArrayAccess k, ByteArrayAccess a) =>
proxy a -> k -> a -> MessageAuthenticationCode
hmacWith DigestProxy hashAlg
alg
  where
    hmacWith :: proxy a -> k -> a -> MessageAuthenticationCode
hmacWith proxy a
p k
key = Bytes -> MessageAuthenticationCode
AuthTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a k m (proxy :: * -> *).
(HashAlgorithm a, ByteArrayAccess k, ByteArrayAccess m) =>
proxy a -> k -> m -> HMAC a
runHMAC proxy a
p k
key

    runHMAC :: (Hash.HashAlgorithm a, ByteArrayAccess k, ByteArrayAccess m)
        => proxy a -> k -> m -> HMAC.HMAC a
    runHMAC :: forall a k m (proxy :: * -> *).
(HashAlgorithm a, ByteArrayAccess k, ByteArrayAccess m) =>
proxy a -> k -> m -> HMAC a
runHMAC proxy a
_ = forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
HMAC.hmac


-- Content encryption

-- | CMS content encryption cipher.
data ContentEncryptionCipher cipher where
    -- | DES
    DES         :: ContentEncryptionCipher Cipher.DES
    -- | Triple-DES with 2 keys used in alternative direction
    DES_EDE2    :: ContentEncryptionCipher Cipher.DES_EDE2
    -- | Triple-DES with 3 keys used in alternative direction
    DES_EDE3    :: ContentEncryptionCipher Cipher.DES_EDE3
    -- | AES with 128-bit key
    AES128      :: ContentEncryptionCipher Cipher.AES128
    -- | AES with 192-bit key
    AES192      :: ContentEncryptionCipher Cipher.AES192
    -- | AES with 256-bit key
    AES256      :: ContentEncryptionCipher Cipher.AES256
    -- | CAST5 (aka CAST-128) with key between 40 and 128 bits
    CAST5       :: ContentEncryptionCipher Cipher.CAST5
    -- | Camellia with 128-bit key
    Camellia128 :: ContentEncryptionCipher Cipher.Camellia128

deriving instance Show (ContentEncryptionCipher cipher)
deriving instance Eq (ContentEncryptionCipher cipher)

cecI :: ContentEncryptionCipher c -> Int
cecI :: forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
DES         = Int
0
cecI ContentEncryptionCipher c
DES_EDE2    = Int
1
cecI ContentEncryptionCipher c
DES_EDE3    = Int
2
cecI ContentEncryptionCipher c
AES128      = Int
3
cecI ContentEncryptionCipher c
AES192      = Int
4
cecI ContentEncryptionCipher c
AES256      = Int
5
cecI ContentEncryptionCipher c
CAST5       = Int
6
cecI ContentEncryptionCipher c
Camellia128 = Int
7

getCipherKeySizeSpecifier :: Cipher cipher => proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier :: forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier = forall cipher. Cipher cipher => cipher -> KeySizeSpecifier
cipherKeySize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (proxy :: * -> *) a. proxy a -> a
cipherFromProxy

-- | Cipher and mode of operation for content encryption.
data ContentEncryptionAlg
    = forall c . BlockCipher c => ECB (ContentEncryptionCipher c)
      -- ^ Electronic Codebook
    | forall c . BlockCipher c => CBC (ContentEncryptionCipher c)
      -- ^ Cipher Block Chaining
    | CBC_RC2
      -- ^ RC2 in CBC mode
    | forall c . BlockCipher c => CFB (ContentEncryptionCipher c)
      -- ^ Cipher Feedback
    | forall c . BlockCipher c => CTR (ContentEncryptionCipher c)
      -- ^ Counter

instance Show ContentEncryptionAlg where
    show :: ContentEncryptionAlg -> String
show (ECB ContentEncryptionCipher c
c) = forall a. Show a => a -> ShowS
shows ContentEncryptionCipher c
c String
"_ECB"
    show (CBC ContentEncryptionCipher c
c) = forall a. Show a => a -> ShowS
shows ContentEncryptionCipher c
c String
"_CBC"
    show ContentEncryptionAlg
CBC_RC2 = String
"RC2_CBC"
    show (CFB ContentEncryptionCipher c
c) = forall a. Show a => a -> ShowS
shows ContentEncryptionCipher c
c String
"_CFB"
    show (CTR ContentEncryptionCipher c
c) = forall a. Show a => a -> ShowS
shows ContentEncryptionCipher c
c String
"_CTR"

instance Enumerable ContentEncryptionAlg where
    values :: [ContentEncryptionAlg]
values = [ forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CBC ContentEncryptionCipher DES
DES
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CBC ContentEncryptionCipher DES_EDE3
DES_EDE3
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CBC ContentEncryptionCipher AES128
AES128
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CBC ContentEncryptionCipher AES192
AES192
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CBC ContentEncryptionCipher AES256
AES256
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CBC ContentEncryptionCipher CAST5
CAST5
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CBC ContentEncryptionCipher Camellia128
Camellia128
             , ContentEncryptionAlg
CBC_RC2

             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
ECB ContentEncryptionCipher DES
DES
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
ECB ContentEncryptionCipher AES128
AES128
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
ECB ContentEncryptionCipher AES192
AES192
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
ECB ContentEncryptionCipher AES256
AES256
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
ECB ContentEncryptionCipher Camellia128
Camellia128

             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CFB ContentEncryptionCipher DES
DES
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CFB ContentEncryptionCipher AES128
AES128
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CFB ContentEncryptionCipher AES192
AES192
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CFB ContentEncryptionCipher AES256
AES256
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CFB ContentEncryptionCipher Camellia128
Camellia128

             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CTR ContentEncryptionCipher Camellia128
Camellia128
             ]

instance OIDable ContentEncryptionAlg where
    getObjectID :: ContentEncryptionAlg -> OID
getObjectID (CBC ContentEncryptionCipher c
DES)          = [Integer
1,Integer
3,Integer
14,Integer
3,Integer
2,Integer
7]
    getObjectID (CBC ContentEncryptionCipher c
DES_EDE3)     = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
3,Integer
7]
    getObjectID (CBC ContentEncryptionCipher c
AES128)       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
2]
    getObjectID (CBC ContentEncryptionCipher c
AES192)       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
22]
    getObjectID (CBC ContentEncryptionCipher c
AES256)       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
42]
    getObjectID (CBC ContentEncryptionCipher c
CAST5)        = [Integer
1,Integer
2,Integer
840,Integer
113533,Integer
7,Integer
66,Integer
10]
    getObjectID (CBC ContentEncryptionCipher c
Camellia128)  = [Integer
1,Integer
2,Integer
392,Integer
200011,Integer
61,Integer
1,Integer
1,Integer
1,Integer
2]
    getObjectID ContentEncryptionAlg
CBC_RC2            = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
3,Integer
2]

    getObjectID (ECB ContentEncryptionCipher c
DES)          = [Integer
1,Integer
3,Integer
14,Integer
3,Integer
2,Integer
6]
    getObjectID (ECB ContentEncryptionCipher c
AES128)       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
1]
    getObjectID (ECB ContentEncryptionCipher c
AES192)       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
21]
    getObjectID (ECB ContentEncryptionCipher c
AES256)       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
41]
    getObjectID (ECB ContentEncryptionCipher c
Camellia128)  = [Integer
0,Integer
3,Integer
4401,Integer
5,Integer
3,Integer
1,Integer
9,Integer
1]

    getObjectID (CFB ContentEncryptionCipher c
DES)          = [Integer
1,Integer
3,Integer
14,Integer
3,Integer
2,Integer
9]
    getObjectID (CFB ContentEncryptionCipher c
AES128)       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
4]
    getObjectID (CFB ContentEncryptionCipher c
AES192)       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
24]
    getObjectID (CFB ContentEncryptionCipher c
AES256)       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
44]
    getObjectID (CFB ContentEncryptionCipher c
Camellia128)  = [Integer
0,Integer
3,Integer
4401,Integer
5,Integer
3,Integer
1,Integer
9,Integer
4]

    getObjectID (CTR ContentEncryptionCipher c
Camellia128)  = [Integer
0,Integer
3,Integer
4401,Integer
5,Integer
3,Integer
1,Integer
9,Integer
9]

    getObjectID ContentEncryptionAlg
ty = forall a. HasCallStack => String -> a
error (String
"Unsupported ContentEncryptionAlg: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ContentEncryptionAlg
ty)

instance OIDNameable ContentEncryptionAlg where
    fromObjectID :: OID -> Maybe ContentEncryptionAlg
fromObjectID OID
oid = forall a. OIDNameableWrapper a -> a
unOIDNW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid

-- | Content encryption algorithm with associated parameters (i.e. the
-- initialization vector).
--
-- A value can be generated with 'generateEncryptionParams'.
data ContentEncryptionParams
    = forall c . BlockCipher c => ParamsECB (ContentEncryptionCipher c)
      -- ^ Electronic Codebook
    | forall c . BlockCipher c => ParamsCBC (ContentEncryptionCipher c) (IV c)
      -- ^ Cipher Block Chaining
    | ParamsCBCRC2 Int (IV RC2)
      -- ^ RC2 in CBC mode
    | forall c . BlockCipher c => ParamsCFB (ContentEncryptionCipher c) (IV c)
      -- ^ Cipher Feedback
    | forall c . BlockCipher c => ParamsCTR (ContentEncryptionCipher c) (IV c)
      -- ^ Counter

instance Show ContentEncryptionParams where
    show :: ContentEncryptionParams -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentEncryptionParams -> ContentEncryptionAlg
getContentEncryptionAlg

instance Eq ContentEncryptionParams where
    ParamsECB ContentEncryptionCipher c
c1        == :: ContentEncryptionParams -> ContentEncryptionParams -> Bool
== ParamsECB ContentEncryptionCipher c
c2        = forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c1 forall a. Eq a => a -> a -> Bool
== forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c2
    ParamsCBC ContentEncryptionCipher c
c1 IV c
iv1    == ParamsCBC ContentEncryptionCipher c
c2 IV c
iv2    = forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c1 forall a. Eq a => a -> a -> Bool
== forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c2 Bool -> Bool -> Bool
&& IV c
iv1 forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`B.eq` IV c
iv2
    ParamsCBCRC2 Int
i1 IV RC2
iv1 == ParamsCBCRC2 Int
i2 IV RC2
iv2 = Int
i1 forall a. Eq a => a -> a -> Bool
== Int
i2 Bool -> Bool -> Bool
&& IV RC2
iv1 forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`B.eq` IV RC2
iv2
    ParamsCFB ContentEncryptionCipher c
c1 IV c
iv1    == ParamsCFB ContentEncryptionCipher c
c2 IV c
iv2    = forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c1 forall a. Eq a => a -> a -> Bool
== forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c2 Bool -> Bool -> Bool
&& IV c
iv1 forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`B.eq` IV c
iv2
    ParamsCTR ContentEncryptionCipher c
c1 IV c
iv1    == ParamsCTR ContentEncryptionCipher c
c2 IV c
iv2    = forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c1 forall a. Eq a => a -> a -> Bool
== forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c2 Bool -> Bool -> Bool
&& IV c
iv1 forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`B.eq` IV c
iv2
    ContentEncryptionParams
_                   == ContentEncryptionParams
_                   = Bool
False

instance HasKeySize ContentEncryptionParams where
    getKeySizeSpecifier :: ContentEncryptionParams -> KeySizeSpecifier
getKeySizeSpecifier (ParamsECB ContentEncryptionCipher c
c)      = forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher c
c
    getKeySizeSpecifier (ParamsCBC ContentEncryptionCipher c
c IV c
_)    = forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher c
c
    getKeySizeSpecifier (ParamsCBCRC2 Int
i IV RC2
_) = Int -> KeySizeSpecifier
KeySizeFixed forall a b. (a -> b) -> a -> b
$ (Int
i forall a. Num a => a -> a -> a
+ Int
7) forall a. Integral a => a -> a -> a
`div` Int
8
    getKeySizeSpecifier (ParamsCFB ContentEncryptionCipher c
c IV c
_)    = forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher c
c
    getKeySizeSpecifier (ParamsCTR ContentEncryptionCipher c
c IV c
_)    = forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher c
c

instance ASN1Elem e => ProduceASN1Object e ContentEncryptionParams where
    asn1s :: ContentEncryptionParams -> ASN1Stream e
asn1s ContentEncryptionParams
param =
        forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
oid forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
params)
      where
        oid :: ASN1Stream e
oid    = forall e. ASN1Elem e => OID -> ASN1Stream e
gOID (forall a. OIDable a => a -> OID
getObjectID forall a b. (a -> b) -> a -> b
$ ContentEncryptionParams -> ContentEncryptionAlg
getContentEncryptionAlg ContentEncryptionParams
param)
        params :: ASN1Stream e
params = forall e. ASN1Elem e => ContentEncryptionParams -> ASN1Stream e
ceParameterASN1S ContentEncryptionParams
param

instance Monoid e => ParseASN1Object e ContentEncryptionParams where
    parse :: ParseASN1 e ContentEncryptionParams
parse = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
        OID OID
oid <- forall e. Monoid e => ParseASN1 e ASN1
getNext
        forall a e b.
OIDNameable a =>
String -> OID -> (a -> ParseASN1 e b) -> ParseASN1 e b
withObjectID String
"content encryption algorithm" OID
oid forall e.
Monoid e =>
ContentEncryptionAlg -> ParseASN1 e ContentEncryptionParams
parseCEParameter

ceParameterASN1S :: ASN1Elem e => ContentEncryptionParams -> ASN1Stream e
ceParameterASN1S :: forall e. ASN1Elem e => ContentEncryptionParams -> ASN1Stream e
ceParameterASN1S (ParamsECB ContentEncryptionCipher c
_)         = forall a. a -> a
id
ceParameterASN1S (ParamsCBC ContentEncryptionCipher c
_ IV c
iv)      = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert IV c
iv)
ceParameterASN1S (ParamsCBCRC2 Int
len IV RC2
iv) = forall e. ASN1Elem e => Int -> IV RC2 -> ASN1Stream e
rc2ParameterASN1S Int
len IV RC2
iv
ceParameterASN1S (ParamsCFB ContentEncryptionCipher c
_ IV c
iv)      = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert IV c
iv)
ceParameterASN1S (ParamsCTR ContentEncryptionCipher c
_ IV c
iv)      = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert IV c
iv)

parseCEParameter :: Monoid e
                 => ContentEncryptionAlg -> ParseASN1 e ContentEncryptionParams
parseCEParameter :: forall e.
Monoid e =>
ContentEncryptionAlg -> ParseASN1 e ContentEncryptionParams
parseCEParameter (ECB ContentEncryptionCipher c
c) = forall e a. ParseASN1 e a -> ParseASN1 e [a]
getMany forall e. Monoid e => ParseASN1 e ASN1
getNext forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionParams
ParamsECB ContentEncryptionCipher c
c)
parseCEParameter (CBC ContentEncryptionCipher c
c) = forall c.
BlockCipher c =>
ContentEncryptionCipher c -> IV c -> ContentEncryptionParams
ParamsCBC ContentEncryptionCipher c
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e. Monoid e => ParseASN1 e ASN1
getNext forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall cipher e.
BlockCipher cipher =>
ASN1 -> ParseASN1 e (IV cipher)
getIV)
parseCEParameter ContentEncryptionAlg
CBC_RC2 = forall e. Monoid e => ParseASN1 e ContentEncryptionParams
parseRC2Parameter
parseCEParameter (CFB ContentEncryptionCipher c
c) = forall c.
BlockCipher c =>
ContentEncryptionCipher c -> IV c -> ContentEncryptionParams
ParamsCFB ContentEncryptionCipher c
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e. Monoid e => ParseASN1 e ASN1
getNext forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall cipher e.
BlockCipher cipher =>
ASN1 -> ParseASN1 e (IV cipher)
getIV)
parseCEParameter (CTR ContentEncryptionCipher c
c) = forall c.
BlockCipher c =>
ContentEncryptionCipher c -> IV c -> ContentEncryptionParams
ParamsCTR ContentEncryptionCipher c
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e. Monoid e => ParseASN1 e ASN1
getNext forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall cipher e.
BlockCipher cipher =>
ASN1 -> ParseASN1 e (IV cipher)
getIV)

getIV :: BlockCipher cipher => ASN1 -> ParseASN1 e (IV cipher)
getIV :: forall cipher e.
BlockCipher cipher =>
ASN1 -> ParseASN1 e (IV cipher)
getIV (OctetString ByteString
ivBs) =
    case forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV ByteString
ivBs of
        Maybe (IV cipher)
Nothing -> forall e a. String -> ParseASN1 e a
throwParseError String
"Bad IV in parsed parameters"
        Just IV cipher
v  -> forall (m :: * -> *) a. Monad m => a -> m a
return IV cipher
v
getIV ASN1
_ = forall e a. String -> ParseASN1 e a
throwParseError String
"No IV in parsed parameter or incorrect format"

rc2ParameterASN1S :: ASN1Elem e => Int -> IV RC2 -> ASN1Stream e
rc2ParameterASN1S :: forall e. ASN1Elem e => Int -> IV RC2 -> ASN1Stream e
rc2ParameterASN1S Int
len IV RC2
iv
    | Int
len forall a. Eq a => a -> a -> Bool
== Int
32 = ASN1Stream e
gIV
    | Bool
otherwise = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (forall e. ASN1Elem e => Int -> ASN1Stream e
rc2VersionASN1 Int
len forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
gIV)
  where gIV :: ASN1Stream e
gIV = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert IV RC2
iv)

parseRC2Parameter :: Monoid e => ParseASN1 e ContentEncryptionParams
parseRC2Parameter :: forall e. Monoid e => ParseASN1 e ContentEncryptionParams
parseRC2Parameter = forall {e}. Monoid e => Int -> ParseASN1 e ContentEncryptionParams
parseOnlyIV Int
32 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e ContentEncryptionParams
parseFullParams
  where
    parseOnlyIV :: Int -> ParseASN1 e ContentEncryptionParams
parseOnlyIV Int
len = Int -> IV RC2 -> ContentEncryptionParams
ParamsCBCRC2 Int
len forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e. Monoid e => ParseASN1 e ASN1
getNext forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall cipher e.
BlockCipher cipher =>
ASN1 -> ParseASN1 e (IV cipher)
getIV)
    parseFullParams :: ParseASN1 e ContentEncryptionParams
parseFullParams = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$
        forall e. Monoid e => ParseASN1 e Int
parseRC2Version forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {e}. Monoid e => Int -> ParseASN1 e ContentEncryptionParams
parseOnlyIV

-- | Get the content encryption algorithm.
getContentEncryptionAlg :: ContentEncryptionParams -> ContentEncryptionAlg
getContentEncryptionAlg :: ContentEncryptionParams -> ContentEncryptionAlg
getContentEncryptionAlg (ParamsECB ContentEncryptionCipher c
c)      = forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
ECB ContentEncryptionCipher c
c
getContentEncryptionAlg (ParamsCBC ContentEncryptionCipher c
c IV c
_)    = forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CBC ContentEncryptionCipher c
c
getContentEncryptionAlg (ParamsCBCRC2 Int
_ IV RC2
_) = ContentEncryptionAlg
CBC_RC2
getContentEncryptionAlg (ParamsCFB ContentEncryptionCipher c
c IV c
_)    = forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CFB ContentEncryptionCipher c
c
getContentEncryptionAlg (ParamsCTR ContentEncryptionCipher c
c IV c
_)    = forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CTR ContentEncryptionCipher c
c

-- | Generate random parameters for the specified content encryption algorithm.
generateEncryptionParams :: MonadRandom m
                         => ContentEncryptionAlg -> m ContentEncryptionParams
generateEncryptionParams :: forall (m :: * -> *).
MonadRandom m =>
ContentEncryptionAlg -> m ContentEncryptionParams
generateEncryptionParams (ECB ContentEncryptionCipher c
c) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionParams
ParamsECB ContentEncryptionCipher c
c)
generateEncryptionParams (CBC ContentEncryptionCipher c
c) = forall c.
BlockCipher c =>
ContentEncryptionCipher c -> IV c -> ContentEncryptionParams
ParamsCBC ContentEncryptionCipher c
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall cipher (m :: * -> *).
(BlockCipher cipher, MonadRandom m) =>
cipher -> m (IV cipher)
ivGenerate forall a. HasCallStack => a
undefined
generateEncryptionParams ContentEncryptionAlg
CBC_RC2 = Int -> IV RC2 -> ContentEncryptionParams
ParamsCBCRC2 Int
128 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall cipher (m :: * -> *).
(BlockCipher cipher, MonadRandom m) =>
cipher -> m (IV cipher)
ivGenerate forall a. HasCallStack => a
undefined
generateEncryptionParams (CFB ContentEncryptionCipher c
c) = forall c.
BlockCipher c =>
ContentEncryptionCipher c -> IV c -> ContentEncryptionParams
ParamsCFB ContentEncryptionCipher c
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall cipher (m :: * -> *).
(BlockCipher cipher, MonadRandom m) =>
cipher -> m (IV cipher)
ivGenerate forall a. HasCallStack => a
undefined
generateEncryptionParams (CTR ContentEncryptionCipher c
c) = forall c.
BlockCipher c =>
ContentEncryptionCipher c -> IV c -> ContentEncryptionParams
ParamsCTR ContentEncryptionCipher c
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall cipher (m :: * -> *).
(BlockCipher cipher, MonadRandom m) =>
cipher -> m (IV cipher)
ivGenerate forall a. HasCallStack => a
undefined

-- | Generate random RC2 parameters with the specified effective key length (in
-- bits).
generateRC2EncryptionParams :: MonadRandom m
                            => Int -> m ContentEncryptionParams
generateRC2EncryptionParams :: forall (m :: * -> *).
MonadRandom m =>
Int -> m ContentEncryptionParams
generateRC2EncryptionParams Int
len = Int -> IV RC2 -> ContentEncryptionParams
ParamsCBCRC2 Int
len forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall cipher (m :: * -> *).
(BlockCipher cipher, MonadRandom m) =>
cipher -> m (IV cipher)
ivGenerate forall a. HasCallStack => a
undefined

-- | Encrypt a bytearray with the specified content encryption key and
-- algorithm.
contentEncrypt :: (ByteArray cek, ByteArray ba)
               => cek
               -> ContentEncryptionParams
               -> ba -> Either StoreError ba
contentEncrypt :: forall cek ba.
(ByteArray cek, ByteArray ba) =>
cek -> ContentEncryptionParams -> ba -> Either StoreError ba
contentEncrypt cek
key ContentEncryptionParams
params ba
bs =
    case ContentEncryptionParams
params of
        ParamsECB ContentEncryptionCipher c
cipher    -> forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher cek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> forall {b} {a}. b -> Either a b
force forall a b. (a -> b) -> a -> b
$ forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt c
c    forall a b. (a -> b) -> a -> b
$ forall {byteArray} {cipher}.
(ByteArray byteArray, BlockCipher cipher) =>
cipher -> byteArray -> byteArray
padded c
c ba
bs)
        ParamsCBC ContentEncryptionCipher c
cipher IV c
iv -> forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher cek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> forall {b} {a}. b -> Either a b
force forall a b. (a -> b) -> a -> b
$ forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcEncrypt c
c IV c
iv forall a b. (a -> b) -> a -> b
$ forall {byteArray} {cipher}.
(ByteArray byteArray, BlockCipher cipher) =>
cipher -> byteArray -> byteArray
padded c
c ba
bs)
        ParamsCBCRC2 Int
len IV RC2
iv -> forall key. ByteArray key => Int -> key -> Either StoreError RC2
getRC2Cipher Int
len cek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\RC2
c -> forall {b} {a}. b -> Either a b
force forall a b. (a -> b) -> a -> b
$ forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcEncrypt RC2
c IV RC2
iv forall a b. (a -> b) -> a -> b
$ forall {byteArray} {cipher}.
(ByteArray byteArray, BlockCipher cipher) =>
cipher -> byteArray -> byteArray
padded RC2
c ba
bs)
        ParamsCFB ContentEncryptionCipher c
cipher IV c
iv -> forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher cek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> forall {b} {a}. b -> Either a b
force forall a b. (a -> b) -> a -> b
$ forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cfbEncrypt c
c IV c
iv forall a b. (a -> b) -> a -> b
$ forall {byteArray} {cipher}.
(ByteArray byteArray, BlockCipher cipher) =>
cipher -> byteArray -> byteArray
padded c
c ba
bs)
        ParamsCTR ContentEncryptionCipher c
cipher IV c
iv -> forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher cek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> forall {b} {a}. b -> Either a b
force forall a b. (a -> b) -> a -> b
$ forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
ctrCombine c
c IV c
iv forall a b. (a -> b) -> a -> b
$ forall {byteArray} {cipher}.
(ByteArray byteArray, BlockCipher cipher) =>
cipher -> byteArray -> byteArray
padded c
c ba
bs)
  where
    force :: b -> Either a b
force b
x  = b
x seq :: forall a b. a -> b -> b
`seq` forall a b. b -> Either a b
Right b
x
    padded :: cipher -> byteArray -> byteArray
padded cipher
c = forall byteArray.
ByteArray byteArray =>
Format -> byteArray -> byteArray
pad (Int -> Format
PKCS7 forall a b. (a -> b) -> a -> b
$ forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
c)

-- | Decrypt a bytearray with the specified content encryption key and
-- algorithm.
contentDecrypt :: (ByteArray cek, ByteArray ba)
               => cek
               -> ContentEncryptionParams
               -> ba -> Either StoreError ba
contentDecrypt :: forall cek ba.
(ByteArray cek, ByteArray ba) =>
cek -> ContentEncryptionParams -> ba -> Either StoreError ba
contentDecrypt cek
key ContentEncryptionParams
params ba
bs =
    case ContentEncryptionParams
params of
        ParamsECB ContentEncryptionCipher c
cipher    -> forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher cek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> forall {b} {cipher}.
(ByteArray b, BlockCipher cipher) =>
cipher -> b -> Either StoreError b
unpadded c
c (forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbDecrypt c
c    ba
bs))
        ParamsCBC ContentEncryptionCipher c
cipher IV c
iv -> forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher cek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> forall {b} {cipher}.
(ByteArray b, BlockCipher cipher) =>
cipher -> b -> Either StoreError b
unpadded c
c (forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcDecrypt c
c IV c
iv ba
bs))
        ParamsCBCRC2 Int
len IV RC2
iv -> forall key. ByteArray key => Int -> key -> Either StoreError RC2
getRC2Cipher Int
len cek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\RC2
c -> forall {b} {cipher}.
(ByteArray b, BlockCipher cipher) =>
cipher -> b -> Either StoreError b
unpadded RC2
c (forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcDecrypt RC2
c IV RC2
iv ba
bs))
        ParamsCFB ContentEncryptionCipher c
cipher IV c
iv -> forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher cek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> forall {b} {cipher}.
(ByteArray b, BlockCipher cipher) =>
cipher -> b -> Either StoreError b
unpadded c
c (forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cfbDecrypt c
c IV c
iv ba
bs))
        ParamsCTR ContentEncryptionCipher c
cipher IV c
iv -> forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher cek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> forall {b} {cipher}.
(ByteArray b, BlockCipher cipher) =>
cipher -> b -> Either StoreError b
unpadded c
c (forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
ctrCombine c
c IV c
iv ba
bs))
  where
    unpadded :: cipher -> b -> Either StoreError b
unpadded cipher
c b
decrypted =
        case forall byteArray.
ByteArray byteArray =>
Format -> byteArray -> Maybe byteArray
unpad (Int -> Format
PKCS7 forall a b. (a -> b) -> a -> b
$ forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
c) b
decrypted of
            Maybe b
Nothing  -> forall a b. a -> Either a b
Left StoreError
DecryptionFailed
            Just b
out -> forall a b. b -> Either a b
Right b
out

-- from RFC 2268 section 6
rc2Table :: [Word8]
rc2Table :: [Word8]
rc2Table =
    [ Word8
0xbd, Word8
0x56, Word8
0xea, Word8
0xf2, Word8
0xa2, Word8
0xf1, Word8
0xac, Word8
0x2a, Word8
0xb0, Word8
0x93, Word8
0xd1, Word8
0x9c, Word8
0x1b, Word8
0x33, Word8
0xfd, Word8
0xd0
    , Word8
0x30, Word8
0x04, Word8
0xb6, Word8
0xdc, Word8
0x7d, Word8
0xdf, Word8
0x32, Word8
0x4b, Word8
0xf7, Word8
0xcb, Word8
0x45, Word8
0x9b, Word8
0x31, Word8
0xbb, Word8
0x21, Word8
0x5a
    , Word8
0x41, Word8
0x9f, Word8
0xe1, Word8
0xd9, Word8
0x4a, Word8
0x4d, Word8
0x9e, Word8
0xda, Word8
0xa0, Word8
0x68, Word8
0x2c, Word8
0xc3, Word8
0x27, Word8
0x5f, Word8
0x80, Word8
0x36
    , Word8
0x3e, Word8
0xee, Word8
0xfb, Word8
0x95, Word8
0x1a, Word8
0xfe, Word8
0xce, Word8
0xa8, Word8
0x34, Word8
0xa9, Word8
0x13, Word8
0xf0, Word8
0xa6, Word8
0x3f, Word8
0xd8, Word8
0x0c
    , Word8
0x78, Word8
0x24, Word8
0xaf, Word8
0x23, Word8
0x52, Word8
0xc1, Word8
0x67, Word8
0x17, Word8
0xf5, Word8
0x66, Word8
0x90, Word8
0xe7, Word8
0xe8, Word8
0x07, Word8
0xb8, Word8
0x60
    , Word8
0x48, Word8
0xe6, Word8
0x1e, Word8
0x53, Word8
0xf3, Word8
0x92, Word8
0xa4, Word8
0x72, Word8
0x8c, Word8
0x08, Word8
0x15, Word8
0x6e, Word8
0x86, Word8
0x00, Word8
0x84, Word8
0xfa
    , Word8
0xf4, Word8
0x7f, Word8
0x8a, Word8
0x42, Word8
0x19, Word8
0xf6, Word8
0xdb, Word8
0xcd, Word8
0x14, Word8
0x8d, Word8
0x50, Word8
0x12, Word8
0xba, Word8
0x3c, Word8
0x06, Word8
0x4e
    , Word8
0xec, Word8
0xb3, Word8
0x35, Word8
0x11, Word8
0xa1, Word8
0x88, Word8
0x8e, Word8
0x2b, Word8
0x94, Word8
0x99, Word8
0xb7, Word8
0x71, Word8
0x74, Word8
0xd3, Word8
0xe4, Word8
0xbf
    , Word8
0x3a, Word8
0xde, Word8
0x96, Word8
0x0e, Word8
0xbc, Word8
0x0a, Word8
0xed, Word8
0x77, Word8
0xfc, Word8
0x37, Word8
0x6b, Word8
0x03, Word8
0x79, Word8
0x89, Word8
0x62, Word8
0xc6
    , Word8
0xd7, Word8
0xc0, Word8
0xd2, Word8
0x7c, Word8
0x6a, Word8
0x8b, Word8
0x22, Word8
0xa3, Word8
0x5b, Word8
0x05, Word8
0x5d, Word8
0x02, Word8
0x75, Word8
0xd5, Word8
0x61, Word8
0xe3
    , Word8
0x18, Word8
0x8f, Word8
0x55, Word8
0x51, Word8
0xad, Word8
0x1f, Word8
0x0b, Word8
0x5e, Word8
0x85, Word8
0xe5, Word8
0xc2, Word8
0x57, Word8
0x63, Word8
0xca, Word8
0x3d, Word8
0x6c
    , Word8
0xb4, Word8
0xc5, Word8
0xcc, Word8
0x70, Word8
0xb2, Word8
0x91, Word8
0x59, Word8
0x0d, Word8
0x47, Word8
0x20, Word8
0xc8, Word8
0x4f, Word8
0x58, Word8
0xe0, Word8
0x01, Word8
0xe2
    , Word8
0x16, Word8
0x38, Word8
0xc4, Word8
0x6f, Word8
0x3b, Word8
0x0f, Word8
0x65, Word8
0x46, Word8
0xbe, Word8
0x7e, Word8
0x2d, Word8
0x7b, Word8
0x82, Word8
0xf9, Word8
0x40, Word8
0xb5
    , Word8
0x1d, Word8
0x73, Word8
0xf8, Word8
0xeb, Word8
0x26, Word8
0xc7, Word8
0x87, Word8
0x97, Word8
0x25, Word8
0x54, Word8
0xb1, Word8
0x28, Word8
0xaa, Word8
0x98, Word8
0x9d, Word8
0xa5
    , Word8
0x64, Word8
0x6d, Word8
0x7a, Word8
0xd4, Word8
0x10, Word8
0x81, Word8
0x44, Word8
0xef, Word8
0x49, Word8
0xd6, Word8
0xae, Word8
0x2e, Word8
0xdd, Word8
0x76, Word8
0x5c, Word8
0x2f
    , Word8
0xa7, Word8
0x1c, Word8
0xc9, Word8
0x09, Word8
0x69, Word8
0x9a, Word8
0x83, Word8
0xcf, Word8
0x29, Word8
0x39, Word8
0xb9, Word8
0xe9, Word8
0x4c, Word8
0xff, Word8
0x43, Word8
0xab
    ]

rc2Forward :: B.Bytes
rc2Forward :: Bytes
rc2Forward = forall a. ByteArray a => [Word8] -> a
B.pack [Word8]
rc2Table

rc2Reverse :: B.Bytes
rc2Reverse :: Bytes
rc2Reverse = forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
rc2Table) ([(Word8, Word8)] -> Ptr Word8 -> IO ()
loop forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Word8
0..] [Word8]
rc2Table)
  where
    loop :: [(Word8, Word8)] -> Ptr Word8 -> IO ()
    loop :: [(Word8, Word8)] -> Ptr Word8 -> IO ()
loop []         Ptr Word8
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    loop ((Word8
a,Word8
b):[(Word8, Word8)]
ts) Ptr Word8
p = forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
p (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Word8
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Word8, Word8)] -> Ptr Word8 -> IO ()
loop [(Word8, Word8)]
ts Ptr Word8
p

rc2VersionASN1 :: ASN1Elem e => Int -> ASN1Stream e
rc2VersionASN1 :: forall e. ASN1Elem e => Int -> ASN1Stream e
rc2VersionASN1 Int
len = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
v
  where
    v :: Integer
v | Int
len forall a. Ord a => a -> a -> Bool
< Int
0    = forall a. HasCallStack => String -> a
error String
"invalid RC2 effective key length"
      | Int
len forall a. Ord a => a -> a -> Bool
>= Int
256 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
      | Bool
otherwise  = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. ByteArrayAccess a => a -> Int -> Word8
B.index Bytes
rc2Forward Int
len)

parseRC2Version :: Monoid e => ParseASN1 e Int
parseRC2Version :: forall e. Monoid e => ParseASN1 e Int
parseRC2Version = do
    IntVal Integer
i <- forall e. Monoid e => ParseASN1 e ASN1
getNext
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
i forall a. Ord a => a -> a -> Bool
< Integer
0) forall a b. (a -> b) -> a -> b
$ forall e a. String -> ParseASN1 e a
throwParseError String
"Parsed invalid RC2 effective key length"
    let j :: Int
j = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Integer
i forall a. Ord a => a -> a -> Bool
>= Integer
256 then Int
j else forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. ByteArrayAccess a => a -> Int -> Word8
B.index Bytes
rc2Reverse Int
j)


-- Authenticated-content encryption

-- | Cipher and mode of operation for authenticated-content encryption.
data AuthContentEncryptionAlg
    = AUTH_ENC_128
      -- ^ authEnc with 128-bit key
    | AUTH_ENC_256
      -- ^ authEnc with 256-bit key
    | CHACHA20_POLY1305
      -- ^ ChaCha20-Poly1305 Authenticated Encryption
    | forall c . BlockCipher c => CCM (ContentEncryptionCipher c)
      -- ^ Counter with CBC-MAC
    | forall c . BlockCipher c => GCM (ContentEncryptionCipher c)
      -- ^ Galois Counter Mode

instance Show AuthContentEncryptionAlg where
    show :: AuthContentEncryptionAlg -> String
show AuthContentEncryptionAlg
AUTH_ENC_128 = String
"AUTH_ENC_128"
    show AuthContentEncryptionAlg
AUTH_ENC_256 = String
"AUTH_ENC_256"
    show AuthContentEncryptionAlg
CHACHA20_POLY1305 = String
"CHACHA20_POLY1305"
    show (CCM ContentEncryptionCipher c
c)      = forall a. Show a => a -> ShowS
shows ContentEncryptionCipher c
c String
"_CCM"
    show (GCM ContentEncryptionCipher c
c)      = forall a. Show a => a -> ShowS
shows ContentEncryptionCipher c
c String
"_GCM"

instance Enumerable AuthContentEncryptionAlg where
    values :: [AuthContentEncryptionAlg]
values = [ AuthContentEncryptionAlg
AUTH_ENC_128
             , AuthContentEncryptionAlg
AUTH_ENC_256
             , AuthContentEncryptionAlg
CHACHA20_POLY1305

             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> AuthContentEncryptionAlg
CCM ContentEncryptionCipher AES128
AES128
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> AuthContentEncryptionAlg
CCM ContentEncryptionCipher AES192
AES192
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> AuthContentEncryptionAlg
CCM ContentEncryptionCipher AES256
AES256

             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> AuthContentEncryptionAlg
GCM ContentEncryptionCipher AES128
AES128
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> AuthContentEncryptionAlg
GCM ContentEncryptionCipher AES192
AES192
             , forall c.
BlockCipher c =>
ContentEncryptionCipher c -> AuthContentEncryptionAlg
GCM ContentEncryptionCipher AES256
AES256
             ]

instance OIDable AuthContentEncryptionAlg where
    getObjectID :: AuthContentEncryptionAlg -> OID
getObjectID AuthContentEncryptionAlg
AUTH_ENC_128       = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
9,Integer
16,Integer
3,Integer
15]
    getObjectID AuthContentEncryptionAlg
AUTH_ENC_256       = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
9,Integer
16,Integer
3,Integer
16]
    getObjectID AuthContentEncryptionAlg
CHACHA20_POLY1305  = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
9,Integer
16,Integer
3,Integer
18]

    getObjectID (CCM ContentEncryptionCipher c
AES128)       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
7]
    getObjectID (CCM ContentEncryptionCipher c
AES192)       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
27]
    getObjectID (CCM ContentEncryptionCipher c
AES256)       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
47]

    getObjectID (GCM ContentEncryptionCipher c
AES128)       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
6]
    getObjectID (GCM ContentEncryptionCipher c
AES192)       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
26]
    getObjectID (GCM ContentEncryptionCipher c
AES256)       = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
46]

    getObjectID AuthContentEncryptionAlg
ty = forall a. HasCallStack => String -> a
error (String
"Unsupported AuthContentEncryptionAlg: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show AuthContentEncryptionAlg
ty)

instance OIDNameable AuthContentEncryptionAlg where
    fromObjectID :: OID -> Maybe AuthContentEncryptionAlg
fromObjectID OID
oid = forall a. OIDNameableWrapper a -> a
unOIDNW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid

data AuthEncParams = AuthEncParams
    { AuthEncParams -> PBKDF2_PRF
prfAlgorithm :: PBKDF2_PRF
    , AuthEncParams -> ContentEncryptionParams
encAlgorithm :: ContentEncryptionParams
    , AuthEncParams -> MACAlgorithm
macAlgorithm :: MACAlgorithm
    }
    deriving (Int -> AuthEncParams -> ShowS
[AuthEncParams] -> ShowS
AuthEncParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthEncParams] -> ShowS
$cshowList :: [AuthEncParams] -> ShowS
show :: AuthEncParams -> String
$cshow :: AuthEncParams -> String
showsPrec :: Int -> AuthEncParams -> ShowS
$cshowsPrec :: Int -> AuthEncParams -> ShowS
Show,AuthEncParams -> AuthEncParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthEncParams -> AuthEncParams -> Bool
$c/= :: AuthEncParams -> AuthEncParams -> Bool
== :: AuthEncParams -> AuthEncParams -> Bool
$c== :: AuthEncParams -> AuthEncParams -> Bool
Eq)

instance ASN1Elem e => ProduceASN1Object e AuthEncParams where
    asn1s :: AuthEncParams -> ASN1Stream e
asn1s AuthEncParams{PBKDF2_PRF
ContentEncryptionParams
MACAlgorithm
macAlgorithm :: MACAlgorithm
encAlgorithm :: ContentEncryptionParams
prfAlgorithm :: PBKDF2_PRF
macAlgorithm :: AuthEncParams -> MACAlgorithm
encAlgorithm :: AuthEncParams -> ContentEncryptionParams
prfAlgorithm :: AuthEncParams -> PBKDF2_PRF
..} = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
kdf forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
encAlg forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
macAlg)
      where
        kdf :: ASN1Stream e
kdf    = forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) (PBKDF2_PRF -> KeyDerivationFunc
asKDF PBKDF2_PRF
prfAlgorithm)
        encAlg :: ASN1Stream e
encAlg = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s ContentEncryptionParams
encAlgorithm
        macAlg :: ASN1Stream e
macAlg = forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence MACAlgorithm
macAlgorithm

        asKDF :: PBKDF2_PRF -> KeyDerivationFunc
asKDF PBKDF2_PRF
algPrf = PBKDF2 { pbkdf2Salt :: ByteString
pbkdf2Salt = forall a. ByteArray a => a
B.empty
                              , pbkdf2IterationCount :: Int
pbkdf2IterationCount = Int
1
                              , pbkdf2KeyLength :: Maybe Int
pbkdf2KeyLength = forall a. Maybe a
Nothing
                              , pbkdf2Prf :: PBKDF2_PRF
pbkdf2Prf = PBKDF2_PRF
algPrf
                              }

instance Monoid e => ParseASN1Object e AuthEncParams where
    parse :: ParseASN1 e AuthEncParams
parse = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
        Maybe KeyDerivationFunc
kdf    <- forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e (Maybe param)
parseAlgorithmMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
        ContentEncryptionParams
encAlg <- forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        MACAlgorithm
macAlg <- forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
        PBKDF2_PRF
prfAlg <-
            case Maybe KeyDerivationFunc
kdf of
                Maybe KeyDerivationFunc
Nothing               -> forall (m :: * -> *) a. Monad m => a -> m a
return PBKDF2_PRF
PBKDF2_SHA1
                Just (PBKDF2 ByteString
_ Int
_ Maybe Int
_ PBKDF2_PRF
a) -> forall (m :: * -> *) a. Monad m => a -> m a
return PBKDF2_PRF
a
                Just KeyDerivationFunc
other            -> forall e a. String -> ParseASN1 e a
throwParseError
                    (String
"Unable to use " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show KeyDerivationFunc
other forall a. [a] -> [a] -> [a]
++ String
" in AuthEncParams")
        forall (m :: * -> *) a. Monad m => a -> m a
return AuthEncParams { prfAlgorithm :: PBKDF2_PRF
prfAlgorithm = PBKDF2_PRF
prfAlg
                             , encAlgorithm :: ContentEncryptionParams
encAlgorithm = ContentEncryptionParams
encAlg
                             , macAlgorithm :: MACAlgorithm
macAlgorithm = MACAlgorithm
macAlg
                             }

-- | Authenticated-content encryption algorithm with associated parameters
-- (i.e. the nonce).
--
-- A value can be generated with functions 'generateAuthEnc128Params',
-- 'generateAuthEnc256Params', 'generateChaChaPoly1305Params',
-- 'generateCCMParams' and 'generateGCMParams'.
data AuthContentEncryptionParams
    = Params_AUTH_ENC_128 AuthEncParams
      -- ^ authEnc with 128-bit keying material
    | Params_AUTH_ENC_256 AuthEncParams
      -- ^ authEnc with 256-bit keying material
    | Params_CHACHA20_POLY1305 ChaChaPoly1305.Nonce
      -- ^ ChaCha20-Poly1305 Authenticated Encryption
    | forall c . BlockCipher c => ParamsCCM (ContentEncryptionCipher c) B.Bytes CCM_M CCM_L
      -- ^ Counter with CBC-MAC
    | forall c . BlockCipher c => ParamsGCM (ContentEncryptionCipher c) B.Bytes Int
      -- ^ Galois Counter Mode

instance Show AuthContentEncryptionParams where
    show :: AuthContentEncryptionParams -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthContentEncryptionParams -> AuthContentEncryptionAlg
getAuthContentEncryptionAlg

instance Eq AuthContentEncryptionParams where
    Params_AUTH_ENC_128 AuthEncParams
p1 == :: AuthContentEncryptionParams -> AuthContentEncryptionParams -> Bool
== Params_AUTH_ENC_128 AuthEncParams
p2 = AuthEncParams
p1 forall a. Eq a => a -> a -> Bool
== AuthEncParams
p2
    Params_AUTH_ENC_256 AuthEncParams
p1 == Params_AUTH_ENC_256 AuthEncParams
p2 = AuthEncParams
p1 forall a. Eq a => a -> a -> Bool
== AuthEncParams
p2
    Params_CHACHA20_POLY1305 Nonce
iv1 == Params_CHACHA20_POLY1305 Nonce
iv2 =
        Nonce
iv1 forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`B.eq` Nonce
iv2

    ParamsCCM ContentEncryptionCipher c
c1 Bytes
iv1 CCM_M
m1 CCM_L
l1 == ParamsCCM ContentEncryptionCipher c
c2 Bytes
iv2 CCM_M
m2 CCM_L
l2 =
        forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c1 forall a. Eq a => a -> a -> Bool
== forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c2 Bool -> Bool -> Bool
&& Bytes
iv1 forall a. Eq a => a -> a -> Bool
== Bytes
iv2 Bool -> Bool -> Bool
&& (CCM_M
m1, CCM_L
l1) forall a. Eq a => a -> a -> Bool
== (CCM_M
m2, CCM_L
l2)
    ParamsGCM ContentEncryptionCipher c
c1 Bytes
iv1 Int
len1  == ParamsGCM ContentEncryptionCipher c
c2 Bytes
iv2 Int
len2  =
        forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c1 forall a. Eq a => a -> a -> Bool
== forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c2 Bool -> Bool -> Bool
&& Bytes
iv1 forall a. Eq a => a -> a -> Bool
== Bytes
iv2 Bool -> Bool -> Bool
&& Int
len1 forall a. Eq a => a -> a -> Bool
== Int
len2
    AuthContentEncryptionParams
_               == AuthContentEncryptionParams
_               = Bool
False

instance HasKeySize AuthContentEncryptionParams where
    getKeySizeSpecifier :: AuthContentEncryptionParams -> KeySizeSpecifier
getKeySizeSpecifier (Params_AUTH_ENC_128 AuthEncParams
_) = Int -> KeySizeSpecifier
KeySizeFixed Int
16
    getKeySizeSpecifier (Params_AUTH_ENC_256 AuthEncParams
_) = Int -> KeySizeSpecifier
KeySizeFixed Int
32
    getKeySizeSpecifier (Params_CHACHA20_POLY1305 Nonce
_) = Int -> KeySizeSpecifier
KeySizeFixed Int
32
    getKeySizeSpecifier (ParamsCCM ContentEncryptionCipher c
c Bytes
_ CCM_M
_ CCM_L
_)     = forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher c
c
    getKeySizeSpecifier (ParamsGCM ContentEncryptionCipher c
c Bytes
_ Int
_)       = forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher c
c

instance ASN1Elem e => ProduceASN1Object e AuthContentEncryptionParams where
    asn1s :: AuthContentEncryptionParams -> ASN1Stream e
asn1s AuthContentEncryptionParams
param =
        forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
oid forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
params)
      where
        oid :: ASN1Stream e
oid    = forall e. ASN1Elem e => OID -> ASN1Stream e
gOID (forall a. OIDable a => a -> OID
getObjectID forall a b. (a -> b) -> a -> b
$ AuthContentEncryptionParams -> AuthContentEncryptionAlg
getAuthContentEncryptionAlg AuthContentEncryptionParams
param)
        params :: ASN1Stream e
params = forall e. ASN1Elem e => AuthContentEncryptionParams -> ASN1Stream e
aceParameterASN1S AuthContentEncryptionParams
param

instance Monoid e => ParseASN1Object e AuthContentEncryptionParams where
    parse :: ParseASN1 e AuthContentEncryptionParams
parse = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
        OID OID
oid <- forall e. Monoid e => ParseASN1 e ASN1
getNext
        forall a e b.
OIDNameable a =>
String -> OID -> (a -> ParseASN1 e b) -> ParseASN1 e b
withObjectID String
"authenticated-content encryption algorithm" OID
oid
            forall e.
Monoid e =>
AuthContentEncryptionAlg -> ParseASN1 e AuthContentEncryptionParams
parseACEParameter

aceParameterASN1S :: ASN1Elem e => AuthContentEncryptionParams -> ASN1Stream e
aceParameterASN1S :: forall e. ASN1Elem e => AuthContentEncryptionParams -> ASN1Stream e
aceParameterASN1S (Params_AUTH_ENC_128 AuthEncParams
p) = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s AuthEncParams
p
aceParameterASN1S (Params_AUTH_ENC_256 AuthEncParams
p) = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s AuthEncParams
p
aceParameterASN1S (Params_CHACHA20_POLY1305 Nonce
iv) = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert Nonce
iv)
aceParameterASN1S (ParamsCCM ContentEncryptionCipher c
_ Bytes
iv CCM_M
m CCM_L
_) =
    forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence ([e] -> [e]
nonce forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> [e]
icvlen)
  where
    nonce :: [e] -> [e]
nonce  = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert Bytes
iv)
    icvlen :: [e] -> [e]
icvlen = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CCM_M -> Int
getM CCM_M
m)
aceParameterASN1S (ParamsGCM ContentEncryptionCipher c
_ Bytes
iv Int
len) =
    forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence ([e] -> [e]
nonce forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> [e]
icvlen)
  where
    nonce :: [e] -> [e]
nonce  = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert Bytes
iv)
    icvlen :: [e] -> [e]
icvlen = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

parseACEParameter :: Monoid e
                  => AuthContentEncryptionAlg
                  -> ParseASN1 e AuthContentEncryptionParams
parseACEParameter :: forall e.
Monoid e =>
AuthContentEncryptionAlg -> ParseASN1 e AuthContentEncryptionParams
parseACEParameter AuthContentEncryptionAlg
AUTH_ENC_128 = AuthEncParams -> AuthContentEncryptionParams
Params_AUTH_ENC_128 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
parseACEParameter AuthContentEncryptionAlg
AUTH_ENC_256 = AuthEncParams -> AuthContentEncryptionParams
Params_AUTH_ENC_256 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
parseACEParameter AuthContentEncryptionAlg
CHACHA20_POLY1305 = do
    OctetString ByteString
bs <- forall e. Monoid e => ParseASN1 e ASN1
getNext
    case forall iv. ByteArrayAccess iv => iv -> CryptoFailable Nonce
ChaChaPoly1305.nonce12 ByteString
bs of
        CryptoPassed Nonce
iv -> forall (m :: * -> *) a. Monad m => a -> m a
return (Nonce -> AuthContentEncryptionParams
Params_CHACHA20_POLY1305 Nonce
iv)
        CryptoFailed CryptoError
e  ->
            forall e a. String -> ParseASN1 e a
throwParseError forall a b. (a -> b) -> a -> b
$ String
"Parsed invalid ChaChaPoly1305 nonce: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CryptoError
e
parseACEParameter (CCM ContentEncryptionCipher c
c)      = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
    OctetString ByteString
iv <- forall e. Monoid e => ParseASN1 e ASN1
getNext
    let ivlen :: Int
ivlen = forall ba. ByteArrayAccess ba => ba -> Int
B.length ByteString
iv
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ivlen forall a. Ord a => a -> a -> Bool
< Int
7 Bool -> Bool -> Bool
|| Int
ivlen forall a. Ord a => a -> a -> Bool
> Int
13) forall a b. (a -> b) -> a -> b
$
        forall e a. String -> ParseASN1 e a
throwParseError forall a b. (a -> b) -> a -> b
$ String
"Parsed invalid CCM nonce length: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
ivlen
    let Just CCM_L
l = Int -> Maybe CCM_L
fromL (Int
15 forall a. Num a => a -> a -> a
- Int
ivlen)
    CCM_M
m <- forall e. Monoid e => ParseASN1 e CCM_M
parseM
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall c.
BlockCipher c =>
ContentEncryptionCipher c
-> Bytes -> CCM_M -> CCM_L -> AuthContentEncryptionParams
ParamsCCM ContentEncryptionCipher c
c (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ByteString
iv) CCM_M
m CCM_L
l)
parseACEParameter (GCM ContentEncryptionCipher c
c)      = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
    OctetString ByteString
iv <- forall e. Monoid e => ParseASN1 e ASN1
getNext
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. ByteArrayAccess a => a -> Bool
B.null ByteString
iv) forall a b. (a -> b) -> a -> b
$
        forall e a. String -> ParseASN1 e a
throwParseError String
"Parsed empty GCM nonce"
    Integer
icvlen <- forall a. a -> Maybe a -> a
fromMaybe Integer
12 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe Integer
intOrNothing
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
icvlen forall a. Ord a => a -> a -> Bool
< Integer
12 Bool -> Bool -> Bool
|| Integer
icvlen forall a. Ord a => a -> a -> Bool
> Integer
16) forall a b. (a -> b) -> a -> b
$
        forall e a. String -> ParseASN1 e a
throwParseError forall a b. (a -> b) -> a -> b
$ String
"Parsed invalid GCM ICV length: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
icvlen
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall c.
BlockCipher c =>
ContentEncryptionCipher c
-> Bytes -> Int -> AuthContentEncryptionParams
ParamsGCM ContentEncryptionCipher c
c (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ByteString
iv) forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
icvlen)

-- | Get the authenticated-content encryption algorithm.
getAuthContentEncryptionAlg :: AuthContentEncryptionParams
                            -> AuthContentEncryptionAlg
getAuthContentEncryptionAlg :: AuthContentEncryptionParams -> AuthContentEncryptionAlg
getAuthContentEncryptionAlg (Params_AUTH_ENC_128 AuthEncParams
_) = AuthContentEncryptionAlg
AUTH_ENC_128
getAuthContentEncryptionAlg (Params_AUTH_ENC_256 AuthEncParams
_) = AuthContentEncryptionAlg
AUTH_ENC_256
getAuthContentEncryptionAlg (Params_CHACHA20_POLY1305 Nonce
_) = AuthContentEncryptionAlg
CHACHA20_POLY1305
getAuthContentEncryptionAlg (ParamsCCM ContentEncryptionCipher c
c Bytes
_ CCM_M
_ CCM_L
_)     = forall c.
BlockCipher c =>
ContentEncryptionCipher c -> AuthContentEncryptionAlg
CCM ContentEncryptionCipher c
c
getAuthContentEncryptionAlg (ParamsGCM ContentEncryptionCipher c
c Bytes
_ Int
_)       = forall c.
BlockCipher c =>
ContentEncryptionCipher c -> AuthContentEncryptionAlg
GCM ContentEncryptionCipher c
c

-- | Generate random 'AUTH_ENC_128' parameters with the specified algorithms.
generateAuthEnc128Params :: MonadRandom m
                         => PBKDF2_PRF -> ContentEncryptionAlg -> MACAlgorithm
                         -> m AuthContentEncryptionParams
generateAuthEnc128Params :: forall (m :: * -> *).
MonadRandom m =>
PBKDF2_PRF
-> ContentEncryptionAlg
-> MACAlgorithm
-> m AuthContentEncryptionParams
generateAuthEnc128Params PBKDF2_PRF
prfAlg ContentEncryptionAlg
cea MACAlgorithm
macAlg = do
    ContentEncryptionParams
params <- forall (m :: * -> *).
MonadRandom m =>
ContentEncryptionAlg -> m ContentEncryptionParams
generateEncryptionParams ContentEncryptionAlg
cea
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AuthEncParams -> AuthContentEncryptionParams
Params_AUTH_ENC_128 forall a b. (a -> b) -> a -> b
$
        AuthEncParams { prfAlgorithm :: PBKDF2_PRF
prfAlgorithm = PBKDF2_PRF
prfAlg
                      , encAlgorithm :: ContentEncryptionParams
encAlgorithm = ContentEncryptionParams
params
                      , macAlgorithm :: MACAlgorithm
macAlgorithm = MACAlgorithm
macAlg
                      }

-- | Generate random 'AUTH_ENC_256' parameters with the specified algorithms.
generateAuthEnc256Params :: MonadRandom m
                         => PBKDF2_PRF -> ContentEncryptionAlg -> MACAlgorithm
                         -> m AuthContentEncryptionParams
generateAuthEnc256Params :: forall (m :: * -> *).
MonadRandom m =>
PBKDF2_PRF
-> ContentEncryptionAlg
-> MACAlgorithm
-> m AuthContentEncryptionParams
generateAuthEnc256Params PBKDF2_PRF
prfAlg ContentEncryptionAlg
cea MACAlgorithm
macAlg = do
    ContentEncryptionParams
params <- forall (m :: * -> *).
MonadRandom m =>
ContentEncryptionAlg -> m ContentEncryptionParams
generateEncryptionParams ContentEncryptionAlg
cea
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AuthEncParams -> AuthContentEncryptionParams
Params_AUTH_ENC_256 forall a b. (a -> b) -> a -> b
$
        AuthEncParams { prfAlgorithm :: PBKDF2_PRF
prfAlgorithm = PBKDF2_PRF
prfAlg
                      , encAlgorithm :: ContentEncryptionParams
encAlgorithm = ContentEncryptionParams
params
                      , macAlgorithm :: MACAlgorithm
macAlgorithm = MACAlgorithm
macAlg
                      }

-- | Generate random 'CHACHA20_POLY1305' parameters.
generateChaChaPoly1305Params :: MonadRandom m => m AuthContentEncryptionParams
generateChaChaPoly1305Params :: forall (m :: * -> *).
MonadRandom m =>
m AuthContentEncryptionParams
generateChaChaPoly1305Params = do
    Bytes
bs <- forall (m :: * -> *). MonadRandom m => Int -> m Bytes
nonceGenerate Int
12
    let iv :: Nonce
iv = forall a. CryptoFailable a -> a
throwCryptoError (forall iv. ByteArrayAccess iv => iv -> CryptoFailable Nonce
ChaChaPoly1305.nonce12 Bytes
bs)
    forall (m :: * -> *) a. Monad m => a -> m a
return (Nonce -> AuthContentEncryptionParams
Params_CHACHA20_POLY1305 Nonce
iv)

-- | Generate random 'CCM' parameters for the specified cipher.
generateCCMParams :: (MonadRandom m, BlockCipher c)
                  => ContentEncryptionCipher c -> CCM_M -> CCM_L
                  -> m AuthContentEncryptionParams
generateCCMParams :: forall (m :: * -> *) c.
(MonadRandom m, BlockCipher c) =>
ContentEncryptionCipher c
-> CCM_M -> CCM_L -> m AuthContentEncryptionParams
generateCCMParams ContentEncryptionCipher c
c CCM_M
m CCM_L
l = do
    Bytes
iv <- forall (m :: * -> *). MonadRandom m => Int -> m Bytes
nonceGenerate (Int
15 forall a. Num a => a -> a -> a
- CCM_L -> Int
getL CCM_L
l)
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall c.
BlockCipher c =>
ContentEncryptionCipher c
-> Bytes -> CCM_M -> CCM_L -> AuthContentEncryptionParams
ParamsCCM ContentEncryptionCipher c
c Bytes
iv CCM_M
m CCM_L
l)

-- | Generate random 'GCM' parameters for the specified cipher.
generateGCMParams :: (MonadRandom m, BlockCipher c)
                  => ContentEncryptionCipher c -> Int
                  -> m AuthContentEncryptionParams
generateGCMParams :: forall (m :: * -> *) c.
(MonadRandom m, BlockCipher c) =>
ContentEncryptionCipher c -> Int -> m AuthContentEncryptionParams
generateGCMParams ContentEncryptionCipher c
c Int
l = do
    Bytes
iv <- forall (m :: * -> *). MonadRandom m => Int -> m Bytes
nonceGenerate Int
12
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall c.
BlockCipher c =>
ContentEncryptionCipher c
-> Bytes -> Int -> AuthContentEncryptionParams
ParamsGCM ContentEncryptionCipher c
c Bytes
iv Int
l)

-- | Encrypt a bytearray with the specified authenticated-content encryption
-- key and algorithm.
authContentEncrypt :: forall cek aad ba . (ByteArray cek, ByteArrayAccess aad, ByteArray ba)
                   => cek
                   -> AuthContentEncryptionParams -> ba
                   -> aad -> ba -> Either StoreError (AuthTag, ba)
authContentEncrypt :: forall cek aad ba.
(ByteArray cek, ByteArrayAccess aad, ByteArray ba) =>
cek
-> AuthContentEncryptionParams
-> ba
-> aad
-> ba
-> Either StoreError (MessageAuthenticationCode, ba)
authContentEncrypt cek
key AuthContentEncryptionParams
params ba
paramsRaw aad
aad ba
bs =
    case AuthContentEncryptionParams
params of
        Params_AUTH_ENC_128 AuthEncParams
p   -> forall cek.
ByteArrayAccess cek =>
Int -> cek -> Either StoreError ()
checkAuthKey Int
16 cek
key forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AuthEncParams -> Either StoreError (MessageAuthenticationCode, ba)
authEncrypt AuthEncParams
p
        Params_AUTH_ENC_256 AuthEncParams
p   -> forall cek.
ByteArrayAccess cek =>
Int -> cek -> Either StoreError ()
checkAuthKey Int
32 cek
key forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AuthEncParams -> Either StoreError (MessageAuthenticationCode, ba)
authEncrypt AuthEncParams
p
        Params_CHACHA20_POLY1305 Nonce
iv -> forall key aad.
(ByteArrayAccess key, ByteArrayAccess aad) =>
key -> Nonce -> aad -> Either StoreError State
ccpInit cek
key Nonce
iv aad
aad forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. State -> Either a (MessageAuthenticationCode, ba)
ccpEncrypt
        ParamsCCM ContentEncryptionCipher c
cipher Bytes
iv CCM_M
m CCM_L
l -> forall cipher key iv (proxy :: * -> *).
(BlockCipher cipher, ByteArray key, ByteArrayAccess iv) =>
proxy cipher
-> key -> AEADMode -> iv -> Either StoreError (AEAD cipher)
getAEAD ContentEncryptionCipher c
cipher cek
key (Int -> CCM_M -> CCM_L -> AEADMode
AEAD_CCM Int
msglen CCM_M
m CCM_L
l) Bytes
iv forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a.
Int -> AEAD a -> Either StoreError (MessageAuthenticationCode, ba)
encrypt (CCM_M -> Int
getM CCM_M
m)
        ParamsGCM ContentEncryptionCipher c
cipher Bytes
iv Int
len -> forall cipher key iv (proxy :: * -> *).
(BlockCipher cipher, ByteArray key, ByteArrayAccess iv) =>
proxy cipher
-> key -> AEADMode -> iv -> Either StoreError (AEAD cipher)
getAEAD ContentEncryptionCipher c
cipher cek
key AEADMode
AEAD_GCM Bytes
iv forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a.
Int -> AEAD a -> Either StoreError (MessageAuthenticationCode, ba)
encrypt Int
len
  where
    msglen :: Int
msglen  = forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs
    force :: b -> Either a b
force b
x = b
x seq :: forall a b. a -> b -> b
`seq` forall a b. b -> Either a b
Right b
x

    encrypt :: Int -> AEAD a -> Either StoreError (AuthTag, ba)
    encrypt :: forall a.
Int -> AEAD a -> Either StoreError (MessageAuthenticationCode, ba)
encrypt Int
len AEAD a
aead = forall {b} {a}. b -> Either a b
force forall a b. (a -> b) -> a -> b
$ forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> Int -> (MessageAuthenticationCode, ba)
aeadSimpleEncrypt AEAD a
aead aad
aad ba
bs Int
len

    ccpEncrypt :: ChaChaPoly1305.State -> Either a (AuthTag, ba)
    ccpEncrypt :: forall a. State -> Either a (MessageAuthenticationCode, ba)
ccpEncrypt State
state = forall {b} {a}. b -> Either a b
force (MessageAuthenticationCode
found, ba
encrypted)
      where
        (ba
encrypted, State
state') = forall ba. ByteArray ba => ba -> State -> (ba, State)
ChaChaPoly1305.encrypt ba
bs State
state
        found :: MessageAuthenticationCode
found = Auth -> MessageAuthenticationCode
ccpTag (State -> Auth
ChaChaPoly1305.finalize State
state')

    authEncrypt :: AuthEncParams -> Either StoreError (AuthTag, ba)
    authEncrypt :: AuthEncParams -> Either StoreError (MessageAuthenticationCode, ba)
authEncrypt p :: AuthEncParams
p@AuthEncParams{PBKDF2_PRF
ContentEncryptionParams
MACAlgorithm
macAlgorithm :: MACAlgorithm
encAlgorithm :: ContentEncryptionParams
prfAlgorithm :: PBKDF2_PRF
macAlgorithm :: AuthEncParams -> MACAlgorithm
encAlgorithm :: AuthEncParams -> ContentEncryptionParams
prfAlgorithm :: AuthEncParams -> PBKDF2_PRF
..} = do
        let (ScrubbedBytes
encKey, ScrubbedBytes
macKey) = forall password.
ByteArrayAccess password =>
password -> AuthEncParams -> (ScrubbedBytes, ScrubbedBytes)
authKeys cek
key AuthEncParams
p
        ba
encrypted <- forall cek ba.
(ByteArray cek, ByteArray ba) =>
cek -> ContentEncryptionParams -> ba -> Either StoreError ba
contentEncrypt ScrubbedBytes
encKey ContentEncryptionParams
encAlgorithm ba
bs
        let macMsg :: ba
macMsg = ba
paramsRaw forall bs. ByteArray bs => bs -> bs -> bs
`B.append` ba
encrypted forall bs. ByteArray bs => bs -> bs -> bs
`B.append` forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert aad
aad
            found :: MessageAuthenticationCode
found  = forall key message.
(ByteArrayAccess key, ByteArrayAccess message) =>
MACAlgorithm -> key -> message -> MessageAuthenticationCode
mac MACAlgorithm
macAlgorithm ScrubbedBytes
macKey ba
macMsg
        forall (m :: * -> *) a. Monad m => a -> m a
return (MessageAuthenticationCode
found, ba
encrypted)

-- | Decrypt a bytearray with the specified authenticated-content encryption key
-- and algorithm.
authContentDecrypt :: forall cek aad ba . (ByteArray cek, ByteArrayAccess aad, ByteArray ba)
                   => cek
                   -> AuthContentEncryptionParams -> ba
                   -> aad -> ba -> AuthTag -> Either StoreError ba
authContentDecrypt :: forall cek aad ba.
(ByteArray cek, ByteArrayAccess aad, ByteArray ba) =>
cek
-> AuthContentEncryptionParams
-> ba
-> aad
-> ba
-> MessageAuthenticationCode
-> Either StoreError ba
authContentDecrypt cek
key AuthContentEncryptionParams
params ba
paramsRaw aad
aad ba
bs MessageAuthenticationCode
expected =
    case AuthContentEncryptionParams
params of
        Params_AUTH_ENC_128 AuthEncParams
p   -> forall cek.
ByteArrayAccess cek =>
Int -> cek -> Either StoreError ()
checkAuthKey Int
16 cek
key forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AuthEncParams -> Either StoreError ba
authDecrypt AuthEncParams
p
        Params_AUTH_ENC_256 AuthEncParams
p   -> forall cek.
ByteArrayAccess cek =>
Int -> cek -> Either StoreError ()
checkAuthKey Int
32 cek
key forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AuthEncParams -> Either StoreError ba
authDecrypt AuthEncParams
p
        Params_CHACHA20_POLY1305 Nonce
iv -> forall key aad.
(ByteArrayAccess key, ByteArrayAccess aad) =>
key -> Nonce -> aad -> Either StoreError State
ccpInit cek
key Nonce
iv aad
aad forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= State -> Either StoreError ba
ccpDecrypt
        ParamsCCM ContentEncryptionCipher c
cipher Bytes
iv CCM_M
m CCM_L
l -> forall cipher key iv (proxy :: * -> *).
(BlockCipher cipher, ByteArray key, ByteArrayAccess iv) =>
proxy cipher
-> key -> AEADMode -> iv -> Either StoreError (AEAD cipher)
getAEAD ContentEncryptionCipher c
cipher cek
key (Int -> CCM_M -> CCM_L -> AEADMode
AEAD_CCM Int
msglen CCM_M
m CCM_L
l) Bytes
iv forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. AEAD a -> Either StoreError ba
decrypt
        ParamsGCM ContentEncryptionCipher c
cipher Bytes
iv Int
_   -> forall cipher key iv (proxy :: * -> *).
(BlockCipher cipher, ByteArray key, ByteArrayAccess iv) =>
proxy cipher
-> key -> AEADMode -> iv -> Either StoreError (AEAD cipher)
getAEAD ContentEncryptionCipher c
cipher cek
key AEADMode
AEAD_GCM Bytes
iv forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. AEAD a -> Either StoreError ba
decrypt
  where
    msglen :: Int
msglen  = forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs
    badMac :: Either StoreError b
badMac  = forall a b. a -> Either a b
Left StoreError
BadContentMAC

    decrypt :: AEAD a -> Either StoreError ba
    decrypt :: forall a. AEAD a -> Either StoreError ba
decrypt AEAD a
aead = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {b}. Either StoreError b
badMac forall a b. b -> Either a b
Right (forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> MessageAuthenticationCode -> Maybe ba
aeadSimpleDecrypt AEAD a
aead aad
aad ba
bs MessageAuthenticationCode
expected)

    ccpDecrypt :: ChaChaPoly1305.State -> Either StoreError ba
    ccpDecrypt :: State -> Either StoreError ba
ccpDecrypt State
state
        | MessageAuthenticationCode
found forall a. Eq a => a -> a -> Bool
== MessageAuthenticationCode
expected = forall a b. b -> Either a b
Right ba
decrypted
        | Bool
otherwise         = forall {b}. Either StoreError b
badMac
      where
        (ba
decrypted, State
state') = forall ba. ByteArray ba => ba -> State -> (ba, State)
ChaChaPoly1305.decrypt ba
bs State
state
        found :: MessageAuthenticationCode
found = Auth -> MessageAuthenticationCode
ccpTag (State -> Auth
ChaChaPoly1305.finalize State
state')

    authDecrypt :: AuthEncParams -> Either StoreError ba
    authDecrypt :: AuthEncParams -> Either StoreError ba
authDecrypt p :: AuthEncParams
p@AuthEncParams{PBKDF2_PRF
ContentEncryptionParams
MACAlgorithm
macAlgorithm :: MACAlgorithm
encAlgorithm :: ContentEncryptionParams
prfAlgorithm :: PBKDF2_PRF
macAlgorithm :: AuthEncParams -> MACAlgorithm
encAlgorithm :: AuthEncParams -> ContentEncryptionParams
prfAlgorithm :: AuthEncParams -> PBKDF2_PRF
..}
        | Bool -> Bool
not Bool
acceptable    = forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"authEnc MAC too weak")
        | MessageAuthenticationCode
found forall a. Eq a => a -> a -> Bool
== MessageAuthenticationCode
expected = forall cek ba.
(ByteArray cek, ByteArray ba) =>
cek -> ContentEncryptionParams -> ba -> Either StoreError ba
contentDecrypt ScrubbedBytes
encKey ContentEncryptionParams
encAlgorithm ba
bs
        | Bool
otherwise         = forall {b}. Either StoreError b
badMac
      where
        (ScrubbedBytes
encKey, ScrubbedBytes
macKey) = forall password.
ByteArrayAccess password =>
password -> AuthEncParams -> (ScrubbedBytes, ScrubbedBytes)
authKeys cek
key AuthEncParams
p
        macMsg :: ba
macMsg = ba
paramsRaw forall bs. ByteArray bs => bs -> bs -> bs
`B.append` ba
bs forall bs. ByteArray bs => bs -> bs -> bs
`B.append` forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert aad
aad
        found :: MessageAuthenticationCode
found  = forall key message.
(ByteArrayAccess key, ByteArrayAccess message) =>
MACAlgorithm -> key -> message -> MessageAuthenticationCode
mac MACAlgorithm
macAlgorithm ScrubbedBytes
macKey ba
macMsg
        acceptable :: Bool
acceptable = forall params. HasStrength params => params -> Bool
securityAcceptable MACAlgorithm
macAlgorithm

getAEAD :: (BlockCipher cipher, ByteArray key, ByteArrayAccess iv)
        => proxy cipher -> key -> AEADMode -> iv -> Either StoreError (AEAD cipher)
getAEAD :: forall cipher key iv (proxy :: * -> *).
(BlockCipher cipher, ByteArray key, ByteArrayAccess iv) =>
proxy cipher
-> key -> AEADMode -> iv -> Either StoreError (AEAD cipher)
getAEAD proxy cipher
cipher key
key AEADMode
mode iv
iv = do
    cipher
c <- forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher proxy cipher
cipher key
key
    forall a. CryptoFailable a -> Either StoreError a
fromCryptoFailable forall a b. (a -> b) -> a -> b
$ forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
aeadInit AEADMode
mode cipher
c iv
iv

authKeys :: ByteArrayAccess password
         => password -> AuthEncParams
         -> (B.ScrubbedBytes, B.ScrubbedBytes)
authKeys :: forall password.
ByteArrayAccess password =>
password -> AuthEncParams -> (ScrubbedBytes, ScrubbedBytes)
authKeys password
key AuthEncParams{PBKDF2_PRF
ContentEncryptionParams
MACAlgorithm
macAlgorithm :: MACAlgorithm
encAlgorithm :: ContentEncryptionParams
prfAlgorithm :: PBKDF2_PRF
macAlgorithm :: AuthEncParams -> MACAlgorithm
encAlgorithm :: AuthEncParams -> ContentEncryptionParams
prfAlgorithm :: AuthEncParams -> PBKDF2_PRF
..} = (ScrubbedBytes
encKey, ScrubbedBytes
macKey)
  where
    encKDF :: KeyDerivationFunc
encKDF = ByteString -> Int -> Maybe Int -> PBKDF2_PRF -> KeyDerivationFunc
PBKDF2 ByteString
"encryption" Int
1 forall a. Maybe a
Nothing PBKDF2_PRF
prfAlgorithm
    encLen :: Int
encLen = forall params. HasKeySize params => params -> Int
getMaximumKeySize ContentEncryptionParams
encAlgorithm
    encKey :: ScrubbedBytes
encKey = forall password out.
(ByteArrayAccess password, ByteArray out) =>
KeyDerivationFunc -> Int -> password -> out
kdfDerive KeyDerivationFunc
encKDF Int
encLen password
key

    macKDF :: KeyDerivationFunc
macKDF = ByteString -> Int -> Maybe Int -> PBKDF2_PRF -> KeyDerivationFunc
PBKDF2 ByteString
"authentication" Int
1 forall a. Maybe a
Nothing PBKDF2_PRF
prfAlgorithm
    macKey :: ScrubbedBytes
macKey = forall password out.
(ByteArrayAccess password, ByteArray out) =>
KeyDerivationFunc -> Int -> password -> out
kdfDerive KeyDerivationFunc
macKDF Int
macLen password
key

    -- RFC 6476 section 4.2: "Specifying a MAC key size gets a bit tricky"
    -- TODO: this is a hack but allows both test vectors to pass
    macLen :: Int
macLen | Int
encLen forall a. Eq a => a -> a -> Bool
== Int
24 = Int
16
           | Bool
otherwise    = forall params. HasKeySize params => params -> Int
getMaximumKeySize MACAlgorithm
macAlgorithm

checkAuthKey :: ByteArrayAccess cek => Int -> cek -> Either StoreError ()
checkAuthKey :: forall cek.
ByteArrayAccess cek =>
Int -> cek -> Either StoreError ()
checkAuthKey Int
sz cek
key
    | Int
actual forall a. Eq a => a -> a -> Bool
== Int
sz = forall a b. b -> Either a b
Right ()
    | Bool
otherwise    = forall a b. a -> Either a b
Left (CryptoError -> StoreError
CryptoError CryptoError
CryptoError_KeySizeInvalid)
  where actual :: Int
actual = forall ba. ByteArrayAccess ba => ba -> Int
B.length cek
key

ccpInit :: (ByteArrayAccess key, ByteArrayAccess aad)
        => key
        -> ChaChaPoly1305.Nonce
        -> aad
        -> Either StoreError ChaChaPoly1305.State
ccpInit :: forall key aad.
(ByteArrayAccess key, ByteArrayAccess aad) =>
key -> Nonce -> aad -> Either StoreError State
ccpInit key
key Nonce
nonce aad
aad = case forall key.
ByteArrayAccess key =>
key -> Nonce -> CryptoFailable State
ChaChaPoly1305.initialize key
key Nonce
nonce of
    CryptoPassed State
s -> forall (m :: * -> *) a. Monad m => a -> m a
return (State -> State
addAAD State
s)
    CryptoFailed CryptoError
e -> forall a b. a -> Either a b
Left (CryptoError -> StoreError
CryptoError CryptoError
e)
  where addAAD :: State -> State
addAAD = State -> State
ChaChaPoly1305.finalizeAAD forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba. ByteArrayAccess ba => ba -> State -> State
ChaChaPoly1305.appendAAD aad
aad

ccpTag :: Poly1305.Auth -> AuthTag
ccpTag :: Auth -> MessageAuthenticationCode
ccpTag (Poly1305.Auth Bytes
bs) = Bytes -> MessageAuthenticationCode
AuthTag Bytes
bs

-- PRF

-- | Pseudorandom function used for PBKDF2.
data PBKDF2_PRF = PBKDF2_SHA1   -- ^ hmacWithSHA1
                | PBKDF2_SHA256 -- ^ hmacWithSHA256
                | PBKDF2_SHA512 -- ^ hmacWithSHA512
                deriving (Int -> PBKDF2_PRF -> ShowS
[PBKDF2_PRF] -> ShowS
PBKDF2_PRF -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBKDF2_PRF] -> ShowS
$cshowList :: [PBKDF2_PRF] -> ShowS
show :: PBKDF2_PRF -> String
$cshow :: PBKDF2_PRF -> String
showsPrec :: Int -> PBKDF2_PRF -> ShowS
$cshowsPrec :: Int -> PBKDF2_PRF -> ShowS
Show,PBKDF2_PRF -> PBKDF2_PRF -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBKDF2_PRF -> PBKDF2_PRF -> Bool
$c/= :: PBKDF2_PRF -> PBKDF2_PRF -> Bool
== :: PBKDF2_PRF -> PBKDF2_PRF -> Bool
$c== :: PBKDF2_PRF -> PBKDF2_PRF -> Bool
Eq)

instance Enumerable PBKDF2_PRF where
    values :: [PBKDF2_PRF]
values = [ PBKDF2_PRF
PBKDF2_SHA1
             , PBKDF2_PRF
PBKDF2_SHA256
             , PBKDF2_PRF
PBKDF2_SHA512
             ]

instance OIDable PBKDF2_PRF where
    getObjectID :: PBKDF2_PRF -> OID
getObjectID PBKDF2_PRF
PBKDF2_SHA1   = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
2,Integer
7]
    getObjectID PBKDF2_PRF
PBKDF2_SHA256 = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
2,Integer
9]
    getObjectID PBKDF2_PRF
PBKDF2_SHA512 = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
2,Integer
11]

instance OIDNameable PBKDF2_PRF where
    fromObjectID :: OID -> Maybe PBKDF2_PRF
fromObjectID OID
oid = forall a. OIDNameableWrapper a -> a
unOIDNW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid

instance AlgorithmId PBKDF2_PRF where
    type AlgorithmType PBKDF2_PRF = PBKDF2_PRF
    algorithmName :: PBKDF2_PRF -> String
algorithmName PBKDF2_PRF
_  = String
"PBKDF2 PRF"
    algorithmType :: PBKDF2_PRF -> AlgorithmType PBKDF2_PRF
algorithmType    = forall a. a -> a
id
    parameterASN1S :: forall e. ASN1Elem e => PBKDF2_PRF -> ASN1Stream e
parameterASN1S PBKDF2_PRF
_ = forall a. a -> a
id
    parseParameter :: forall e.
Monoid e =>
AlgorithmType PBKDF2_PRF -> ParseASN1 e PBKDF2_PRF
parseParameter AlgorithmType PBKDF2_PRF
p = forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe ()
nullOrNothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return AlgorithmType PBKDF2_PRF
p

-- | Invoke the pseudorandom function.
prf :: (ByteArrayAccess salt, ByteArrayAccess password, ByteArray out)
    => PBKDF2_PRF -> PBKDF2.Parameters -> password -> salt -> out
prf :: forall salt password out.
(ByteArrayAccess salt, ByteArrayAccess password, ByteArray out) =>
PBKDF2_PRF -> Parameters -> password -> salt -> out
prf PBKDF2_PRF
PBKDF2_SHA1   = forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Parameters -> password -> salt -> out
PBKDF2.fastPBKDF2_SHA1
prf PBKDF2_PRF
PBKDF2_SHA256 = forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Parameters -> password -> salt -> out
PBKDF2.fastPBKDF2_SHA256
prf PBKDF2_PRF
PBKDF2_SHA512 = forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Parameters -> password -> salt -> out
PBKDF2.fastPBKDF2_SHA512


-- Key derivation

-- | Salt value used for key derivation.
type Salt = ByteString

-- | Key derivation algorithm.
data KeyDerivationAlgorithm = TypePBKDF2 | TypeScrypt

instance Enumerable KeyDerivationAlgorithm where
    values :: [KeyDerivationAlgorithm]
values = [ KeyDerivationAlgorithm
TypePBKDF2
             , KeyDerivationAlgorithm
TypeScrypt
             ]

instance OIDable KeyDerivationAlgorithm where
    getObjectID :: KeyDerivationAlgorithm -> OID
getObjectID KeyDerivationAlgorithm
TypePBKDF2 = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
5,Integer
12]
    getObjectID KeyDerivationAlgorithm
TypeScrypt = [Integer
1,Integer
3,Integer
6,Integer
1,Integer
4,Integer
1,Integer
11591,Integer
4,Integer
11]

instance OIDNameable KeyDerivationAlgorithm where
    fromObjectID :: OID -> Maybe KeyDerivationAlgorithm
fromObjectID OID
oid = forall a. OIDNameableWrapper a -> a
unOIDNW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid

-- | Key derivation algorithm and associated parameters.
data KeyDerivationFunc =
      -- | Key derivation with PBKDF2
      PBKDF2 { KeyDerivationFunc -> ByteString
pbkdf2Salt           :: Salt       -- ^ Salt value
             , KeyDerivationFunc -> Int
pbkdf2IterationCount :: Int        -- ^ Iteration count
             , KeyDerivationFunc -> Maybe Int
pbkdf2KeyLength      :: Maybe Int  -- ^ Optional key length
             , KeyDerivationFunc -> PBKDF2_PRF
pbkdf2Prf            :: PBKDF2_PRF -- ^ Pseudorandom function
             }
      -- | Key derivation with Scrypt
    | Scrypt { KeyDerivationFunc -> ByteString
scryptSalt      :: Salt       -- ^ Salt value
             , KeyDerivationFunc -> Word64
scryptN         :: Word64     -- ^ N value
             , KeyDerivationFunc -> Int
scryptR         :: Int        -- ^ R value
             , KeyDerivationFunc -> Int
scryptP         :: Int        -- ^ P value
             , KeyDerivationFunc -> Maybe Int
scryptKeyLength :: Maybe Int  -- ^ Optional key length
             }
    deriving (Int -> KeyDerivationFunc -> ShowS
[KeyDerivationFunc] -> ShowS
KeyDerivationFunc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyDerivationFunc] -> ShowS
$cshowList :: [KeyDerivationFunc] -> ShowS
show :: KeyDerivationFunc -> String
$cshow :: KeyDerivationFunc -> String
showsPrec :: Int -> KeyDerivationFunc -> ShowS
$cshowsPrec :: Int -> KeyDerivationFunc -> ShowS
Show,KeyDerivationFunc -> KeyDerivationFunc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyDerivationFunc -> KeyDerivationFunc -> Bool
$c/= :: KeyDerivationFunc -> KeyDerivationFunc -> Bool
== :: KeyDerivationFunc -> KeyDerivationFunc -> Bool
$c== :: KeyDerivationFunc -> KeyDerivationFunc -> Bool
Eq)

instance AlgorithmId KeyDerivationFunc where
    type AlgorithmType KeyDerivationFunc = KeyDerivationAlgorithm

    algorithmName :: KeyDerivationFunc -> String
algorithmName KeyDerivationFunc
_ = String
"key derivation algorithm"
    algorithmType :: KeyDerivationFunc -> AlgorithmType KeyDerivationFunc
algorithmType PBKDF2{} = KeyDerivationAlgorithm
TypePBKDF2
    algorithmType Scrypt{} = KeyDerivationAlgorithm
TypeScrypt

    parameterASN1S :: forall e. ASN1Elem e => KeyDerivationFunc -> ASN1Stream e
parameterASN1S PBKDF2{Int
Maybe Int
ByteString
PBKDF2_PRF
pbkdf2Prf :: PBKDF2_PRF
pbkdf2KeyLength :: Maybe Int
pbkdf2IterationCount :: Int
pbkdf2Salt :: ByteString
pbkdf2Prf :: KeyDerivationFunc -> PBKDF2_PRF
pbkdf2KeyLength :: KeyDerivationFunc -> Maybe Int
pbkdf2IterationCount :: KeyDerivationFunc -> Int
pbkdf2Salt :: KeyDerivationFunc -> ByteString
..} =
        forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence ([e] -> [e]
salt forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> [e]
iters forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> [e]
keyLen forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> [e]
mprf)
      where
        salt :: [e] -> [e]
salt   = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
pbkdf2Salt
        iters :: [e] -> [e]
iters  = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (forall a. Integral a => a -> Integer
toInteger Int
pbkdf2IterationCount)
        keyLen :: [e] -> [e]
keyLen = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger) Maybe Int
pbkdf2KeyLength
        mprf :: [e] -> [e]
mprf   = if PBKDF2_PRF
pbkdf2Prf forall a. Eq a => a -> a -> Bool
== PBKDF2_PRF
PBKDF2_SHA1 then forall a. a -> a
id else forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence PBKDF2_PRF
pbkdf2Prf

    parameterASN1S Scrypt{Int
Maybe Int
Word64
ByteString
scryptKeyLength :: Maybe Int
scryptP :: Int
scryptR :: Int
scryptN :: Word64
scryptSalt :: ByteString
scryptKeyLength :: KeyDerivationFunc -> Maybe Int
scryptP :: KeyDerivationFunc -> Int
scryptR :: KeyDerivationFunc -> Int
scryptN :: KeyDerivationFunc -> Word64
scryptSalt :: KeyDerivationFunc -> ByteString
..} =
        forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence ([e] -> [e]
salt forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> [e]
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> [e]
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> [e]
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> [e]
keyLen)
      where
        salt :: [e] -> [e]
salt   = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
scryptSalt
        n :: [e] -> [e]
n      = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (forall a. Integral a => a -> Integer
toInteger Word64
scryptN)
        r :: [e] -> [e]
r      = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (forall a. Integral a => a -> Integer
toInteger Int
scryptR)
        p :: [e] -> [e]
p      = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (forall a. Integral a => a -> Integer
toInteger Int
scryptP)
        keyLen :: [e] -> [e]
keyLen = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger) Maybe Int
scryptKeyLength

    parseParameter :: forall e.
Monoid e =>
AlgorithmType KeyDerivationFunc -> ParseASN1 e KeyDerivationFunc
parseParameter AlgorithmType KeyDerivationFunc
KeyDerivationAlgorithm
TypePBKDF2 = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
        OctetString ByteString
salt <- forall e. Monoid e => ParseASN1 e ASN1
getNext
        IntVal Integer
iters <- forall e. Monoid e => ParseASN1 e ASN1
getNext
        Maybe Integer
keyLen <- forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe Integer
intOrNothing
        Bool
b <- forall e. ParseASN1 e Bool
hasNext
        PBKDF2_PRF
mprf <- if Bool
b then forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence else forall (m :: * -> *) a. Monad m => a -> m a
return PBKDF2_PRF
PBKDF2_SHA1
        forall (m :: * -> *) a. Monad m => a -> m a
return PBKDF2 { pbkdf2Salt :: ByteString
pbkdf2Salt           = ByteString
salt
                      , pbkdf2IterationCount :: Int
pbkdf2IterationCount = forall a. Num a => Integer -> a
fromInteger Integer
iters
                      , pbkdf2KeyLength :: Maybe Int
pbkdf2KeyLength      = forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
keyLen
                      , pbkdf2Prf :: PBKDF2_PRF
pbkdf2Prf            = PBKDF2_PRF
mprf
                      }

    parseParameter AlgorithmType KeyDerivationFunc
KeyDerivationAlgorithm
TypeScrypt = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
        OctetString ByteString
salt <- forall e. Monoid e => ParseASN1 e ASN1
getNext
        IntVal Integer
n <- forall e. Monoid e => ParseASN1 e ASN1
getNext
        IntVal Integer
r <- forall e. Monoid e => ParseASN1 e ASN1
getNext
        IntVal Integer
p <- forall e. Monoid e => ParseASN1 e ASN1
getNext
        Maybe Integer
keyLen <- forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe Integer
intOrNothing
        forall (m :: * -> *) a. Monad m => a -> m a
return Scrypt { scryptSalt :: ByteString
scryptSalt      = ByteString
salt
                      , scryptN :: Word64
scryptN         = forall a. Num a => Integer -> a
fromInteger Integer
n
                      , scryptR :: Int
scryptR         = forall a. Num a => Integer -> a
fromInteger Integer
r
                      , scryptP :: Int
scryptP         = forall a. Num a => Integer -> a
fromInteger Integer
p
                      , scryptKeyLength :: Maybe Int
scryptKeyLength = forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
keyLen
                      }

-- | Return the optional key length stored in the KDF parameters.
kdfKeyLength :: KeyDerivationFunc -> Maybe Int
kdfKeyLength :: KeyDerivationFunc -> Maybe Int
kdfKeyLength PBKDF2{Int
Maybe Int
ByteString
PBKDF2_PRF
pbkdf2Prf :: PBKDF2_PRF
pbkdf2KeyLength :: Maybe Int
pbkdf2IterationCount :: Int
pbkdf2Salt :: ByteString
pbkdf2Prf :: KeyDerivationFunc -> PBKDF2_PRF
pbkdf2KeyLength :: KeyDerivationFunc -> Maybe Int
pbkdf2IterationCount :: KeyDerivationFunc -> Int
pbkdf2Salt :: KeyDerivationFunc -> ByteString
..} = Maybe Int
pbkdf2KeyLength
kdfKeyLength Scrypt{Int
Maybe Int
Word64
ByteString
scryptKeyLength :: Maybe Int
scryptP :: Int
scryptR :: Int
scryptN :: Word64
scryptSalt :: ByteString
scryptKeyLength :: KeyDerivationFunc -> Maybe Int
scryptP :: KeyDerivationFunc -> Int
scryptR :: KeyDerivationFunc -> Int
scryptN :: KeyDerivationFunc -> Word64
scryptSalt :: KeyDerivationFunc -> ByteString
..} = Maybe Int
scryptKeyLength

-- | Run a key derivation function to produce a result of the specified length
-- using the supplied password.
kdfDerive :: (ByteArrayAccess password, ByteArray out)
          => KeyDerivationFunc -> Int -> password -> out
kdfDerive :: forall password out.
(ByteArrayAccess password, ByteArray out) =>
KeyDerivationFunc -> Int -> password -> out
kdfDerive PBKDF2{Int
Maybe Int
ByteString
PBKDF2_PRF
pbkdf2Prf :: PBKDF2_PRF
pbkdf2KeyLength :: Maybe Int
pbkdf2IterationCount :: Int
pbkdf2Salt :: ByteString
pbkdf2Prf :: KeyDerivationFunc -> PBKDF2_PRF
pbkdf2KeyLength :: KeyDerivationFunc -> Maybe Int
pbkdf2IterationCount :: KeyDerivationFunc -> Int
pbkdf2Salt :: KeyDerivationFunc -> ByteString
..} Int
len password
pwd = forall salt password out.
(ByteArrayAccess salt, ByteArrayAccess password, ByteArray out) =>
PBKDF2_PRF -> Parameters -> password -> salt -> out
prf PBKDF2_PRF
pbkdf2Prf Parameters
params password
pwd ByteString
pbkdf2Salt
  where params :: Parameters
params = Int -> Int -> Parameters
PBKDF2.Parameters Int
pbkdf2IterationCount Int
len
kdfDerive Scrypt{Int
Maybe Int
Word64
ByteString
scryptKeyLength :: Maybe Int
scryptP :: Int
scryptR :: Int
scryptN :: Word64
scryptSalt :: ByteString
scryptKeyLength :: KeyDerivationFunc -> Maybe Int
scryptP :: KeyDerivationFunc -> Int
scryptR :: KeyDerivationFunc -> Int
scryptN :: KeyDerivationFunc -> Word64
scryptSalt :: KeyDerivationFunc -> ByteString
..} Int
len password
pwd = forall password salt output.
(ByteArrayAccess password, ByteArrayAccess salt,
 ByteArray output) =>
Parameters -> password -> salt -> output
Scrypt.generate Parameters
params password
pwd ByteString
scryptSalt
  where params :: Parameters
params = Scrypt.Parameters { n :: Word64
Scrypt.n = Word64
scryptN
                                   , r :: Int
Scrypt.r = Int
scryptR
                                   , p :: Int
Scrypt.p = Int
scryptP
                                   , outputLength :: Int
Scrypt.outputLength = Int
len
                                   }

-- | Generate a random salt with the specified length in bytes.  To be most
-- effective, the length should be at least 8 bytes.
generateSalt :: MonadRandom m => Int -> m Salt
generateSalt :: forall (m :: * -> *). MonadRandom m => Int -> m ByteString
generateSalt = forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes


-- Key encryption

data KeyEncryptionType = TypePWRIKEK
                       | TypeAES128_WRAP
                       | TypeAES192_WRAP
                       | TypeAES256_WRAP
                       | TypeAES128_WRAP_PAD
                       | TypeAES192_WRAP_PAD
                       | TypeAES256_WRAP_PAD
                       | TypeDES_EDE3_WRAP
                       | TypeRC2_WRAP

instance Enumerable KeyEncryptionType where
    values :: [KeyEncryptionType]
values = [ KeyEncryptionType
TypePWRIKEK
             , KeyEncryptionType
TypeAES128_WRAP
             , KeyEncryptionType
TypeAES192_WRAP
             , KeyEncryptionType
TypeAES256_WRAP
             , KeyEncryptionType
TypeAES128_WRAP_PAD
             , KeyEncryptionType
TypeAES192_WRAP_PAD
             , KeyEncryptionType
TypeAES256_WRAP_PAD
             , KeyEncryptionType
TypeDES_EDE3_WRAP
             , KeyEncryptionType
TypeRC2_WRAP
             ]

instance OIDable KeyEncryptionType where
    getObjectID :: KeyEncryptionType -> OID
getObjectID KeyEncryptionType
TypePWRIKEK         = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
9,Integer
16,Integer
3,Integer
9]

    getObjectID KeyEncryptionType
TypeAES128_WRAP     = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
5]
    getObjectID KeyEncryptionType
TypeAES192_WRAP     = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
25]
    getObjectID KeyEncryptionType
TypeAES256_WRAP     = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
45]

    getObjectID KeyEncryptionType
TypeAES128_WRAP_PAD = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
8]
    getObjectID KeyEncryptionType
TypeAES192_WRAP_PAD = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
28]
    getObjectID KeyEncryptionType
TypeAES256_WRAP_PAD = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
1,Integer
48]

    getObjectID KeyEncryptionType
TypeDES_EDE3_WRAP   = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
9,Integer
16,Integer
3,Integer
6]
    getObjectID KeyEncryptionType
TypeRC2_WRAP        = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
9,Integer
16,Integer
3,Integer
7]

instance OIDNameable KeyEncryptionType where
    fromObjectID :: OID -> Maybe KeyEncryptionType
fromObjectID OID
oid = forall a. OIDNameableWrapper a -> a
unOIDNW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid

-- | Key encryption algorithm with associated parameters (i.e. the underlying
-- encryption algorithm).
data KeyEncryptionParams = PWRIKEK ContentEncryptionParams  -- ^ PWRI-KEK key wrap algorithm
                         | AES128_WRAP                      -- ^ AES-128 key wrap
                         | AES192_WRAP                      -- ^ AES-192 key wrap
                         | AES256_WRAP                      -- ^ AES-256 key wrap
                         | AES128_WRAP_PAD                  -- ^ AES-128 extended key wrap
                         | AES192_WRAP_PAD                  -- ^ AES-192 extended key wrap
                         | AES256_WRAP_PAD                  -- ^ AES-256 extended key wrap
                         | DES_EDE3_WRAP                    -- ^ Triple-DES key wrap
                         | RC2_WRAP Int                     -- ^ RC2 key wrap with effective key length
                         deriving (Int -> KeyEncryptionParams -> ShowS
[KeyEncryptionParams] -> ShowS
KeyEncryptionParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyEncryptionParams] -> ShowS
$cshowList :: [KeyEncryptionParams] -> ShowS
show :: KeyEncryptionParams -> String
$cshow :: KeyEncryptionParams -> String
showsPrec :: Int -> KeyEncryptionParams -> ShowS
$cshowsPrec :: Int -> KeyEncryptionParams -> ShowS
Show,KeyEncryptionParams -> KeyEncryptionParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyEncryptionParams -> KeyEncryptionParams -> Bool
$c/= :: KeyEncryptionParams -> KeyEncryptionParams -> Bool
== :: KeyEncryptionParams -> KeyEncryptionParams -> Bool
$c== :: KeyEncryptionParams -> KeyEncryptionParams -> Bool
Eq)

instance AlgorithmId KeyEncryptionParams where
    type AlgorithmType KeyEncryptionParams = KeyEncryptionType
    algorithmName :: KeyEncryptionParams -> String
algorithmName KeyEncryptionParams
_ = String
"key encryption algorithm"

    algorithmType :: KeyEncryptionParams -> AlgorithmType KeyEncryptionParams
algorithmType (PWRIKEK ContentEncryptionParams
_)      = KeyEncryptionType
TypePWRIKEK
    algorithmType KeyEncryptionParams
AES128_WRAP      = KeyEncryptionType
TypeAES128_WRAP
    algorithmType KeyEncryptionParams
AES192_WRAP      = KeyEncryptionType
TypeAES192_WRAP
    algorithmType KeyEncryptionParams
AES256_WRAP      = KeyEncryptionType
TypeAES256_WRAP
    algorithmType KeyEncryptionParams
AES128_WRAP_PAD  = KeyEncryptionType
TypeAES128_WRAP_PAD
    algorithmType KeyEncryptionParams
AES192_WRAP_PAD  = KeyEncryptionType
TypeAES192_WRAP_PAD
    algorithmType KeyEncryptionParams
AES256_WRAP_PAD  = KeyEncryptionType
TypeAES256_WRAP_PAD
    algorithmType KeyEncryptionParams
DES_EDE3_WRAP    = KeyEncryptionType
TypeDES_EDE3_WRAP
    algorithmType (RC2_WRAP Int
_)     = KeyEncryptionType
TypeRC2_WRAP

    parameterASN1S :: forall e. ASN1Elem e => KeyEncryptionParams -> ASN1Stream e
parameterASN1S (PWRIKEK ContentEncryptionParams
cep)  = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s ContentEncryptionParams
cep
    parameterASN1S KeyEncryptionParams
DES_EDE3_WRAP  = forall e. ASN1Elem e => ASN1Stream e
gNull
    parameterASN1S (RC2_WRAP Int
ekl) = forall e. ASN1Elem e => Int -> ASN1Stream e
rc2VersionASN1 Int
ekl
    parameterASN1S KeyEncryptionParams
_              = forall a. a -> a
id

    parseParameter :: forall e.
Monoid e =>
AlgorithmType KeyEncryptionParams
-> ParseASN1 e KeyEncryptionParams
parseParameter AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypePWRIKEK          = ContentEncryptionParams -> KeyEncryptionParams
PWRIKEK forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
    parseParameter AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypeAES128_WRAP      = forall (m :: * -> *) a. Monad m => a -> m a
return KeyEncryptionParams
AES128_WRAP
    parseParameter AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypeAES192_WRAP      = forall (m :: * -> *) a. Monad m => a -> m a
return KeyEncryptionParams
AES192_WRAP
    parseParameter AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypeAES256_WRAP      = forall (m :: * -> *) a. Monad m => a -> m a
return KeyEncryptionParams
AES256_WRAP
    parseParameter AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypeAES128_WRAP_PAD  = forall (m :: * -> *) a. Monad m => a -> m a
return KeyEncryptionParams
AES128_WRAP_PAD
    parseParameter AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypeAES192_WRAP_PAD  = forall (m :: * -> *) a. Monad m => a -> m a
return KeyEncryptionParams
AES192_WRAP_PAD
    parseParameter AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypeAES256_WRAP_PAD  = forall (m :: * -> *) a. Monad m => a -> m a
return KeyEncryptionParams
AES256_WRAP_PAD
    parseParameter AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypeDES_EDE3_WRAP    = forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe ()
nullOrNothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return KeyEncryptionParams
DES_EDE3_WRAP
    parseParameter AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypeRC2_WRAP         = Int -> KeyEncryptionParams
RC2_WRAP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Monoid e => ParseASN1 e Int
parseRC2Version

instance HasKeySize KeyEncryptionParams where
    getKeySizeSpecifier :: KeyEncryptionParams -> KeySizeSpecifier
getKeySizeSpecifier (PWRIKEK ContentEncryptionParams
cep)   = forall params. HasKeySize params => params -> KeySizeSpecifier
getKeySizeSpecifier ContentEncryptionParams
cep
    getKeySizeSpecifier KeyEncryptionParams
AES128_WRAP     = forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher AES128
AES128
    getKeySizeSpecifier KeyEncryptionParams
AES192_WRAP     = forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher AES192
AES192
    getKeySizeSpecifier KeyEncryptionParams
AES256_WRAP     = forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher AES256
AES256
    getKeySizeSpecifier KeyEncryptionParams
AES128_WRAP_PAD = forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher AES128
AES128
    getKeySizeSpecifier KeyEncryptionParams
AES192_WRAP_PAD = forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher AES192
AES192
    getKeySizeSpecifier KeyEncryptionParams
AES256_WRAP_PAD = forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher AES256
AES256
    getKeySizeSpecifier KeyEncryptionParams
DES_EDE3_WRAP   = forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher DES_EDE3
DES_EDE3
    getKeySizeSpecifier (RC2_WRAP Int
_)    = Int -> KeySizeSpecifier
KeySizeFixed Int
16

-- | Encrypt a key with the specified key encryption key and algorithm.
keyEncrypt :: (MonadRandom m, ByteArray kek, ByteArray ba)
           => kek -> KeyEncryptionParams -> ba -> m (Either StoreError ba)
keyEncrypt :: forall (m :: * -> *) kek ba.
(MonadRandom m, ByteArray kek, ByteArray ba) =>
kek -> KeyEncryptionParams -> ba -> m (Either StoreError ba)
keyEncrypt kek
key (PWRIKEK ContentEncryptionParams
params) ba
bs =
    case ContentEncryptionParams
params of
        ParamsECB ContentEncryptionCipher c
cipher    -> let cc :: Either StoreError c
cc = forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher kek
key in forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (\c
c -> forall (m :: * -> *) cipher ba.
(MonadRandom m, BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> m (Either StoreError ba)
wrapEncrypt (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt) c
c forall a. HasCallStack => a
undefined ba
bs) Either StoreError c
cc
        ParamsCBC ContentEncryptionCipher c
cipher IV c
iv -> let cc :: Either StoreError c
cc = forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher kek
key in forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (\c
c -> forall (m :: * -> *) cipher ba.
(MonadRandom m, BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> m (Either StoreError ba)
wrapEncrypt forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcEncrypt c
c IV c
iv ba
bs) Either StoreError c
cc
        ParamsCBCRC2 Int
len IV RC2
iv -> let cc :: Either StoreError RC2
cc = forall key. ByteArray key => Int -> key -> Either StoreError RC2
getRC2Cipher Int
len kek
key in forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (\RC2
c -> forall (m :: * -> *) cipher ba.
(MonadRandom m, BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> m (Either StoreError ba)
wrapEncrypt forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcEncrypt RC2
c IV RC2
iv ba
bs) Either StoreError RC2
cc
        ParamsCFB ContentEncryptionCipher c
cipher IV c
iv -> let cc :: Either StoreError c
cc = forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher kek
key in forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (\c
c -> forall (m :: * -> *) cipher ba.
(MonadRandom m, BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> m (Either StoreError ba)
wrapEncrypt forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cfbEncrypt c
c IV c
iv ba
bs) Either StoreError c
cc
        ParamsCTR ContentEncryptionCipher c
_ IV c
_       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"Unable to wrap key in CTR mode")
keyEncrypt kek
key KeyEncryptionParams
AES128_WRAP      ba
bs = forall (m :: * -> *) a. Monad m => a -> m a
return (forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES128
AES128 kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall aes ba.
(BlockCipher aes, ByteArray ba) =>
aes -> ba -> Either StoreError ba
`AES_KW.wrap` ba
bs))
keyEncrypt kek
key KeyEncryptionParams
AES192_WRAP      ba
bs = forall (m :: * -> *) a. Monad m => a -> m a
return (forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES192
AES192 kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall aes ba.
(BlockCipher aes, ByteArray ba) =>
aes -> ba -> Either StoreError ba
`AES_KW.wrap` ba
bs))
keyEncrypt kek
key KeyEncryptionParams
AES256_WRAP      ba
bs = forall (m :: * -> *) a. Monad m => a -> m a
return (forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES256
AES256 kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall aes ba.
(BlockCipher aes, ByteArray ba) =>
aes -> ba -> Either StoreError ba
`AES_KW.wrap` ba
bs))
keyEncrypt kek
key KeyEncryptionParams
AES128_WRAP_PAD  ba
bs = forall (m :: * -> *) a. Monad m => a -> m a
return (forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES128
AES128 kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall aes ba.
(BlockCipher aes, ByteArray ba) =>
aes -> ba -> Either StoreError ba
`AES_KW.wrapPad` ba
bs))
keyEncrypt kek
key KeyEncryptionParams
AES192_WRAP_PAD  ba
bs = forall (m :: * -> *) a. Monad m => a -> m a
return (forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES192
AES192 kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall aes ba.
(BlockCipher aes, ByteArray ba) =>
aes -> ba -> Either StoreError ba
`AES_KW.wrapPad` ba
bs))
keyEncrypt kek
key KeyEncryptionParams
AES256_WRAP_PAD  ba
bs = forall (m :: * -> *) a. Monad m => a -> m a
return (forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES256
AES256 kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall aes ba.
(BlockCipher aes, ByteArray ba) =>
aes -> ba -> Either StoreError ba
`AES_KW.wrapPad` ba
bs))
keyEncrypt kek
key KeyEncryptionParams
DES_EDE3_WRAP    ba
bs = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (forall {f :: * -> *} {cipher} {ba}.
(BlockCipher cipher, ByteArray ba, MonadRandom f) =>
ba -> cipher -> f (Either StoreError ba)
wrap3DES ba
bs) (forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher DES_EDE3
DES_EDE3 kek
key)
  where wrap3DES :: ba -> cipher -> f (Either StoreError ba)
wrap3DES ba
b cipher
c = (\IV cipher
iv -> forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> Either StoreError ba
TripleDES_KW.wrap cipher
c IV cipher
iv ba
b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall cipher (m :: * -> *).
(BlockCipher cipher, MonadRandom m) =>
cipher -> m (IV cipher)
ivGenerate cipher
c
keyEncrypt kek
key (RC2_WRAP Int
ekl)   ba
bs = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (forall {m :: * -> *} {cipher} {ba}.
(BlockCipher cipher, MonadRandom m, ByteArray ba) =>
ba -> cipher -> m (Either StoreError ba)
wrapRC2 ba
bs) (forall key. ByteArray key => Int -> key -> Either StoreError RC2
getRC2Cipher Int
ekl kek
key)
  where wrapRC2 :: ba -> cipher -> m (Either StoreError ba)
wrapRC2 ba
b cipher
c = do IV cipher
iv <- forall cipher (m :: * -> *).
(BlockCipher cipher, MonadRandom m) =>
cipher -> m (IV cipher)
ivGenerate cipher
c; forall (m :: * -> *) cipher ba.
(MonadRandom m, BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> m (Either StoreError ba)
RC2_KW.wrap cipher
c IV cipher
iv ba
b

-- | Decrypt a key with the specified key encryption key and algorithm.
keyDecrypt :: (ByteArray kek, ByteArray ba)
           => kek -> KeyEncryptionParams -> ba -> Either StoreError ba
keyDecrypt :: forall kek ba.
(ByteArray kek, ByteArray ba) =>
kek -> KeyEncryptionParams -> ba -> Either StoreError ba
keyDecrypt kek
key (PWRIKEK ContentEncryptionParams
params) ba
bs =
    case ContentEncryptionParams
params of
        ParamsECB ContentEncryptionCipher c
cipher    -> forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> Either StoreError ba
wrapDecrypt (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbDecrypt) c
c forall a. HasCallStack => a
undefined ba
bs)
        ParamsCBC ContentEncryptionCipher c
cipher IV c
iv -> forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> Either StoreError ba
wrapDecrypt forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcDecrypt c
c IV c
iv ba
bs)
        ParamsCBCRC2 Int
len IV RC2
iv -> forall key. ByteArray key => Int -> key -> Either StoreError RC2
getRC2Cipher Int
len kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\RC2
c -> forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> Either StoreError ba
wrapDecrypt forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcDecrypt RC2
c IV RC2
iv ba
bs)
        ParamsCFB ContentEncryptionCipher c
cipher IV c
iv -> forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> Either StoreError ba
wrapDecrypt forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cfbDecrypt c
c IV c
iv ba
bs)
        ParamsCTR ContentEncryptionCipher c
_ IV c
_       -> forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"Unable to unwrap key in CTR mode")
keyDecrypt kek
key KeyEncryptionParams
AES128_WRAP      ba
bs = forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES128
AES128   kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall aes ba.
(BlockCipher aes, ByteArray ba) =>
aes -> ba -> Either StoreError ba
`AES_KW.unwrap` ba
bs)
keyDecrypt kek
key KeyEncryptionParams
AES192_WRAP      ba
bs = forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES192
AES192   kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall aes ba.
(BlockCipher aes, ByteArray ba) =>
aes -> ba -> Either StoreError ba
`AES_KW.unwrap` ba
bs)
keyDecrypt kek
key KeyEncryptionParams
AES256_WRAP      ba
bs = forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES256
AES256   kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall aes ba.
(BlockCipher aes, ByteArray ba) =>
aes -> ba -> Either StoreError ba
`AES_KW.unwrap` ba
bs)
keyDecrypt kek
key KeyEncryptionParams
AES128_WRAP_PAD  ba
bs = forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES128
AES128   kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall aes ba.
(BlockCipher aes, ByteArray ba) =>
aes -> ba -> Either StoreError ba
`AES_KW.unwrapPad` ba
bs)
keyDecrypt kek
key KeyEncryptionParams
AES192_WRAP_PAD  ba
bs = forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES192
AES192   kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall aes ba.
(BlockCipher aes, ByteArray ba) =>
aes -> ba -> Either StoreError ba
`AES_KW.unwrapPad` ba
bs)
keyDecrypt kek
key KeyEncryptionParams
AES256_WRAP_PAD  ba
bs = forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES256
AES256   kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall aes ba.
(BlockCipher aes, ByteArray ba) =>
aes -> ba -> Either StoreError ba
`AES_KW.unwrapPad` ba
bs)
keyDecrypt kek
key KeyEncryptionParams
DES_EDE3_WRAP    ba
bs = forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher DES_EDE3
DES_EDE3 kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall aes ba.
(BlockCipher aes, ByteArray ba) =>
aes -> ba -> Either StoreError ba
`TripleDES_KW.unwrap` ba
bs)
keyDecrypt kek
key (RC2_WRAP Int
ekl)   ba
bs = forall key. ByteArray key => Int -> key -> Either StoreError RC2
getRC2Cipher Int
ekl kek
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall aes ba.
(BlockCipher aes, ByteArray ba) =>
aes -> ba -> Either StoreError ba
`RC2_KW.unwrap` ba
bs)

keyWrap :: (MonadRandom m, ByteArray ba)
        => Int -> ba -> m (Either StoreError ba)
keyWrap :: forall (m :: * -> *) ba.
(MonadRandom m, ByteArray ba) =>
Int -> ba -> m (Either StoreError ba)
keyWrap Int
sz ba
input
    | Int
inLen forall a. Ord a => a -> a -> Bool
<   Int
3 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"keyWrap: input key too short")
    | Int
inLen forall a. Ord a => a -> a -> Bool
> Int
255 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"keyWrap: input key too long")
    | Int
pLen forall a. Eq a => a -> a -> Bool
== Int
0   = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat [ ba
count, ba
check, ba
input ]
    | Bool
otherwise   = do
        ba
padding <- forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
pLen
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat [ ba
count, ba
check, ba
input, ba
padding ]
  where
    inLen :: Int
inLen = forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input
    count :: ba
count = forall a. ByteArray a => Word8 -> a
B.singleton (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
inLen)
    check :: ba
check = forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.xor ba
input (forall a. ByteArray a => [Word8] -> a
B.pack [Word8
255, Word8
255, Word8
255] :: B.Bytes)
    pLen :: Int
pLen  = Int
sz forall a. Num a => a -> a -> a
- (Int
inLen forall a. Num a => a -> a -> a
+ Int
4) forall a. Integral a => a -> a -> a
`mod` Int
sz forall a. Num a => a -> a -> a
+ Int
comp
    comp :: Int
comp  = if Int
inLen forall a. Num a => a -> a -> a
+ Int
4 forall a. Ord a => a -> a -> Bool
> Int
sz then Int
0 else Int
sz

keyUnwrap :: ByteArray ba => ba -> Either StoreError ba
keyUnwrap :: forall ba. ByteArray ba => ba -> Either StoreError ba
keyUnwrap ba
input
    | Int
inLen forall a. Ord a => a -> a -> Bool
< Int
4         = forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"keyUnwrap: invalid wrapped key")
    | Bool
valid             = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall bs. ByteArray bs => Int -> bs -> bs
B.take Int
count (forall bs. ByteArray bs => Int -> bs -> bs
B.drop Int
4 ba
input)
    | Bool
otherwise         = forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"keyUnwrap: invalid wrapped key")
  where
    inLen :: Int
inLen = forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input
    count :: Int
count = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. ByteArrayAccess a => a -> Int -> Word8
B.index ba
input Int
0)
    bytes :: [Word8]
bytes = [ forall a. ByteArrayAccess a => a -> Int -> Word8
B.index ba
input (Int
i forall a. Num a => a -> a -> a
+ Int
1) forall a. Bits a => a -> a -> a
`xor` forall a. ByteArrayAccess a => a -> Int -> Word8
B.index ba
input (Int
i forall a. Num a => a -> a -> a
+ Int
4) | Int
i <- [Int
0..Int
2] ]
    valid :: Bool
valid = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall a. Bits a => a -> a -> a
(.&.) [Word8]
bytes forall a. Eq a => a -> a -> Bool
== Word8
0xFF Bool -> Bool -> Bool
&&! Int
inLen forall a. Ord a => a -> a -> Bool
>= Int
count forall a. Num a => a -> a -> a
- Int
4

wrapEncrypt :: (MonadRandom m, BlockCipher cipher, ByteArray ba)
            => (cipher -> IV cipher -> ba -> ba)
            -> cipher -> IV cipher -> ba -> m (Either StoreError ba)
wrapEncrypt :: forall (m :: * -> *) cipher ba.
(MonadRandom m, BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> m (Either StoreError ba)
wrapEncrypt cipher -> IV cipher -> ba -> ba
encFn cipher
cipher IV cipher
iv ba
input = do
    Either StoreError ba
wrapped <- forall (m :: * -> *) ba.
(MonadRandom m, ByteArray ba) =>
Int -> ba -> m (Either StoreError ba)
keyWrap Int
sz ba
input
    forall (m :: * -> *) a. Monad m => a -> m a
return (ba -> ba
fn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either StoreError ba
wrapped)
  where
    sz :: Int
sz = forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher
    fn :: ba -> ba
fn ba
formatted =
        let firstPass :: ba
firstPass = cipher -> IV cipher -> ba -> ba
encFn cipher
cipher IV cipher
iv ba
formatted
            lastBlock :: View ba
lastBlock = forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
B.dropView ba
firstPass (forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
firstPass forall a. Num a => a -> a -> a
- Int
sz)
            Just IV cipher
iv'  = forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV View ba
lastBlock
         in cipher -> IV cipher -> ba -> ba
encFn cipher
cipher IV cipher
iv' ba
firstPass

wrapDecrypt :: (BlockCipher cipher, ByteArray ba)
            => (cipher -> IV cipher -> ba -> ba)
            -> cipher -> IV cipher -> ba -> Either StoreError ba
wrapDecrypt :: forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> Either StoreError ba
wrapDecrypt cipher -> IV cipher -> ba -> ba
decFn cipher
cipher IV cipher
iv ba
input = forall ba. ByteArray ba => ba -> Either StoreError ba
keyUnwrap (cipher -> IV cipher -> ba -> ba
decFn cipher
cipher IV cipher
iv ba
firstPass)
  where
    sz :: Int
sz = forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher
    (ba
beg, ba
lb) = forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt (forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input forall a. Num a => a -> a -> a
- Int
sz) ba
input
    lastBlock :: ba
lastBlock = cipher -> IV cipher -> ba -> ba
decFn cipher
cipher IV cipher
iv' ba
lb
    Just IV cipher
iv'  = forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV (forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
B.dropView ba
beg (forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
beg forall a. Num a => a -> a -> a
- Int
sz))
    Just IV cipher
iv'' = forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV ba
lastBlock
    firstPass :: ba
firstPass = cipher -> IV cipher -> ba -> ba
decFn cipher
cipher IV cipher
iv'' ba
beg forall bs. ByteArray bs => bs -> bs -> bs
`B.append` ba
lastBlock


-- Key transport

-- | Encryption parameters for RSAES-OAEP.
data OAEPParams = OAEPParams
    { OAEPParams -> DigestAlgorithm
oaepHashAlgorithm :: DigestAlgorithm       -- ^ Hash function
    , OAEPParams -> MaskGenerationFunc
oaepMaskGenAlgorithm :: MaskGenerationFunc -- ^ Mask generation function
    }
    deriving (Int -> OAEPParams -> ShowS
[OAEPParams] -> ShowS
OAEPParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAEPParams] -> ShowS
$cshowList :: [OAEPParams] -> ShowS
show :: OAEPParams -> String
$cshow :: OAEPParams -> String
showsPrec :: Int -> OAEPParams -> ShowS
$cshowsPrec :: Int -> OAEPParams -> ShowS
Show,OAEPParams -> OAEPParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAEPParams -> OAEPParams -> Bool
$c/= :: OAEPParams -> OAEPParams -> Bool
== :: OAEPParams -> OAEPParams -> Bool
$c== :: OAEPParams -> OAEPParams -> Bool
Eq)

instance HasStrength OAEPParams where
    getSecurityBits :: OAEPParams -> Int
getSecurityBits OAEPParams{MaskGenerationFunc
DigestAlgorithm
oaepMaskGenAlgorithm :: MaskGenerationFunc
oaepHashAlgorithm :: DigestAlgorithm
oaepMaskGenAlgorithm :: OAEPParams -> MaskGenerationFunc
oaepHashAlgorithm :: OAEPParams -> DigestAlgorithm
..} =
        forall a. Ord a => a -> a -> a
min (forall params. HasStrength params => params -> Int
getSecurityBits DigestAlgorithm
oaepHashAlgorithm)
            (forall params. HasStrength params => params -> Int
getSecurityBits MaskGenerationFunc
oaepMaskGenAlgorithm)

withOAEPParams :: forall seed output a . (ByteArrayAccess seed, ByteArray output)
               => OAEPParams
               -> (forall hash . Hash.HashAlgorithm hash => RSAOAEP.OAEPParams hash seed output -> a)
               -> a
withOAEPParams :: forall seed output a.
(ByteArrayAccess seed, ByteArray output) =>
OAEPParams
-> (forall hash.
    HashAlgorithm hash =>
    OAEPParams hash seed output -> a)
-> a
withOAEPParams OAEPParams
p forall hash. HashAlgorithm hash => OAEPParams hash seed output -> a
fn =
    case OAEPParams -> DigestAlgorithm
oaepHashAlgorithm OAEPParams
p of
        DigestAlgorithm DigestProxy hashAlg
hashAlg ->
            forall hash. HashAlgorithm hash => OAEPParams hash seed output -> a
fn RSAOAEP.OAEPParams
                { oaepHash :: hashAlg
RSAOAEP.oaepHash = forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy DigestProxy hashAlg
hashAlg
                , oaepMaskGenAlg :: MaskGenAlgorithm seed output
RSAOAEP.oaepMaskGenAlg = forall seed output.
(ByteArrayAccess seed, ByteArray output) =>
MaskGenerationFunc -> seed -> Int -> output
mgf (OAEPParams -> MaskGenerationFunc
oaepMaskGenAlgorithm OAEPParams
p)
                , oaepLabel :: Maybe ByteString
RSAOAEP.oaepLabel = forall a. Maybe a
Nothing
                }

instance ASN1Elem e => ProduceASN1Object e OAEPParams where
    asn1s :: OAEPParams -> ASN1Stream e
asn1s OAEPParams{MaskGenerationFunc
DigestAlgorithm
oaepMaskGenAlgorithm :: MaskGenerationFunc
oaepHashAlgorithm :: DigestAlgorithm
oaepMaskGenAlgorithm :: OAEPParams -> MaskGenerationFunc
oaepHashAlgorithm :: OAEPParams -> DigestAlgorithm
..} =
        forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
m)
      where
        sha1 :: DigestAlgorithm
sha1  = forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1
        tag :: Int -> ASN1Stream e -> ASN1Stream e
tag Int
i = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
i)

        h :: ASN1Stream e
h | DigestAlgorithm
oaepHashAlgorithm forall a. Eq a => a -> a -> Bool
== DigestAlgorithm
sha1 = forall a. a -> a
id
          | Bool
otherwise = forall {e}. ASN1Elem e => Int -> ASN1Stream e -> ASN1Stream e
tag Int
0 (forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence DigestAlgorithm
oaepHashAlgorithm)

        m :: ASN1Stream e
m | MaskGenerationFunc
oaepMaskGenAlgorithm forall a. Eq a => a -> a -> Bool
== DigestAlgorithm -> MaskGenerationFunc
MGF1 DigestAlgorithm
sha1 = forall a. a -> a
id
          | Bool
otherwise = forall {e}. ASN1Elem e => Int -> ASN1Stream e -> ASN1Stream e
tag Int
1 (forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence MaskGenerationFunc
oaepMaskGenAlgorithm)

instance Monoid e => ParseASN1Object e OAEPParams where
    parse :: ParseASN1 e OAEPParams
parse = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
        Maybe DigestAlgorithm
h <- forall {e} {a}.
Monoid e =>
Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
0 (forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence)
        Maybe MaskGenerationFunc
m <- forall {e} {a}.
Monoid e =>
Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
1 (forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence)
        Maybe ()
_ <- forall {e} {a}.
Monoid e =>
Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
2 ParseASN1 e ()
parsePSpecified
        forall (m :: * -> *) a. Monad m => a -> m a
return OAEPParams { oaepHashAlgorithm :: DigestAlgorithm
oaepHashAlgorithm = forall a. a -> Maybe a -> a
fromMaybe DigestAlgorithm
sha1 Maybe DigestAlgorithm
h
                          , oaepMaskGenAlgorithm :: MaskGenerationFunc
oaepMaskGenAlgorithm = forall a. a -> Maybe a -> a
fromMaybe (DigestAlgorithm -> MaskGenerationFunc
MGF1 DigestAlgorithm
sha1) Maybe MaskGenerationFunc
m
                          }
      where
        sha1 :: DigestAlgorithm
sha1  = forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1
        tag :: Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
i = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e (Maybe a)
onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
i)

        parsePSpecified :: ParseASN1 e ()
parsePSpecified = do
            OID [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
9] <- forall e. Monoid e => ParseASN1 e ASN1
getNext
            OctetString ByteString
p <- forall e. Monoid e => ParseASN1 e ASN1
getNext
            forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall a. ByteArrayAccess a => a -> Bool
B.null ByteString
p)

data KeyTransportType = TypeRSAES
                      | TypeRSAESOAEP

instance Enumerable KeyTransportType where
    values :: [KeyTransportType]
values = [ KeyTransportType
TypeRSAES
             , KeyTransportType
TypeRSAESOAEP
             ]

instance OIDable KeyTransportType where
    getObjectID :: KeyTransportType -> OID
getObjectID KeyTransportType
TypeRSAES          = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
1]
    getObjectID KeyTransportType
TypeRSAESOAEP      = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
7]

instance OIDNameable KeyTransportType where
    fromObjectID :: OID -> Maybe KeyTransportType
fromObjectID OID
oid = forall a. OIDNameableWrapper a -> a
unOIDNW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid

-- | Key transport algorithm with associated parameters.
data KeyTransportParams = RSAES                 -- ^ RSAES-PKCS1
                        | RSAESOAEP OAEPParams  -- ^ RSAES-OAEP
                        deriving (Int -> KeyTransportParams -> ShowS
[KeyTransportParams] -> ShowS
KeyTransportParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyTransportParams] -> ShowS
$cshowList :: [KeyTransportParams] -> ShowS
show :: KeyTransportParams -> String
$cshow :: KeyTransportParams -> String
showsPrec :: Int -> KeyTransportParams -> ShowS
$cshowsPrec :: Int -> KeyTransportParams -> ShowS
Show,KeyTransportParams -> KeyTransportParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyTransportParams -> KeyTransportParams -> Bool
$c/= :: KeyTransportParams -> KeyTransportParams -> Bool
== :: KeyTransportParams -> KeyTransportParams -> Bool
$c== :: KeyTransportParams -> KeyTransportParams -> Bool
Eq)

instance AlgorithmId KeyTransportParams where
    type AlgorithmType KeyTransportParams = KeyTransportType
    algorithmName :: KeyTransportParams -> String
algorithmName KeyTransportParams
_ = String
"key transport algorithm"

    algorithmType :: KeyTransportParams -> AlgorithmType KeyTransportParams
algorithmType KeyTransportParams
RSAES              = KeyTransportType
TypeRSAES
    algorithmType (RSAESOAEP OAEPParams
_)      = KeyTransportType
TypeRSAESOAEP

    parameterASN1S :: forall e. ASN1Elem e => KeyTransportParams -> ASN1Stream e
parameterASN1S KeyTransportParams
RSAES             = forall e. ASN1Elem e => ASN1Stream e
gNull
    parameterASN1S (RSAESOAEP OAEPParams
p)     = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s OAEPParams
p

    parseParameter :: forall e.
Monoid e =>
AlgorithmType KeyTransportParams -> ParseASN1 e KeyTransportParams
parseParameter AlgorithmType KeyTransportParams
KeyTransportType
TypeRSAES         = forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe ()
nullOrNothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return KeyTransportParams
RSAES
    parseParameter AlgorithmType KeyTransportParams
KeyTransportType
TypeRSAESOAEP     = OAEPParams -> KeyTransportParams
RSAESOAEP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse

-- | Encrypt the specified content with a key-transport algorithm and recipient
-- public key.
transportEncrypt :: MonadRandom m
                 => KeyTransportParams
                 -> X509.PubKey
                 -> ByteString
                 -> m (Either StoreError ByteString)
transportEncrypt :: forall (m :: * -> *).
MonadRandom m =>
KeyTransportParams
-> PubKey -> ByteString -> m (Either StoreError ByteString)
transportEncrypt KeyTransportParams
RSAES         (X509.PubKeyRSA PublicKey
pub) ByteString
bs =
    forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft Error -> StoreError
RSAError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadRandom m =>
PublicKey -> ByteString -> m (Either Error ByteString)
RSA.encrypt PublicKey
pub ByteString
bs
transportEncrypt (RSAESOAEP OAEPParams
p) (X509.PubKeyRSA PublicKey
pub) ByteString
bs =
    forall seed output a.
(ByteArrayAccess seed, ByteArray output) =>
OAEPParams
-> (forall hash.
    HashAlgorithm hash =>
    OAEPParams hash seed output -> a)
-> a
withOAEPParams OAEPParams
p forall a b. (a -> b) -> a -> b
$ \OAEPParams hash ByteString ByteString
params ->
        forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft Error -> StoreError
RSAError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
OAEPParams hash ByteString ByteString
-> PublicKey -> ByteString -> m (Either Error ByteString)
RSAOAEP.encrypt OAEPParams hash ByteString ByteString
params PublicKey
pub ByteString
bs
transportEncrypt KeyTransportParams
_ PubKey
_ ByteString
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left StoreError
UnexpectedPublicKeyType

-- | Decrypt the specified content with a key-transport algorithm and recipient
-- private key.
transportDecrypt :: MonadRandom m
                 => KeyTransportParams
                 -> X509.PrivKey
                 -> ByteString
                 -> m (Either StoreError ByteString)
transportDecrypt :: forall (m :: * -> *).
MonadRandom m =>
KeyTransportParams
-> PrivKey -> ByteString -> m (Either StoreError ByteString)
transportDecrypt KeyTransportParams
RSAES         (X509.PrivKeyRSA PrivateKey
priv) ByteString
bs =
    forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft Error -> StoreError
RSAError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadRandom m =>
PrivateKey -> ByteString -> m (Either Error ByteString)
RSA.decryptSafer PrivateKey
priv ByteString
bs
transportDecrypt (RSAESOAEP OAEPParams
p) (X509.PrivKeyRSA PrivateKey
priv) ByteString
bs
    | forall params. HasStrength params => params -> Bool
securityAcceptable OAEPParams
p =
        forall seed output a.
(ByteArrayAccess seed, ByteArray output) =>
OAEPParams
-> (forall hash.
    HashAlgorithm hash =>
    OAEPParams hash seed output -> a)
-> a
withOAEPParams OAEPParams
p forall a b. (a -> b) -> a -> b
$ \OAEPParams hash ByteString ByteString
params ->
            forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft Error -> StoreError
RSAError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
OAEPParams hash ByteString ByteString
-> PrivateKey -> ByteString -> m (Either Error ByteString)
RSAOAEP.decryptSafer OAEPParams hash ByteString ByteString
params PrivateKey
priv ByteString
bs
    | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"OAEP parameters too weak")
transportDecrypt KeyTransportParams
_ PrivKey
_ ByteString
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left StoreError
UnexpectedPrivateKeyType


-- Key agreement

data KeyAgreementType = TypeStdDH DigestAlgorithm
                      | TypeCofactorDH DigestAlgorithm
                      deriving (Int -> KeyAgreementType -> ShowS
[KeyAgreementType] -> ShowS
KeyAgreementType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyAgreementType] -> ShowS
$cshowList :: [KeyAgreementType] -> ShowS
show :: KeyAgreementType -> String
$cshow :: KeyAgreementType -> String
showsPrec :: Int -> KeyAgreementType -> ShowS
$cshowsPrec :: Int -> KeyAgreementType -> ShowS
Show,KeyAgreementType -> KeyAgreementType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyAgreementType -> KeyAgreementType -> Bool
$c/= :: KeyAgreementType -> KeyAgreementType -> Bool
== :: KeyAgreementType -> KeyAgreementType -> Bool
$c== :: KeyAgreementType -> KeyAgreementType -> Bool
Eq)

instance Enumerable KeyAgreementType where
    values :: [KeyAgreementType]
values = [ DigestAlgorithm -> KeyAgreementType
TypeStdDH (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1)
             , DigestAlgorithm -> KeyAgreementType
TypeStdDH (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA224
SHA224)
             , DigestAlgorithm -> KeyAgreementType
TypeStdDH (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA256
SHA256)
             , DigestAlgorithm -> KeyAgreementType
TypeStdDH (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA384
SHA384)
             , DigestAlgorithm -> KeyAgreementType
TypeStdDH (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA512
SHA512)

             , DigestAlgorithm -> KeyAgreementType
TypeCofactorDH (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1)
             , DigestAlgorithm -> KeyAgreementType
TypeCofactorDH (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA224
SHA224)
             , DigestAlgorithm -> KeyAgreementType
TypeCofactorDH (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA256
SHA256)
             , DigestAlgorithm -> KeyAgreementType
TypeCofactorDH (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA384
SHA384)
             , DigestAlgorithm -> KeyAgreementType
TypeCofactorDH (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA512
SHA512)
             ]

instance OIDable KeyAgreementType where
    getObjectID :: KeyAgreementType -> OID
getObjectID (TypeStdDH (DigestAlgorithm DigestProxy hashAlg
SHA1))        = [Integer
1,Integer
3,Integer
133,Integer
16,Integer
840,Integer
63,Integer
0,Integer
2]
    getObjectID (TypeStdDH (DigestAlgorithm DigestProxy hashAlg
SHA224))      = [Integer
1,Integer
3,Integer
132,Integer
1,Integer
11,Integer
0]
    getObjectID (TypeStdDH (DigestAlgorithm DigestProxy hashAlg
SHA256))      = [Integer
1,Integer
3,Integer
132,Integer
1,Integer
11,Integer
1]
    getObjectID (TypeStdDH (DigestAlgorithm DigestProxy hashAlg
SHA384))      = [Integer
1,Integer
3,Integer
132,Integer
1,Integer
11,Integer
2]
    getObjectID (TypeStdDH (DigestAlgorithm DigestProxy hashAlg
SHA512))      = [Integer
1,Integer
3,Integer
132,Integer
1,Integer
11,Integer
3]

    getObjectID (TypeCofactorDH (DigestAlgorithm DigestProxy hashAlg
SHA1))   = [Integer
1,Integer
3,Integer
133,Integer
16,Integer
840,Integer
63,Integer
0,Integer
3]
    getObjectID (TypeCofactorDH (DigestAlgorithm DigestProxy hashAlg
SHA224)) = [Integer
1,Integer
3,Integer
132,Integer
1,Integer
14,Integer
0]
    getObjectID (TypeCofactorDH (DigestAlgorithm DigestProxy hashAlg
SHA256)) = [Integer
1,Integer
3,Integer
132,Integer
1,Integer
14,Integer
1]
    getObjectID (TypeCofactorDH (DigestAlgorithm DigestProxy hashAlg
SHA384)) = [Integer
1,Integer
3,Integer
132,Integer
1,Integer
14,Integer
2]
    getObjectID (TypeCofactorDH (DigestAlgorithm DigestProxy hashAlg
SHA512)) = [Integer
1,Integer
3,Integer
132,Integer
1,Integer
14,Integer
3]

    getObjectID KeyAgreementType
ty = forall a. HasCallStack => String -> a
error (String
"Unsupported KeyAgreementType: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show KeyAgreementType
ty)

instance OIDNameable KeyAgreementType where
    fromObjectID :: OID -> Maybe KeyAgreementType
fromObjectID OID
oid = forall a. OIDNameableWrapper a -> a
unOIDNW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid

-- | Key agreement algorithm with associated parameters.
data KeyAgreementParams = StdDH DigestAlgorithm KeyEncryptionParams
                          -- ^ 1-Pass D-H with Stardard ECDH
                        | CofactorDH DigestAlgorithm KeyEncryptionParams
                          -- ^ 1-Pass D-H with Cofactor ECDH
                        deriving (Int -> KeyAgreementParams -> ShowS
[KeyAgreementParams] -> ShowS
KeyAgreementParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyAgreementParams] -> ShowS
$cshowList :: [KeyAgreementParams] -> ShowS
show :: KeyAgreementParams -> String
$cshow :: KeyAgreementParams -> String
showsPrec :: Int -> KeyAgreementParams -> ShowS
$cshowsPrec :: Int -> KeyAgreementParams -> ShowS
Show,KeyAgreementParams -> KeyAgreementParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyAgreementParams -> KeyAgreementParams -> Bool
$c/= :: KeyAgreementParams -> KeyAgreementParams -> Bool
== :: KeyAgreementParams -> KeyAgreementParams -> Bool
$c== :: KeyAgreementParams -> KeyAgreementParams -> Bool
Eq)

instance AlgorithmId KeyAgreementParams where
    type AlgorithmType KeyAgreementParams = KeyAgreementType
    algorithmName :: KeyAgreementParams -> String
algorithmName KeyAgreementParams
_ = String
"key agreement algorithm"

    algorithmType :: KeyAgreementParams -> AlgorithmType KeyAgreementParams
algorithmType (StdDH DigestAlgorithm
d KeyEncryptionParams
_)         = DigestAlgorithm -> KeyAgreementType
TypeStdDH DigestAlgorithm
d
    algorithmType (CofactorDH DigestAlgorithm
d KeyEncryptionParams
_)    = DigestAlgorithm -> KeyAgreementType
TypeCofactorDH DigestAlgorithm
d

    parameterASN1S :: forall e. ASN1Elem e => KeyAgreementParams -> ASN1Stream e
parameterASN1S (StdDH DigestAlgorithm
_ KeyEncryptionParams
p)        = forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence KeyEncryptionParams
p
    parameterASN1S (CofactorDH DigestAlgorithm
_ KeyEncryptionParams
p)   = forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence KeyEncryptionParams
p

    parseParameter :: forall e.
Monoid e =>
AlgorithmType KeyAgreementParams -> ParseASN1 e KeyAgreementParams
parseParameter (TypeStdDH DigestAlgorithm
d)      = DigestAlgorithm -> KeyEncryptionParams -> KeyAgreementParams
StdDH DigestAlgorithm
d forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
    parseParameter (TypeCofactorDH DigestAlgorithm
d) = DigestAlgorithm -> KeyEncryptionParams -> KeyAgreementParams
CofactorDH DigestAlgorithm
d forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence

ecdhKeyMaterial :: (ByteArrayAccess bin, ByteArray bout)
                => DigestAlgorithm -> KeyEncryptionParams -> Maybe ByteString -> bin -> bout
ecdhKeyMaterial :: forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
DigestAlgorithm
-> KeyEncryptionParams -> Maybe ByteString -> bin -> bout
ecdhKeyMaterial (DigestAlgorithm DigestProxy hashAlg
hashAlg) KeyEncryptionParams
kep Maybe ByteString
ukm bin
zz
    | Int
r forall a. Eq a => a -> a -> Bool
== Int
0    = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat (forall a b. (a -> b) -> [a] -> [b]
map Int -> bout
chunk [Int
1..Int
d])
    | Bool
otherwise = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat (forall a b. (a -> b) -> [a] -> [b]
map Int -> bout
chunk [Int
1..Int
d]) forall bs. ByteArray bs => bs -> bs -> bs
`B.append` forall bs. ByteArray bs => Int -> bs -> bs
B.take Int
r (Int -> bout
chunk forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
succ Int
d)
  where
    (Int
d, Int
r)   = Int
outLen forall a. Integral a => a -> a -> (a, a)
`divMod` forall a. HashAlgorithm a => a -> Int
Hash.hashDigestSize hashAlg
prx

    prx :: hashAlg
prx      = forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy DigestProxy hashAlg
hashAlg
    outLen :: Int
outLen   = forall params. HasKeySize params => params -> Int
getMaximumKeySize KeyEncryptionParams
kep
    outBits :: Int
outBits  = Int
8 forall a. Num a => a -> a -> a
* Int
outLen
    toWord32 :: Int -> ByteString
toWord32 = forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

    chunk :: Int -> bout
chunk     = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashAlgorithm a => Context a -> Digest a
Hash.hashFinalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Context hashAlg
hashCtx
    hashCtx' :: Context hashAlg
hashCtx'  = forall alg. HashAlgorithm alg => alg -> Context alg
Hash.hashInitWith hashAlg
prx
    hashCtx :: Int -> Context hashAlg
hashCtx Int
i = forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
Hash.hashUpdate (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
Hash.hashUpdate (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
Hash.hashUpdate Context hashAlg
hashCtx' bin
zz) (Int -> ByteString
toWord32 Int
i)) ByteString
otherInfo
    otherInfo :: ByteString
otherInfo =
        let ki :: ASN1Stream ASN1P
ki  = forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence KeyEncryptionParams
kep
            eui :: ASN1Stream ASN1P
eui = case Maybe ByteString
ukm of
                    Maybe ByteString
Nothing -> forall a. a -> a
id
                    Just ByteString
bs -> forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
                                   (forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
bs)
            spi :: ASN1Stream ASN1P
spi = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
2)
                      (forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString forall a b. (a -> b) -> a -> b
$ Int -> ByteString
toWord32 Int
outBits)
         in ASN1Stream ASN1P -> ByteString
encodeASN1S forall a b. (a -> b) -> a -> b
$ forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream ASN1P
ki forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
eui forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
spi)

-- | Key pair for ECDH.
data ECDHPair
    = PairEC ECC.Curve ECC.PrivateNumber ECC.Point
    | PairX25519 X25519.SecretKey X25519.PublicKey
    | PairX448 X448.SecretKey X448.PublicKey

-- | Generate an ephemeral ECDH key.
ecdhGenerate :: MonadRandom m => X509.PubKey -> m (Either StoreError ECDHPair)
ecdhGenerate :: forall (m :: * -> *).
MonadRandom m =>
PubKey -> m (Either StoreError ECDHPair)
ecdhGenerate (X509.PubKeyEC PubKeyEC
pub) =
    case PubKeyEC -> Maybe CurveName
ecPubKeyCurveName PubKeyEC
pub of
        Maybe CurveName
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left StoreError
NamedCurveRequired
        Just CurveName
n  -> do
            let curve :: Curve
curve = CurveName -> Curve
ECC.getCurveByName CurveName
n
            Integer
priv <- forall (m :: * -> *). MonadRandom m => Curve -> m Integer
ECDH.generatePrivate Curve
curve
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Curve -> SerializedPoint -> Maybe Point
unserializePoint Curve
curve (PubKeyEC -> SerializedPoint
X509.pubkeyEC_pub PubKeyEC
pub) of
                Maybe Point
Nothing -> forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"Invalid serialized point")
                Just Point
pt -> forall a b. b -> Either a b
Right (Curve -> Integer -> Point -> ECDHPair
PairEC Curve
curve Integer
priv Point
pt)
ecdhGenerate (X509.PubKeyX25519 PublicKey
pub) = do
    SecretKey
priv <- forall (m :: * -> *). MonadRandom m => m SecretKey
X25519.generateSecretKey
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (SecretKey -> PublicKey -> ECDHPair
PairX25519 SecretKey
priv PublicKey
pub)
ecdhGenerate (X509.PubKeyX448 PublicKey
pub) = do
    SecretKey
priv <- forall (m :: * -> *). MonadRandom m => m SecretKey
X448.generateSecretKey
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (SecretKey -> PublicKey -> ECDHPair
PairX448 SecretKey
priv PublicKey
pub)
ecdhGenerate PubKey
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left StoreError
UnexpectedPublicKeyType

-- | Return the serialized public key corresponding to the ECDH private key.
ecdhPublic :: ECDHPair -> ByteString
ecdhPublic :: ECDHPair -> ByteString
ecdhPublic (PairEC Curve
curve Integer
d Point
_)  = SerializedPoint -> ByteString
unSerialize (Curve -> Integer -> SerializedPoint
getSerializedPoint Curve
curve Integer
d)
  where unSerialize :: SerializedPoint -> ByteString
unSerialize (X509.SerializedPoint ByteString
pt) = ByteString
pt
ecdhPublic (PairX25519 SecretKey
priv PublicKey
_) = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (SecretKey -> PublicKey
X25519.toPublic SecretKey
priv)
ecdhPublic (PairX448 SecretKey
priv PublicKey
_)   = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (SecretKey -> PublicKey
X448.toPublic SecretKey
priv)

-- | Encrypt the specified content with an ECDH key pair and key-agreement
-- algorithm.
ecdhEncrypt :: (MonadRandom m, ByteArray ba)
            => KeyAgreementParams -> Maybe ByteString -> ECDHPair -> ba -> m (Either StoreError ba)
ecdhEncrypt :: forall (m :: * -> *) ba.
(MonadRandom m, ByteArray ba) =>
KeyAgreementParams
-> Maybe ByteString -> ECDHPair -> ba -> m (Either StoreError ba)
ecdhEncrypt (StdDH DigestAlgorithm
dig KeyEncryptionParams
kep) Maybe ByteString
ukm (PairEC Curve
curve Integer
d Point
pub) ba
bs = do
    let s :: SharedKey
s = Curve -> Integer -> Point -> SharedKey
ECDH.getShared Curve
curve Integer
d Point
pub
        k :: ScrubbedBytes
k = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
DigestAlgorithm
-> KeyEncryptionParams -> Maybe ByteString -> bin -> bout
ecdhKeyMaterial DigestAlgorithm
dig KeyEncryptionParams
kep Maybe ByteString
ukm SharedKey
s :: B.ScrubbedBytes
    forall (m :: * -> *) kek ba.
(MonadRandom m, ByteArray kek, ByteArray ba) =>
kek -> KeyEncryptionParams -> ba -> m (Either StoreError ba)
keyEncrypt ScrubbedBytes
k KeyEncryptionParams
kep ba
bs
ecdhEncrypt (StdDH DigestAlgorithm
dig KeyEncryptionParams
kep) Maybe ByteString
ukm (PairX25519 SecretKey
priv PublicKey
pub) ba
bs =
    case forall a. CryptoFailable a -> Either StoreError a
fromCryptoFailable (forall curve (proxy :: * -> *).
EllipticCurveDH curve =>
proxy curve
-> Scalar curve -> Point curve -> CryptoFailable SharedSecret
ecdh Proxy Curve_X25519
x25519 SecretKey
priv PublicKey
pub) of
        Left StoreError
e  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left StoreError
e)
        Right SharedSecret
s ->
            let k :: ScrubbedBytes
k = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
DigestAlgorithm
-> KeyEncryptionParams -> Maybe ByteString -> bin -> bout
ecdhKeyMaterial DigestAlgorithm
dig KeyEncryptionParams
kep Maybe ByteString
ukm SharedSecret
s :: B.ScrubbedBytes
             in forall (m :: * -> *) kek ba.
(MonadRandom m, ByteArray kek, ByteArray ba) =>
kek -> KeyEncryptionParams -> ba -> m (Either StoreError ba)
keyEncrypt ScrubbedBytes
k KeyEncryptionParams
kep ba
bs
ecdhEncrypt (StdDH DigestAlgorithm
dig KeyEncryptionParams
kep) Maybe ByteString
ukm (PairX448 SecretKey
priv PublicKey
pub) ba
bs =
    case forall a. CryptoFailable a -> Either StoreError a
fromCryptoFailable (forall curve (proxy :: * -> *).
EllipticCurveDH curve =>
proxy curve
-> Scalar curve -> Point curve -> CryptoFailable SharedSecret
ecdh Proxy Curve_X448
x448 SecretKey
priv PublicKey
pub) of
        Left StoreError
e  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left StoreError
e)
        Right SharedSecret
s ->
            let k :: ScrubbedBytes
k = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
DigestAlgorithm
-> KeyEncryptionParams -> Maybe ByteString -> bin -> bout
ecdhKeyMaterial DigestAlgorithm
dig KeyEncryptionParams
kep Maybe ByteString
ukm SharedSecret
s :: B.ScrubbedBytes
             in forall (m :: * -> *) kek ba.
(MonadRandom m, ByteArray kek, ByteArray ba) =>
kek -> KeyEncryptionParams -> ba -> m (Either StoreError ba)
keyEncrypt ScrubbedBytes
k KeyEncryptionParams
kep ba
bs
ecdhEncrypt (CofactorDH DigestAlgorithm
dig KeyEncryptionParams
kep) Maybe ByteString
ukm (PairEC Curve
curve Integer
d Point
pub) ba
bs = do
    let h :: Integer
h = CurveCommon -> Integer
ECC.ecc_h (Curve -> CurveCommon
ECC.common_curve Curve
curve)
        s :: SharedKey
s = Curve -> Integer -> Point -> SharedKey
ECDH.getShared Curve
curve (Integer
h forall a. Num a => a -> a -> a
* Integer
d) Point
pub
        k :: ScrubbedBytes
k = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
DigestAlgorithm
-> KeyEncryptionParams -> Maybe ByteString -> bin -> bout
ecdhKeyMaterial DigestAlgorithm
dig KeyEncryptionParams
kep Maybe ByteString
ukm SharedKey
s :: B.ScrubbedBytes
    forall (m :: * -> *) kek ba.
(MonadRandom m, ByteArray kek, ByteArray ba) =>
kek -> KeyEncryptionParams -> ba -> m (Either StoreError ba)
keyEncrypt ScrubbedBytes
k KeyEncryptionParams
kep ba
bs
ecdhEncrypt (CofactorDH DigestAlgorithm
_ KeyEncryptionParams
_) Maybe ByteString
_ (PairX25519 SecretKey
_ PublicKey
_) ba
_ =
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"X25519 is not supported for cofactor DH")
ecdhEncrypt (CofactorDH DigestAlgorithm
_ KeyEncryptionParams
_) Maybe ByteString
_ (PairX448 SecretKey
_ PublicKey
_) ba
_ =
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"X448 is not supported for cofactor DH")

-- | Decrypt the specified content with an ECDH key pair and key-agreement
-- algorithm.
ecdhDecrypt :: ByteArray ba
            => KeyAgreementParams -> Maybe ByteString -> X509.PrivKey -> ByteString -> ba -> Either StoreError ba
ecdhDecrypt :: forall ba.
ByteArray ba =>
KeyAgreementParams
-> Maybe ByteString
-> PrivKey
-> ByteString
-> ba
-> Either StoreError ba
ecdhDecrypt (StdDH DigestAlgorithm
dig KeyEncryptionParams
kep) Maybe ByteString
ukm (X509.PrivKeyEC PrivKeyEC
priv) ByteString
pt ba
bs =
    case PrivKeyEC -> Maybe Curve
ecPrivKeyCurve PrivKeyEC
priv of
        Maybe Curve
Nothing    -> forall a b. a -> Either a b
Left StoreError
UnsupportedEllipticCurve
        Just Curve
curve ->
            case Curve -> SerializedPoint -> Maybe Point
unserializePoint Curve
curve (ByteString -> SerializedPoint
X509.SerializedPoint ByteString
pt) of
                Maybe Point
Nothing  -> forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"Invalid serialized point")
                Just Point
pub -> do
                    let d :: Integer
d = PrivKeyEC -> Integer
X509.privkeyEC_priv PrivKeyEC
priv
                        s :: SharedKey
s = Curve -> Integer -> Point -> SharedKey
ECDH.getShared Curve
curve Integer
d Point
pub
                        k :: ScrubbedBytes
k = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
DigestAlgorithm
-> KeyEncryptionParams -> Maybe ByteString -> bin -> bout
ecdhKeyMaterial DigestAlgorithm
dig KeyEncryptionParams
kep Maybe ByteString
ukm SharedKey
s :: B.ScrubbedBytes
                    forall kek ba.
(ByteArray kek, ByteArray ba) =>
kek -> KeyEncryptionParams -> ba -> Either StoreError ba
keyDecrypt ScrubbedBytes
k KeyEncryptionParams
kep ba
bs
ecdhDecrypt (StdDH DigestAlgorithm
dig KeyEncryptionParams
kep) Maybe ByteString
ukm (X509.PrivKeyX25519 SecretKey
priv) ByteString
pt ba
bs = do
    SharedSecret
s <- forall a. CryptoFailable a -> Either StoreError a
fromCryptoFailable (forall bs. ByteArrayAccess bs => bs -> CryptoFailable PublicKey
X25519.publicKey ByteString
pt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall curve (proxy :: * -> *).
EllipticCurveDH curve =>
proxy curve
-> Scalar curve -> Point curve -> CryptoFailable SharedSecret
ecdh Proxy Curve_X25519
x25519 SecretKey
priv)
    let k :: ScrubbedBytes
k = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
DigestAlgorithm
-> KeyEncryptionParams -> Maybe ByteString -> bin -> bout
ecdhKeyMaterial DigestAlgorithm
dig KeyEncryptionParams
kep Maybe ByteString
ukm SharedSecret
s :: B.ScrubbedBytes
    forall kek ba.
(ByteArray kek, ByteArray ba) =>
kek -> KeyEncryptionParams -> ba -> Either StoreError ba
keyDecrypt ScrubbedBytes
k KeyEncryptionParams
kep ba
bs
ecdhDecrypt (StdDH DigestAlgorithm
dig KeyEncryptionParams
kep) Maybe ByteString
ukm (X509.PrivKeyX448 SecretKey
priv) ByteString
pt ba
bs = do
    SharedSecret
s <- forall a. CryptoFailable a -> Either StoreError a
fromCryptoFailable (forall bs. ByteArrayAccess bs => bs -> CryptoFailable PublicKey
X448.publicKey ByteString
pt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall curve (proxy :: * -> *).
EllipticCurveDH curve =>
proxy curve
-> Scalar curve -> Point curve -> CryptoFailable SharedSecret
ecdh Proxy Curve_X448
x448 SecretKey
priv)
    let k :: ScrubbedBytes
k = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
DigestAlgorithm
-> KeyEncryptionParams -> Maybe ByteString -> bin -> bout
ecdhKeyMaterial DigestAlgorithm
dig KeyEncryptionParams
kep Maybe ByteString
ukm SharedSecret
s :: B.ScrubbedBytes
    forall kek ba.
(ByteArray kek, ByteArray ba) =>
kek -> KeyEncryptionParams -> ba -> Either StoreError ba
keyDecrypt ScrubbedBytes
k KeyEncryptionParams
kep ba
bs
ecdhDecrypt (StdDH DigestAlgorithm
_ KeyEncryptionParams
_) Maybe ByteString
_ PrivKey
_ ByteString
_ ba
_ = forall a b. a -> Either a b
Left StoreError
UnexpectedPrivateKeyType
ecdhDecrypt (CofactorDH DigestAlgorithm
dig KeyEncryptionParams
kep) Maybe ByteString
ukm (X509.PrivKeyEC PrivKeyEC
priv) ByteString
pt ba
bs =
    case PrivKeyEC -> Maybe Curve
ecPrivKeyCurve PrivKeyEC
priv of
        Maybe Curve
Nothing    -> forall a b. a -> Either a b
Left StoreError
UnsupportedEllipticCurve
        Just Curve
curve ->
            case Curve -> SerializedPoint -> Maybe Point
unserializePoint Curve
curve (ByteString -> SerializedPoint
X509.SerializedPoint ByteString
pt) of
                Maybe Point
Nothing  -> forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"Invalid serialized point")
                Just Point
pub -> do
                    let h :: Integer
h = CurveCommon -> Integer
ECC.ecc_h (Curve -> CurveCommon
ECC.common_curve Curve
curve)
                        d :: Integer
d = PrivKeyEC -> Integer
X509.privkeyEC_priv PrivKeyEC
priv
                        s :: SharedKey
s = Curve -> Integer -> Point -> SharedKey
ECDH.getShared Curve
curve (Integer
h forall a. Num a => a -> a -> a
* Integer
d) Point
pub
                        k :: ScrubbedBytes
k = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
DigestAlgorithm
-> KeyEncryptionParams -> Maybe ByteString -> bin -> bout
ecdhKeyMaterial DigestAlgorithm
dig KeyEncryptionParams
kep Maybe ByteString
ukm SharedKey
s :: B.ScrubbedBytes
                    forall kek ba.
(ByteArray kek, ByteArray ba) =>
kek -> KeyEncryptionParams -> ba -> Either StoreError ba
keyDecrypt ScrubbedBytes
k KeyEncryptionParams
kep ba
bs
ecdhDecrypt (CofactorDH DigestAlgorithm
_ KeyEncryptionParams
_) Maybe ByteString
_ PrivKey
_ ByteString
_ ba
_ = forall a b. a -> Either a b
Left StoreError
UnexpectedPrivateKeyType

x25519 :: Proxy Curve_X25519
x25519 :: Proxy Curve_X25519
x25519 = forall {k} (t :: k). Proxy t
Proxy

x448 :: Proxy Curve_X448
x448 :: Proxy Curve_X448
x448 = forall {k} (t :: k). Proxy t
Proxy


-- Utilities

getCipher :: (BlockCipher cipher, ByteArray key)
          => proxy cipher -> key -> Either StoreError cipher
getCipher :: forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher proxy cipher
_ key
key = forall a. CryptoFailable a -> Either StoreError a
fromCryptoFailable (forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit key
key)

getRC2Cipher :: ByteArray key => Int -> key -> Either StoreError RC2
getRC2Cipher :: forall key. ByteArray key => Int -> key -> Either StoreError RC2
getRC2Cipher Int
len key
key = forall a. CryptoFailable a -> Either StoreError a
fromCryptoFailable (forall key. ByteArrayAccess key => Int -> key -> CryptoFailable RC2
rc2WithEffectiveKeyLength Int
len key
key)

ivGenerate :: (BlockCipher cipher, MonadRandom m) => cipher -> m (IV cipher)
ivGenerate :: forall cipher (m :: * -> *).
(BlockCipher cipher, MonadRandom m) =>
cipher -> m (IV cipher)
ivGenerate cipher
cipher = do
    ByteString
bs <- forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes (forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher)
    let Just IV cipher
iv = forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV (ByteString
bs :: ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
return IV cipher
iv

nonceGenerate :: MonadRandom m => Int -> m B.Bytes
nonceGenerate :: forall (m :: * -> *). MonadRandom m => Int -> m Bytes
nonceGenerate = forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes

cipherFromProxy :: proxy cipher -> cipher
cipherFromProxy :: forall (proxy :: * -> *) a. proxy a -> a
cipherFromProxy proxy cipher
_ = forall a. HasCallStack => a
undefined

-- | Return the block size of the specified block cipher.
proxyBlockSize :: BlockCipher cipher => proxy cipher -> Int
proxyBlockSize :: forall cipher (proxy :: * -> *).
BlockCipher cipher =>
proxy cipher -> Int
proxyBlockSize = forall cipher. BlockCipher cipher => cipher -> Int
blockSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (proxy :: * -> *) a. proxy a -> a
cipherFromProxy

getL :: CCM_L -> Int
getL :: CCM_L -> Int
getL CCM_L
CCM_L2 = Int
2
getL CCM_L
CCM_L3 = Int
3
getL CCM_L
CCM_L4 = Int
4

getM :: CCM_M -> Int
getM :: CCM_M -> Int
getM CCM_M
CCM_M4  = Int
4
getM CCM_M
CCM_M6  = Int
6
getM CCM_M
CCM_M8  = Int
8
getM CCM_M
CCM_M10 = Int
10
getM CCM_M
CCM_M12 = Int
12
getM CCM_M
CCM_M14 = Int
14
getM CCM_M
CCM_M16 = Int
16

fromL :: Int -> Maybe CCM_L
fromL :: Int -> Maybe CCM_L
fromL Int
2 = forall a. a -> Maybe a
Just CCM_L
CCM_L2
fromL Int
3 = forall a. a -> Maybe a
Just CCM_L
CCM_L3
fromL Int
4 = forall a. a -> Maybe a
Just CCM_L
CCM_L4
fromL Int
_ = forall a. Maybe a
Nothing

parseM :: Monoid e => ParseASN1 e CCM_M
parseM :: forall e. Monoid e => ParseASN1 e CCM_M
parseM = do
    IntVal Integer
l <- forall e. Monoid e => ParseASN1 e ASN1
getNext
    case Integer
l of
        Integer
4  -> forall (m :: * -> *) a. Monad m => a -> m a
return CCM_M
CCM_M4
        Integer
6  -> forall (m :: * -> *) a. Monad m => a -> m a
return CCM_M
CCM_M6
        Integer
8  -> forall (m :: * -> *) a. Monad m => a -> m a
return CCM_M
CCM_M8
        Integer
10 -> forall (m :: * -> *) a. Monad m => a -> m a
return CCM_M
CCM_M10
        Integer
12 -> forall (m :: * -> *) a. Monad m => a -> m a
return CCM_M
CCM_M12
        Integer
14 -> forall (m :: * -> *) a. Monad m => a -> m a
return CCM_M
CCM_M14
        Integer
16 -> forall (m :: * -> *) a. Monad m => a -> m a
return CCM_M
CCM_M16
        Integer
i -> forall e a. String -> ParseASN1 e a
throwParseError (String
"Parsed invalid CCM parameter M: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
i)


-- Mask generation functions

data MaskGenerationType = TypeMGF1
    deriving (Int -> MaskGenerationType -> ShowS
[MaskGenerationType] -> ShowS
MaskGenerationType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaskGenerationType] -> ShowS
$cshowList :: [MaskGenerationType] -> ShowS
show :: MaskGenerationType -> String
$cshow :: MaskGenerationType -> String
showsPrec :: Int -> MaskGenerationType -> ShowS
$cshowsPrec :: Int -> MaskGenerationType -> ShowS
Show,MaskGenerationType -> MaskGenerationType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaskGenerationType -> MaskGenerationType -> Bool
$c/= :: MaskGenerationType -> MaskGenerationType -> Bool
== :: MaskGenerationType -> MaskGenerationType -> Bool
$c== :: MaskGenerationType -> MaskGenerationType -> Bool
Eq)

instance Enumerable MaskGenerationType where
    values :: [MaskGenerationType]
values = [ MaskGenerationType
TypeMGF1
             ]

instance OIDable MaskGenerationType where
    getObjectID :: MaskGenerationType -> OID
getObjectID MaskGenerationType
TypeMGF1     = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
8]

instance OIDNameable MaskGenerationType where
    fromObjectID :: OID -> Maybe MaskGenerationType
fromObjectID OID
oid = forall a. OIDNameableWrapper a -> a
unOIDNW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid

-- | Mask Generation Functions (MGF) and associated parameters.
newtype MaskGenerationFunc = MGF1 DigestAlgorithm
    deriving (Int -> MaskGenerationFunc -> ShowS
[MaskGenerationFunc] -> ShowS
MaskGenerationFunc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaskGenerationFunc] -> ShowS
$cshowList :: [MaskGenerationFunc] -> ShowS
show :: MaskGenerationFunc -> String
$cshow :: MaskGenerationFunc -> String
showsPrec :: Int -> MaskGenerationFunc -> ShowS
$cshowsPrec :: Int -> MaskGenerationFunc -> ShowS
Show,MaskGenerationFunc -> MaskGenerationFunc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaskGenerationFunc -> MaskGenerationFunc -> Bool
$c/= :: MaskGenerationFunc -> MaskGenerationFunc -> Bool
== :: MaskGenerationFunc -> MaskGenerationFunc -> Bool
$c== :: MaskGenerationFunc -> MaskGenerationFunc -> Bool
Eq)

instance HasStrength MaskGenerationFunc where
    getSecurityBits :: MaskGenerationFunc -> Int
getSecurityBits (MGF1 DigestAlgorithm
d) = forall params. HasStrength params => params -> Int
getSecurityBits DigestAlgorithm
d

instance AlgorithmId MaskGenerationFunc where
    type AlgorithmType MaskGenerationFunc = MaskGenerationType
    algorithmName :: MaskGenerationFunc -> String
algorithmName MaskGenerationFunc
_  = String
"mask generation function"

    algorithmType :: MaskGenerationFunc -> AlgorithmType MaskGenerationFunc
algorithmType (MGF1 DigestAlgorithm
_)   = MaskGenerationType
TypeMGF1

    parameterASN1S :: forall e. ASN1Elem e => MaskGenerationFunc -> ASN1Stream e
parameterASN1S (MGF1 DigestAlgorithm
d)  = forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence DigestAlgorithm
d

    parseParameter :: forall e.
Monoid e =>
AlgorithmType MaskGenerationFunc -> ParseASN1 e MaskGenerationFunc
parseParameter AlgorithmType MaskGenerationFunc
MaskGenerationType
TypeMGF1  = DigestAlgorithm -> MaskGenerationFunc
MGF1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence

-- | Generate a mask with the MGF.
mgf :: (ByteArrayAccess seed, ByteArray output)
    => MaskGenerationFunc -> seed -> Int -> output
mgf :: forall seed output.
(ByteArrayAccess seed, ByteArray output) =>
MaskGenerationFunc -> seed -> Int -> output
mgf (MGF1 (DigestAlgorithm DigestProxy hashAlg
hashAlg)) = forall seed output hashAlg.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hashAlg) =>
hashAlg -> seed -> Int -> output
MGF.mgf1 (forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy DigestProxy hashAlg
hashAlg)


-- Signature algorithms

-- | Signature value.
type SignatureValue = ByteString

-- | Signature parameters for RSASSA-PSS.
data PSSParams = PSSParams
    { PSSParams -> DigestAlgorithm
pssHashAlgorithm :: DigestAlgorithm       -- ^ Hash function
    , PSSParams -> MaskGenerationFunc
pssMaskGenAlgorithm :: MaskGenerationFunc -- ^ Mask generation function
    , PSSParams -> Int
pssSaltLength :: Int                      -- ^ Length of the salt in bytes
    }
    deriving (Int -> PSSParams -> ShowS
[PSSParams] -> ShowS
PSSParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PSSParams] -> ShowS
$cshowList :: [PSSParams] -> ShowS
show :: PSSParams -> String
$cshow :: PSSParams -> String
showsPrec :: Int -> PSSParams -> ShowS
$cshowsPrec :: Int -> PSSParams -> ShowS
Show,PSSParams -> PSSParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PSSParams -> PSSParams -> Bool
$c/= :: PSSParams -> PSSParams -> Bool
== :: PSSParams -> PSSParams -> Bool
$c== :: PSSParams -> PSSParams -> Bool
Eq)

instance HasStrength PSSParams where
    getSecurityBits :: PSSParams -> Int
getSecurityBits PSSParams{Int
MaskGenerationFunc
DigestAlgorithm
pssSaltLength :: Int
pssMaskGenAlgorithm :: MaskGenerationFunc
pssHashAlgorithm :: DigestAlgorithm
pssSaltLength :: PSSParams -> Int
pssMaskGenAlgorithm :: PSSParams -> MaskGenerationFunc
pssHashAlgorithm :: PSSParams -> DigestAlgorithm
..} =
        forall a. Ord a => a -> a -> a
min (forall params. HasStrength params => params -> Int
getSecurityBits DigestAlgorithm
pssHashAlgorithm)
            (forall params. HasStrength params => params -> Int
getSecurityBits MaskGenerationFunc
pssMaskGenAlgorithm)

withPSSParams :: forall seed output a . (ByteArrayAccess seed, ByteArray output)
              => PSSParams
              -> (forall hash . Hash.HashAlgorithm hash => RSAPSS.PSSParams hash seed output -> a)
              -> a
withPSSParams :: forall seed output a.
(ByteArrayAccess seed, ByteArray output) =>
PSSParams
-> (forall hash.
    HashAlgorithm hash =>
    PSSParams hash seed output -> a)
-> a
withPSSParams PSSParams
p forall hash. HashAlgorithm hash => PSSParams hash seed output -> a
fn =
    case PSSParams -> DigestAlgorithm
pssHashAlgorithm PSSParams
p of
        DigestAlgorithm DigestProxy hashAlg
hashAlg ->
            forall hash. HashAlgorithm hash => PSSParams hash seed output -> a
fn RSAPSS.PSSParams
                { pssHash :: hashAlg
RSAPSS.pssHash = forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy DigestProxy hashAlg
hashAlg
                , pssMaskGenAlg :: MaskGenAlgorithm seed output
RSAPSS.pssMaskGenAlg = forall seed output.
(ByteArrayAccess seed, ByteArray output) =>
MaskGenerationFunc -> seed -> Int -> output
mgf (PSSParams -> MaskGenerationFunc
pssMaskGenAlgorithm PSSParams
p)
                , pssSaltLength :: Int
RSAPSS.pssSaltLength = PSSParams -> Int
pssSaltLength PSSParams
p
                , pssTrailerField :: Word8
RSAPSS.pssTrailerField = Word8
0xbc
                }

instance ASN1Elem e => ProduceASN1Object e PSSParams where
    asn1s :: PSSParams -> ASN1Stream e
asn1s PSSParams{Int
MaskGenerationFunc
DigestAlgorithm
pssSaltLength :: Int
pssMaskGenAlgorithm :: MaskGenerationFunc
pssHashAlgorithm :: DigestAlgorithm
pssSaltLength :: PSSParams -> Int
pssMaskGenAlgorithm :: PSSParams -> MaskGenerationFunc
pssHashAlgorithm :: PSSParams -> DigestAlgorithm
..} =
        forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
s)
      where
        sha1 :: DigestAlgorithm
sha1  = forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1
        tag :: Int -> ASN1Stream e -> ASN1Stream e
tag Int
i = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
i)

        h :: ASN1Stream e
h | DigestAlgorithm
pssHashAlgorithm forall a. Eq a => a -> a -> Bool
== DigestAlgorithm
sha1 = forall a. a -> a
id
          | Bool
otherwise = forall {e}. ASN1Elem e => Int -> ASN1Stream e -> ASN1Stream e
tag Int
0 (forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence DigestAlgorithm
pssHashAlgorithm)

        m :: ASN1Stream e
m | MaskGenerationFunc
pssMaskGenAlgorithm forall a. Eq a => a -> a -> Bool
== DigestAlgorithm -> MaskGenerationFunc
MGF1 DigestAlgorithm
sha1 = forall a. a -> a
id
          | Bool
otherwise = forall {e}. ASN1Elem e => Int -> ASN1Stream e -> ASN1Stream e
tag Int
1 (forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence MaskGenerationFunc
pssMaskGenAlgorithm)

        s :: ASN1Stream e
s | Int
pssSaltLength forall a. Eq a => a -> a -> Bool
== Int
20 Bool -> Bool -> Bool
&& DigestAlgorithm
pssHashAlgorithm forall a. Eq a => a -> a -> Bool
== DigestAlgorithm
sha1 = forall a. a -> a
id
          | Bool
otherwise = forall {e}. ASN1Elem e => Int -> ASN1Stream e -> ASN1Stream e
tag Int
2 (forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pssSaltLength)

instance Monoid e => ParseASN1Object e PSSParams where
    parse :: ParseASN1 e PSSParams
parse = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
        Maybe DigestAlgorithm
h <- forall {e} {a}.
Monoid e =>
Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
0 (forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence)
        Maybe MaskGenerationFunc
m <- forall {e} {a}.
Monoid e =>
Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
1 (forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence)
        Maybe Int
s <- forall {e} {a}.
Monoid e =>
Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
2 forall a b. (a -> b) -> a -> b
$ do { IntVal Integer
i <- forall e. Monoid e => ParseASN1 e ASN1
getNext; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) }
        Maybe ()
_ <- forall {e} {a}.
Monoid e =>
Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
3 forall a b. (a -> b) -> a -> b
$ do { IntVal Integer
1 <- forall e. Monoid e => ParseASN1 e ASN1
getNext; forall (m :: * -> *) a. Monad m => a -> m a
return () }
        forall (m :: * -> *) a. Monad m => a -> m a
return PSSParams { pssHashAlgorithm :: DigestAlgorithm
pssHashAlgorithm = forall a. a -> Maybe a -> a
fromMaybe DigestAlgorithm
sha1 Maybe DigestAlgorithm
h
                         , pssMaskGenAlgorithm :: MaskGenerationFunc
pssMaskGenAlgorithm = forall a. a -> Maybe a -> a
fromMaybe (DigestAlgorithm -> MaskGenerationFunc
MGF1 DigestAlgorithm
sha1) Maybe MaskGenerationFunc
m
                         , pssSaltLength :: Int
pssSaltLength = forall a. a -> Maybe a -> a
fromMaybe Int
20 Maybe Int
s
                         }
      where
        sha1 :: DigestAlgorithm
sha1  = forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1
        tag :: Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
i = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e (Maybe a)
onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
i)

data SignatureType = TypeRSAAnyHash
                   | TypeRSA DigestAlgorithm
                   | TypeRSAPSS
                   | TypeDSA DigestAlgorithm
                   | TypeECDSA DigestAlgorithm
                   | TypeEd25519
                   | TypeEd448
    deriving (Int -> SignatureType -> ShowS
[SignatureType] -> ShowS
SignatureType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignatureType] -> ShowS
$cshowList :: [SignatureType] -> ShowS
show :: SignatureType -> String
$cshow :: SignatureType -> String
showsPrec :: Int -> SignatureType -> ShowS
$cshowsPrec :: Int -> SignatureType -> ShowS
Show,SignatureType -> SignatureType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureType -> SignatureType -> Bool
$c/= :: SignatureType -> SignatureType -> Bool
== :: SignatureType -> SignatureType -> Bool
$c== :: SignatureType -> SignatureType -> Bool
Eq)

instance Enumerable SignatureType where
    values :: [SignatureType]
values = [ SignatureType
TypeRSAAnyHash

             , DigestAlgorithm -> SignatureType
TypeRSA (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy MD2
MD2)
             , DigestAlgorithm -> SignatureType
TypeRSA (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy MD5
MD5)
             , DigestAlgorithm -> SignatureType
TypeRSA (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1)
             , DigestAlgorithm -> SignatureType
TypeRSA (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA224
SHA224)
             , DigestAlgorithm -> SignatureType
TypeRSA (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA256
SHA256)
             , DigestAlgorithm -> SignatureType
TypeRSA (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA384
SHA384)
             , DigestAlgorithm -> SignatureType
TypeRSA (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA512
SHA512)

             , SignatureType
TypeRSAPSS

             , DigestAlgorithm -> SignatureType
TypeDSA (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1)
             , DigestAlgorithm -> SignatureType
TypeDSA (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA224
SHA224)
             , DigestAlgorithm -> SignatureType
TypeDSA (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA256
SHA256)

             , DigestAlgorithm -> SignatureType
TypeECDSA (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1)
             , DigestAlgorithm -> SignatureType
TypeECDSA (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA224
SHA224)
             , DigestAlgorithm -> SignatureType
TypeECDSA (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA256
SHA256)
             , DigestAlgorithm -> SignatureType
TypeECDSA (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA384
SHA384)
             , DigestAlgorithm -> SignatureType
TypeECDSA (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA512
SHA512)

             , SignatureType
TypeEd25519
             , SignatureType
TypeEd448
             ]

instance OIDable SignatureType where
    getObjectID :: SignatureType -> OID
getObjectID SignatureType
TypeRSAAnyHash                       = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
1]

    getObjectID (TypeRSA (DigestAlgorithm DigestProxy hashAlg
MD2))      = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
2]
    getObjectID (TypeRSA (DigestAlgorithm DigestProxy hashAlg
MD5))      = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
4]
    getObjectID (TypeRSA (DigestAlgorithm DigestProxy hashAlg
SHA1))     = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
5]
    getObjectID (TypeRSA (DigestAlgorithm DigestProxy hashAlg
SHA224))   = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
14]
    getObjectID (TypeRSA (DigestAlgorithm DigestProxy hashAlg
SHA256))   = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
11]
    getObjectID (TypeRSA (DigestAlgorithm DigestProxy hashAlg
SHA384))   = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
12]
    getObjectID (TypeRSA (DigestAlgorithm DigestProxy hashAlg
SHA512))   = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
13]

    getObjectID SignatureType
TypeRSAPSS                           = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
10]

    getObjectID (TypeDSA (DigestAlgorithm DigestProxy hashAlg
SHA1))     = [Integer
1,Integer
2,Integer
840,Integer
10040,Integer
4,Integer
3]
    getObjectID (TypeDSA (DigestAlgorithm DigestProxy hashAlg
SHA224))   = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
3,Integer
1]
    getObjectID (TypeDSA (DigestAlgorithm DigestProxy hashAlg
SHA256))   = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
3,Integer
2]

    getObjectID (TypeECDSA (DigestAlgorithm DigestProxy hashAlg
SHA1))   = [Integer
1,Integer
2,Integer
840,Integer
10045,Integer
4,Integer
1]
    getObjectID (TypeECDSA (DigestAlgorithm DigestProxy hashAlg
SHA224)) = [Integer
1,Integer
2,Integer
840,Integer
10045,Integer
4,Integer
3,Integer
1]
    getObjectID (TypeECDSA (DigestAlgorithm DigestProxy hashAlg
SHA256)) = [Integer
1,Integer
2,Integer
840,Integer
10045,Integer
4,Integer
3,Integer
2]
    getObjectID (TypeECDSA (DigestAlgorithm DigestProxy hashAlg
SHA384)) = [Integer
1,Integer
2,Integer
840,Integer
10045,Integer
4,Integer
3,Integer
3]
    getObjectID (TypeECDSA (DigestAlgorithm DigestProxy hashAlg
SHA512)) = [Integer
1,Integer
2,Integer
840,Integer
10045,Integer
4,Integer
3,Integer
4]

    getObjectID SignatureType
TypeEd25519                          = [Integer
1,Integer
3,Integer
101,Integer
112]
    getObjectID SignatureType
TypeEd448                            = [Integer
1,Integer
3,Integer
101,Integer
113]

    getObjectID SignatureType
ty = forall a. HasCallStack => String -> a
error (String
"Unsupported SignatureType: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SignatureType
ty)

instance OIDNameable SignatureType where
    fromObjectID :: OID -> Maybe SignatureType
fromObjectID OID
oid = forall a. OIDNameableWrapper a -> a
unOIDNW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid

-- | CMS signature algorithms and associated parameters.
data SignatureAlg = RSAAnyHash
                  | RSA DigestAlgorithm
                  | RSAPSS PSSParams
                  | DSA DigestAlgorithm
                  | ECDSA DigestAlgorithm
                  | Ed25519
                  | Ed448
    deriving (Int -> SignatureAlg -> ShowS
[SignatureAlg] -> ShowS
SignatureAlg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignatureAlg] -> ShowS
$cshowList :: [SignatureAlg] -> ShowS
show :: SignatureAlg -> String
$cshow :: SignatureAlg -> String
showsPrec :: Int -> SignatureAlg -> ShowS
$cshowsPrec :: Int -> SignatureAlg -> ShowS
Show,SignatureAlg -> SignatureAlg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureAlg -> SignatureAlg -> Bool
$c/= :: SignatureAlg -> SignatureAlg -> Bool
== :: SignatureAlg -> SignatureAlg -> Bool
$c== :: SignatureAlg -> SignatureAlg -> Bool
Eq)

instance AlgorithmId SignatureAlg where
    type AlgorithmType SignatureAlg = SignatureType
    algorithmName :: SignatureAlg -> String
algorithmName SignatureAlg
_  = String
"signature algorithm"

    algorithmType :: SignatureAlg -> AlgorithmType SignatureAlg
algorithmType SignatureAlg
RSAAnyHash  = SignatureType
TypeRSAAnyHash
    algorithmType (RSA DigestAlgorithm
alg)   = DigestAlgorithm -> SignatureType
TypeRSA DigestAlgorithm
alg
    algorithmType (RSAPSS PSSParams
_)  = SignatureType
TypeRSAPSS
    algorithmType (DSA DigestAlgorithm
alg)   = DigestAlgorithm -> SignatureType
TypeDSA DigestAlgorithm
alg
    algorithmType (ECDSA DigestAlgorithm
alg) = DigestAlgorithm -> SignatureType
TypeECDSA DigestAlgorithm
alg
    algorithmType SignatureAlg
Ed25519     = SignatureType
TypeEd25519
    algorithmType SignatureAlg
Ed448       = SignatureType
TypeEd448

    parameterASN1S :: forall e. ASN1Elem e => SignatureAlg -> ASN1Stream e
parameterASN1S SignatureAlg
RSAAnyHash = forall e. ASN1Elem e => ASN1Stream e
gNull
    parameterASN1S (RSA DigestAlgorithm
_)    = forall e. ASN1Elem e => ASN1Stream e
gNull
    parameterASN1S (RSAPSS PSSParams
p) = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s PSSParams
p
    parameterASN1S (DSA DigestAlgorithm
_)    = forall a. a -> a
id
    parameterASN1S (ECDSA DigestAlgorithm
_)  = forall a. a -> a
id
    parameterASN1S SignatureAlg
Ed25519    = forall a. a -> a
id
    parameterASN1S SignatureAlg
Ed448      = forall a. a -> a
id

    parseParameter :: forall e.
Monoid e =>
AlgorithmType SignatureAlg -> ParseASN1 e SignatureAlg
parseParameter AlgorithmType SignatureAlg
SignatureType
TypeRSAAnyHash   = forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe ()
nullOrNothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return SignatureAlg
RSAAnyHash
    parseParameter (TypeRSA DigestAlgorithm
alg)    = forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe ()
nullOrNothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (DigestAlgorithm -> SignatureAlg
RSA DigestAlgorithm
alg)
    parseParameter AlgorithmType SignatureAlg
SignatureType
TypeRSAPSS       = PSSParams -> SignatureAlg
RSAPSS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
    parseParameter (TypeDSA DigestAlgorithm
alg)    = forall (m :: * -> *) a. Monad m => a -> m a
return (DigestAlgorithm -> SignatureAlg
DSA DigestAlgorithm
alg)
    parseParameter (TypeECDSA DigestAlgorithm
alg)  = forall (m :: * -> *) a. Monad m => a -> m a
return (DigestAlgorithm -> SignatureAlg
ECDSA DigestAlgorithm
alg)
    parseParameter AlgorithmType SignatureAlg
SignatureType
TypeEd25519      = forall (m :: * -> *) a. Monad m => a -> m a
return SignatureAlg
Ed25519
    parseParameter AlgorithmType SignatureAlg
SignatureType
TypeEd448        = forall (m :: * -> *) a. Monad m => a -> m a
return SignatureAlg
Ed448

-- | Sign a message using the specified algorithm and private key.  The
-- corresponding public key is also required for some algorithms.
signatureGenerate :: MonadRandom m => SignatureAlg -> X509.PrivKey -> X509.PubKey -> ByteString -> m (Either StoreError SignatureValue)
signatureGenerate :: forall (m :: * -> *).
MonadRandom m =>
SignatureAlg
-> PrivKey
-> PubKey
-> ByteString
-> m (Either StoreError ByteString)
signatureGenerate SignatureAlg
RSAAnyHash PrivKey
_ PubKey
_ ByteString
_ =
    forall a. HasCallStack => String -> a
error String
"signatureGenerate: should call signatureResolveHash first"
signatureGenerate (RSA DigestAlgorithm
alg)   (X509.PrivKeyRSA PrivateKey
priv) (X509.PubKeyRSA PublicKey
_) ByteString
msg =
    let err :: m (Either StoreError ByteString)
err = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> StoreError
InvalidParameter (String
"Invalid hash algorithm for RSA: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show DigestAlgorithm
alg)
     in forall a.
DigestAlgorithm
-> a
-> (forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a)
-> a
withHashAlgorithmASN1 DigestAlgorithm
alg m (Either StoreError ByteString)
err forall a b. (a -> b) -> a -> b
$ \hashAlg
hashAlg ->
            forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft Error -> StoreError
RSAError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall hashAlg (m :: * -> *).
(HashAlgorithmASN1 hashAlg, MonadRandom m) =>
Maybe hashAlg
-> PrivateKey -> ByteString -> m (Either Error ByteString)
RSA.signSafer (forall a. a -> Maybe a
Just hashAlg
hashAlg) PrivateKey
priv ByteString
msg
signatureGenerate (RSAPSS PSSParams
p)  (X509.PrivKeyRSA PrivateKey
priv) (X509.PubKeyRSA PublicKey
_) ByteString
msg =
    forall seed output a.
(ByteArrayAccess seed, ByteArray output) =>
PSSParams
-> (forall hash.
    HashAlgorithm hash =>
    PSSParams hash seed output -> a)
-> a
withPSSParams PSSParams
p forall a b. (a -> b) -> a -> b
$ \PSSParams hash ByteString ByteString
params ->
        forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft Error -> StoreError
RSAError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
PSSParams hash ByteString ByteString
-> PrivateKey -> ByteString -> m (Either Error ByteString)
RSAPSS.signSafer PSSParams hash ByteString ByteString
params PrivateKey
priv ByteString
msg
signatureGenerate (DSA DigestAlgorithm
alg)   (X509.PrivKeyDSA PrivateKey
priv) (X509.PubKeyDSA PublicKey
_) ByteString
msg =
    case DigestAlgorithm
alg of
        DigestAlgorithm DigestProxy hashAlg
t ->
            forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
dsaFromSignature forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall msg hash (m :: * -> *).
(ByteArrayAccess msg, HashAlgorithm hash, MonadRandom m) =>
PrivateKey -> hash -> msg -> m Signature
DSA.sign PrivateKey
priv (forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy DigestProxy hashAlg
t) ByteString
msg
signatureGenerate (ECDSA DigestAlgorithm
alg) (X509.PrivKeyEC PrivKeyEC
priv)  (X509.PubKeyEC PubKeyEC
_)  ByteString
msg =
    case DigestAlgorithm
alg of
        DigestAlgorithm DigestProxy hashAlg
t ->
            case PrivKeyEC -> Maybe PrivateKey
ecdsaToPrivateKey PrivKeyEC
priv of
                Maybe PrivateKey
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left StoreError
UnsupportedEllipticCurve)
                Just PrivateKey
p  ->
                    let h :: hashAlg
h = forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy DigestProxy hashAlg
t
                     in forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
ecdsaFromSignature forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall msg hash (m :: * -> *).
(ByteArrayAccess msg, HashAlgorithm hash, MonadRandom m) =>
PrivateKey -> hash -> msg -> m Signature
ECDSA.sign PrivateKey
p hashAlg
h ByteString
msg
signatureGenerate SignatureAlg
Ed25519 (X509.PrivKeyEd25519 SecretKey
priv) (X509.PubKeyEd25519 PublicKey
pub) ByteString
msg =
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert forall a b. (a -> b) -> a -> b
$ forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed25519.sign SecretKey
priv PublicKey
pub ByteString
msg
signatureGenerate SignatureAlg
Ed448 (X509.PrivKeyEd448 SecretKey
priv) (X509.PubKeyEd448 PublicKey
pub) ByteString
msg =
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert forall a b. (a -> b) -> a -> b
$ forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed448.sign SecretKey
priv PublicKey
pub ByteString
msg
signatureGenerate SignatureAlg
_ PrivKey
_ PubKey
_ ByteString
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left StoreError
UnexpectedPrivateKeyType)

-- | Verify a message signature using the specified algorithm and public key.
signatureVerify :: SignatureAlg -> X509.PubKey -> ByteString -> SignatureValue -> Bool
signatureVerify :: SignatureAlg -> PubKey -> ByteString -> ByteString -> Bool
signatureVerify SignatureAlg
RSAAnyHash PubKey
_ ByteString
_ ByteString
_ =
    forall a. HasCallStack => String -> a
error String
"signatureVerify: should call signatureResolveHash first"
signatureVerify (RSA DigestAlgorithm
alg)   (X509.PubKeyRSA PublicKey
pub) ByteString
msg ByteString
sig =
    forall a.
DigestAlgorithm
-> a
-> (forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a)
-> a
withHashAlgorithmASN1 DigestAlgorithm
alg Bool
False forall a b. (a -> b) -> a -> b
$ \hashAlg
hashAlg ->
        forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
RSA.verify (forall a. a -> Maybe a
Just hashAlg
hashAlg) PublicKey
pub ByteString
msg ByteString
sig
signatureVerify (RSAPSS PSSParams
p)  (X509.PubKeyRSA PublicKey
pub) ByteString
msg ByteString
sig
    | forall params. HasStrength params => params -> Bool
securityAcceptable PSSParams
p =
        forall seed output a.
(ByteArrayAccess seed, ByteArray output) =>
PSSParams
-> (forall hash.
    HashAlgorithm hash =>
    PSSParams hash seed output -> a)
-> a
withPSSParams PSSParams
p forall a b. (a -> b) -> a -> b
$ \PSSParams hash ByteString ByteString
params -> forall hash.
HashAlgorithm hash =>
PSSParams hash ByteString ByteString
-> PublicKey -> ByteString -> ByteString -> Bool
RSAPSS.verify PSSParams hash ByteString ByteString
params PublicKey
pub ByteString
msg ByteString
sig
    | Bool
otherwise = Bool
False
signatureVerify (DSA DigestAlgorithm
alg)   (X509.PubKeyDSA PublicKey
pub) ByteString
msg ByteString
sig = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
    Signature
s <- ByteString -> Maybe Signature
dsaToSignature ByteString
sig
    case DigestAlgorithm
alg of
        DigestAlgorithm DigestProxy hashAlg
t -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
hash -> PublicKey -> Signature -> msg -> Bool
DSA.verify (forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy DigestProxy hashAlg
t) PublicKey
pub Signature
s ByteString
msg
signatureVerify (ECDSA DigestAlgorithm
alg) (X509.PubKeyEC PubKeyEC
pub)  ByteString
msg ByteString
sig = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
    PublicKey
p <- PubKeyEC -> Maybe PublicKey
ecdsaToPublicKey PubKeyEC
pub
    Signature
s <- ByteString -> Maybe Signature
ecdsaToSignature ByteString
sig
    case DigestAlgorithm
alg of
        DigestAlgorithm DigestProxy hashAlg
t -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
hash -> PublicKey -> Signature -> msg -> Bool
ECDSA.verify (forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy DigestProxy hashAlg
t) PublicKey
p Signature
s ByteString
msg
signatureVerify SignatureAlg
Ed25519 (X509.PubKeyEd25519 PublicKey
pub) ByteString
msg ByteString
sig =
    case forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature ByteString
sig of
        CryptoFailed CryptoError
_ -> Bool
False
        CryptoPassed Signature
s -> forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed25519.verify PublicKey
pub ByteString
msg Signature
s
signatureVerify SignatureAlg
Ed448 (X509.PubKeyEd448 PublicKey
pub) ByteString
msg ByteString
sig =
    case forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed448.signature ByteString
sig of
        CryptoFailed CryptoError
_ -> Bool
False
        CryptoPassed Signature
s -> forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed448.verify PublicKey
pub ByteString
msg Signature
s
signatureVerify SignatureAlg
_                 PubKey
_                    ByteString
_   ByteString
_   = Bool
False

withHashAlgorithmASN1 :: DigestAlgorithm
                      -> a
                      -> (forall hashAlg . RSA.HashAlgorithmASN1 hashAlg => hashAlg -> a)
                      -> a
withHashAlgorithmASN1 :: forall a.
DigestAlgorithm
-> a
-> (forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a)
-> a
withHashAlgorithmASN1 (DigestAlgorithm DigestProxy hashAlg
MD2)    a
_ forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f = forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f MD2
Hash.MD2
withHashAlgorithmASN1 (DigestAlgorithm DigestProxy hashAlg
MD5)    a
_ forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f = forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f MD5
Hash.MD5
withHashAlgorithmASN1 (DigestAlgorithm DigestProxy hashAlg
SHA1)   a
_ forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f = forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f SHA1
Hash.SHA1
withHashAlgorithmASN1 (DigestAlgorithm DigestProxy hashAlg
SHA224) a
_ forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f = forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f SHA224
Hash.SHA224
withHashAlgorithmASN1 (DigestAlgorithm DigestProxy hashAlg
SHA256) a
_ forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f = forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f SHA256
Hash.SHA256
withHashAlgorithmASN1 (DigestAlgorithm DigestProxy hashAlg
SHA384) a
_ forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f = forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f SHA384
Hash.SHA384
withHashAlgorithmASN1 (DigestAlgorithm DigestProxy hashAlg
SHA512) a
_ forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f = forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f SHA512
Hash.SHA512
withHashAlgorithmASN1 DigestAlgorithm
_                        a
e forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
_ = a
e

-- | Return on which digest algorithm the specified signature algorithm is
-- based, as well as a substitution algorithm for when a default digest
-- algorithm is required.
signatureResolveHash :: Bool -> DigestAlgorithm -> SignatureAlg -> (DigestAlgorithm, SignatureAlg)
signatureResolveHash :: Bool
-> DigestAlgorithm
-> SignatureAlg
-> (DigestAlgorithm, SignatureAlg)
signatureResolveHash Bool
_     DigestAlgorithm
d SignatureAlg
RSAAnyHash     = (DigestAlgorithm
d, DigestAlgorithm -> SignatureAlg
RSA DigestAlgorithm
d)
signatureResolveHash Bool
_     DigestAlgorithm
_ alg :: SignatureAlg
alg@(RSA DigestAlgorithm
d)    = (DigestAlgorithm
d, SignatureAlg
alg)
signatureResolveHash Bool
_     DigestAlgorithm
_ alg :: SignatureAlg
alg@(RSAPSS PSSParams
p) = (PSSParams -> DigestAlgorithm
pssHashAlgorithm PSSParams
p, SignatureAlg
alg)
signatureResolveHash Bool
_     DigestAlgorithm
_ alg :: SignatureAlg
alg@(DSA DigestAlgorithm
d)    = (DigestAlgorithm
d, SignatureAlg
alg)
signatureResolveHash Bool
_     DigestAlgorithm
_ alg :: SignatureAlg
alg@(ECDSA DigestAlgorithm
d)  = (DigestAlgorithm
d, SignatureAlg
alg)
signatureResolveHash Bool
_     DigestAlgorithm
_ alg :: SignatureAlg
alg@SignatureAlg
Ed25519    = (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA512
SHA512, SignatureAlg
alg)
signatureResolveHash Bool
True  DigestAlgorithm
_ alg :: SignatureAlg
alg@SignatureAlg
Ed448      = (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy (SHAKE256 512)
SHAKE256_512, SignatureAlg
alg)
signatureResolveHash Bool
False DigestAlgorithm
_ alg :: SignatureAlg
alg@SignatureAlg
Ed448      = (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm (forall (n :: Nat).
KnownNat n =>
Proxy n -> DigestProxy (SHAKE256 n)
SHAKE256 Proxy 512
p512), SignatureAlg
alg)

-- | Check that a signature algorithm is based on the specified digest algorithm
-- and return a substitution algorithm for when a default digest algorithm is
-- required.
signatureCheckHash :: DigestAlgorithm -> SignatureAlg -> Maybe SignatureAlg
signatureCheckHash :: DigestAlgorithm -> SignatureAlg -> Maybe SignatureAlg
signatureCheckHash DigestAlgorithm
expected SignatureAlg
RSAAnyHash = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ DigestAlgorithm -> SignatureAlg
RSA DigestAlgorithm
expected
signatureCheckHash DigestAlgorithm
expected alg :: SignatureAlg
alg@(RSA DigestAlgorithm
found)
    | DigestAlgorithm
expected forall a. Eq a => a -> a -> Bool
== DigestAlgorithm
found = forall a. a -> Maybe a
Just SignatureAlg
alg
    | Bool
otherwise         = forall a. Maybe a
Nothing
signatureCheckHash DigestAlgorithm
expected alg :: SignatureAlg
alg@(RSAPSS PSSParams
p)
    | DigestAlgorithm
expected forall a. Eq a => a -> a -> Bool
== PSSParams -> DigestAlgorithm
pssHashAlgorithm PSSParams
p = forall a. a -> Maybe a
Just SignatureAlg
alg
    | Bool
otherwise                      = forall a. Maybe a
Nothing
signatureCheckHash DigestAlgorithm
expected alg :: SignatureAlg
alg@(DSA DigestAlgorithm
found)
    | DigestAlgorithm
expected forall a. Eq a => a -> a -> Bool
== DigestAlgorithm
found = forall a. a -> Maybe a
Just SignatureAlg
alg
    | Bool
otherwise         = forall a. Maybe a
Nothing
signatureCheckHash DigestAlgorithm
expected alg :: SignatureAlg
alg@(ECDSA DigestAlgorithm
found)
    | DigestAlgorithm
expected forall a. Eq a => a -> a -> Bool
== DigestAlgorithm
found = forall a. a -> Maybe a
Just SignatureAlg
alg
    | Bool
otherwise         = forall a. Maybe a
Nothing
signatureCheckHash DigestAlgorithm
expected alg :: SignatureAlg
alg@SignatureAlg
Ed25519
    | DigestAlgorithm
expected forall a. Eq a => a -> a -> Bool
== forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA512
SHA512 = forall a. a -> Maybe a
Just SignatureAlg
alg
    | Bool
otherwise                          = forall a. Maybe a
Nothing
signatureCheckHash DigestAlgorithm
expected alg :: SignatureAlg
alg@SignatureAlg
Ed448
    | DigestAlgorithm
expected forall a. Eq a => a -> a -> Bool
== forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy (SHAKE256 512)
SHAKE256_512    = forall a. a -> Maybe a
Just SignatureAlg
alg
    | DigestAlgorithm
expected forall a. Eq a => a -> a -> Bool
== forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm (forall (n :: Nat).
KnownNat n =>
Proxy n -> DigestProxy (SHAKE256 n)
SHAKE256 Proxy 512
p512) = forall a. a -> Maybe a
Just SignatureAlg
alg
    | Bool
otherwise                                   = forall a. Maybe a
Nothing

dsaToSignature :: ByteString -> Maybe DSA.Signature
dsaToSignature :: ByteString -> Maybe Signature
dsaToSignature ByteString
b = forall a. ByteString -> ParseASN1 () a -> Maybe a
tryDecodeAndParse ByteString
b forall a b. (a -> b) -> a -> b
$ forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
    IntVal Integer
r <- forall e. Monoid e => ParseASN1 e ASN1
getNext
    IntVal Integer
s <- forall e. Monoid e => ParseASN1 e ASN1
getNext
    forall (m :: * -> *) a. Monad m => a -> m a
return DSA.Signature { sign_r :: Integer
DSA.sign_r = Integer
r, sign_s :: Integer
DSA.sign_s = Integer
s }

dsaFromSignature :: DSA.Signature -> ByteString
dsaFromSignature :: Signature -> ByteString
dsaFromSignature Signature
sig = ASN1Stream ASN1P -> ByteString
encodeASN1S forall a b. (a -> b) -> a -> b
$ forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence
    (forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Signature -> Integer
DSA.sign_r Signature
sig) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Signature -> Integer
DSA.sign_s Signature
sig))

ecdsaToSignature :: ByteString -> Maybe ECDSA.Signature
ecdsaToSignature :: ByteString -> Maybe Signature
ecdsaToSignature ByteString
b = forall a. ByteString -> ParseASN1 () a -> Maybe a
tryDecodeAndParse ByteString
b forall a b. (a -> b) -> a -> b
$ forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
    IntVal Integer
r <- forall e. Monoid e => ParseASN1 e ASN1
getNext
    IntVal Integer
s <- forall e. Monoid e => ParseASN1 e ASN1
getNext
    forall (m :: * -> *) a. Monad m => a -> m a
return ECDSA.Signature { sign_r :: Integer
ECDSA.sign_r = Integer
r, sign_s :: Integer
ECDSA.sign_s = Integer
s }

ecdsaFromSignature :: ECDSA.Signature -> ByteString
ecdsaFromSignature :: Signature -> ByteString
ecdsaFromSignature Signature
sig = ASN1Stream ASN1P -> ByteString
encodeASN1S forall a b. (a -> b) -> a -> b
$ forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence
    (forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Signature -> Integer
ECDSA.sign_r Signature
sig) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Signature -> Integer
ECDSA.sign_s Signature
sig))

ecdsaToPublicKey :: X509.PubKeyEC -> Maybe ECDSA.PublicKey
ecdsaToPublicKey :: PubKeyEC -> Maybe PublicKey
ecdsaToPublicKey PubKeyEC
key = do
    Curve
curve <- PubKeyEC -> Maybe Curve
ecPubKeyCurve PubKeyEC
key
    Point
pt <- Curve -> SerializedPoint -> Maybe Point
unserializePoint Curve
curve (PubKeyEC -> SerializedPoint
X509.pubkeyEC_pub PubKeyEC
key)
    forall (m :: * -> *) a. Monad m => a -> m a
return ECDSA.PublicKey { public_curve :: Curve
ECDSA.public_curve = Curve
curve, public_q :: Point
ECDSA.public_q = Point
pt }

ecdsaToPrivateKey :: X509.PrivKeyEC -> Maybe ECDSA.PrivateKey
ecdsaToPrivateKey :: PrivKeyEC -> Maybe PrivateKey
ecdsaToPrivateKey PrivKeyEC
key = do
    Curve
curve <- PrivKeyEC -> Maybe Curve
ecPrivKeyCurve PrivKeyEC
key
    let d :: Integer
d = PrivKeyEC -> Integer
X509.privkeyEC_priv PrivKeyEC
key
    forall (m :: * -> *) a. Monad m => a -> m a
return ECDSA.PrivateKey { private_curve :: Curve
ECDSA.private_curve = Curve
curve, private_d :: Integer
ECDSA.private_d = Integer
d }

tryDecodeAndParse :: ByteString -> ParseASN1 () a -> Maybe a
tryDecodeAndParse :: forall a. ByteString -> ParseASN1 () a -> Maybe a
tryDecodeAndParse ByteString
b ParseASN1 () a
parser =
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        case forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
b of
            Left ASN1Error
_     -> forall a b. a -> Either a b
Left forall a. HasCallStack => a
undefined -- value ignored
            Right [ASN1]
asn1 -> forall a. ParseASN1 () a -> [ASN1] -> Either String a
runParseASN1 ParseASN1 () a
parser [ASN1]
asn1