-- |
-- 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) = Int -> Proxy n -> Int
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
Int -> proxy n -> Int
shakeSecurityBits Int
128 Proxy n
a
    getSecurityBits (SHAKE256 Proxy n
a) = Int -> Proxy n -> Int
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 :: Int -> proxy n -> Int
shakeSecurityBits Int
m proxy n
a = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
m (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal proxy n
a) Int -> Int -> Int
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) = DigestProxy hashAlg -> String
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) = Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy n
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy n
b
    DigestAlgorithm (SHAKE256 Proxy n
a) == DigestAlgorithm (SHAKE256 Proxy n
b) = Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy n
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy n -> Integer
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) = DigestProxy hashAlg -> Int
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 = OIDNameableWrapper DigestType -> DigestType
forall a. OIDNameableWrapper a -> a
unOIDNW (OIDNameableWrapper DigestType -> DigestType)
-> Maybe (OIDNameableWrapper DigestType) -> Maybe DigestType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OID -> Maybe (OIDNameableWrapper DigestType)
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)          = AlgorithmType DigestAlgorithm
DigestType
Type_MD2
    algorithmType (DigestAlgorithm DigestProxy hashAlg
MD4)          = AlgorithmType DigestAlgorithm
DigestType
Type_MD4
    algorithmType (DigestAlgorithm DigestProxy hashAlg
MD5)          = AlgorithmType DigestAlgorithm
DigestType
Type_MD5
    algorithmType (DigestAlgorithm DigestProxy hashAlg
SHA1)         = AlgorithmType DigestAlgorithm
DigestType
Type_SHA1
    algorithmType (DigestAlgorithm DigestProxy hashAlg
SHA224)       = AlgorithmType DigestAlgorithm
DigestType
Type_SHA224
    algorithmType (DigestAlgorithm DigestProxy hashAlg
SHA256)       = AlgorithmType DigestAlgorithm
DigestType
Type_SHA256
    algorithmType (DigestAlgorithm DigestProxy hashAlg
SHA384)       = AlgorithmType DigestAlgorithm
DigestType
Type_SHA384
    algorithmType (DigestAlgorithm DigestProxy hashAlg
SHA512)       = AlgorithmType DigestAlgorithm
DigestType
Type_SHA512
    algorithmType (DigestAlgorithm DigestProxy hashAlg
SHAKE128_256) = AlgorithmType DigestAlgorithm
DigestType
Type_SHAKE128_256
    algorithmType (DigestAlgorithm DigestProxy hashAlg
SHAKE256_512) = AlgorithmType DigestAlgorithm
DigestType
Type_SHAKE256_512
    algorithmType (DigestAlgorithm (SHAKE128 Proxy n
_)) = AlgorithmType DigestAlgorithm
DigestType
Type_SHAKE128_Len
    algorithmType (DigestAlgorithm (SHAKE256 Proxy n
_)) = AlgorithmType DigestAlgorithm
DigestType
Type_SHAKE256_Len

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

    parseParameter :: AlgorithmType DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseParameter AlgorithmType DigestAlgorithm
Type_MD2          = DigestAlgorithm -> ParseASN1 e DigestAlgorithm
forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (DigestProxy MD2 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy MD2
MD2)
    parseParameter AlgorithmType DigestAlgorithm
Type_MD4          = DigestAlgorithm -> ParseASN1 e DigestAlgorithm
forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (DigestProxy MD4 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy MD4
MD4)
    parseParameter AlgorithmType DigestAlgorithm
Type_MD5          = DigestAlgorithm -> ParseASN1 e DigestAlgorithm
forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (DigestProxy MD5 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy MD5
MD5)
    parseParameter AlgorithmType DigestAlgorithm
Type_SHA1         = DigestAlgorithm -> ParseASN1 e DigestAlgorithm
forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (DigestProxy SHA1 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1)
    parseParameter AlgorithmType DigestAlgorithm
Type_SHA224       = DigestAlgorithm -> ParseASN1 e DigestAlgorithm
forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (DigestProxy SHA224 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA224
SHA224)
    parseParameter AlgorithmType DigestAlgorithm
Type_SHA256       = DigestAlgorithm -> ParseASN1 e DigestAlgorithm
forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (DigestProxy SHA256 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA256
SHA256)
    parseParameter AlgorithmType DigestAlgorithm
Type_SHA384       = DigestAlgorithm -> ParseASN1 e DigestAlgorithm
forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (DigestProxy SHA384 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA384
SHA384)
    parseParameter AlgorithmType DigestAlgorithm
Type_SHA512       = DigestAlgorithm -> ParseASN1 e DigestAlgorithm
forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (DigestProxy SHA512 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA512
SHA512)
    parseParameter AlgorithmType DigestAlgorithm
Type_SHAKE128_256 = DigestAlgorithm -> ParseASN1 e DigestAlgorithm
forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (DigestProxy (SHAKE128 256) -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy (SHAKE128 256)
SHAKE128_256)
    parseParameter AlgorithmType DigestAlgorithm
Type_SHAKE256_512 = DigestAlgorithm -> ParseASN1 e DigestAlgorithm
forall e.
Monoid e =>
DigestAlgorithm -> ParseASN1 e DigestAlgorithm
parseDigestParam (DigestProxy (SHAKE256 512) -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy (SHAKE256 512)
SHAKE256_512)
    parseParameter AlgorithmType DigestAlgorithm
Type_SHAKE128_Len = (SomeNat -> DigestAlgorithm) -> ParseASN1 e DigestAlgorithm
forall e a. Monoid e => (SomeNat -> a) -> ParseASN1 e a
parseBitLen ((SomeNat -> DigestAlgorithm) -> ParseASN1 e DigestAlgorithm)
-> (SomeNat -> DigestAlgorithm) -> ParseASN1 e DigestAlgorithm
forall a b. (a -> b) -> a -> b
$
        \(SomeNat Proxy n
p) -> DigestProxy (SHAKE128 n) -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm (Proxy n -> DigestProxy (SHAKE128 n)
forall (n :: Nat).
KnownNat n =>
Proxy n -> DigestProxy (SHAKE128 n)
SHAKE128 Proxy n
p)
    parseParameter AlgorithmType DigestAlgorithm
Type_SHAKE256_Len = (SomeNat -> DigestAlgorithm) -> ParseASN1 e DigestAlgorithm
forall e a. Monoid e => (SomeNat -> a) -> ParseASN1 e a
parseBitLen ((SomeNat -> DigestAlgorithm) -> ParseASN1 e DigestAlgorithm)
-> (SomeNat -> DigestAlgorithm) -> ParseASN1 e DigestAlgorithm
forall a b. (a -> b) -> a -> b
$
        \(SomeNat Proxy n
p) -> DigestProxy (SHAKE256 n) -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm (Proxy n -> DigestProxy (SHAKE256 n)
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 :: DigestAlgorithm -> message -> ByteString
digest (DigestAlgorithm DigestProxy hashAlg
hashAlg) message
message = Digest hashAlg -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (DigestProxy hashAlg -> message -> Digest hashAlg
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 :: proxy hashAlg -> ba -> Digest hashAlg
doHash proxy hashAlg
_ = ba -> Digest hashAlg
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Hash.hash

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

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

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

p512 :: Proxy 512
p512 :: Proxy 512
p512 = Proxy 512
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 :: params -> Bool
securityAcceptable = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
64) (Int -> Bool) -> (params -> Int) -> params -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. params -> Int
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 :: params -> Int
getMaximumKeySize params
params =
    case params -> KeySizeSpecifier
forall params. HasKeySize params => params -> KeySizeSpecifier
getKeySizeSpecifier params
params of
        KeySizeRange Int
_ Int
n -> Int
n
        KeySizeEnum  [Int]
l   -> [Int] -> Int
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 :: params -> Int -> Bool
validateKeySize params
params Int
len =
    case params -> KeySizeSpecifier
forall params. HasKeySize params => params -> KeySizeSpecifier
getKeySizeSpecifier params
params of
        KeySizeRange Int
a Int
b -> Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
len Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
b
        KeySizeEnum  [Int]
l   -> Int
len Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
l
        KeySizeFixed Int
n   -> Int
len Int -> Int -> Bool
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 :: params -> m key
generateKey params
params = Int -> m key
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes (params -> Int
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 = DigestProxy hashAlg -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy hashAlg
a1 DigestAlgorithm -> DigestAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== DigestProxy hashAlg -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy hashAlg
a2

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

instance Enumerable MACAlgorithm where
    values :: [MACAlgorithm]
values = [ DigestProxy MD5 -> MACAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> MACAlgorithm
HMAC DigestProxy MD5
MD5
             , DigestProxy SHA1 -> MACAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> MACAlgorithm
HMAC DigestProxy SHA1
SHA1
             , DigestProxy SHA224 -> MACAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> MACAlgorithm
HMAC DigestProxy SHA224
SHA224
             , DigestProxy SHA256 -> MACAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> MACAlgorithm
HMAC DigestProxy SHA256
SHA256
             , DigestProxy SHA384 -> MACAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> MACAlgorithm
HMAC DigestProxy SHA384
SHA384
             , DigestProxy SHA512 -> MACAlgorithm
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 = String -> OID
forall a. HasCallStack => String -> a
error (String
"Unsupported MACAlgorithm: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ MACAlgorithm -> String
forall a. Show a => a -> String
show MACAlgorithm
ty)

instance OIDNameable MACAlgorithm where
    fromObjectID :: OID -> Maybe MACAlgorithm
fromObjectID OID
oid = OIDNameableWrapper MACAlgorithm -> MACAlgorithm
forall a. OIDNameableWrapper a -> a
unOIDNW (OIDNameableWrapper MACAlgorithm -> MACAlgorithm)
-> Maybe (OIDNameableWrapper MACAlgorithm) -> Maybe MACAlgorithm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OID -> Maybe (OIDNameableWrapper MACAlgorithm)
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    = MACAlgorithm -> AlgorithmType MACAlgorithm
forall a. a -> a
id
    parameterASN1S :: MACAlgorithm -> ASN1Stream e
parameterASN1S MACAlgorithm
_ = ASN1Stream e
forall a. a -> a
id
    parseParameter :: AlgorithmType MACAlgorithm -> ParseASN1 e MACAlgorithm
parseParameter AlgorithmType MACAlgorithm
p = (ASN1 -> Maybe ()) -> ParseASN1 e (Maybe ())
forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe ()
nullOrNothing ParseASN1 e (Maybe ())
-> ParseASN1 e MACAlgorithm -> ParseASN1 e MACAlgorithm
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MACAlgorithm -> ParseASN1 e MACAlgorithm
forall (m :: * -> *) a. Monad m => a -> m a
return AlgorithmType MACAlgorithm
MACAlgorithm
p

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

-- | Invoke the MAC function.
mac :: (ByteArrayAccess key, ByteArrayAccess message)
     => MACAlgorithm -> key -> message -> MessageAuthenticationCode
mac :: MACAlgorithm -> key -> message -> MessageAuthenticationCode
mac (HMAC DigestProxy hashAlg
alg) = DigestProxy hashAlg -> key -> message -> MessageAuthenticationCode
forall a k m (proxy :: * -> *).
(HashAlgorithm a, ByteArrayAccess k, ByteArrayAccess m) =>
proxy a -> k -> m -> MessageAuthenticationCode
hmacWith DigestProxy hashAlg
alg
  where
    hmacWith :: proxy a -> k -> m -> MessageAuthenticationCode
hmacWith proxy a
p k
key = Bytes -> MessageAuthenticationCode
AuthTag (Bytes -> MessageAuthenticationCode)
-> (m -> Bytes) -> m -> MessageAuthenticationCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HMAC a -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (HMAC a -> Bytes) -> (m -> HMAC a) -> m -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy a -> k -> m -> HMAC a
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 :: proxy a -> k -> m -> HMAC a
runHMAC proxy a
_ = k -> m -> HMAC 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 :: 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 :: proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier = cipher -> KeySizeSpecifier
forall cipher. Cipher cipher => cipher -> KeySizeSpecifier
cipherKeySize (cipher -> KeySizeSpecifier)
-> (proxy cipher -> cipher) -> proxy cipher -> KeySizeSpecifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy cipher -> cipher
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) = ContentEncryptionCipher c -> ShowS
forall a. Show a => a -> ShowS
shows ContentEncryptionCipher c
c String
"_ECB"
    show (CBC ContentEncryptionCipher c
c) = ContentEncryptionCipher c -> ShowS
forall a. Show a => a -> ShowS
shows ContentEncryptionCipher c
c String
"_CBC"
    show ContentEncryptionAlg
CBC_RC2 = String
"RC2_CBC"
    show (CFB ContentEncryptionCipher c
c) = ContentEncryptionCipher c -> ShowS
forall a. Show a => a -> ShowS
shows ContentEncryptionCipher c
c String
"_CFB"
    show (CTR ContentEncryptionCipher c
c) = ContentEncryptionCipher c -> ShowS
forall a. Show a => a -> ShowS
shows ContentEncryptionCipher c
c String
"_CTR"

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

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

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

             , ContentEncryptionCipher Camellia128 -> ContentEncryptionAlg
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 = String -> OID
forall a. HasCallStack => String -> a
error (String
"Unsupported ContentEncryptionAlg: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ContentEncryptionAlg -> String
forall a. Show a => a -> String
show ContentEncryptionAlg
ty)

instance OIDNameable ContentEncryptionAlg where
    fromObjectID :: OID -> Maybe ContentEncryptionAlg
fromObjectID OID
oid = OIDNameableWrapper ContentEncryptionAlg -> ContentEncryptionAlg
forall a. OIDNameableWrapper a -> a
unOIDNW (OIDNameableWrapper ContentEncryptionAlg -> ContentEncryptionAlg)
-> Maybe (OIDNameableWrapper ContentEncryptionAlg)
-> Maybe ContentEncryptionAlg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OID -> Maybe (OIDNameableWrapper ContentEncryptionAlg)
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 = ContentEncryptionAlg -> String
forall a. Show a => a -> String
show (ContentEncryptionAlg -> String)
-> (ContentEncryptionParams -> ContentEncryptionAlg)
-> ContentEncryptionParams
-> String
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        = ContentEncryptionCipher c -> Int
forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ContentEncryptionCipher c -> Int
forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c2
    ParamsCBC ContentEncryptionCipher c
c1 IV c
iv1    == ParamsCBC ContentEncryptionCipher c
c2 IV c
iv2    = ContentEncryptionCipher c -> Int
forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ContentEncryptionCipher c -> Int
forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c2 Bool -> Bool -> Bool
&& IV c
iv1 IV c -> IV c -> Bool
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i2 Bool -> Bool -> Bool
&& IV RC2
iv1 IV RC2 -> IV RC2 -> Bool
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    = ContentEncryptionCipher c -> Int
forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ContentEncryptionCipher c -> Int
forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c2 Bool -> Bool -> Bool
&& IV c
iv1 IV c -> IV c -> Bool
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    = ContentEncryptionCipher c -> Int
forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ContentEncryptionCipher c -> Int
forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c2 Bool -> Bool -> Bool
&& IV c
iv1 IV c -> IV c -> Bool
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)      = ContentEncryptionCipher c -> KeySizeSpecifier
forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher c
c
    getKeySizeSpecifier (ParamsCBC ContentEncryptionCipher c
c IV c
_)    = ContentEncryptionCipher c -> KeySizeSpecifier
forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher c
c
    getKeySizeSpecifier (ParamsCBCRC2 Int
i IV RC2
_) = Int -> KeySizeSpecifier
KeySizeFixed (Int -> KeySizeSpecifier) -> Int -> KeySizeSpecifier
forall a b. (a -> b) -> a -> b
$ (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
    getKeySizeSpecifier (ParamsCFB ContentEncryptionCipher c
c IV c
_)    = ContentEncryptionCipher c -> KeySizeSpecifier
forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher c
c
    getKeySizeSpecifier (ParamsCTR ContentEncryptionCipher c
c IV c
_)    = ContentEncryptionCipher c -> KeySizeSpecifier
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 =
        ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
oid ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
params)
      where
        oid :: ASN1Stream e
oid    = OID -> ASN1Stream e
forall e. ASN1Elem e => OID -> ASN1Stream e
gOID (ContentEncryptionAlg -> OID
forall a. OIDable a => a -> OID
getObjectID (ContentEncryptionAlg -> OID) -> ContentEncryptionAlg -> OID
forall a b. (a -> b) -> a -> b
$ ContentEncryptionParams -> ContentEncryptionAlg
getContentEncryptionAlg ContentEncryptionParams
param)
        params :: ASN1Stream e
params = ContentEncryptionParams -> ASN1Stream e
forall e. ASN1Elem e => ContentEncryptionParams -> ASN1Stream e
ceParameterASN1S ContentEncryptionParams
param

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

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

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

getIV :: BlockCipher cipher => ASN1 -> ParseASN1 e (IV cipher)
getIV :: ASN1 -> ParseASN1 e (IV cipher)
getIV (OctetString ByteString
ivBs) =
    case ByteString -> Maybe (IV cipher)
forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV ByteString
ivBs of
        Maybe (IV cipher)
Nothing -> String -> ParseASN1 e (IV cipher)
forall e a. String -> ParseASN1 e a
throwParseError String
"Bad IV in parsed parameters"
        Just IV cipher
v  -> IV cipher -> ParseASN1 e (IV cipher)
forall (m :: * -> *) a. Monad m => a -> m a
return IV cipher
v
getIV ASN1
_ = String -> ParseASN1 e (IV cipher)
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 :: Int -> IV RC2 -> ASN1Stream e
rc2ParameterASN1S Int
len IV RC2
iv
    | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = ASN1Stream e
gIV
    | Bool
otherwise = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (Int -> ASN1Stream e
forall e. ASN1Elem e => Int -> ASN1Stream e
rc2VersionASN1 Int
len ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
gIV)
  where gIV :: ASN1Stream e
gIV = ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (IV RC2 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert IV RC2
iv)

parseRC2Parameter :: Monoid e => ParseASN1 e ContentEncryptionParams
parseRC2Parameter :: ParseASN1 e ContentEncryptionParams
parseRC2Parameter = Int -> ParseASN1 e ContentEncryptionParams
forall e. Monoid e => Int -> ParseASN1 e ContentEncryptionParams
parseOnlyIV Int
32 ParseASN1 e ContentEncryptionParams
-> ParseASN1 e ContentEncryptionParams
-> ParseASN1 e ContentEncryptionParams
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 (IV RC2 -> ContentEncryptionParams)
-> ParseASN1 e (IV RC2) -> ParseASN1 e ContentEncryptionParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext ParseASN1 e ASN1
-> (ASN1 -> ParseASN1 e (IV RC2)) -> ParseASN1 e (IV RC2)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ASN1 -> ParseASN1 e (IV RC2)
forall cipher e.
BlockCipher cipher =>
ASN1 -> ParseASN1 e (IV cipher)
getIV)
    parseFullParams :: ParseASN1 e ContentEncryptionParams
parseFullParams = ASN1ConstructionType
-> ParseASN1 e ContentEncryptionParams
-> ParseASN1 e ContentEncryptionParams
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e ContentEncryptionParams
 -> ParseASN1 e ContentEncryptionParams)
-> ParseASN1 e ContentEncryptionParams
-> ParseASN1 e ContentEncryptionParams
forall a b. (a -> b) -> a -> b
$
        ParseASN1 e Int
forall e. Monoid e => ParseASN1 e Int
parseRC2Version ParseASN1 e Int
-> (Int -> ParseASN1 e ContentEncryptionParams)
-> ParseASN1 e ContentEncryptionParams
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ParseASN1 e ContentEncryptionParams
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)      = ContentEncryptionCipher c -> ContentEncryptionAlg
forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
ECB ContentEncryptionCipher c
c
getContentEncryptionAlg (ParamsCBC ContentEncryptionCipher c
c IV c
_)    = ContentEncryptionCipher c -> ContentEncryptionAlg
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
_)    = ContentEncryptionCipher c -> ContentEncryptionAlg
forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionAlg
CFB ContentEncryptionCipher c
c
getContentEncryptionAlg (ParamsCTR ContentEncryptionCipher c
c IV c
_)    = ContentEncryptionCipher c -> ContentEncryptionAlg
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 :: ContentEncryptionAlg -> m ContentEncryptionParams
generateEncryptionParams (ECB ContentEncryptionCipher c
c) = ContentEncryptionParams -> m ContentEncryptionParams
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentEncryptionCipher c -> ContentEncryptionParams
forall c.
BlockCipher c =>
ContentEncryptionCipher c -> ContentEncryptionParams
ParamsECB ContentEncryptionCipher c
c)
generateEncryptionParams (CBC ContentEncryptionCipher c
c) = ContentEncryptionCipher c -> IV c -> ContentEncryptionParams
forall c.
BlockCipher c =>
ContentEncryptionCipher c -> IV c -> ContentEncryptionParams
ParamsCBC ContentEncryptionCipher c
c (IV c -> ContentEncryptionParams)
-> m (IV c) -> m ContentEncryptionParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> m (IV c)
forall cipher (m :: * -> *).
(BlockCipher cipher, MonadRandom m) =>
cipher -> m (IV cipher)
ivGenerate c
forall a. HasCallStack => a
undefined
generateEncryptionParams ContentEncryptionAlg
CBC_RC2 = Int -> IV RC2 -> ContentEncryptionParams
ParamsCBCRC2 Int
128 (IV RC2 -> ContentEncryptionParams)
-> m (IV RC2) -> m ContentEncryptionParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RC2 -> m (IV RC2)
forall cipher (m :: * -> *).
(BlockCipher cipher, MonadRandom m) =>
cipher -> m (IV cipher)
ivGenerate RC2
forall a. HasCallStack => a
undefined
generateEncryptionParams (CFB ContentEncryptionCipher c
c) = ContentEncryptionCipher c -> IV c -> ContentEncryptionParams
forall c.
BlockCipher c =>
ContentEncryptionCipher c -> IV c -> ContentEncryptionParams
ParamsCFB ContentEncryptionCipher c
c (IV c -> ContentEncryptionParams)
-> m (IV c) -> m ContentEncryptionParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> m (IV c)
forall cipher (m :: * -> *).
(BlockCipher cipher, MonadRandom m) =>
cipher -> m (IV cipher)
ivGenerate c
forall a. HasCallStack => a
undefined
generateEncryptionParams (CTR ContentEncryptionCipher c
c) = ContentEncryptionCipher c -> IV c -> ContentEncryptionParams
forall c.
BlockCipher c =>
ContentEncryptionCipher c -> IV c -> ContentEncryptionParams
ParamsCTR ContentEncryptionCipher c
c (IV c -> ContentEncryptionParams)
-> m (IV c) -> m ContentEncryptionParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> m (IV c)
forall cipher (m :: * -> *).
(BlockCipher cipher, MonadRandom m) =>
cipher -> m (IV cipher)
ivGenerate c
forall a. HasCallStack => a
undefined

-- | Generate random RC2 parameters with the specified effective key length (in
-- bits).
generateRC2EncryptionParams :: MonadRandom m
                            => Int -> m ContentEncryptionParams
generateRC2EncryptionParams :: Int -> m ContentEncryptionParams
generateRC2EncryptionParams Int
len = Int -> IV RC2 -> ContentEncryptionParams
ParamsCBCRC2 Int
len (IV RC2 -> ContentEncryptionParams)
-> m (IV RC2) -> m ContentEncryptionParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RC2 -> m (IV RC2)
forall cipher (m :: * -> *).
(BlockCipher cipher, MonadRandom m) =>
cipher -> m (IV cipher)
ivGenerate RC2
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 :: cek -> ContentEncryptionParams -> ba -> Either StoreError ba
contentEncrypt cek
key ContentEncryptionParams
params ba
bs =
    case ContentEncryptionParams
params of
        ParamsECB ContentEncryptionCipher c
cipher    -> ContentEncryptionCipher c -> cek -> Either StoreError c
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher cek
key Either StoreError c
-> (c -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> ba -> Either StoreError ba
forall b a. b -> Either a b
force (ba -> Either StoreError ba) -> ba -> Either StoreError ba
forall a b. (a -> b) -> a -> b
$ c -> ba -> ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt c
c    (ba -> ba) -> ba -> ba
forall a b. (a -> b) -> a -> b
$ c -> ba -> ba
forall byteArray cipher.
(ByteArray byteArray, BlockCipher cipher) =>
cipher -> byteArray -> byteArray
padded c
c ba
bs)
        ParamsCBC ContentEncryptionCipher c
cipher IV c
iv -> ContentEncryptionCipher c -> cek -> Either StoreError c
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher cek
key Either StoreError c
-> (c -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> ba -> Either StoreError ba
forall b a. b -> Either a b
force (ba -> Either StoreError ba) -> ba -> Either StoreError ba
forall a b. (a -> b) -> a -> b
$ c -> IV c -> ba -> ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcEncrypt c
c IV c
iv (ba -> ba) -> ba -> ba
forall a b. (a -> b) -> a -> b
$ c -> ba -> ba
forall byteArray cipher.
(ByteArray byteArray, BlockCipher cipher) =>
cipher -> byteArray -> byteArray
padded c
c ba
bs)
        ParamsCBCRC2 Int
len IV RC2
iv -> Int -> cek -> Either StoreError RC2
forall key. ByteArray key => Int -> key -> Either StoreError RC2
getRC2Cipher Int
len cek
key Either StoreError RC2
-> (RC2 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\RC2
c -> ba -> Either StoreError ba
forall b a. b -> Either a b
force (ba -> Either StoreError ba) -> ba -> Either StoreError ba
forall a b. (a -> b) -> a -> b
$ RC2 -> IV RC2 -> ba -> ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcEncrypt RC2
c IV RC2
iv (ba -> ba) -> ba -> ba
forall a b. (a -> b) -> a -> b
$ RC2 -> ba -> ba
forall byteArray cipher.
(ByteArray byteArray, BlockCipher cipher) =>
cipher -> byteArray -> byteArray
padded RC2
c ba
bs)
        ParamsCFB ContentEncryptionCipher c
cipher IV c
iv -> ContentEncryptionCipher c -> cek -> Either StoreError c
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher cek
key Either StoreError c
-> (c -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> ba -> Either StoreError ba
forall b a. b -> Either a b
force (ba -> Either StoreError ba) -> ba -> Either StoreError ba
forall a b. (a -> b) -> a -> b
$ c -> IV c -> ba -> ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cfbEncrypt c
c IV c
iv (ba -> ba) -> ba -> ba
forall a b. (a -> b) -> a -> b
$ c -> ba -> ba
forall byteArray cipher.
(ByteArray byteArray, BlockCipher cipher) =>
cipher -> byteArray -> byteArray
padded c
c ba
bs)
        ParamsCTR ContentEncryptionCipher c
cipher IV c
iv -> ContentEncryptionCipher c -> cek -> Either StoreError c
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher cek
key Either StoreError c
-> (c -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> ba -> Either StoreError ba
forall b a. b -> Either a b
force (ba -> Either StoreError ba) -> ba -> Either StoreError ba
forall a b. (a -> b) -> a -> b
$ c -> IV c -> ba -> ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
ctrCombine c
c IV c
iv (ba -> ba) -> ba -> ba
forall a b. (a -> b) -> a -> b
$ c -> ba -> ba
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 b -> Either a b -> Either a b
`seq` b -> Either a b
forall a b. b -> Either a b
Right b
x
    padded :: cipher -> byteArray -> byteArray
padded cipher
c = Format -> byteArray -> byteArray
forall byteArray.
ByteArray byteArray =>
Format -> byteArray -> byteArray
pad (Int -> Format
PKCS7 (Int -> Format) -> Int -> Format
forall a b. (a -> b) -> a -> b
$ cipher -> Int
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 :: cek -> ContentEncryptionParams -> ba -> Either StoreError ba
contentDecrypt cek
key ContentEncryptionParams
params ba
bs =
    case ContentEncryptionParams
params of
        ParamsECB ContentEncryptionCipher c
cipher    -> ContentEncryptionCipher c -> cek -> Either StoreError c
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher cek
key Either StoreError c
-> (c -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> c -> ba -> Either StoreError ba
forall b cipher.
(ByteArray b, BlockCipher cipher) =>
cipher -> b -> Either StoreError b
unpadded c
c (c -> ba -> ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbDecrypt c
c    ba
bs))
        ParamsCBC ContentEncryptionCipher c
cipher IV c
iv -> ContentEncryptionCipher c -> cek -> Either StoreError c
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher cek
key Either StoreError c
-> (c -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> c -> ba -> Either StoreError ba
forall b cipher.
(ByteArray b, BlockCipher cipher) =>
cipher -> b -> Either StoreError b
unpadded c
c (c -> IV c -> ba -> ba
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 -> Int -> cek -> Either StoreError RC2
forall key. ByteArray key => Int -> key -> Either StoreError RC2
getRC2Cipher Int
len cek
key Either StoreError RC2
-> (RC2 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\RC2
c -> RC2 -> ba -> Either StoreError ba
forall b cipher.
(ByteArray b, BlockCipher cipher) =>
cipher -> b -> Either StoreError b
unpadded RC2
c (RC2 -> IV RC2 -> ba -> ba
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 -> ContentEncryptionCipher c -> cek -> Either StoreError c
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher cek
key Either StoreError c
-> (c -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> c -> ba -> Either StoreError ba
forall b cipher.
(ByteArray b, BlockCipher cipher) =>
cipher -> b -> Either StoreError b
unpadded c
c (c -> IV c -> ba -> ba
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 -> ContentEncryptionCipher c -> cek -> Either StoreError c
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher cek
key Either StoreError c
-> (c -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> c -> ba -> Either StoreError ba
forall b cipher.
(ByteArray b, BlockCipher cipher) =>
cipher -> b -> Either StoreError b
unpadded c
c (c -> IV c -> ba -> ba
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 Format -> b -> Maybe b
forall byteArray.
ByteArray byteArray =>
Format -> byteArray -> Maybe byteArray
unpad (Int -> Format
PKCS7 (Int -> Format) -> Int -> Format
forall a b. (a -> b) -> a -> b
$ cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
c) b
decrypted of
            Maybe b
Nothing  -> StoreError -> Either StoreError b
forall a b. a -> Either a b
Left StoreError
DecryptionFailed
            Just b
out -> b -> Either StoreError b
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 = [Word8] -> Bytes
forall a. ByteArray a => [Word8] -> a
B.pack [Word8]
rc2Table

rc2Reverse :: B.Bytes
rc2Reverse :: Bytes
rc2Reverse = Int -> (Ptr Word8 -> IO ()) -> Bytes
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze ([Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
rc2Table) ([(Word8, Word8)] -> Ptr Word8 -> IO ()
loop ([(Word8, Word8)] -> Ptr Word8 -> IO ())
-> [(Word8, Word8)] -> Ptr Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ [Word8] -> [Word8] -> [(Word8, Word8)]
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
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    loop ((Word8
a,Word8
b):[(Word8, Word8)]
ts) Ptr Word8
p = Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
p (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Word8
a IO () -> IO () -> IO ()
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 :: Int -> ASN1Stream e
rc2VersionASN1 Int
len = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
v
  where
    v :: Integer
v | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0    = String -> Integer
forall a. HasCallStack => String -> a
error String
"invalid RC2 effective key length"
      | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
256 = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
      | Bool
otherwise  = Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bytes -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index Bytes
rc2Forward Int
len)

parseRC2Version :: Monoid e => ParseASN1 e Int
parseRC2Version :: ParseASN1 e Int
parseRC2Version = do
    IntVal Integer
i <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    Bool -> ParseASN1 e () -> ParseASN1 e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0) (ParseASN1 e () -> ParseASN1 e ())
-> ParseASN1 e () -> ParseASN1 e ()
forall a b. (a -> b) -> a -> b
$ String -> ParseASN1 e ()
forall e a. String -> ParseASN1 e a
throwParseError String
"Parsed invalid RC2 effective key length"
    let j :: Int
j = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i
    Int -> ParseASN1 e Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParseASN1 e Int) -> Int -> ParseASN1 e Int
forall a b. (a -> b) -> a -> b
$ if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
256 then Int
j else Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bytes -> Int -> Word8
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)      = ContentEncryptionCipher c -> ShowS
forall a. Show a => a -> ShowS
shows ContentEncryptionCipher c
c String
"_CCM"
    show (GCM ContentEncryptionCipher c
c)      = ContentEncryptionCipher c -> ShowS
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

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

             , ContentEncryptionCipher AES128 -> AuthContentEncryptionAlg
forall c.
BlockCipher c =>
ContentEncryptionCipher c -> AuthContentEncryptionAlg
GCM ContentEncryptionCipher AES128
AES128
             , ContentEncryptionCipher AES192 -> AuthContentEncryptionAlg
forall c.
BlockCipher c =>
ContentEncryptionCipher c -> AuthContentEncryptionAlg
GCM ContentEncryptionCipher AES192
AES192
             , ContentEncryptionCipher AES256 -> AuthContentEncryptionAlg
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 = String -> OID
forall a. HasCallStack => String -> a
error (String
"Unsupported AuthContentEncryptionAlg: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AuthContentEncryptionAlg -> String
forall a. Show a => a -> String
show AuthContentEncryptionAlg
ty)

instance OIDNameable AuthContentEncryptionAlg where
    fromObjectID :: OID -> Maybe AuthContentEncryptionAlg
fromObjectID OID
oid = OIDNameableWrapper AuthContentEncryptionAlg
-> AuthContentEncryptionAlg
forall a. OIDNameableWrapper a -> a
unOIDNW (OIDNameableWrapper AuthContentEncryptionAlg
 -> AuthContentEncryptionAlg)
-> Maybe (OIDNameableWrapper AuthContentEncryptionAlg)
-> Maybe AuthContentEncryptionAlg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OID -> Maybe (OIDNameableWrapper AuthContentEncryptionAlg)
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
(Int -> AuthEncParams -> ShowS)
-> (AuthEncParams -> String)
-> ([AuthEncParams] -> ShowS)
-> Show AuthEncParams
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
(AuthEncParams -> AuthEncParams -> Bool)
-> (AuthEncParams -> AuthEncParams -> Bool) -> Eq AuthEncParams
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
..} = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
kdf ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
encAlg ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
macAlg)
      where
        kdf :: ASN1Stream e
kdf    = ASN1ConstructionType -> KeyDerivationFunc -> ASN1Stream e
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 = ContentEncryptionParams -> ASN1Stream e
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s ContentEncryptionParams
encAlgorithm
        macAlg :: ASN1Stream e
macAlg = ASN1ConstructionType -> MACAlgorithm -> ASN1Stream e
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 :: ByteString -> Int -> Maybe Int -> PBKDF2_PRF -> KeyDerivationFunc
PBKDF2 { pbkdf2Salt :: ByteString
pbkdf2Salt = ByteString
forall a. ByteArray a => a
B.empty
                              , pbkdf2IterationCount :: Int
pbkdf2IterationCount = Int
1
                              , pbkdf2KeyLength :: Maybe Int
pbkdf2KeyLength = Maybe Int
forall a. Maybe a
Nothing
                              , pbkdf2Prf :: PBKDF2_PRF
pbkdf2Prf = PBKDF2_PRF
algPrf
                              }

instance Monoid e => ParseASN1Object e AuthEncParams where
    parse :: ParseASN1 e AuthEncParams
parse = ASN1ConstructionType
-> ParseASN1 e AuthEncParams -> ParseASN1 e AuthEncParams
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e AuthEncParams -> ParseASN1 e AuthEncParams)
-> ParseASN1 e AuthEncParams -> ParseASN1 e AuthEncParams
forall a b. (a -> b) -> a -> b
$ do
        Maybe KeyDerivationFunc
kdf    <- ASN1ConstructionType -> ParseASN1 e (Maybe KeyDerivationFunc)
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 <- ParseASN1 e ContentEncryptionParams
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        MACAlgorithm
macAlg <- ASN1ConstructionType -> ParseASN1 e MACAlgorithm
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               -> PBKDF2_PRF -> ParseASN1 e PBKDF2_PRF
forall (m :: * -> *) a. Monad m => a -> m a
return PBKDF2_PRF
PBKDF2_SHA1
                Just (PBKDF2 ByteString
_ Int
_ Maybe Int
_ PBKDF2_PRF
a) -> PBKDF2_PRF -> ParseASN1 e PBKDF2_PRF
forall (m :: * -> *) a. Monad m => a -> m a
return PBKDF2_PRF
a
                Just KeyDerivationFunc
other            -> String -> ParseASN1 e PBKDF2_PRF
forall e a. String -> ParseASN1 e a
throwParseError
                    (String
"Unable to use " String -> ShowS
forall a. [a] -> [a] -> [a]
++ KeyDerivationFunc -> String
forall a. Show a => a -> String
show KeyDerivationFunc
other String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in AuthEncParams")
        AuthEncParams -> ParseASN1 e AuthEncParams
forall (m :: * -> *) a. Monad m => a -> m a
return AuthEncParams :: PBKDF2_PRF
-> ContentEncryptionParams -> MACAlgorithm -> AuthEncParams
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 = AuthContentEncryptionAlg -> String
forall a. Show a => a -> String
show (AuthContentEncryptionAlg -> String)
-> (AuthContentEncryptionParams -> AuthContentEncryptionAlg)
-> AuthContentEncryptionParams
-> String
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 AuthEncParams -> AuthEncParams -> Bool
forall a. Eq a => a -> a -> Bool
== AuthEncParams
p2
    Params_AUTH_ENC_256 AuthEncParams
p1 == Params_AUTH_ENC_256 AuthEncParams
p2 = AuthEncParams
p1 AuthEncParams -> AuthEncParams -> Bool
forall a. Eq a => a -> a -> Bool
== AuthEncParams
p2
    Params_CHACHA20_POLY1305 Nonce
iv1 == Params_CHACHA20_POLY1305 Nonce
iv2 =
        Nonce
iv1 Nonce -> Nonce -> Bool
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 =
        ContentEncryptionCipher c -> Int
forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ContentEncryptionCipher c -> Int
forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c2 Bool -> Bool -> Bool
&& Bytes
iv1 Bytes -> Bytes -> Bool
forall a. Eq a => a -> a -> Bool
== Bytes
iv2 Bool -> Bool -> Bool
&& (CCM_M
m1, CCM_L
l1) (CCM_M, CCM_L) -> (CCM_M, CCM_L) -> Bool
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  =
        ContentEncryptionCipher c -> Int
forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ContentEncryptionCipher c -> Int
forall c. ContentEncryptionCipher c -> Int
cecI ContentEncryptionCipher c
c2 Bool -> Bool -> Bool
&& Bytes
iv1 Bytes -> Bytes -> Bool
forall a. Eq a => a -> a -> Bool
== Bytes
iv2 Bool -> Bool -> Bool
&& Int
len1 Int -> Int -> Bool
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
_)     = ContentEncryptionCipher c -> KeySizeSpecifier
forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher c
c
    getKeySizeSpecifier (ParamsGCM ContentEncryptionCipher c
c Bytes
_ Int
_)       = ContentEncryptionCipher c -> KeySizeSpecifier
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 =
        ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
oid ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
params)
      where
        oid :: ASN1Stream e
oid    = OID -> ASN1Stream e
forall e. ASN1Elem e => OID -> ASN1Stream e
gOID (AuthContentEncryptionAlg -> OID
forall a. OIDable a => a -> OID
getObjectID (AuthContentEncryptionAlg -> OID)
-> AuthContentEncryptionAlg -> OID
forall a b. (a -> b) -> a -> b
$ AuthContentEncryptionParams -> AuthContentEncryptionAlg
getAuthContentEncryptionAlg AuthContentEncryptionParams
param)
        params :: ASN1Stream e
params = AuthContentEncryptionParams -> ASN1Stream e
forall e. ASN1Elem e => AuthContentEncryptionParams -> ASN1Stream e
aceParameterASN1S AuthContentEncryptionParams
param

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

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

parseACEParameter :: Monoid e
                  => AuthContentEncryptionAlg
                  -> ParseASN1 e AuthContentEncryptionParams
parseACEParameter :: AuthContentEncryptionAlg -> ParseASN1 e AuthContentEncryptionParams
parseACEParameter AuthContentEncryptionAlg
AUTH_ENC_128 = AuthEncParams -> AuthContentEncryptionParams
Params_AUTH_ENC_128 (AuthEncParams -> AuthContentEncryptionParams)
-> ParseASN1 e AuthEncParams
-> ParseASN1 e AuthContentEncryptionParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e AuthEncParams
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
parseACEParameter AuthContentEncryptionAlg
AUTH_ENC_256 = AuthEncParams -> AuthContentEncryptionParams
Params_AUTH_ENC_256 (AuthEncParams -> AuthContentEncryptionParams)
-> ParseASN1 e AuthEncParams
-> ParseASN1 e AuthContentEncryptionParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e AuthEncParams
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
parseACEParameter AuthContentEncryptionAlg
CHACHA20_POLY1305 = do
    OctetString ByteString
bs <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    case ByteString -> CryptoFailable Nonce
forall iv. ByteArrayAccess iv => iv -> CryptoFailable Nonce
ChaChaPoly1305.nonce12 ByteString
bs of
        CryptoPassed Nonce
iv -> AuthContentEncryptionParams
-> ParseASN1 e AuthContentEncryptionParams
forall (m :: * -> *) a. Monad m => a -> m a
return (Nonce -> AuthContentEncryptionParams
Params_CHACHA20_POLY1305 Nonce
iv)
        CryptoFailed CryptoError
e  ->
            String -> ParseASN1 e AuthContentEncryptionParams
forall e a. String -> ParseASN1 e a
throwParseError (String -> ParseASN1 e AuthContentEncryptionParams)
-> String -> ParseASN1 e AuthContentEncryptionParams
forall a b. (a -> b) -> a -> b
$ String
"Parsed invalid ChaChaPoly1305 nonce: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e
parseACEParameter (CCM ContentEncryptionCipher c
c)      = ASN1ConstructionType
-> ParseASN1 e AuthContentEncryptionParams
-> ParseASN1 e AuthContentEncryptionParams
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e AuthContentEncryptionParams
 -> ParseASN1 e AuthContentEncryptionParams)
-> ParseASN1 e AuthContentEncryptionParams
-> ParseASN1 e AuthContentEncryptionParams
forall a b. (a -> b) -> a -> b
$ do
    OctetString ByteString
iv <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    let ivlen :: Int
ivlen = ByteString -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ByteString
iv
    Bool -> ParseASN1 e () -> ParseASN1 e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ivlen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
7 Bool -> Bool -> Bool
|| Int
ivlen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
13) (ParseASN1 e () -> ParseASN1 e ())
-> ParseASN1 e () -> ParseASN1 e ()
forall a b. (a -> b) -> a -> b
$
        String -> ParseASN1 e ()
forall e a. String -> ParseASN1 e a
throwParseError (String -> ParseASN1 e ()) -> String -> ParseASN1 e ()
forall a b. (a -> b) -> a -> b
$ String
"Parsed invalid CCM nonce length: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ivlen
    let Just CCM_L
l = Int -> Maybe CCM_L
fromL (Int
15 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ivlen)
    CCM_M
m <- ParseASN1 e CCM_M
forall e. Monoid e => ParseASN1 e CCM_M
parseM
    AuthContentEncryptionParams
-> ParseASN1 e AuthContentEncryptionParams
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentEncryptionCipher c
-> Bytes -> CCM_M -> CCM_L -> AuthContentEncryptionParams
forall c.
BlockCipher c =>
ContentEncryptionCipher c
-> Bytes -> CCM_M -> CCM_L -> AuthContentEncryptionParams
ParamsCCM ContentEncryptionCipher c
c (ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ByteString
iv) CCM_M
m CCM_L
l)
parseACEParameter (GCM ContentEncryptionCipher c
c)      = ASN1ConstructionType
-> ParseASN1 e AuthContentEncryptionParams
-> ParseASN1 e AuthContentEncryptionParams
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e AuthContentEncryptionParams
 -> ParseASN1 e AuthContentEncryptionParams)
-> ParseASN1 e AuthContentEncryptionParams
-> ParseASN1 e AuthContentEncryptionParams
forall a b. (a -> b) -> a -> b
$ do
    OctetString ByteString
iv <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    Bool -> ParseASN1 e () -> ParseASN1 e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
forall a. ByteArrayAccess a => a -> Bool
B.null ByteString
iv) (ParseASN1 e () -> ParseASN1 e ())
-> ParseASN1 e () -> ParseASN1 e ()
forall a b. (a -> b) -> a -> b
$
        String -> ParseASN1 e ()
forall e a. String -> ParseASN1 e a
throwParseError String
"Parsed empty GCM nonce"
    Integer
icvlen <- Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
12 (Maybe Integer -> Integer)
-> ParseASN1 e (Maybe Integer) -> ParseASN1 e Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ASN1 -> Maybe Integer) -> ParseASN1 e (Maybe Integer)
forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe Integer
intOrNothing
    Bool -> ParseASN1 e () -> ParseASN1 e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
icvlen Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
12 Bool -> Bool -> Bool
|| Integer
icvlen Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
16) (ParseASN1 e () -> ParseASN1 e ())
-> ParseASN1 e () -> ParseASN1 e ()
forall a b. (a -> b) -> a -> b
$
        String -> ParseASN1 e ()
forall e a. String -> ParseASN1 e a
throwParseError (String -> ParseASN1 e ()) -> String -> ParseASN1 e ()
forall a b. (a -> b) -> a -> b
$ String
"Parsed invalid GCM ICV length: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
icvlen
    AuthContentEncryptionParams
-> ParseASN1 e AuthContentEncryptionParams
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentEncryptionCipher c
-> Bytes -> Int -> AuthContentEncryptionParams
forall c.
BlockCipher c =>
ContentEncryptionCipher c
-> Bytes -> Int -> AuthContentEncryptionParams
ParamsGCM ContentEncryptionCipher c
c (ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ByteString
iv) (Int -> AuthContentEncryptionParams)
-> Int -> AuthContentEncryptionParams
forall a b. (a -> b) -> a -> b
$ Integer -> Int
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
_)     = ContentEncryptionCipher c -> AuthContentEncryptionAlg
forall c.
BlockCipher c =>
ContentEncryptionCipher c -> AuthContentEncryptionAlg
CCM ContentEncryptionCipher c
c
getAuthContentEncryptionAlg (ParamsGCM ContentEncryptionCipher c
c Bytes
_ Int
_)       = ContentEncryptionCipher c -> AuthContentEncryptionAlg
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 :: PBKDF2_PRF
-> ContentEncryptionAlg
-> MACAlgorithm
-> m AuthContentEncryptionParams
generateAuthEnc128Params PBKDF2_PRF
prfAlg ContentEncryptionAlg
cea MACAlgorithm
macAlg = do
    ContentEncryptionParams
params <- ContentEncryptionAlg -> m ContentEncryptionParams
forall (m :: * -> *).
MonadRandom m =>
ContentEncryptionAlg -> m ContentEncryptionParams
generateEncryptionParams ContentEncryptionAlg
cea
    AuthContentEncryptionParams -> m AuthContentEncryptionParams
forall (m :: * -> *) a. Monad m => a -> m a
return (AuthContentEncryptionParams -> m AuthContentEncryptionParams)
-> AuthContentEncryptionParams -> m AuthContentEncryptionParams
forall a b. (a -> b) -> a -> b
$ AuthEncParams -> AuthContentEncryptionParams
Params_AUTH_ENC_128 (AuthEncParams -> AuthContentEncryptionParams)
-> AuthEncParams -> AuthContentEncryptionParams
forall a b. (a -> b) -> a -> b
$
        AuthEncParams :: PBKDF2_PRF
-> ContentEncryptionParams -> MACAlgorithm -> AuthEncParams
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 :: PBKDF2_PRF
-> ContentEncryptionAlg
-> MACAlgorithm
-> m AuthContentEncryptionParams
generateAuthEnc256Params PBKDF2_PRF
prfAlg ContentEncryptionAlg
cea MACAlgorithm
macAlg = do
    ContentEncryptionParams
params <- ContentEncryptionAlg -> m ContentEncryptionParams
forall (m :: * -> *).
MonadRandom m =>
ContentEncryptionAlg -> m ContentEncryptionParams
generateEncryptionParams ContentEncryptionAlg
cea
    AuthContentEncryptionParams -> m AuthContentEncryptionParams
forall (m :: * -> *) a. Monad m => a -> m a
return (AuthContentEncryptionParams -> m AuthContentEncryptionParams)
-> AuthContentEncryptionParams -> m AuthContentEncryptionParams
forall a b. (a -> b) -> a -> b
$ AuthEncParams -> AuthContentEncryptionParams
Params_AUTH_ENC_256 (AuthEncParams -> AuthContentEncryptionParams)
-> AuthEncParams -> AuthContentEncryptionParams
forall a b. (a -> b) -> a -> b
$
        AuthEncParams :: PBKDF2_PRF
-> ContentEncryptionParams -> MACAlgorithm -> AuthEncParams
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 :: m AuthContentEncryptionParams
generateChaChaPoly1305Params = do
    Bytes
bs <- Int -> m Bytes
forall (m :: * -> *). MonadRandom m => Int -> m Bytes
nonceGenerate Int
12
    let iv :: Nonce
iv = CryptoFailable Nonce -> Nonce
forall a. CryptoFailable a -> a
throwCryptoError (Bytes -> CryptoFailable Nonce
forall iv. ByteArrayAccess iv => iv -> CryptoFailable Nonce
ChaChaPoly1305.nonce12 Bytes
bs)
    AuthContentEncryptionParams -> m AuthContentEncryptionParams
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 :: ContentEncryptionCipher c
-> CCM_M -> CCM_L -> m AuthContentEncryptionParams
generateCCMParams ContentEncryptionCipher c
c CCM_M
m CCM_L
l = do
    Bytes
iv <- Int -> m Bytes
forall (m :: * -> *). MonadRandom m => Int -> m Bytes
nonceGenerate (Int
15 Int -> Int -> Int
forall a. Num a => a -> a -> a
- CCM_L -> Int
getL CCM_L
l)
    AuthContentEncryptionParams -> m AuthContentEncryptionParams
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentEncryptionCipher c
-> Bytes -> CCM_M -> CCM_L -> AuthContentEncryptionParams
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 :: ContentEncryptionCipher c -> Int -> m AuthContentEncryptionParams
generateGCMParams ContentEncryptionCipher c
c Int
l = do
    Bytes
iv <- Int -> m Bytes
forall (m :: * -> *). MonadRandom m => Int -> m Bytes
nonceGenerate Int
12
    AuthContentEncryptionParams -> m AuthContentEncryptionParams
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentEncryptionCipher c
-> Bytes -> Int -> AuthContentEncryptionParams
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 :: 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   -> Int -> cek -> Either StoreError ()
forall cek.
ByteArrayAccess cek =>
Int -> cek -> Either StoreError ()
checkAuthKey Int
16 cek
key Either StoreError ()
-> Either StoreError (MessageAuthenticationCode, ba)
-> Either StoreError (MessageAuthenticationCode, ba)
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   -> Int -> cek -> Either StoreError ()
forall cek.
ByteArrayAccess cek =>
Int -> cek -> Either StoreError ()
checkAuthKey Int
32 cek
key Either StoreError ()
-> Either StoreError (MessageAuthenticationCode, ba)
-> Either StoreError (MessageAuthenticationCode, ba)
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 -> cek -> Nonce -> aad -> Either StoreError State
forall key aad.
(ByteArrayAccess key, ByteArrayAccess aad) =>
key -> Nonce -> aad -> Either StoreError State
ccpInit cek
key Nonce
iv aad
aad Either StoreError State
-> (State -> Either StoreError (MessageAuthenticationCode, ba))
-> Either StoreError (MessageAuthenticationCode, ba)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= State -> Either StoreError (MessageAuthenticationCode, ba)
forall a. State -> Either a (MessageAuthenticationCode, ba)
ccpEncrypt
        ParamsCCM ContentEncryptionCipher c
cipher Bytes
iv CCM_M
m CCM_L
l -> ContentEncryptionCipher c
-> cek -> AEADMode -> Bytes -> Either StoreError (AEAD c)
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 Either StoreError (AEAD c)
-> (AEAD c -> Either StoreError (MessageAuthenticationCode, ba))
-> Either StoreError (MessageAuthenticationCode, ba)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> AEAD c -> Either StoreError (MessageAuthenticationCode, ba)
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 -> ContentEncryptionCipher c
-> cek -> AEADMode -> Bytes -> Either StoreError (AEAD c)
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 Either StoreError (AEAD c)
-> (AEAD c -> Either StoreError (MessageAuthenticationCode, ba))
-> Either StoreError (MessageAuthenticationCode, ba)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> AEAD c -> Either StoreError (MessageAuthenticationCode, ba)
forall a.
Int -> AEAD a -> Either StoreError (MessageAuthenticationCode, ba)
encrypt Int
len
  where
    msglen :: Int
msglen  = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs
    force :: b -> Either a b
force b
x = b
x b -> Either a b -> Either a b
`seq` b -> Either a b
forall a b. b -> Either a b
Right b
x

    encrypt :: Int -> AEAD a -> Either StoreError (AuthTag, ba)
    encrypt :: Int -> AEAD a -> Either StoreError (MessageAuthenticationCode, ba)
encrypt Int
len AEAD a
aead = (MessageAuthenticationCode, ba)
-> Either StoreError (MessageAuthenticationCode, ba)
forall b a. b -> Either a b
force ((MessageAuthenticationCode, ba)
 -> Either StoreError (MessageAuthenticationCode, ba))
-> (MessageAuthenticationCode, ba)
-> Either StoreError (MessageAuthenticationCode, ba)
forall a b. (a -> b) -> a -> b
$ AEAD a -> aad -> ba -> Int -> (MessageAuthenticationCode, ba)
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 :: State -> Either a (MessageAuthenticationCode, ba)
ccpEncrypt State
state = (MessageAuthenticationCode, ba)
-> Either a (MessageAuthenticationCode, ba)
forall b a. b -> Either a b
force (MessageAuthenticationCode
found, ba
encrypted)
      where
        (ba
encrypted, State
state') = ba -> State -> (ba, 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) = cek -> AuthEncParams -> (ScrubbedBytes, ScrubbedBytes)
forall password.
ByteArrayAccess password =>
password -> AuthEncParams -> (ScrubbedBytes, ScrubbedBytes)
authKeys cek
key AuthEncParams
p
        ba
encrypted <- ScrubbedBytes
-> ContentEncryptionParams -> ba -> Either StoreError ba
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 ba -> ba -> ba
forall bs. ByteArray bs => bs -> bs -> bs
`B.append` ba
encrypted ba -> ba -> ba
forall bs. ByteArray bs => bs -> bs -> bs
`B.append` aad -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert aad
aad
            found :: MessageAuthenticationCode
found  = MACAlgorithm -> ScrubbedBytes -> ba -> MessageAuthenticationCode
forall key message.
(ByteArrayAccess key, ByteArrayAccess message) =>
MACAlgorithm -> key -> message -> MessageAuthenticationCode
mac MACAlgorithm
macAlgorithm ScrubbedBytes
macKey ba
macMsg
        (MessageAuthenticationCode, ba)
-> Either StoreError (MessageAuthenticationCode, ba)
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 :: 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   -> Int -> cek -> Either StoreError ()
forall cek.
ByteArrayAccess cek =>
Int -> cek -> Either StoreError ()
checkAuthKey Int
16 cek
key Either StoreError ()
-> Either StoreError ba -> Either StoreError ba
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   -> Int -> cek -> Either StoreError ()
forall cek.
ByteArrayAccess cek =>
Int -> cek -> Either StoreError ()
checkAuthKey Int
32 cek
key Either StoreError ()
-> Either StoreError ba -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AuthEncParams -> Either StoreError ba
authDecrypt AuthEncParams
p
        Params_CHACHA20_POLY1305 Nonce
iv -> cek -> Nonce -> aad -> Either StoreError State
forall key aad.
(ByteArrayAccess key, ByteArrayAccess aad) =>
key -> Nonce -> aad -> Either StoreError State
ccpInit cek
key Nonce
iv aad
aad Either StoreError State
-> (State -> Either StoreError ba) -> Either StoreError ba
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 -> ContentEncryptionCipher c
-> cek -> AEADMode -> Bytes -> Either StoreError (AEAD c)
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 Either StoreError (AEAD c)
-> (AEAD c -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AEAD c -> Either StoreError ba
forall a. AEAD a -> Either StoreError ba
decrypt
        ParamsGCM ContentEncryptionCipher c
cipher Bytes
iv Int
_   -> ContentEncryptionCipher c
-> cek -> AEADMode -> Bytes -> Either StoreError (AEAD c)
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 Either StoreError (AEAD c)
-> (AEAD c -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AEAD c -> Either StoreError ba
forall a. AEAD a -> Either StoreError ba
decrypt
  where
    msglen :: Int
msglen  = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs
    badMac :: Either StoreError b
badMac  = StoreError -> Either StoreError b
forall a b. a -> Either a b
Left StoreError
BadContentMAC

    decrypt :: AEAD a -> Either StoreError ba
    decrypt :: AEAD a -> Either StoreError ba
decrypt AEAD a
aead = Either StoreError ba
-> (ba -> Either StoreError ba) -> Maybe ba -> Either StoreError ba
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either StoreError ba
forall b. Either StoreError b
badMac ba -> Either StoreError ba
forall a b. b -> Either a b
Right (AEAD a -> aad -> ba -> MessageAuthenticationCode -> Maybe ba
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 MessageAuthenticationCode -> MessageAuthenticationCode -> Bool
forall a. Eq a => a -> a -> Bool
== MessageAuthenticationCode
expected = ba -> Either StoreError ba
forall a b. b -> Either a b
Right ba
decrypted
        | Bool
otherwise         = Either StoreError ba
forall b. Either StoreError b
badMac
      where
        (ba
decrypted, State
state') = ba -> State -> (ba, 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    = StoreError -> Either StoreError ba
forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"authEnc MAC too weak")
        | MessageAuthenticationCode
found MessageAuthenticationCode -> MessageAuthenticationCode -> Bool
forall a. Eq a => a -> a -> Bool
== MessageAuthenticationCode
expected = ScrubbedBytes
-> ContentEncryptionParams -> ba -> Either StoreError ba
forall cek ba.
(ByteArray cek, ByteArray ba) =>
cek -> ContentEncryptionParams -> ba -> Either StoreError ba
contentDecrypt ScrubbedBytes
encKey ContentEncryptionParams
encAlgorithm ba
bs
        | Bool
otherwise         = Either StoreError ba
forall b. Either StoreError b
badMac
      where
        (ScrubbedBytes
encKey, ScrubbedBytes
macKey) = cek -> AuthEncParams -> (ScrubbedBytes, ScrubbedBytes)
forall password.
ByteArrayAccess password =>
password -> AuthEncParams -> (ScrubbedBytes, ScrubbedBytes)
authKeys cek
key AuthEncParams
p
        macMsg :: ba
macMsg = ba
paramsRaw ba -> ba -> ba
forall bs. ByteArray bs => bs -> bs -> bs
`B.append` ba
bs ba -> ba -> ba
forall bs. ByteArray bs => bs -> bs -> bs
`B.append` aad -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert aad
aad
        found :: MessageAuthenticationCode
found  = MACAlgorithm -> ScrubbedBytes -> ba -> MessageAuthenticationCode
forall key message.
(ByteArrayAccess key, ByteArrayAccess message) =>
MACAlgorithm -> key -> message -> MessageAuthenticationCode
mac MACAlgorithm
macAlgorithm ScrubbedBytes
macKey ba
macMsg
        acceptable :: Bool
acceptable = MACAlgorithm -> Bool
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 :: proxy cipher
-> key -> AEADMode -> iv -> Either StoreError (AEAD cipher)
getAEAD proxy cipher
cipher key
key AEADMode
mode iv
iv = do
    cipher
c <- proxy cipher -> key -> Either StoreError cipher
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher proxy cipher
cipher key
key
    CryptoFailable (AEAD cipher) -> Either StoreError (AEAD cipher)
forall a. CryptoFailable a -> Either StoreError a
fromCryptoFailable (CryptoFailable (AEAD cipher) -> Either StoreError (AEAD cipher))
-> CryptoFailable (AEAD cipher) -> Either StoreError (AEAD cipher)
forall a b. (a -> b) -> a -> b
$ AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
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 :: 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 Maybe Int
forall a. Maybe a
Nothing PBKDF2_PRF
prfAlgorithm
    encLen :: Int
encLen = ContentEncryptionParams -> Int
forall params. HasKeySize params => params -> Int
getMaximumKeySize ContentEncryptionParams
encAlgorithm
    encKey :: ScrubbedBytes
encKey = KeyDerivationFunc -> Int -> password -> ScrubbedBytes
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 Maybe Int
forall a. Maybe a
Nothing PBKDF2_PRF
prfAlgorithm
    macKey :: ScrubbedBytes
macKey = KeyDerivationFunc -> Int -> password -> ScrubbedBytes
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
24 = Int
16
           | Bool
otherwise    = MACAlgorithm -> Int
forall params. HasKeySize params => params -> Int
getMaximumKeySize MACAlgorithm
macAlgorithm

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

ccpInit :: (ByteArrayAccess key, ByteArrayAccess aad)
        => key
        -> ChaChaPoly1305.Nonce
        -> aad
        -> Either StoreError ChaChaPoly1305.State
ccpInit :: key -> Nonce -> aad -> Either StoreError State
ccpInit key
key Nonce
nonce aad
aad = case key -> Nonce -> CryptoFailable State
forall key.
ByteArrayAccess key =>
key -> Nonce -> CryptoFailable State
ChaChaPoly1305.initialize key
key Nonce
nonce of
    CryptoPassed State
s -> State -> Either StoreError State
forall (m :: * -> *) a. Monad m => a -> m a
return (State -> State
addAAD State
s)
    CryptoFailed CryptoError
e -> StoreError -> Either StoreError State
forall a b. a -> Either a b
Left (CryptoError -> StoreError
CryptoError CryptoError
e)
  where addAAD :: State -> State
addAAD = State -> State
ChaChaPoly1305.finalizeAAD (State -> State) -> (State -> State) -> State -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. aad -> State -> State
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
(Int -> PBKDF2_PRF -> ShowS)
-> (PBKDF2_PRF -> String)
-> ([PBKDF2_PRF] -> ShowS)
-> Show PBKDF2_PRF
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
(PBKDF2_PRF -> PBKDF2_PRF -> Bool)
-> (PBKDF2_PRF -> PBKDF2_PRF -> Bool) -> Eq PBKDF2_PRF
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 = OIDNameableWrapper PBKDF2_PRF -> PBKDF2_PRF
forall a. OIDNameableWrapper a -> a
unOIDNW (OIDNameableWrapper PBKDF2_PRF -> PBKDF2_PRF)
-> Maybe (OIDNameableWrapper PBKDF2_PRF) -> Maybe PBKDF2_PRF
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OID -> Maybe (OIDNameableWrapper PBKDF2_PRF)
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    = PBKDF2_PRF -> AlgorithmType PBKDF2_PRF
forall a. a -> a
id
    parameterASN1S :: PBKDF2_PRF -> ASN1Stream e
parameterASN1S PBKDF2_PRF
_ = ASN1Stream e
forall a. a -> a
id
    parseParameter :: AlgorithmType PBKDF2_PRF -> ParseASN1 e PBKDF2_PRF
parseParameter AlgorithmType PBKDF2_PRF
p = (ASN1 -> Maybe ()) -> ParseASN1 e (Maybe ())
forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe ()
nullOrNothing ParseASN1 e (Maybe ())
-> ParseASN1 e PBKDF2_PRF -> ParseASN1 e PBKDF2_PRF
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PBKDF2_PRF -> ParseASN1 e PBKDF2_PRF
forall (m :: * -> *) a. Monad m => a -> m a
return AlgorithmType PBKDF2_PRF
PBKDF2_PRF
p

-- | Invoke the pseudorandom function.
prf :: (ByteArrayAccess salt, ByteArrayAccess password, ByteArray out)
    => PBKDF2_PRF -> PBKDF2.Parameters -> password -> salt -> out
prf :: PBKDF2_PRF -> Parameters -> password -> salt -> out
prf PBKDF2_PRF
PBKDF2_SHA1   = Parameters -> password -> salt -> out
forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Parameters -> password -> salt -> out
PBKDF2.fastPBKDF2_SHA1
prf PBKDF2_PRF
PBKDF2_SHA256 = Parameters -> password -> salt -> out
forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Parameters -> password -> salt -> out
PBKDF2.fastPBKDF2_SHA256
prf PBKDF2_PRF
PBKDF2_SHA512 = Parameters -> password -> salt -> out
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 = OIDNameableWrapper KeyDerivationAlgorithm -> KeyDerivationAlgorithm
forall a. OIDNameableWrapper a -> a
unOIDNW (OIDNameableWrapper KeyDerivationAlgorithm
 -> KeyDerivationAlgorithm)
-> Maybe (OIDNameableWrapper KeyDerivationAlgorithm)
-> Maybe KeyDerivationAlgorithm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OID -> Maybe (OIDNameableWrapper KeyDerivationAlgorithm)
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
(Int -> KeyDerivationFunc -> ShowS)
-> (KeyDerivationFunc -> String)
-> ([KeyDerivationFunc] -> ShowS)
-> Show KeyDerivationFunc
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
(KeyDerivationFunc -> KeyDerivationFunc -> Bool)
-> (KeyDerivationFunc -> KeyDerivationFunc -> Bool)
-> Eq KeyDerivationFunc
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{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
..} = AlgorithmType KeyDerivationFunc
KeyDerivationAlgorithm
TypePBKDF2
    algorithmType 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
..} = AlgorithmType KeyDerivationFunc
KeyDerivationAlgorithm
TypeScrypt

    parameterASN1S :: 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
..} =
        ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
salt ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
iters ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
keyLen ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
mprf)
      where
        salt :: ASN1Stream e
salt   = ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
pbkdf2Salt
        iters :: ASN1Stream e
iters  = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
pbkdf2IterationCount)
        keyLen :: ASN1Stream e
keyLen = ASN1Stream e -> (Int -> ASN1Stream e) -> Maybe Int -> ASN1Stream e
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ASN1Stream e
forall a. a -> a
id (Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Integer -> ASN1Stream e)
-> (Int -> Integer) -> Int -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger) Maybe Int
pbkdf2KeyLength
        mprf :: ASN1Stream e
mprf   = if PBKDF2_PRF
pbkdf2Prf PBKDF2_PRF -> PBKDF2_PRF -> Bool
forall a. Eq a => a -> a -> Bool
== PBKDF2_PRF
PBKDF2_SHA1 then ASN1Stream e
forall a. a -> a
id else ASN1ConstructionType -> PBKDF2_PRF -> ASN1Stream e
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
..} =
        ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
salt ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
n ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
r ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
p ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
keyLen)
      where
        salt :: ASN1Stream e
salt   = ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
scryptSalt
        n :: ASN1Stream e
n      = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
scryptN)
        r :: ASN1Stream e
r      = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
scryptR)
        p :: ASN1Stream e
p      = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
scryptP)
        keyLen :: ASN1Stream e
keyLen = ASN1Stream e -> (Int -> ASN1Stream e) -> Maybe Int -> ASN1Stream e
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ASN1Stream e
forall a. a -> a
id (Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Integer -> ASN1Stream e)
-> (Int -> Integer) -> Int -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger) Maybe Int
scryptKeyLength

    parseParameter :: AlgorithmType KeyDerivationFunc -> ParseASN1 e KeyDerivationFunc
parseParameter AlgorithmType KeyDerivationFunc
TypePBKDF2 = ASN1ConstructionType
-> ParseASN1 e KeyDerivationFunc -> ParseASN1 e KeyDerivationFunc
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e KeyDerivationFunc -> ParseASN1 e KeyDerivationFunc)
-> ParseASN1 e KeyDerivationFunc -> ParseASN1 e KeyDerivationFunc
forall a b. (a -> b) -> a -> b
$ do
        OctetString ByteString
salt <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        IntVal Integer
iters <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        Maybe Integer
keyLen <- (ASN1 -> Maybe Integer) -> ParseASN1 e (Maybe Integer)
forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe Integer
intOrNothing
        Bool
b <- ParseASN1 e Bool
forall e. ParseASN1 e Bool
hasNext
        PBKDF2_PRF
mprf <- if Bool
b then ASN1ConstructionType -> ParseASN1 e PBKDF2_PRF
forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence else PBKDF2_PRF -> ParseASN1 e PBKDF2_PRF
forall (m :: * -> *) a. Monad m => a -> m a
return PBKDF2_PRF
PBKDF2_SHA1
        KeyDerivationFunc -> ParseASN1 e KeyDerivationFunc
forall (m :: * -> *) a. Monad m => a -> m a
return PBKDF2 :: ByteString -> Int -> Maybe Int -> PBKDF2_PRF -> KeyDerivationFunc
PBKDF2 { pbkdf2Salt :: ByteString
pbkdf2Salt           = ByteString
salt
                      , pbkdf2IterationCount :: Int
pbkdf2IterationCount = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
iters
                      , pbkdf2KeyLength :: Maybe Int
pbkdf2KeyLength      = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Maybe Integer -> Maybe Int
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
TypeScrypt = ASN1ConstructionType
-> ParseASN1 e KeyDerivationFunc -> ParseASN1 e KeyDerivationFunc
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e KeyDerivationFunc -> ParseASN1 e KeyDerivationFunc)
-> ParseASN1 e KeyDerivationFunc -> ParseASN1 e KeyDerivationFunc
forall a b. (a -> b) -> a -> b
$ do
        OctetString ByteString
salt <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        IntVal Integer
n <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        IntVal Integer
r <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        IntVal Integer
p <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        Maybe Integer
keyLen <- (ASN1 -> Maybe Integer) -> ParseASN1 e (Maybe Integer)
forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe Integer
intOrNothing
        KeyDerivationFunc -> ParseASN1 e KeyDerivationFunc
forall (m :: * -> *) a. Monad m => a -> m a
return Scrypt :: ByteString
-> Word64 -> Int -> Int -> Maybe Int -> KeyDerivationFunc
Scrypt { scryptSalt :: ByteString
scryptSalt      = ByteString
salt
                      , scryptN :: Word64
scryptN         = Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
n
                      , scryptR :: Int
scryptR         = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
r
                      , scryptP :: Int
scryptP         = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
p
                      , scryptKeyLength :: Maybe Int
scryptKeyLength = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Maybe Integer -> Maybe Int
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 :: 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 = PBKDF2_PRF -> Parameters -> password -> ByteString -> out
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 = Parameters -> password -> ByteString -> out
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 = Parameters :: Word64 -> Int -> Int -> Int -> Parameters
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 :: Int -> m ByteString
generateSalt = Int -> m ByteString
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 = OIDNameableWrapper KeyEncryptionType -> KeyEncryptionType
forall a. OIDNameableWrapper a -> a
unOIDNW (OIDNameableWrapper KeyEncryptionType -> KeyEncryptionType)
-> Maybe (OIDNameableWrapper KeyEncryptionType)
-> Maybe KeyEncryptionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OID -> Maybe (OIDNameableWrapper KeyEncryptionType)
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
(Int -> KeyEncryptionParams -> ShowS)
-> (KeyEncryptionParams -> String)
-> ([KeyEncryptionParams] -> ShowS)
-> Show KeyEncryptionParams
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
(KeyEncryptionParams -> KeyEncryptionParams -> Bool)
-> (KeyEncryptionParams -> KeyEncryptionParams -> Bool)
-> Eq KeyEncryptionParams
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
_)      = AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypePWRIKEK
    algorithmType KeyEncryptionParams
AES128_WRAP      = AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypeAES128_WRAP
    algorithmType KeyEncryptionParams
AES192_WRAP      = AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypeAES192_WRAP
    algorithmType KeyEncryptionParams
AES256_WRAP      = AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypeAES256_WRAP
    algorithmType KeyEncryptionParams
AES128_WRAP_PAD  = AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypeAES128_WRAP_PAD
    algorithmType KeyEncryptionParams
AES192_WRAP_PAD  = AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypeAES192_WRAP_PAD
    algorithmType KeyEncryptionParams
AES256_WRAP_PAD  = AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypeAES256_WRAP_PAD
    algorithmType KeyEncryptionParams
DES_EDE3_WRAP    = AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypeDES_EDE3_WRAP
    algorithmType (RC2_WRAP Int
_)     = AlgorithmType KeyEncryptionParams
KeyEncryptionType
TypeRC2_WRAP

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

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

instance HasKeySize KeyEncryptionParams where
    getKeySizeSpecifier :: KeyEncryptionParams -> KeySizeSpecifier
getKeySizeSpecifier (PWRIKEK ContentEncryptionParams
cep)   = ContentEncryptionParams -> KeySizeSpecifier
forall params. HasKeySize params => params -> KeySizeSpecifier
getKeySizeSpecifier ContentEncryptionParams
cep
    getKeySizeSpecifier KeyEncryptionParams
AES128_WRAP     = ContentEncryptionCipher AES128 -> KeySizeSpecifier
forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher AES128
AES128
    getKeySizeSpecifier KeyEncryptionParams
AES192_WRAP     = ContentEncryptionCipher AES192 -> KeySizeSpecifier
forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher AES192
AES192
    getKeySizeSpecifier KeyEncryptionParams
AES256_WRAP     = ContentEncryptionCipher AES256 -> KeySizeSpecifier
forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher AES256
AES256
    getKeySizeSpecifier KeyEncryptionParams
AES128_WRAP_PAD = ContentEncryptionCipher AES128 -> KeySizeSpecifier
forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher AES128
AES128
    getKeySizeSpecifier KeyEncryptionParams
AES192_WRAP_PAD = ContentEncryptionCipher AES192 -> KeySizeSpecifier
forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher AES192
AES192
    getKeySizeSpecifier KeyEncryptionParams
AES256_WRAP_PAD = ContentEncryptionCipher AES256 -> KeySizeSpecifier
forall cipher (proxy :: * -> *).
Cipher cipher =>
proxy cipher -> KeySizeSpecifier
getCipherKeySizeSpecifier ContentEncryptionCipher AES256
AES256
    getKeySizeSpecifier KeyEncryptionParams
DES_EDE3_WRAP   = ContentEncryptionCipher DES_EDE3 -> KeySizeSpecifier
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 :: 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 = ContentEncryptionCipher c -> kek -> Either StoreError c
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher kek
key in (StoreError -> m (Either StoreError ba))
-> (c -> m (Either StoreError ba))
-> Either StoreError c
-> m (Either StoreError ba)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ba -> m (Either StoreError ba))
-> (StoreError -> Either StoreError ba)
-> StoreError
-> m (Either StoreError ba)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError ba
forall a b. a -> Either a b
Left) (\c
c -> (c -> IV c -> ba -> ba)
-> c -> IV c -> ba -> m (Either StoreError ba)
forall (m :: * -> *) cipher ba.
(MonadRandom m, BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> m (Either StoreError ba)
wrapEncrypt ((ba -> ba) -> IV c -> ba -> ba
forall a b. a -> b -> a
const ((ba -> ba) -> IV c -> ba -> ba)
-> (c -> ba -> ba) -> c -> IV c -> ba -> ba
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> ba -> ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt) c
c IV 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 = ContentEncryptionCipher c -> kek -> Either StoreError c
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher kek
key in (StoreError -> m (Either StoreError ba))
-> (c -> m (Either StoreError ba))
-> Either StoreError c
-> m (Either StoreError ba)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ba -> m (Either StoreError ba))
-> (StoreError -> Either StoreError ba)
-> StoreError
-> m (Either StoreError ba)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError ba
forall a b. a -> Either a b
Left) (\c
c -> (c -> IV c -> ba -> ba)
-> c -> IV c -> ba -> m (Either StoreError ba)
forall (m :: * -> *) cipher ba.
(MonadRandom m, BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> m (Either StoreError ba)
wrapEncrypt c -> IV c -> ba -> ba
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 = Int -> kek -> Either StoreError RC2
forall key. ByteArray key => Int -> key -> Either StoreError RC2
getRC2Cipher Int
len kek
key in (StoreError -> m (Either StoreError ba))
-> (RC2 -> m (Either StoreError ba))
-> Either StoreError RC2
-> m (Either StoreError ba)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ba -> m (Either StoreError ba))
-> (StoreError -> Either StoreError ba)
-> StoreError
-> m (Either StoreError ba)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError ba
forall a b. a -> Either a b
Left) (\RC2
c -> (RC2 -> IV RC2 -> ba -> ba)
-> RC2 -> IV RC2 -> ba -> m (Either StoreError ba)
forall (m :: * -> *) cipher ba.
(MonadRandom m, BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> m (Either StoreError ba)
wrapEncrypt RC2 -> IV RC2 -> ba -> ba
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 = ContentEncryptionCipher c -> kek -> Either StoreError c
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher kek
key in (StoreError -> m (Either StoreError ba))
-> (c -> m (Either StoreError ba))
-> Either StoreError c
-> m (Either StoreError ba)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ba -> m (Either StoreError ba))
-> (StoreError -> Either StoreError ba)
-> StoreError
-> m (Either StoreError ba)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError ba
forall a b. a -> Either a b
Left) (\c
c -> (c -> IV c -> ba -> ba)
-> c -> IV c -> ba -> m (Either StoreError ba)
forall (m :: * -> *) cipher ba.
(MonadRandom m, BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> m (Either StoreError ba)
wrapEncrypt c -> IV c -> ba -> ba
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
_       -> Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ba -> m (Either StoreError ba))
-> Either StoreError ba -> m (Either StoreError ba)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError ba
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 = Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentEncryptionCipher AES128 -> kek -> Either StoreError AES128
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES128
AES128 kek
key Either StoreError AES128
-> (AES128 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AES128 -> ba -> Either StoreError ba
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 = Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentEncryptionCipher AES192 -> kek -> Either StoreError AES192
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES192
AES192 kek
key Either StoreError AES192
-> (AES192 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AES192 -> ba -> Either StoreError ba
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 = Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentEncryptionCipher AES256 -> kek -> Either StoreError AES256
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES256
AES256 kek
key Either StoreError AES256
-> (AES256 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AES256 -> ba -> Either StoreError ba
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 = Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentEncryptionCipher AES128 -> kek -> Either StoreError AES128
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES128
AES128 kek
key Either StoreError AES128
-> (AES128 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AES128 -> ba -> Either StoreError ba
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 = Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentEncryptionCipher AES192 -> kek -> Either StoreError AES192
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES192
AES192 kek
key Either StoreError AES192
-> (AES192 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AES192 -> ba -> Either StoreError ba
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 = Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentEncryptionCipher AES256 -> kek -> Either StoreError AES256
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES256
AES256 kek
key Either StoreError AES256
-> (AES256 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AES256 -> ba -> Either StoreError ba
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 = (StoreError -> m (Either StoreError ba))
-> (DES_EDE3 -> m (Either StoreError ba))
-> Either StoreError DES_EDE3
-> m (Either StoreError ba)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ba -> m (Either StoreError ba))
-> (StoreError -> Either StoreError ba)
-> StoreError
-> m (Either StoreError ba)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError ba
forall a b. a -> Either a b
Left) (ba -> DES_EDE3 -> m (Either StoreError ba)
forall (f :: * -> *) cipher ba.
(BlockCipher cipher, ByteArray ba, MonadRandom f) =>
ba -> cipher -> f (Either StoreError ba)
wrap3DES ba
bs) (ContentEncryptionCipher DES_EDE3
-> kek -> Either StoreError DES_EDE3
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 -> cipher -> IV cipher -> ba -> Either StoreError ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> Either StoreError ba
TripleDES_KW.wrap cipher
c IV cipher
iv ba
b) (IV cipher -> Either StoreError ba)
-> f (IV cipher) -> f (Either StoreError ba)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> cipher -> f (IV cipher)
forall cipher (m :: * -> *).
(BlockCipher cipher, MonadRandom m) =>
cipher -> m (IV cipher)
ivGenerate cipher
c
keyEncrypt kek
key (RC2_WRAP Int
ekl)   ba
bs = (StoreError -> m (Either StoreError ba))
-> (RC2 -> m (Either StoreError ba))
-> Either StoreError RC2
-> m (Either StoreError ba)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ba -> m (Either StoreError ba))
-> (StoreError -> Either StoreError ba)
-> StoreError
-> m (Either StoreError ba)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError ba
forall a b. a -> Either a b
Left) (ba -> RC2 -> m (Either StoreError ba)
forall (m :: * -> *) cipher ba.
(BlockCipher cipher, MonadRandom m, ByteArray ba) =>
ba -> cipher -> m (Either StoreError ba)
wrapRC2 ba
bs) (Int -> kek -> Either StoreError RC2
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 <- cipher -> m (IV cipher)
forall cipher (m :: * -> *).
(BlockCipher cipher, MonadRandom m) =>
cipher -> m (IV cipher)
ivGenerate cipher
c; cipher -> IV cipher -> ba -> m (Either StoreError ba)
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 :: kek -> KeyEncryptionParams -> ba -> Either StoreError ba
keyDecrypt kek
key (PWRIKEK ContentEncryptionParams
params) ba
bs =
    case ContentEncryptionParams
params of
        ParamsECB ContentEncryptionCipher c
cipher    -> ContentEncryptionCipher c -> kek -> Either StoreError c
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher kek
key Either StoreError c
-> (c -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> (c -> IV c -> ba -> ba) -> c -> IV c -> ba -> Either StoreError ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> Either StoreError ba
wrapDecrypt ((ba -> ba) -> IV c -> ba -> ba
forall a b. a -> b -> a
const ((ba -> ba) -> IV c -> ba -> ba)
-> (c -> ba -> ba) -> c -> IV c -> ba -> ba
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> ba -> ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbDecrypt) c
c IV c
forall a. HasCallStack => a
undefined ba
bs)
        ParamsCBC ContentEncryptionCipher c
cipher IV c
iv -> ContentEncryptionCipher c -> kek -> Either StoreError c
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher kek
key Either StoreError c
-> (c -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> (c -> IV c -> ba -> ba) -> c -> IV c -> ba -> Either StoreError ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> Either StoreError ba
wrapDecrypt c -> IV c -> ba -> ba
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 -> Int -> kek -> Either StoreError RC2
forall key. ByteArray key => Int -> key -> Either StoreError RC2
getRC2Cipher Int
len kek
key Either StoreError RC2
-> (RC2 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\RC2
c -> (RC2 -> IV RC2 -> ba -> ba)
-> RC2 -> IV RC2 -> ba -> Either StoreError ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> Either StoreError ba
wrapDecrypt RC2 -> IV RC2 -> ba -> ba
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 -> ContentEncryptionCipher c -> kek -> Either StoreError c
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher c
cipher kek
key Either StoreError c
-> (c -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c
c -> (c -> IV c -> ba -> ba) -> c -> IV c -> ba -> Either StoreError ba
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
(cipher -> IV cipher -> ba -> ba)
-> cipher -> IV cipher -> ba -> Either StoreError ba
wrapDecrypt c -> IV c -> ba -> ba
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
_       -> StoreError -> Either StoreError ba
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 = ContentEncryptionCipher AES128 -> kek -> Either StoreError AES128
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES128
AES128   kek
key Either StoreError AES128
-> (AES128 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AES128 -> ba -> Either StoreError ba
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 = ContentEncryptionCipher AES192 -> kek -> Either StoreError AES192
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES192
AES192   kek
key Either StoreError AES192
-> (AES192 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AES192 -> ba -> Either StoreError ba
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 = ContentEncryptionCipher AES256 -> kek -> Either StoreError AES256
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES256
AES256   kek
key Either StoreError AES256
-> (AES256 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AES256 -> ba -> Either StoreError ba
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 = ContentEncryptionCipher AES128 -> kek -> Either StoreError AES128
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES128
AES128   kek
key Either StoreError AES128
-> (AES128 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AES128 -> ba -> Either StoreError ba
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 = ContentEncryptionCipher AES192 -> kek -> Either StoreError AES192
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES192
AES192   kek
key Either StoreError AES192
-> (AES192 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AES192 -> ba -> Either StoreError ba
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 = ContentEncryptionCipher AES256 -> kek -> Either StoreError AES256
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher AES256
AES256   kek
key Either StoreError AES256
-> (AES256 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AES256 -> ba -> Either StoreError ba
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 = ContentEncryptionCipher DES_EDE3
-> kek -> Either StoreError DES_EDE3
forall cipher key (proxy :: * -> *).
(BlockCipher cipher, ByteArray key) =>
proxy cipher -> key -> Either StoreError cipher
getCipher ContentEncryptionCipher DES_EDE3
DES_EDE3 kek
key Either StoreError DES_EDE3
-> (DES_EDE3 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (DES_EDE3 -> ba -> Either StoreError ba
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 = Int -> kek -> Either StoreError RC2
forall key. ByteArray key => Int -> key -> Either StoreError RC2
getRC2Cipher Int
ekl kek
key Either StoreError RC2
-> (RC2 -> Either StoreError ba) -> Either StoreError ba
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (RC2 -> ba -> Either StoreError ba
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 :: Int -> ba -> m (Either StoreError ba)
keyWrap Int
sz ba
input
    | Int
inLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<   Int
3 = Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ba -> m (Either StoreError ba))
-> Either StoreError ba -> m (Either StoreError ba)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError ba
forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"keyWrap: input key too short")
    | Int
inLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
255 = Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ba -> m (Either StoreError ba))
-> Either StoreError ba -> m (Either StoreError ba)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError ba
forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"keyWrap: input key too long")
    | Int
pLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   = Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ba -> m (Either StoreError ba))
-> Either StoreError ba -> m (Either StoreError ba)
forall a b. (a -> b) -> a -> b
$ ba -> Either StoreError ba
forall a b. b -> Either a b
Right (ba -> Either StoreError ba) -> ba -> Either StoreError ba
forall a b. (a -> b) -> a -> b
$ [ba] -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat [ ba
count, ba
check, ba
input ]
    | Bool
otherwise   = do
        ba
padding <- Int -> m ba
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
pLen
        Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ba -> m (Either StoreError ba))
-> Either StoreError ba -> m (Either StoreError ba)
forall a b. (a -> b) -> a -> b
$ ba -> Either StoreError ba
forall a b. b -> Either a b
Right (ba -> Either StoreError ba) -> ba -> Either StoreError ba
forall a b. (a -> b) -> a -> b
$ [ba] -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat [ ba
count, ba
check, ba
input, ba
padding ]
  where
    inLen :: Int
inLen = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input
    count :: ba
count = Word8 -> ba
forall a. ByteArray a => Word8 -> a
B.singleton (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
inLen)
    check :: ba
check = ba -> Bytes -> ba
forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
B.xor ba
input ([Word8] -> Bytes
forall a. ByteArray a => [Word8] -> a
B.pack [Word8
255, Word8
255, Word8
255] :: B.Bytes)
    pLen :: Int
pLen  = Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
inLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
comp
    comp :: Int
comp  = if Int
inLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
sz then Int
0 else Int
sz

keyUnwrap :: ByteArray ba => ba -> Either StoreError ba
keyUnwrap :: ba -> Either StoreError ba
keyUnwrap ba
input
    | Int
inLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4         = StoreError -> Either StoreError ba
forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"keyUnwrap: invalid wrapped key")
    | Bool
valid             = ba -> Either StoreError ba
forall a b. b -> Either a b
Right (ba -> Either StoreError ba) -> ba -> Either StoreError ba
forall a b. (a -> b) -> a -> b
$ Int -> ba -> ba
forall bs. ByteArray bs => Int -> bs -> bs
B.take Int
count (Int -> ba -> ba
forall bs. ByteArray bs => Int -> bs -> bs
B.drop Int
4 ba
input)
    | Bool
otherwise         = StoreError -> Either StoreError ba
forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"keyUnwrap: invalid wrapped key")
  where
    inLen :: Int
inLen = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input
    count :: Int
count = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ba -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index ba
input Int
0)
    bytes :: [Word8]
bytes = [ ba -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index ba
input (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` ba -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index ba
input (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) | Int
i <- [Int
0..Int
2] ]
    valid :: Bool
valid = (Word8 -> Word8 -> Word8) -> [Word8] -> Word8
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
(.&.) [Word8]
bytes Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xFF Bool -> Bool -> Bool
&&! Int
inLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
count Int -> Int -> Int
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 :: (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 <- Int -> ba -> m (Either StoreError ba)
forall (m :: * -> *) ba.
(MonadRandom m, ByteArray ba) =>
Int -> ba -> m (Either StoreError ba)
keyWrap Int
sz ba
input
    Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (ba -> ba
fn (ba -> ba) -> Either StoreError ba -> Either StoreError ba
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either StoreError ba
wrapped)
  where
    sz :: Int
sz = cipher -> Int
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 = ba -> Int -> View ba
forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
B.dropView ba
firstPass (ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
firstPass Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz)
            Just IV cipher
iv'  = View ba -> Maybe (IV cipher)
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 :: (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 = ba -> Either StoreError ba
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 = cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher
    (ba
beg, ba
lb) = Int -> ba -> (ba, ba)
forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt (ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input Int -> Int -> Int
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'  = View ba -> Maybe (IV cipher)
forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV (ba -> Int -> View ba
forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
B.dropView ba
beg (ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
beg Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz))
    Just IV cipher
iv'' = ba -> Maybe (IV cipher)
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 ba -> ba -> ba
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
(Int -> OAEPParams -> ShowS)
-> (OAEPParams -> String)
-> ([OAEPParams] -> ShowS)
-> Show OAEPParams
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
(OAEPParams -> OAEPParams -> Bool)
-> (OAEPParams -> OAEPParams -> Bool) -> Eq OAEPParams
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
..} =
        Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (DigestAlgorithm -> Int
forall params. HasStrength params => params -> Int
getSecurityBits DigestAlgorithm
oaepHashAlgorithm)
            (MaskGenerationFunc -> Int
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 :: 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 ->
            OAEPParams hashAlg seed output -> a
forall hash. HashAlgorithm hash => OAEPParams hash seed output -> a
fn OAEPParams :: forall hash seed output.
hash
-> MaskGenAlgorithm seed output
-> Maybe ByteString
-> OAEPParams hash seed output
RSAOAEP.OAEPParams
                { oaepHash :: hashAlg
RSAOAEP.oaepHash = DigestProxy hashAlg -> hashAlg
forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy DigestProxy hashAlg
hashAlg
                , oaepMaskGenAlg :: MaskGenAlgorithm seed output
RSAOAEP.oaepMaskGenAlg = MaskGenerationFunc -> MaskGenAlgorithm seed output
forall seed output.
(ByteArrayAccess seed, ByteArray output) =>
MaskGenerationFunc -> seed -> Int -> output
mgf (OAEPParams -> MaskGenerationFunc
oaepMaskGenAlgorithm OAEPParams
p)
                , oaepLabel :: Maybe ByteString
RSAOAEP.oaepLabel = Maybe ByteString
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
..} =
        ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
h ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
m)
      where
        sha1 :: DigestAlgorithm
sha1  = DigestProxy SHA1 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1
        tag :: Int -> ASN1Stream e -> ASN1Stream e
tag Int
i = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
i)

        h :: ASN1Stream e
h | DigestAlgorithm
oaepHashAlgorithm DigestAlgorithm -> DigestAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== DigestAlgorithm
sha1 = ASN1Stream e
forall a. a -> a
id
          | Bool
otherwise = Int -> ASN1Stream e -> ASN1Stream e
forall e. ASN1Elem e => Int -> ASN1Stream e -> ASN1Stream e
tag Int
0 (ASN1ConstructionType -> DigestAlgorithm -> ASN1Stream e
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 MaskGenerationFunc -> MaskGenerationFunc -> Bool
forall a. Eq a => a -> a -> Bool
== DigestAlgorithm -> MaskGenerationFunc
MGF1 DigestAlgorithm
sha1 = ASN1Stream e
forall a. a -> a
id
          | Bool
otherwise = Int -> ASN1Stream e -> ASN1Stream e
forall e. ASN1Elem e => Int -> ASN1Stream e -> ASN1Stream e
tag Int
1 (ASN1ConstructionType -> MaskGenerationFunc -> ASN1Stream e
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 = ASN1ConstructionType
-> ParseASN1 e OAEPParams -> ParseASN1 e OAEPParams
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e OAEPParams -> ParseASN1 e OAEPParams)
-> ParseASN1 e OAEPParams -> ParseASN1 e OAEPParams
forall a b. (a -> b) -> a -> b
$ do
        Maybe DigestAlgorithm
h <- Int
-> ParseASN1 e DigestAlgorithm
-> ParseASN1 e (Maybe DigestAlgorithm)
forall e a.
Monoid e =>
Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
0 (ASN1ConstructionType -> ParseASN1 e DigestAlgorithm
forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence)
        Maybe MaskGenerationFunc
m <- Int
-> ParseASN1 e MaskGenerationFunc
-> ParseASN1 e (Maybe MaskGenerationFunc)
forall e a.
Monoid e =>
Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
1 (ASN1ConstructionType -> ParseASN1 e MaskGenerationFunc
forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence)
        Maybe ()
_ <- Int -> ParseASN1 e () -> ParseASN1 e (Maybe ())
forall e a.
Monoid e =>
Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
2 ParseASN1 e ()
parsePSpecified
        OAEPParams -> ParseASN1 e OAEPParams
forall (m :: * -> *) a. Monad m => a -> m a
return OAEPParams :: DigestAlgorithm -> MaskGenerationFunc -> OAEPParams
OAEPParams { oaepHashAlgorithm :: DigestAlgorithm
oaepHashAlgorithm = DigestAlgorithm -> Maybe DigestAlgorithm -> DigestAlgorithm
forall a. a -> Maybe a -> a
fromMaybe DigestAlgorithm
sha1 Maybe DigestAlgorithm
h
                          , oaepMaskGenAlgorithm :: MaskGenerationFunc
oaepMaskGenAlgorithm = MaskGenerationFunc
-> Maybe MaskGenerationFunc -> MaskGenerationFunc
forall a. a -> Maybe a -> a
fromMaybe (DigestAlgorithm -> MaskGenerationFunc
MGF1 DigestAlgorithm
sha1) Maybe MaskGenerationFunc
m
                          }
      where
        sha1 :: DigestAlgorithm
sha1  = DigestProxy SHA1 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1
        tag :: Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
i = ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e (Maybe a)
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] <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
            OctetString ByteString
p <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
            Bool -> ParseASN1 e ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Bool
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 = OIDNameableWrapper KeyTransportType -> KeyTransportType
forall a. OIDNameableWrapper a -> a
unOIDNW (OIDNameableWrapper KeyTransportType -> KeyTransportType)
-> Maybe (OIDNameableWrapper KeyTransportType)
-> Maybe KeyTransportType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OID -> Maybe (OIDNameableWrapper KeyTransportType)
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
(Int -> KeyTransportParams -> ShowS)
-> (KeyTransportParams -> String)
-> ([KeyTransportParams] -> ShowS)
-> Show KeyTransportParams
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
(KeyTransportParams -> KeyTransportParams -> Bool)
-> (KeyTransportParams -> KeyTransportParams -> Bool)
-> Eq KeyTransportParams
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              = AlgorithmType KeyTransportParams
KeyTransportType
TypeRSAES
    algorithmType (RSAESOAEP OAEPParams
_)      = AlgorithmType KeyTransportParams
KeyTransportType
TypeRSAESOAEP

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

    parseParameter :: AlgorithmType KeyTransportParams -> ParseASN1 e KeyTransportParams
parseParameter AlgorithmType KeyTransportParams
TypeRSAES         = (ASN1 -> Maybe ()) -> ParseASN1 e (Maybe ())
forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe ()
nullOrNothing ParseASN1 e (Maybe ())
-> ParseASN1 e KeyTransportParams -> ParseASN1 e KeyTransportParams
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KeyTransportParams -> ParseASN1 e KeyTransportParams
forall (m :: * -> *) a. Monad m => a -> m a
return KeyTransportParams
RSAES
    parseParameter AlgorithmType KeyTransportParams
TypeRSAESOAEP     = OAEPParams -> KeyTransportParams
RSAESOAEP (OAEPParams -> KeyTransportParams)
-> ParseASN1 e OAEPParams -> ParseASN1 e KeyTransportParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e OAEPParams
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 :: KeyTransportParams
-> PubKey -> ByteString -> m (Either StoreError ByteString)
transportEncrypt KeyTransportParams
RSAES         (X509.PubKeyRSA PublicKey
pub) ByteString
bs =
    (Error -> StoreError)
-> Either Error ByteString -> Either StoreError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft Error -> StoreError
RSAError (Either Error ByteString -> Either StoreError ByteString)
-> m (Either Error ByteString) -> m (Either StoreError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PublicKey -> ByteString -> m (Either Error ByteString)
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 =
    OAEPParams
-> (forall hash.
    HashAlgorithm hash =>
    OAEPParams hash ByteString ByteString
    -> m (Either StoreError ByteString))
-> m (Either StoreError ByteString)
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 ByteString ByteString
  -> m (Either StoreError ByteString))
 -> m (Either StoreError ByteString))
-> (forall hash.
    HashAlgorithm hash =>
    OAEPParams hash ByteString ByteString
    -> m (Either StoreError ByteString))
-> m (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ \OAEPParams hash ByteString ByteString
params ->
        (Error -> StoreError)
-> Either Error ByteString -> Either StoreError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft Error -> StoreError
RSAError (Either Error ByteString -> Either StoreError ByteString)
-> m (Either Error ByteString) -> m (Either StoreError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OAEPParams hash ByteString ByteString
-> PublicKey -> ByteString -> m (Either Error ByteString)
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
_ = Either StoreError ByteString -> m (Either StoreError ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ByteString -> m (Either StoreError ByteString))
-> Either StoreError ByteString -> m (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError ByteString
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 :: KeyTransportParams
-> PrivKey -> ByteString -> m (Either StoreError ByteString)
transportDecrypt KeyTransportParams
RSAES         (X509.PrivKeyRSA PrivateKey
priv) ByteString
bs =
    (Error -> StoreError)
-> Either Error ByteString -> Either StoreError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft Error -> StoreError
RSAError (Either Error ByteString -> Either StoreError ByteString)
-> m (Either Error ByteString) -> m (Either StoreError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrivateKey -> ByteString -> m (Either Error ByteString)
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
    | OAEPParams -> Bool
forall params. HasStrength params => params -> Bool
securityAcceptable OAEPParams
p =
        OAEPParams
-> (forall hash.
    HashAlgorithm hash =>
    OAEPParams hash ByteString ByteString
    -> m (Either StoreError ByteString))
-> m (Either StoreError ByteString)
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 ByteString ByteString
  -> m (Either StoreError ByteString))
 -> m (Either StoreError ByteString))
-> (forall hash.
    HashAlgorithm hash =>
    OAEPParams hash ByteString ByteString
    -> m (Either StoreError ByteString))
-> m (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ \OAEPParams hash ByteString ByteString
params ->
            (Error -> StoreError)
-> Either Error ByteString -> Either StoreError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft Error -> StoreError
RSAError (Either Error ByteString -> Either StoreError ByteString)
-> m (Either Error ByteString) -> m (Either StoreError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OAEPParams hash ByteString ByteString
-> PrivateKey -> ByteString -> m (Either Error ByteString)
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 = Either StoreError ByteString -> m (Either StoreError ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ByteString -> m (Either StoreError ByteString))
-> Either StoreError ByteString -> m (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError ByteString
forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"OAEP parameters too weak")
transportDecrypt KeyTransportParams
_ PrivKey
_ ByteString
_ = Either StoreError ByteString -> m (Either StoreError ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ByteString -> m (Either StoreError ByteString))
-> Either StoreError ByteString -> m (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError ByteString
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
(Int -> KeyAgreementType -> ShowS)
-> (KeyAgreementType -> String)
-> ([KeyAgreementType] -> ShowS)
-> Show KeyAgreementType
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
(KeyAgreementType -> KeyAgreementType -> Bool)
-> (KeyAgreementType -> KeyAgreementType -> Bool)
-> Eq KeyAgreementType
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 (DigestProxy SHA1 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1)
             , DigestAlgorithm -> KeyAgreementType
TypeStdDH (DigestProxy SHA224 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA224
SHA224)
             , DigestAlgorithm -> KeyAgreementType
TypeStdDH (DigestProxy SHA256 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA256
SHA256)
             , DigestAlgorithm -> KeyAgreementType
TypeStdDH (DigestProxy SHA384 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA384
SHA384)
             , DigestAlgorithm -> KeyAgreementType
TypeStdDH (DigestProxy SHA512 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA512
SHA512)

             , DigestAlgorithm -> KeyAgreementType
TypeCofactorDH (DigestProxy SHA1 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1)
             , DigestAlgorithm -> KeyAgreementType
TypeCofactorDH (DigestProxy SHA224 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA224
SHA224)
             , DigestAlgorithm -> KeyAgreementType
TypeCofactorDH (DigestProxy SHA256 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA256
SHA256)
             , DigestAlgorithm -> KeyAgreementType
TypeCofactorDH (DigestProxy SHA384 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA384
SHA384)
             , DigestAlgorithm -> KeyAgreementType
TypeCofactorDH (DigestProxy SHA512 -> DigestAlgorithm
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 = String -> OID
forall a. HasCallStack => String -> a
error (String
"Unsupported KeyAgreementType: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ KeyAgreementType -> String
forall a. Show a => a -> String
show KeyAgreementType
ty)

instance OIDNameable KeyAgreementType where
    fromObjectID :: OID -> Maybe KeyAgreementType
fromObjectID OID
oid = OIDNameableWrapper KeyAgreementType -> KeyAgreementType
forall a. OIDNameableWrapper a -> a
unOIDNW (OIDNameableWrapper KeyAgreementType -> KeyAgreementType)
-> Maybe (OIDNameableWrapper KeyAgreementType)
-> Maybe KeyAgreementType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OID -> Maybe (OIDNameableWrapper KeyAgreementType)
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
(Int -> KeyAgreementParams -> ShowS)
-> (KeyAgreementParams -> String)
-> ([KeyAgreementParams] -> ShowS)
-> Show KeyAgreementParams
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
(KeyAgreementParams -> KeyAgreementParams -> Bool)
-> (KeyAgreementParams -> KeyAgreementParams -> Bool)
-> Eq KeyAgreementParams
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 :: KeyAgreementParams -> ASN1Stream e
parameterASN1S (StdDH DigestAlgorithm
_ KeyEncryptionParams
p)        = ASN1ConstructionType -> KeyEncryptionParams -> ASN1Stream e
forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence KeyEncryptionParams
p
    parameterASN1S (CofactorDH DigestAlgorithm
_ KeyEncryptionParams
p)   = ASN1ConstructionType -> KeyEncryptionParams -> ASN1Stream e
forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence KeyEncryptionParams
p

    parseParameter :: AlgorithmType KeyAgreementParams -> ParseASN1 e KeyAgreementParams
parseParameter (TypeStdDH d)      = DigestAlgorithm -> KeyEncryptionParams -> KeyAgreementParams
StdDH DigestAlgorithm
d (KeyEncryptionParams -> KeyAgreementParams)
-> ParseASN1 e KeyEncryptionParams
-> ParseASN1 e KeyAgreementParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1ConstructionType -> ParseASN1 e KeyEncryptionParams
forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
    parseParameter (TypeCofactorDH d) = DigestAlgorithm -> KeyEncryptionParams -> KeyAgreementParams
CofactorDH DigestAlgorithm
d (KeyEncryptionParams -> KeyAgreementParams)
-> ParseASN1 e KeyEncryptionParams
-> ParseASN1 e KeyAgreementParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1ConstructionType -> ParseASN1 e KeyEncryptionParams
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 :: DigestAlgorithm
-> KeyEncryptionParams -> Maybe ByteString -> bin -> bout
ecdhKeyMaterial (DigestAlgorithm DigestProxy hashAlg
hashAlg) KeyEncryptionParams
kep Maybe ByteString
ukm bin
zz
    | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = [bout] -> bout
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat ((Int -> bout) -> [Int] -> [bout]
forall a b. (a -> b) -> [a] -> [b]
map Int -> bout
chunk [Int
1..Int
d])
    | Bool
otherwise = [bout] -> bout
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat ((Int -> bout) -> [Int] -> [bout]
forall a b. (a -> b) -> [a] -> [b]
map Int -> bout
chunk [Int
1..Int
d]) bout -> bout -> bout
forall bs. ByteArray bs => bs -> bs -> bs
`B.append` Int -> bout -> bout
forall bs. ByteArray bs => Int -> bs -> bs
B.take Int
r (Int -> bout
chunk (Int -> bout) -> Int -> bout
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> a
succ Int
d)
  where
    (Int
d, Int
r)   = Int
outLen Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` hashAlg -> Int
forall a. HashAlgorithm a => a -> Int
Hash.hashDigestSize hashAlg
prx

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

    chunk :: Int -> bout
chunk     = Digest hashAlg -> bout
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest hashAlg -> bout) -> (Int -> Digest hashAlg) -> Int -> bout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context hashAlg -> Digest hashAlg
forall a. HashAlgorithm a => Context a -> Digest a
Hash.hashFinalize (Context hashAlg -> Digest hashAlg)
-> (Int -> Context hashAlg) -> Int -> Digest hashAlg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Context hashAlg
hashCtx
    hashCtx' :: Context hashAlg
hashCtx'  = hashAlg -> Context hashAlg
forall alg. HashAlgorithm alg => alg -> Context alg
Hash.hashInitWith hashAlg
prx
    hashCtx :: Int -> Context hashAlg
hashCtx Int
i = Context hashAlg -> ByteString -> Context hashAlg
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
Hash.hashUpdate (Context hashAlg -> ByteString -> Context hashAlg
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
Hash.hashUpdate (Context hashAlg -> bin -> Context hashAlg
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  = ASN1ConstructionType -> KeyEncryptionParams -> ASN1Stream ASN1P
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 -> ASN1Stream ASN1P
forall a. a -> a
id
                    Just ByteString
bs -> ASN1ConstructionType -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
                                   (ByteString -> ASN1Stream ASN1P
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
bs)
            spi :: ASN1Stream ASN1P
spi = ASN1ConstructionType -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
2)
                      (ByteString -> ASN1Stream ASN1P
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (ByteString -> ASN1Stream ASN1P) -> ByteString -> ASN1Stream ASN1P
forall a b. (a -> b) -> a -> b
$ Int -> ByteString
toWord32 Int
outBits)
         in ASN1Stream ASN1P -> ByteString
encodeASN1S (ASN1Stream ASN1P -> ByteString) -> ASN1Stream ASN1P -> ByteString
forall a b. (a -> b) -> a -> b
$ ASN1ConstructionType -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream ASN1P
ki ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
eui ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
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 :: PubKey -> m (Either StoreError ECDHPair)
ecdhGenerate (X509.PubKeyEC PubKeyEC
pub) =
    case PubKeyEC -> Maybe CurveName
ecPubKeyCurveName PubKeyEC
pub of
        Maybe CurveName
Nothing -> Either StoreError ECDHPair -> m (Either StoreError ECDHPair)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ECDHPair -> m (Either StoreError ECDHPair))
-> Either StoreError ECDHPair -> m (Either StoreError ECDHPair)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError ECDHPair
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 <- Curve -> m Integer
forall (m :: * -> *). MonadRandom m => Curve -> m Integer
ECDH.generatePrivate Curve
curve
            Either StoreError ECDHPair -> m (Either StoreError ECDHPair)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ECDHPair -> m (Either StoreError ECDHPair))
-> Either StoreError ECDHPair -> m (Either StoreError ECDHPair)
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 -> StoreError -> Either StoreError ECDHPair
forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"Invalid serialized point")
                Just Point
pt -> ECDHPair -> Either StoreError ECDHPair
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 <- m SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
X25519.generateSecretKey
    Either StoreError ECDHPair -> m (Either StoreError ECDHPair)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ECDHPair -> m (Either StoreError ECDHPair))
-> Either StoreError ECDHPair -> m (Either StoreError ECDHPair)
forall a b. (a -> b) -> a -> b
$ ECDHPair -> Either StoreError ECDHPair
forall a b. b -> Either a b
Right (SecretKey -> PublicKey -> ECDHPair
PairX25519 SecretKey
priv PublicKey
pub)
ecdhGenerate (X509.PubKeyX448 PublicKey
pub) = do
    SecretKey
priv <- m SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
X448.generateSecretKey
    Either StoreError ECDHPair -> m (Either StoreError ECDHPair)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ECDHPair -> m (Either StoreError ECDHPair))
-> Either StoreError ECDHPair -> m (Either StoreError ECDHPair)
forall a b. (a -> b) -> a -> b
$ ECDHPair -> Either StoreError ECDHPair
forall a b. b -> Either a b
Right (SecretKey -> PublicKey -> ECDHPair
PairX448 SecretKey
priv PublicKey
pub)
ecdhGenerate PubKey
_ = Either StoreError ECDHPair -> m (Either StoreError ECDHPair)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ECDHPair -> m (Either StoreError ECDHPair))
-> Either StoreError ECDHPair -> m (Either StoreError ECDHPair)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError ECDHPair
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
_) = PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (SecretKey -> PublicKey
X25519.toPublic SecretKey
priv)
ecdhPublic (PairX448 SecretKey
priv PublicKey
_)   = PublicKey -> ByteString
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 :: 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 = DigestAlgorithm
-> KeyEncryptionParams
-> Maybe ByteString
-> SharedKey
-> ScrubbedBytes
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
    ScrubbedBytes
-> KeyEncryptionParams -> ba -> m (Either StoreError ba)
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 CryptoFailable SharedSecret -> Either StoreError SharedSecret
forall a. CryptoFailable a -> Either StoreError a
fromCryptoFailable (Proxy Curve_X25519
-> Scalar Curve_X25519
-> Point Curve_X25519
-> CryptoFailable SharedSecret
forall curve (proxy :: * -> *).
EllipticCurveDH curve =>
proxy curve
-> Scalar curve -> Point curve -> CryptoFailable SharedSecret
ecdh Proxy Curve_X25519
x25519 Scalar Curve_X25519
SecretKey
priv Point Curve_X25519
PublicKey
pub) of
        Left StoreError
e  -> Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (StoreError -> Either StoreError ba
forall a b. a -> Either a b
Left StoreError
e)
        Right SharedSecret
s ->
            let k :: ScrubbedBytes
k = DigestAlgorithm
-> KeyEncryptionParams
-> Maybe ByteString
-> SharedSecret
-> ScrubbedBytes
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 ScrubbedBytes
-> KeyEncryptionParams -> ba -> m (Either StoreError ba)
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 CryptoFailable SharedSecret -> Either StoreError SharedSecret
forall a. CryptoFailable a -> Either StoreError a
fromCryptoFailable (Proxy Curve_X448
-> Scalar Curve_X448
-> Point Curve_X448
-> CryptoFailable SharedSecret
forall curve (proxy :: * -> *).
EllipticCurveDH curve =>
proxy curve
-> Scalar curve -> Point curve -> CryptoFailable SharedSecret
ecdh Proxy Curve_X448
x448 Scalar Curve_X448
SecretKey
priv Point Curve_X448
PublicKey
pub) of
        Left StoreError
e  -> Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (StoreError -> Either StoreError ba
forall a b. a -> Either a b
Left StoreError
e)
        Right SharedSecret
s ->
            let k :: ScrubbedBytes
k = DigestAlgorithm
-> KeyEncryptionParams
-> Maybe ByteString
-> SharedSecret
-> ScrubbedBytes
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 ScrubbedBytes
-> KeyEncryptionParams -> ba -> m (Either StoreError ba)
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 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d) Point
pub
        k :: ScrubbedBytes
k = DigestAlgorithm
-> KeyEncryptionParams
-> Maybe ByteString
-> SharedKey
-> ScrubbedBytes
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
    ScrubbedBytes
-> KeyEncryptionParams -> ba -> m (Either StoreError ba)
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
_ =
    Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ba -> m (Either StoreError ba))
-> Either StoreError ba -> m (Either StoreError ba)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError ba
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
_ =
    Either StoreError ba -> m (Either StoreError ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ba -> m (Either StoreError ba))
-> Either StoreError ba -> m (Either StoreError ba)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError ba
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 :: 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    -> StoreError -> Either StoreError ba
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  -> StoreError -> Either StoreError ba
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 = DigestAlgorithm
-> KeyEncryptionParams
-> Maybe ByteString
-> SharedKey
-> ScrubbedBytes
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
                    ScrubbedBytes -> KeyEncryptionParams -> ba -> Either StoreError ba
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 <- CryptoFailable SharedSecret -> Either StoreError SharedSecret
forall a. CryptoFailable a -> Either StoreError a
fromCryptoFailable (ByteString -> CryptoFailable PublicKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable PublicKey
X25519.publicKey ByteString
pt CryptoFailable PublicKey
-> (PublicKey -> CryptoFailable SharedSecret)
-> CryptoFailable SharedSecret
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Proxy Curve_X25519
-> Scalar Curve_X25519
-> Point Curve_X25519
-> CryptoFailable SharedSecret
forall curve (proxy :: * -> *).
EllipticCurveDH curve =>
proxy curve
-> Scalar curve -> Point curve -> CryptoFailable SharedSecret
ecdh Proxy Curve_X25519
x25519 Scalar Curve_X25519
SecretKey
priv)
    let k :: ScrubbedBytes
k = DigestAlgorithm
-> KeyEncryptionParams
-> Maybe ByteString
-> SharedSecret
-> ScrubbedBytes
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
    ScrubbedBytes -> KeyEncryptionParams -> ba -> Either StoreError ba
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 <- CryptoFailable SharedSecret -> Either StoreError SharedSecret
forall a. CryptoFailable a -> Either StoreError a
fromCryptoFailable (ByteString -> CryptoFailable PublicKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable PublicKey
X448.publicKey ByteString
pt CryptoFailable PublicKey
-> (PublicKey -> CryptoFailable SharedSecret)
-> CryptoFailable SharedSecret
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Proxy Curve_X448
-> Scalar Curve_X448
-> Point Curve_X448
-> CryptoFailable SharedSecret
forall curve (proxy :: * -> *).
EllipticCurveDH curve =>
proxy curve
-> Scalar curve -> Point curve -> CryptoFailable SharedSecret
ecdh Proxy Curve_X448
x448 Scalar Curve_X448
SecretKey
priv)
    let k :: ScrubbedBytes
k = DigestAlgorithm
-> KeyEncryptionParams
-> Maybe ByteString
-> SharedSecret
-> ScrubbedBytes
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
    ScrubbedBytes -> KeyEncryptionParams -> ba -> Either StoreError ba
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
_ = StoreError -> Either StoreError 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    -> StoreError -> Either StoreError ba
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  -> StoreError -> Either StoreError ba
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 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d) Point
pub
                        k :: ScrubbedBytes
k = DigestAlgorithm
-> KeyEncryptionParams
-> Maybe ByteString
-> SharedKey
-> ScrubbedBytes
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
                    ScrubbedBytes -> KeyEncryptionParams -> ba -> Either StoreError ba
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
_ = StoreError -> Either StoreError ba
forall a b. a -> Either a b
Left StoreError
UnexpectedPrivateKeyType

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

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


-- Utilities

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

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

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

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

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

-- | Return the block size of the specified block cipher.
proxyBlockSize :: BlockCipher cipher => proxy cipher -> Int
proxyBlockSize :: proxy cipher -> Int
proxyBlockSize = cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize (cipher -> Int) -> (proxy cipher -> cipher) -> proxy cipher -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy cipher -> cipher
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 = CCM_L -> Maybe CCM_L
forall a. a -> Maybe a
Just CCM_L
CCM_L2
fromL Int
3 = CCM_L -> Maybe CCM_L
forall a. a -> Maybe a
Just CCM_L
CCM_L3
fromL Int
4 = CCM_L -> Maybe CCM_L
forall a. a -> Maybe a
Just CCM_L
CCM_L4
fromL Int
_ = Maybe CCM_L
forall a. Maybe a
Nothing

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


-- Mask generation functions

data MaskGenerationType = TypeMGF1
    deriving (Int -> MaskGenerationType -> ShowS
[MaskGenerationType] -> ShowS
MaskGenerationType -> String
(Int -> MaskGenerationType -> ShowS)
-> (MaskGenerationType -> String)
-> ([MaskGenerationType] -> ShowS)
-> Show MaskGenerationType
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
(MaskGenerationType -> MaskGenerationType -> Bool)
-> (MaskGenerationType -> MaskGenerationType -> Bool)
-> Eq MaskGenerationType
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 = OIDNameableWrapper MaskGenerationType -> MaskGenerationType
forall a. OIDNameableWrapper a -> a
unOIDNW (OIDNameableWrapper MaskGenerationType -> MaskGenerationType)
-> Maybe (OIDNameableWrapper MaskGenerationType)
-> Maybe MaskGenerationType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OID -> Maybe (OIDNameableWrapper MaskGenerationType)
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
(Int -> MaskGenerationFunc -> ShowS)
-> (MaskGenerationFunc -> String)
-> ([MaskGenerationFunc] -> ShowS)
-> Show MaskGenerationFunc
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
(MaskGenerationFunc -> MaskGenerationFunc -> Bool)
-> (MaskGenerationFunc -> MaskGenerationFunc -> Bool)
-> Eq MaskGenerationFunc
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) = DigestAlgorithm -> Int
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
_)   = AlgorithmType MaskGenerationFunc
MaskGenerationType
TypeMGF1

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

    parseParameter :: AlgorithmType MaskGenerationFunc -> ParseASN1 e MaskGenerationFunc
parseParameter AlgorithmType MaskGenerationFunc
TypeMGF1  = DigestAlgorithm -> MaskGenerationFunc
MGF1 (DigestAlgorithm -> MaskGenerationFunc)
-> ParseASN1 e DigestAlgorithm -> ParseASN1 e MaskGenerationFunc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1ConstructionType -> ParseASN1 e DigestAlgorithm
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 :: MaskGenerationFunc -> seed -> Int -> output
mgf (MGF1 (DigestAlgorithm DigestProxy hashAlg
hashAlg)) = hashAlg -> seed -> Int -> output
forall seed output hashAlg.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hashAlg) =>
hashAlg -> seed -> Int -> output
MGF.mgf1 (DigestProxy hashAlg -> hashAlg
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
(Int -> PSSParams -> ShowS)
-> (PSSParams -> String)
-> ([PSSParams] -> ShowS)
-> Show PSSParams
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
(PSSParams -> PSSParams -> Bool)
-> (PSSParams -> PSSParams -> Bool) -> Eq PSSParams
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
..} =
        Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (DigestAlgorithm -> Int
forall params. HasStrength params => params -> Int
getSecurityBits DigestAlgorithm
pssHashAlgorithm)
            (MaskGenerationFunc -> Int
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 :: 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 ->
            PSSParams hashAlg seed output -> a
forall hash. HashAlgorithm hash => PSSParams hash seed output -> a
fn PSSParams :: forall hash seed output.
hash
-> MaskGenAlgorithm seed output
-> Int
-> Word8
-> PSSParams hash seed output
RSAPSS.PSSParams
                { pssHash :: hashAlg
RSAPSS.pssHash = DigestProxy hashAlg -> hashAlg
forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy DigestProxy hashAlg
hashAlg
                , pssMaskGenAlg :: MaskGenAlgorithm seed output
RSAPSS.pssMaskGenAlg = MaskGenerationFunc -> MaskGenAlgorithm seed output
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
..} =
        ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
h ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
m ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
s)
      where
        sha1 :: DigestAlgorithm
sha1  = DigestProxy SHA1 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1
        tag :: Int -> ASN1Stream e -> ASN1Stream e
tag Int
i = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
i)

        h :: ASN1Stream e
h | DigestAlgorithm
pssHashAlgorithm DigestAlgorithm -> DigestAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== DigestAlgorithm
sha1 = ASN1Stream e
forall a. a -> a
id
          | Bool
otherwise = Int -> ASN1Stream e -> ASN1Stream e
forall e. ASN1Elem e => Int -> ASN1Stream e -> ASN1Stream e
tag Int
0 (ASN1ConstructionType -> DigestAlgorithm -> ASN1Stream e
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 MaskGenerationFunc -> MaskGenerationFunc -> Bool
forall a. Eq a => a -> a -> Bool
== DigestAlgorithm -> MaskGenerationFunc
MGF1 DigestAlgorithm
sha1 = ASN1Stream e
forall a. a -> a
id
          | Bool
otherwise = Int -> ASN1Stream e -> ASN1Stream e
forall e. ASN1Elem e => Int -> ASN1Stream e -> ASN1Stream e
tag Int
1 (ASN1ConstructionType -> MaskGenerationFunc -> ASN1Stream e
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
20 Bool -> Bool -> Bool
&& DigestAlgorithm
pssHashAlgorithm DigestAlgorithm -> DigestAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== DigestAlgorithm
sha1 = ASN1Stream e
forall a. a -> a
id
          | Bool
otherwise = Int -> ASN1Stream e -> ASN1Stream e
forall e. ASN1Elem e => Int -> ASN1Stream e -> ASN1Stream e
tag Int
2 (Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Integer -> ASN1Stream e) -> Integer -> ASN1Stream e
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pssSaltLength)

instance Monoid e => ParseASN1Object e PSSParams where
    parse :: ParseASN1 e PSSParams
parse = ASN1ConstructionType
-> ParseASN1 e PSSParams -> ParseASN1 e PSSParams
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e PSSParams -> ParseASN1 e PSSParams)
-> ParseASN1 e PSSParams -> ParseASN1 e PSSParams
forall a b. (a -> b) -> a -> b
$ do
        Maybe DigestAlgorithm
h <- Int
-> ParseASN1 e DigestAlgorithm
-> ParseASN1 e (Maybe DigestAlgorithm)
forall e a.
Monoid e =>
Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
0 (ASN1ConstructionType -> ParseASN1 e DigestAlgorithm
forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence)
        Maybe MaskGenerationFunc
m <- Int
-> ParseASN1 e MaskGenerationFunc
-> ParseASN1 e (Maybe MaskGenerationFunc)
forall e a.
Monoid e =>
Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
1 (ASN1ConstructionType -> ParseASN1 e MaskGenerationFunc
forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence)
        Maybe Int
s <- Int -> ParseASN1 e Int -> ParseASN1 e (Maybe Int)
forall e a.
Monoid e =>
Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
2 (ParseASN1 e Int -> ParseASN1 e (Maybe Int))
-> ParseASN1 e Int -> ParseASN1 e (Maybe Int)
forall a b. (a -> b) -> a -> b
$ do { IntVal Integer
i <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext; Int -> ParseASN1 e Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) }
        Maybe ()
_ <- Int -> ParseASN1 e () -> ParseASN1 e (Maybe ())
forall e a.
Monoid e =>
Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
3 (ParseASN1 e () -> ParseASN1 e (Maybe ()))
-> ParseASN1 e () -> ParseASN1 e (Maybe ())
forall a b. (a -> b) -> a -> b
$ do { IntVal Integer
1 <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext; () -> ParseASN1 e ()
forall (m :: * -> *) a. Monad m => a -> m a
return () }
        PSSParams -> ParseASN1 e PSSParams
forall (m :: * -> *) a. Monad m => a -> m a
return PSSParams :: DigestAlgorithm -> MaskGenerationFunc -> Int -> PSSParams
PSSParams { pssHashAlgorithm :: DigestAlgorithm
pssHashAlgorithm = DigestAlgorithm -> Maybe DigestAlgorithm -> DigestAlgorithm
forall a. a -> Maybe a -> a
fromMaybe DigestAlgorithm
sha1 Maybe DigestAlgorithm
h
                         , pssMaskGenAlgorithm :: MaskGenerationFunc
pssMaskGenAlgorithm = MaskGenerationFunc
-> Maybe MaskGenerationFunc -> MaskGenerationFunc
forall a. a -> Maybe a -> a
fromMaybe (DigestAlgorithm -> MaskGenerationFunc
MGF1 DigestAlgorithm
sha1) Maybe MaskGenerationFunc
m
                         , pssSaltLength :: Int
pssSaltLength = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
20 Maybe Int
s
                         }
      where
        sha1 :: DigestAlgorithm
sha1  = DigestProxy SHA1 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1
        tag :: Int -> ParseASN1 e a -> ParseASN1 e (Maybe a)
tag Int
i = ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e (Maybe a)
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
(Int -> SignatureType -> ShowS)
-> (SignatureType -> String)
-> ([SignatureType] -> ShowS)
-> Show SignatureType
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
(SignatureType -> SignatureType -> Bool)
-> (SignatureType -> SignatureType -> Bool) -> Eq SignatureType
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 (DigestProxy MD2 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy MD2
MD2)
             , DigestAlgorithm -> SignatureType
TypeRSA (DigestProxy MD5 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy MD5
MD5)
             , DigestAlgorithm -> SignatureType
TypeRSA (DigestProxy SHA1 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1)
             , DigestAlgorithm -> SignatureType
TypeRSA (DigestProxy SHA224 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA224
SHA224)
             , DigestAlgorithm -> SignatureType
TypeRSA (DigestProxy SHA256 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA256
SHA256)
             , DigestAlgorithm -> SignatureType
TypeRSA (DigestProxy SHA384 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA384
SHA384)
             , DigestAlgorithm -> SignatureType
TypeRSA (DigestProxy SHA512 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA512
SHA512)

             , SignatureType
TypeRSAPSS

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

             , DigestAlgorithm -> SignatureType
TypeECDSA (DigestProxy SHA1 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA1
SHA1)
             , DigestAlgorithm -> SignatureType
TypeECDSA (DigestProxy SHA224 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA224
SHA224)
             , DigestAlgorithm -> SignatureType
TypeECDSA (DigestProxy SHA256 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA256
SHA256)
             , DigestAlgorithm -> SignatureType
TypeECDSA (DigestProxy SHA384 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA384
SHA384)
             , DigestAlgorithm -> SignatureType
TypeECDSA (DigestProxy SHA512 -> DigestAlgorithm
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 = String -> OID
forall a. HasCallStack => String -> a
error (String
"Unsupported SignatureType: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SignatureType -> String
forall a. Show a => a -> String
show SignatureType
ty)

instance OIDNameable SignatureType where
    fromObjectID :: OID -> Maybe SignatureType
fromObjectID OID
oid = OIDNameableWrapper SignatureType -> SignatureType
forall a. OIDNameableWrapper a -> a
unOIDNW (OIDNameableWrapper SignatureType -> SignatureType)
-> Maybe (OIDNameableWrapper SignatureType) -> Maybe SignatureType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OID -> Maybe (OIDNameableWrapper SignatureType)
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
(Int -> SignatureAlg -> ShowS)
-> (SignatureAlg -> String)
-> ([SignatureAlg] -> ShowS)
-> Show SignatureAlg
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
(SignatureAlg -> SignatureAlg -> Bool)
-> (SignatureAlg -> SignatureAlg -> Bool) -> Eq SignatureAlg
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  = AlgorithmType SignatureAlg
SignatureType
TypeRSAAnyHash
    algorithmType (RSA DigestAlgorithm
alg)   = DigestAlgorithm -> SignatureType
TypeRSA DigestAlgorithm
alg
    algorithmType (RSAPSS PSSParams
_)  = AlgorithmType SignatureAlg
SignatureType
TypeRSAPSS
    algorithmType (DSA DigestAlgorithm
alg)   = DigestAlgorithm -> SignatureType
TypeDSA DigestAlgorithm
alg
    algorithmType (ECDSA DigestAlgorithm
alg) = DigestAlgorithm -> SignatureType
TypeECDSA DigestAlgorithm
alg
    algorithmType SignatureAlg
Ed25519     = AlgorithmType SignatureAlg
SignatureType
TypeEd25519
    algorithmType SignatureAlg
Ed448       = AlgorithmType SignatureAlg
SignatureType
TypeEd448

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

    parseParameter :: AlgorithmType SignatureAlg -> ParseASN1 e SignatureAlg
parseParameter AlgorithmType SignatureAlg
TypeRSAAnyHash   = (ASN1 -> Maybe ()) -> ParseASN1 e (Maybe ())
forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe ()
nullOrNothing ParseASN1 e (Maybe ())
-> ParseASN1 e SignatureAlg -> ParseASN1 e SignatureAlg
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SignatureAlg -> ParseASN1 e SignatureAlg
forall (m :: * -> *) a. Monad m => a -> m a
return SignatureAlg
RSAAnyHash
    parseParameter (TypeRSA alg)    = (ASN1 -> Maybe ()) -> ParseASN1 e (Maybe ())
forall e a. Monoid e => (ASN1 -> Maybe a) -> ParseASN1 e (Maybe a)
getNextMaybe ASN1 -> Maybe ()
nullOrNothing ParseASN1 e (Maybe ())
-> ParseASN1 e SignatureAlg -> ParseASN1 e SignatureAlg
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SignatureAlg -> ParseASN1 e SignatureAlg
forall (m :: * -> *) a. Monad m => a -> m a
return (DigestAlgorithm -> SignatureAlg
RSA DigestAlgorithm
alg)
    parseParameter AlgorithmType SignatureAlg
TypeRSAPSS       = PSSParams -> SignatureAlg
RSAPSS (PSSParams -> SignatureAlg)
-> ParseASN1 e PSSParams -> ParseASN1 e SignatureAlg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e PSSParams
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
    parseParameter (TypeDSA alg)    = SignatureAlg -> ParseASN1 e SignatureAlg
forall (m :: * -> *) a. Monad m => a -> m a
return (DigestAlgorithm -> SignatureAlg
DSA DigestAlgorithm
alg)
    parseParameter (TypeECDSA alg)  = SignatureAlg -> ParseASN1 e SignatureAlg
forall (m :: * -> *) a. Monad m => a -> m a
return (DigestAlgorithm -> SignatureAlg
ECDSA DigestAlgorithm
alg)
    parseParameter AlgorithmType SignatureAlg
TypeEd25519      = SignatureAlg -> ParseASN1 e SignatureAlg
forall (m :: * -> *) a. Monad m => a -> m a
return SignatureAlg
Ed25519
    parseParameter AlgorithmType SignatureAlg
TypeEd448        = SignatureAlg -> ParseASN1 e SignatureAlg
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 :: SignatureAlg
-> PrivKey
-> PubKey
-> ByteString
-> m (Either StoreError ByteString)
signatureGenerate SignatureAlg
RSAAnyHash PrivKey
_ PubKey
_ ByteString
_ =
    String -> m (Either StoreError 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 = Either StoreError ByteString -> m (Either StoreError ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ByteString -> m (Either StoreError ByteString))
-> (StoreError -> Either StoreError ByteString)
-> StoreError
-> m (Either StoreError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError ByteString
forall a b. a -> Either a b
Left (StoreError -> m (Either StoreError ByteString))
-> StoreError -> m (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ String -> StoreError
InvalidParameter (String
"Invalid hash algorithm for RSA: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DigestAlgorithm -> String
forall a. Show a => a -> String
show DigestAlgorithm
alg)
     in DigestAlgorithm
-> m (Either StoreError ByteString)
-> (forall hashAlg.
    HashAlgorithmASN1 hashAlg =>
    hashAlg -> m (Either StoreError ByteString))
-> m (Either StoreError ByteString)
forall a.
DigestAlgorithm
-> a
-> (forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a)
-> a
withHashAlgorithmASN1 DigestAlgorithm
alg m (Either StoreError ByteString)
err ((forall hashAlg.
  HashAlgorithmASN1 hashAlg =>
  hashAlg -> m (Either StoreError ByteString))
 -> m (Either StoreError ByteString))
-> (forall hashAlg.
    HashAlgorithmASN1 hashAlg =>
    hashAlg -> m (Either StoreError ByteString))
-> m (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ \hashAlg
hashAlg ->
            (Error -> StoreError)
-> Either Error ByteString -> Either StoreError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft Error -> StoreError
RSAError (Either Error ByteString -> Either StoreError ByteString)
-> m (Either Error ByteString) -> m (Either StoreError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe hashAlg
-> PrivateKey -> ByteString -> m (Either Error ByteString)
forall hashAlg (m :: * -> *).
(HashAlgorithmASN1 hashAlg, MonadRandom m) =>
Maybe hashAlg
-> PrivateKey -> ByteString -> m (Either Error ByteString)
RSA.signSafer (hashAlg -> Maybe hashAlg
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 =
    PSSParams
-> (forall hash.
    HashAlgorithm hash =>
    PSSParams hash ByteString ByteString
    -> m (Either StoreError ByteString))
-> m (Either StoreError ByteString)
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 ByteString ByteString
  -> m (Either StoreError ByteString))
 -> m (Either StoreError ByteString))
-> (forall hash.
    HashAlgorithm hash =>
    PSSParams hash ByteString ByteString
    -> m (Either StoreError ByteString))
-> m (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ \PSSParams hash ByteString ByteString
params ->
        (Error -> StoreError)
-> Either Error ByteString -> Either StoreError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft Error -> StoreError
RSAError (Either Error ByteString -> Either StoreError ByteString)
-> m (Either Error ByteString) -> m (Either StoreError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PSSParams hash ByteString ByteString
-> PrivateKey -> ByteString -> m (Either Error ByteString)
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 ->
            ByteString -> Either StoreError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either StoreError ByteString)
-> (Signature -> ByteString)
-> Signature
-> Either StoreError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
dsaFromSignature (Signature -> Either StoreError ByteString)
-> m Signature -> m (Either StoreError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrivateKey -> hashAlg -> ByteString -> m Signature
forall msg hash (m :: * -> *).
(ByteArrayAccess msg, HashAlgorithm hash, MonadRandom m) =>
PrivateKey -> hash -> msg -> m Signature
DSA.sign PrivateKey
priv (DigestProxy hashAlg -> hashAlg
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 -> Either StoreError ByteString -> m (Either StoreError ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (StoreError -> Either StoreError ByteString
forall a b. a -> Either a b
Left StoreError
UnsupportedEllipticCurve)
                Just PrivateKey
p  ->
                    let h :: hashAlg
h = DigestProxy hashAlg -> hashAlg
forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy DigestProxy hashAlg
t
                     in ByteString -> Either StoreError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either StoreError ByteString)
-> (Signature -> ByteString)
-> Signature
-> Either StoreError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
ecdsaFromSignature (Signature -> Either StoreError ByteString)
-> m Signature -> m (Either StoreError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrivateKey -> hashAlg -> ByteString -> m Signature
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 =
    Either StoreError ByteString -> m (Either StoreError ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ByteString -> m (Either StoreError ByteString))
-> (Signature -> Either StoreError ByteString)
-> Signature
-> m (Either StoreError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either StoreError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either StoreError ByteString)
-> (Signature -> ByteString)
-> Signature
-> Either StoreError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Signature -> m (Either StoreError ByteString))
-> Signature -> m (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey -> ByteString -> Signature
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 =
    Either StoreError ByteString -> m (Either StoreError ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError ByteString -> m (Either StoreError ByteString))
-> (Signature -> Either StoreError ByteString)
-> Signature
-> m (Either StoreError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either StoreError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either StoreError ByteString)
-> (Signature -> ByteString)
-> Signature
-> Either StoreError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Signature -> m (Either StoreError ByteString))
-> Signature -> m (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed448.sign SecretKey
priv PublicKey
pub ByteString
msg
signatureGenerate SignatureAlg
_ PrivKey
_ PubKey
_ ByteString
_ = Either StoreError ByteString -> m (Either StoreError ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (StoreError -> Either StoreError ByteString
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
_ =
    String -> Bool
forall a. HasCallStack => String -> a
error String
"signatureVerify: should call signatureResolveHash first"
signatureVerify (RSA DigestAlgorithm
alg)   (X509.PubKeyRSA PublicKey
pub) ByteString
msg ByteString
sig =
    DigestAlgorithm
-> Bool
-> (forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> Bool)
-> Bool
forall a.
DigestAlgorithm
-> a
-> (forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a)
-> a
withHashAlgorithmASN1 DigestAlgorithm
alg Bool
False ((forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> Bool)
 -> Bool)
-> (forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> Bool)
-> Bool
forall a b. (a -> b) -> a -> b
$ \hashAlg
hashAlg ->
        Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
RSA.verify (hashAlg -> Maybe hashAlg
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
    | PSSParams -> Bool
forall params. HasStrength params => params -> Bool
securityAcceptable PSSParams
p =
        PSSParams
-> (forall hash.
    HashAlgorithm hash =>
    PSSParams hash ByteString ByteString -> Bool)
-> Bool
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 ByteString ByteString -> Bool)
 -> Bool)
-> (forall hash.
    HashAlgorithm hash =>
    PSSParams hash ByteString ByteString -> Bool)
-> Bool
forall a b. (a -> b) -> a -> b
$ \PSSParams hash ByteString ByteString
params -> PSSParams hash ByteString ByteString
-> PublicKey -> ByteString -> ByteString -> Bool
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 = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
    Signature
s <- ByteString -> Maybe Signature
dsaToSignature ByteString
sig
    case DigestAlgorithm
alg of
        DigestAlgorithm DigestProxy hashAlg
t -> Bool -> Maybe Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ hashAlg -> PublicKey -> Signature -> ByteString -> Bool
forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
hash -> PublicKey -> Signature -> msg -> Bool
DSA.verify (DigestProxy hashAlg -> hashAlg
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 = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
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 -> Bool -> Maybe Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ hashAlg -> PublicKey -> Signature -> ByteString -> Bool
forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
hash -> PublicKey -> Signature -> msg -> Bool
ECDSA.verify (DigestProxy hashAlg -> hashAlg
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 ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature ByteString
sig of
        CryptoFailed CryptoError
_ -> Bool
False
        CryptoPassed Signature
s -> PublicKey -> ByteString -> Signature -> Bool
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 ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed448.signature ByteString
sig of
        CryptoFailed CryptoError
_ -> Bool
False
        CryptoPassed Signature
s -> PublicKey -> ByteString -> Signature -> Bool
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 :: DigestAlgorithm
-> a
-> (forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a)
-> a
withHashAlgorithmASN1 (DigestAlgorithm DigestProxy hashAlg
MD2)    a
_ forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f = MD2 -> a
forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f MD2
Hash.MD2
withHashAlgorithmASN1 (DigestAlgorithm DigestProxy hashAlg
MD5)    a
_ forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f = MD5 -> a
forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f MD5
Hash.MD5
withHashAlgorithmASN1 (DigestAlgorithm DigestProxy hashAlg
SHA1)   a
_ forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f = SHA1 -> a
forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f SHA1
Hash.SHA1
withHashAlgorithmASN1 (DigestAlgorithm DigestProxy hashAlg
SHA224) a
_ forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f = SHA224 -> a
forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f SHA224
Hash.SHA224
withHashAlgorithmASN1 (DigestAlgorithm DigestProxy hashAlg
SHA256) a
_ forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f = SHA256 -> a
forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f SHA256
Hash.SHA256
withHashAlgorithmASN1 (DigestAlgorithm DigestProxy hashAlg
SHA384) a
_ forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f = SHA384 -> a
forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f SHA384
Hash.SHA384
withHashAlgorithmASN1 (DigestAlgorithm DigestProxy hashAlg
SHA512) a
_ forall hashAlg. HashAlgorithmASN1 hashAlg => hashAlg -> a
f = SHA512 -> a
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    = (DigestProxy SHA512 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA512
SHA512, SignatureAlg
alg)
signatureResolveHash Bool
True  DigestAlgorithm
_ alg :: SignatureAlg
alg@SignatureAlg
Ed448      = (DigestProxy (SHAKE256 512) -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy (SHAKE256 512)
SHAKE256_512, SignatureAlg
alg)
signatureResolveHash Bool
False DigestAlgorithm
_ alg :: SignatureAlg
alg@SignatureAlg
Ed448      = (DigestProxy (SHAKE256 512) -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm (Proxy 512 -> DigestProxy (SHAKE256 512)
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 = SignatureAlg -> Maybe SignatureAlg
forall a. a -> Maybe a
Just (SignatureAlg -> Maybe SignatureAlg)
-> SignatureAlg -> Maybe SignatureAlg
forall a b. (a -> b) -> a -> b
$ DigestAlgorithm -> SignatureAlg
RSA DigestAlgorithm
expected
signatureCheckHash DigestAlgorithm
expected alg :: SignatureAlg
alg@(RSA DigestAlgorithm
found)
    | DigestAlgorithm
expected DigestAlgorithm -> DigestAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== DigestAlgorithm
found = SignatureAlg -> Maybe SignatureAlg
forall a. a -> Maybe a
Just SignatureAlg
alg
    | Bool
otherwise         = Maybe SignatureAlg
forall a. Maybe a
Nothing
signatureCheckHash DigestAlgorithm
expected alg :: SignatureAlg
alg@(RSAPSS PSSParams
p)
    | DigestAlgorithm
expected DigestAlgorithm -> DigestAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PSSParams -> DigestAlgorithm
pssHashAlgorithm PSSParams
p = SignatureAlg -> Maybe SignatureAlg
forall a. a -> Maybe a
Just SignatureAlg
alg
    | Bool
otherwise                      = Maybe SignatureAlg
forall a. Maybe a
Nothing
signatureCheckHash DigestAlgorithm
expected alg :: SignatureAlg
alg@(DSA DigestAlgorithm
found)
    | DigestAlgorithm
expected DigestAlgorithm -> DigestAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== DigestAlgorithm
found = SignatureAlg -> Maybe SignatureAlg
forall a. a -> Maybe a
Just SignatureAlg
alg
    | Bool
otherwise         = Maybe SignatureAlg
forall a. Maybe a
Nothing
signatureCheckHash DigestAlgorithm
expected alg :: SignatureAlg
alg@(ECDSA DigestAlgorithm
found)
    | DigestAlgorithm
expected DigestAlgorithm -> DigestAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== DigestAlgorithm
found = SignatureAlg -> Maybe SignatureAlg
forall a. a -> Maybe a
Just SignatureAlg
alg
    | Bool
otherwise         = Maybe SignatureAlg
forall a. Maybe a
Nothing
signatureCheckHash DigestAlgorithm
expected alg :: SignatureAlg
alg@SignatureAlg
Ed25519
    | DigestAlgorithm
expected DigestAlgorithm -> DigestAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== DigestProxy SHA512 -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy SHA512
SHA512 = SignatureAlg -> Maybe SignatureAlg
forall a. a -> Maybe a
Just SignatureAlg
alg
    | Bool
otherwise                          = Maybe SignatureAlg
forall a. Maybe a
Nothing
signatureCheckHash DigestAlgorithm
expected alg :: SignatureAlg
alg@SignatureAlg
Ed448
    | DigestAlgorithm
expected DigestAlgorithm -> DigestAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== DigestProxy (SHAKE256 512) -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy (SHAKE256 512)
SHAKE256_512    = SignatureAlg -> Maybe SignatureAlg
forall a. a -> Maybe a
Just SignatureAlg
alg
    | DigestAlgorithm
expected DigestAlgorithm -> DigestAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== DigestProxy (SHAKE256 512) -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm (Proxy 512 -> DigestProxy (SHAKE256 512)
forall (n :: Nat).
KnownNat n =>
Proxy n -> DigestProxy (SHAKE256 n)
SHAKE256 Proxy 512
p512) = SignatureAlg -> Maybe SignatureAlg
forall a. a -> Maybe a
Just SignatureAlg
alg
    | Bool
otherwise                                   = Maybe SignatureAlg
forall a. Maybe a
Nothing

dsaToSignature :: ByteString -> Maybe DSA.Signature
dsaToSignature :: ByteString -> Maybe Signature
dsaToSignature ByteString
b = ByteString -> ParseASN1 () Signature -> Maybe Signature
forall a. ByteString -> ParseASN1 () a -> Maybe a
tryDecodeAndParse ByteString
b (ParseASN1 () Signature -> Maybe Signature)
-> ParseASN1 () Signature -> Maybe Signature
forall a b. (a -> b) -> a -> b
$ ASN1ConstructionType
-> ParseASN1 () Signature -> ParseASN1 () Signature
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 () Signature -> ParseASN1 () Signature)
-> ParseASN1 () Signature -> ParseASN1 () Signature
forall a b. (a -> b) -> a -> b
$ do
    IntVal Integer
r <- ParseASN1 () ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    IntVal Integer
s <- ParseASN1 () ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    Signature -> ParseASN1 () Signature
forall (m :: * -> *) a. Monad m => a -> m a
return Signature :: Integer -> Integer -> Signature
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 (ASN1Stream ASN1P -> ByteString) -> ASN1Stream ASN1P -> ByteString
forall a b. (a -> b) -> a -> b
$ ASN1ConstructionType -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence
    (Integer -> ASN1Stream ASN1P
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Signature -> Integer
DSA.sign_r Signature
sig) ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ASN1Stream ASN1P
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 = ByteString -> ParseASN1 () Signature -> Maybe Signature
forall a. ByteString -> ParseASN1 () a -> Maybe a
tryDecodeAndParse ByteString
b (ParseASN1 () Signature -> Maybe Signature)
-> ParseASN1 () Signature -> Maybe Signature
forall a b. (a -> b) -> a -> b
$ ASN1ConstructionType
-> ParseASN1 () Signature -> ParseASN1 () Signature
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 () Signature -> ParseASN1 () Signature)
-> ParseASN1 () Signature -> ParseASN1 () Signature
forall a b. (a -> b) -> a -> b
$ do
    IntVal Integer
r <- ParseASN1 () ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    IntVal Integer
s <- ParseASN1 () ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    Signature -> ParseASN1 () Signature
forall (m :: * -> *) a. Monad m => a -> m a
return Signature :: Integer -> Integer -> Signature
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 (ASN1Stream ASN1P -> ByteString) -> ASN1Stream ASN1P -> ByteString
forall a b. (a -> b) -> a -> b
$ ASN1ConstructionType -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence
    (Integer -> ASN1Stream ASN1P
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Signature -> Integer
ECDSA.sign_r Signature
sig) ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ASN1Stream ASN1P
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)
    PublicKey -> Maybe PublicKey
forall (m :: * -> *) a. Monad m => a -> m a
return PublicKey :: Curve -> Point -> PublicKey
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
    PrivateKey -> Maybe PrivateKey
forall (m :: * -> *) a. Monad m => a -> m a
return PrivateKey :: Curve -> Integer -> PrivateKey
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 :: ByteString -> ParseASN1 () a -> Maybe a
tryDecodeAndParse ByteString
b ParseASN1 () a
parser =
    (String -> Maybe a) -> (a -> Maybe a) -> Either String a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> String -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Either String a -> Maybe a) -> Either String a -> Maybe a
forall a b. (a -> b) -> a -> b
$
        case BER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
b of
            Left ASN1Error
_     -> String -> Either String a
forall a b. a -> Either a b
Left String
forall a. HasCallStack => a
undefined -- value ignored
            Right [ASN1]
asn1 -> ParseASN1 () a -> [ASN1] -> Either String a
forall a. ParseASN1 () a -> [ASN1] -> Either String a
runParseASN1 ParseASN1 () a
parser [ASN1]
asn1