-- |
-- Module      : Data.Store.PKCS5.PBES1
-- License     : BSD-style
-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
-- Password-Based Encryption Schemes
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Crypto.Store.PKCS5.PBES1
    ( PBEParameter(..)
    , Key
    , pkcs5
    , pkcs12
    , pkcs12rc2
    , pkcs12stream
    , pkcs12mac
    , rc4Combine
    ) where

import           Basement.Block (Block)
import           Basement.Compat.IsList
import           Basement.Endianness
import qualified Basement.String as S

import           Crypto.Cipher.Types
import qualified Crypto.Cipher.RC4 as RC4
import qualified Crypto.Hash as Hash

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.Memory.PtrMethods
import           Data.Word

import           Foreign.Ptr (plusPtr)
import           Foreign.Storable

import Crypto.Store.ASN1.Parse
import Crypto.Store.ASN1.Generate
import Crypto.Store.CMS.Algorithms
import Crypto.Store.CMS.Util
import Crypto.Store.Error

-- | Secret key.
type Key = B.ScrubbedBytes

-- | PBES1 parameters.
data PBEParameter = PBEParameter
    { PBEParameter -> Salt
pbeSalt           :: Salt -- ^ 8-octet salt value
    , PBEParameter -> Int
pbeIterationCount :: Int  -- ^ Iteration count
    }
    deriving (Int -> PBEParameter -> ShowS
[PBEParameter] -> ShowS
PBEParameter -> String
(Int -> PBEParameter -> ShowS)
-> (PBEParameter -> String)
-> ([PBEParameter] -> ShowS)
-> Show PBEParameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBEParameter] -> ShowS
$cshowList :: [PBEParameter] -> ShowS
show :: PBEParameter -> String
$cshow :: PBEParameter -> String
showsPrec :: Int -> PBEParameter -> ShowS
$cshowsPrec :: Int -> PBEParameter -> ShowS
Show,PBEParameter -> PBEParameter -> Bool
(PBEParameter -> PBEParameter -> Bool)
-> (PBEParameter -> PBEParameter -> Bool) -> Eq PBEParameter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBEParameter -> PBEParameter -> Bool
$c/= :: PBEParameter -> PBEParameter -> Bool
== :: PBEParameter -> PBEParameter -> Bool
$c== :: PBEParameter -> PBEParameter -> Bool
Eq)

instance ASN1Elem e => ProduceASN1Object e PBEParameter where
    asn1s :: PBEParameter -> ASN1Stream e
asn1s PBEParameter{Int
Salt
pbeIterationCount :: Int
pbeSalt :: Salt
pbeIterationCount :: PBEParameter -> Int
pbeSalt :: PBEParameter -> Salt
..} =
        let salt :: ASN1Stream e
salt  = Salt -> ASN1Stream e
forall e. ASN1Elem e => Salt -> ASN1Stream e
gOctetString Salt
pbeSalt
            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
pbeIterationCount)
         in 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)

instance Monoid e => ParseASN1Object e PBEParameter where
    parse :: ParseASN1 e PBEParameter
parse = ASN1ConstructionType
-> ParseASN1 e PBEParameter -> ParseASN1 e PBEParameter
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e PBEParameter -> ParseASN1 e PBEParameter)
-> ParseASN1 e PBEParameter -> ParseASN1 e PBEParameter
forall a b. (a -> b) -> a -> b
$ do
        OctetString Salt
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
        PBEParameter -> ParseASN1 e PBEParameter
forall (m :: * -> *) a. Monad m => a -> m a
return PBEParameter :: Salt -> Int -> PBEParameter
PBEParameter { pbeSalt :: Salt
pbeSalt = Salt
salt
                            , pbeIterationCount :: Int
pbeIterationCount = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
iters }

cbcWith :: (BlockCipher cipher, ByteArrayAccess iv)
        => ContentEncryptionCipher cipher -> iv -> ContentEncryptionParams
cbcWith :: ContentEncryptionCipher cipher -> iv -> ContentEncryptionParams
cbcWith ContentEncryptionCipher cipher
cipher iv
iv = ContentEncryptionCipher cipher
-> IV cipher -> ContentEncryptionParams
forall c.
BlockCipher c =>
ContentEncryptionCipher c -> IV c -> ContentEncryptionParams
ParamsCBC ContentEncryptionCipher cipher
cipher IV cipher
getIV
  where
    getIV :: IV cipher
getIV = IV cipher -> Maybe (IV cipher) -> IV cipher
forall a. a -> Maybe a -> a
fromMaybe (String -> IV cipher
forall a. HasCallStack => String -> a
error String
"PKCS5: bad initialization vector") (iv -> Maybe (IV cipher)
forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV iv
iv)

rc2cbcWith :: ByteArrayAccess iv => Int -> iv -> ContentEncryptionParams
rc2cbcWith :: Int -> iv -> ContentEncryptionParams
rc2cbcWith Int
len iv
iv = Int -> IV RC2 -> ContentEncryptionParams
ParamsCBCRC2 Int
len IV RC2
getIV
  where
    getIV :: IV RC2
getIV = IV RC2 -> Maybe (IV RC2) -> IV RC2
forall a. a -> Maybe a -> a
fromMaybe (String -> IV RC2
forall a. HasCallStack => String -> a
error String
"PKCS5: bad RC2 initialization vector") (iv -> Maybe (IV RC2)
forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV iv
iv)

-- | RC4 encryption or decryption.
rc4Combine :: (ByteArrayAccess key, ByteArray ba) => key -> ba -> Either StoreError ba
rc4Combine :: key -> ba -> Either StoreError ba
rc4Combine key
key = ba -> Either StoreError ba
forall a b. b -> Either a b
Right (ba -> Either StoreError ba)
-> (ba -> ba) -> ba -> Either StoreError ba
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State, ba) -> ba
forall a b. (a, b) -> b
snd ((State, ba) -> ba) -> (ba -> (State, ba)) -> ba -> ba
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> ba -> (State, ba)
forall ba. ByteArray ba => State -> ba -> (State, ba)
RC4.combine (key -> State
forall key. ByteArrayAccess key => key -> State
RC4.initialize key
key)

-- | Conversion to UCS2 from UTF-8, ignoring non-BMP bits.
toUCS2 :: (ByteArrayAccess butf8, ByteArray bucs2) => butf8 -> Maybe bucs2
toUCS2 :: butf8 -> Maybe bucs2
toUCS2 butf8
pwdUTF8
    | UArray Word8 -> Bool
forall a. ByteArrayAccess a => a -> Bool
B.null UArray Word8
r  = bucs2 -> Maybe bucs2
forall a. a -> Maybe a
Just bucs2
pwdUCS2
    | Bool
otherwise = Maybe bucs2
forall a. Maybe a
Nothing
  where
    (String
p, Maybe ValidationFailure
_, UArray Word8
r) = Encoding
-> UArray Word8 -> (String, Maybe ValidationFailure, UArray Word8)
S.fromBytes Encoding
S.UTF8 (UArray Word8 -> (String, Maybe ValidationFailure, UArray Word8))
-> UArray Word8 -> (String, Maybe ValidationFailure, UArray Word8)
forall a b. (a -> b) -> a -> b
$ UArray Word8 -> Word8 -> UArray Word8
forall a. ByteArray a => a -> Word8 -> a
B.snoc (butf8 -> UArray Word8
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert butf8
pwdUTF8) Word8
0
    pwdBlock :: Block (BE Word16)
pwdBlock  = [Item (Block (BE Word16))] -> Block (BE Word16)
forall l. IsList l => [Item l] -> l
fromList ([Item (Block (BE Word16))] -> Block (BE Word16))
-> [Item (Block (BE Word16))] -> Block (BE Word16)
forall a b. (a -> b) -> a -> b
$ (Char -> BE Word16) -> String -> [BE Word16]
forall a b. (a -> b) -> [a] -> [b]
map Char -> BE Word16
ucs2 (String -> [BE Word16]) -> String -> [BE Word16]
forall a b. (a -> b) -> a -> b
$ String -> [Item String]
forall l. IsList l => l -> [Item l]
toList String
p :: Block (BE Word16)
    pwdUCS2 :: bucs2
pwdUCS2   = Block (BE Word16) -> bucs2
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert Block (BE Word16)
pwdBlock

    ucs2 :: Char -> BE Word16
    ucs2 :: Char -> BE Word16
ucs2 = Word16 -> BE Word16
forall a. ByteSwap a => a -> BE a
toBE (Word16 -> BE Word16) -> (Char -> Word16) -> Char -> BE Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word16
forall a. Enum a => Int -> a
toEnum (Int -> Word16) -> (Char -> Int) -> Char -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum


-- PBES1, RFC 8018 section 6.1.2

-- | Apply PBKDF1 on the specified password and run an encryption or decryption
-- function on some input using derived key and IV.
pkcs5 :: (Hash.HashAlgorithm hash, BlockCipher cipher, ByteArrayAccess password)
      => (StoreError -> result)
      -> (Key -> ContentEncryptionParams -> ByteString -> result)
      -> DigestProxy hash
      -> ContentEncryptionCipher cipher
      -> PBEParameter
      -> ByteString
      -> password
      -> result
pkcs5 :: (StoreError -> result)
-> (Key -> ContentEncryptionParams -> Salt -> result)
-> DigestProxy hash
-> ContentEncryptionCipher cipher
-> PBEParameter
-> Salt
-> password
-> result
pkcs5 StoreError -> result
failure Key -> ContentEncryptionParams -> Salt -> result
encdec DigestProxy hash
hashAlg ContentEncryptionCipher cipher
cec PBEParameter
pbeParam Salt
bs password
pwd
    | ContentEncryptionCipher cipher -> Int
forall cipher (proxy :: * -> *).
BlockCipher cipher =>
proxy cipher -> Int
proxyBlockSize ContentEncryptionCipher cipher
cec Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
8 = StoreError -> result
failure (String -> StoreError
InvalidParameter String
"Invalid cipher block size")
    | Bool
otherwise =
        case DigestProxy hash
-> password -> PBEParameter -> Int -> Either StoreError Key
forall hash password out.
(HashAlgorithm hash, ByteArrayAccess password, ByteArray out) =>
DigestProxy hash
-> password -> PBEParameter -> Int -> Either StoreError out
pbkdf1 DigestProxy hash
hashAlg password
pwd PBEParameter
pbeParam Int
16 of
            Left StoreError
err -> StoreError -> result
failure StoreError
err
            Right Key
dk ->
                let (Key
key, Key
iv) = Int -> Key -> (Key, Key)
forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt Int
8 (Key
dk :: Key)
                 in Key -> ContentEncryptionParams -> Salt -> result
encdec Key
key (ContentEncryptionCipher cipher -> Key -> ContentEncryptionParams
forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
ContentEncryptionCipher cipher -> iv -> ContentEncryptionParams
cbcWith ContentEncryptionCipher cipher
cec Key
iv) Salt
bs


-- PBKDF1, RFC 8018 section 5.1

pbkdf1 :: (Hash.HashAlgorithm hash, ByteArrayAccess password, ByteArray out)
       => DigestProxy hash
       -> password
       -> PBEParameter
       -> Int
       -> Either StoreError out
pbkdf1 :: DigestProxy hash
-> password -> PBEParameter -> Int -> Either StoreError out
pbkdf1 DigestProxy hash
hashAlg password
pwd PBEParameter{Int
Salt
pbeIterationCount :: Int
pbeSalt :: Salt
pbeIterationCount :: PBEParameter -> Int
pbeSalt :: PBEParameter -> Salt
..} Int
dkLen
    | Int
dkLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Digest hash -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length Digest hash
t1 = StoreError -> Either StoreError out
forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"Derived key too long")
    | Bool
otherwise           = out -> Either StoreError out
forall a b. b -> Either a b
Right (View (Digest hash) -> out
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (View (Digest hash) -> out) -> View (Digest hash) -> out
forall a b. (a -> b) -> a -> b
$ Digest hash -> Int -> View (Digest hash)
forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
B.takeView Digest hash
tc Int
dkLen)
  where
    a :: hash
a  = DigestProxy hash -> hash
forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy DigestProxy hash
hashAlg
    t1 :: Digest hash
t1 = Context hash -> Digest hash
forall a. HashAlgorithm a => Context a -> Digest a
Hash.hashFinalize (Context hash -> Salt -> Context hash
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
Hash.hashUpdate (Context hash -> password -> Context hash
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
Hash.hashUpdate (hash -> Context hash
forall alg. HashAlgorithm alg => alg -> Context alg
Hash.hashInitWith hash
a) password
pwd) Salt
pbeSalt)
    tc :: Digest hash
tc = (Digest hash -> Digest hash) -> Digest hash -> [Digest hash]
forall a. (a -> a) -> a -> [a]
iterate (hash -> Digest hash -> Digest hash
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
Hash.hashWith hash
a) Digest hash
t1 [Digest hash] -> Int -> Digest hash
forall a. [a] -> Int -> a
!! Int -> Int
forall a. Enum a => a -> a
pred Int
pbeIterationCount


-- PKCS#12 encryption, RFC 7292 appendix B.2

-- | Apply PKCS #12 derivation on the specified password and run an encryption
-- or decryption function on some input using derived key and IV.
pkcs12 :: (Hash.HashAlgorithm hash, BlockCipher cipher, ByteArrayAccess password)
       => (StoreError -> result)
       -> (Key -> ContentEncryptionParams -> ByteString -> result)
       -> DigestProxy hash
       -> ContentEncryptionCipher cipher
       -> PBEParameter
       -> ByteString
       -> password
       -> result
pkcs12 :: (StoreError -> result)
-> (Key -> ContentEncryptionParams -> Salt -> result)
-> DigestProxy hash
-> ContentEncryptionCipher cipher
-> PBEParameter
-> Salt
-> password
-> result
pkcs12 StoreError -> result
failure Key -> ContentEncryptionParams -> Salt -> result
encdec DigestProxy hash
hashAlg ContentEncryptionCipher cipher
cec PBEParameter
pbeParam Salt
bs password
pwdUTF8 =
    case password -> Maybe Salt
forall butf8 bucs2.
(ByteArrayAccess butf8, ByteArray bucs2) =>
butf8 -> Maybe bucs2
toUCS2 password
pwdUTF8 of
        Maybe Salt
Nothing      -> StoreError -> result
failure StoreError
passwordNotUTF8
        Just Salt
pwdUCS2 ->
            let ivLen :: Int
ivLen   = ContentEncryptionCipher cipher -> Int
forall cipher (proxy :: * -> *).
BlockCipher cipher =>
proxy cipher -> Int
proxyBlockSize ContentEncryptionCipher cipher
cec
                iv :: Bytes
iv      = DigestProxy hash -> PBEParameter -> Word8 -> Salt -> Int -> Bytes
forall hash bout.
(HashAlgorithm hash, ByteArray bout) =>
DigestProxy hash -> PBEParameter -> Word8 -> Salt -> Int -> bout
pkcs12Derive DigestProxy hash
hashAlg PBEParameter
pbeParam Word8
2 Salt
pwdUCS2 Int
ivLen :: B.Bytes
                eScheme :: ContentEncryptionParams
eScheme = ContentEncryptionCipher cipher -> Bytes -> ContentEncryptionParams
forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
ContentEncryptionCipher cipher -> iv -> ContentEncryptionParams
cbcWith ContentEncryptionCipher cipher
cec Bytes
iv
                keyLen :: Int
keyLen  = ContentEncryptionParams -> Int
forall params. HasKeySize params => params -> Int
getMaximumKeySize ContentEncryptionParams
eScheme
                key :: Key
key     = DigestProxy hash -> PBEParameter -> Word8 -> Salt -> Int -> Key
forall hash bout.
(HashAlgorithm hash, ByteArray bout) =>
DigestProxy hash -> PBEParameter -> Word8 -> Salt -> Int -> bout
pkcs12Derive DigestProxy hash
hashAlg PBEParameter
pbeParam Word8
1 Salt
pwdUCS2 Int
keyLen :: Key
            in Key -> ContentEncryptionParams -> Salt -> result
encdec Key
key ContentEncryptionParams
eScheme Salt
bs

-- | Apply PKCS #12 derivation on the specified password and run an encryption
-- or decryption function on some input using derived key and IV.  This variant
-- uses an RC2 cipher with the EKL specified (effective key length).
pkcs12rc2 :: (Hash.HashAlgorithm hash, ByteArrayAccess password)
          => (StoreError -> result)
          -> (Key -> ContentEncryptionParams -> ByteString -> result)
          -> DigestProxy hash
          -> Int
          -> PBEParameter
          -> ByteString
          -> password
          -> result
pkcs12rc2 :: (StoreError -> result)
-> (Key -> ContentEncryptionParams -> Salt -> result)
-> DigestProxy hash
-> Int
-> PBEParameter
-> Salt
-> password
-> result
pkcs12rc2 StoreError -> result
failure Key -> ContentEncryptionParams -> Salt -> result
encdec DigestProxy hash
hashAlg Int
len PBEParameter
pbeParam Salt
bs password
pwdUTF8 =
    case password -> Maybe Salt
forall butf8 bucs2.
(ByteArrayAccess butf8, ByteArray bucs2) =>
butf8 -> Maybe bucs2
toUCS2 password
pwdUTF8 of
        Maybe Salt
Nothing      -> StoreError -> result
failure StoreError
passwordNotUTF8
        Just Salt
pwdUCS2 ->
            let ivLen :: Int
ivLen   = Int
8
                iv :: Bytes
iv      = DigestProxy hash -> PBEParameter -> Word8 -> Salt -> Int -> Bytes
forall hash bout.
(HashAlgorithm hash, ByteArray bout) =>
DigestProxy hash -> PBEParameter -> Word8 -> Salt -> Int -> bout
pkcs12Derive DigestProxy hash
hashAlg PBEParameter
pbeParam Word8
2 Salt
pwdUCS2 Int
ivLen :: B.Bytes
                eScheme :: ContentEncryptionParams
eScheme = Int -> Bytes -> ContentEncryptionParams
forall iv.
ByteArrayAccess iv =>
Int -> iv -> ContentEncryptionParams
rc2cbcWith Int
len Bytes
iv
                keyLen :: Int
keyLen  = ContentEncryptionParams -> Int
forall params. HasKeySize params => params -> Int
getMaximumKeySize ContentEncryptionParams
eScheme
                key :: Key
key     = DigestProxy hash -> PBEParameter -> Word8 -> Salt -> Int -> Key
forall hash bout.
(HashAlgorithm hash, ByteArray bout) =>
DigestProxy hash -> PBEParameter -> Word8 -> Salt -> Int -> bout
pkcs12Derive DigestProxy hash
hashAlg PBEParameter
pbeParam Word8
1 Salt
pwdUCS2 Int
keyLen :: Key
            in Key -> ContentEncryptionParams -> Salt -> result
encdec Key
key ContentEncryptionParams
eScheme Salt
bs

-- | Apply PKCS #12 derivation on the specified password and run an encryption
-- or decryption function on some input using derived key.  This variant does
-- not derive any IV and is required for RC4.
pkcs12stream :: (Hash.HashAlgorithm hash, ByteArrayAccess password)
             => (StoreError -> result)
             -> (Key -> ByteString -> result)
             -> DigestProxy hash
             -> Int
             -> PBEParameter
             -> ByteString
             -> password
             -> result
pkcs12stream :: (StoreError -> result)
-> (Key -> Salt -> result)
-> DigestProxy hash
-> Int
-> PBEParameter
-> Salt
-> password
-> result
pkcs12stream StoreError -> result
failure Key -> Salt -> result
encdec DigestProxy hash
hashAlg Int
keyLen PBEParameter
pbeParam Salt
bs password
pwdUTF8 =
    case password -> Maybe Salt
forall butf8 bucs2.
(ByteArrayAccess butf8, ByteArray bucs2) =>
butf8 -> Maybe bucs2
toUCS2 password
pwdUTF8 of
        Maybe Salt
Nothing      -> StoreError -> result
failure StoreError
passwordNotUTF8
        Just Salt
pwdUCS2 ->
            let key :: Key
key = DigestProxy hash -> PBEParameter -> Word8 -> Salt -> Int -> Key
forall hash bout.
(HashAlgorithm hash, ByteArray bout) =>
DigestProxy hash -> PBEParameter -> Word8 -> Salt -> Int -> bout
pkcs12Derive DigestProxy hash
hashAlg PBEParameter
pbeParam Word8
1 Salt
pwdUCS2 Int
keyLen :: Key
             in Key -> Salt -> result
encdec Key
key Salt
bs

-- | Apply PKCS #12 derivation on the specified password and run a MAC function
-- on some input using derived key.
pkcs12mac :: (Hash.HashAlgorithm hash, ByteArrayAccess password)
          => (StoreError -> result)
          -> (Key -> MACAlgorithm -> ByteString -> result)
          -> DigestProxy hash
          -> PBEParameter
          -> ByteString
          -> password
          -> result
pkcs12mac :: (StoreError -> result)
-> (Key -> MACAlgorithm -> Salt -> result)
-> DigestProxy hash
-> PBEParameter
-> Salt
-> password
-> result
pkcs12mac StoreError -> result
failure Key -> MACAlgorithm -> Salt -> result
macFn DigestProxy hash
hashAlg PBEParameter
pbeParam Salt
bs password
pwdUTF8 =
    case password -> Maybe Salt
forall butf8 bucs2.
(ByteArrayAccess butf8, ByteArray bucs2) =>
butf8 -> Maybe bucs2
toUCS2 password
pwdUTF8 of
        Maybe Salt
Nothing      -> StoreError -> result
failure StoreError
passwordNotUTF8
        Just Salt
pwdUCS2 ->
            let macAlg :: MACAlgorithm
macAlg = DigestProxy hash -> MACAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> MACAlgorithm
HMAC DigestProxy hash
hashAlg
                keyLen :: Int
keyLen = MACAlgorithm -> Int
forall params. HasKeySize params => params -> Int
getMaximumKeySize MACAlgorithm
macAlg
                key :: Key
key    = DigestProxy hash -> PBEParameter -> Word8 -> Salt -> Int -> Key
forall hash bout.
(HashAlgorithm hash, ByteArray bout) =>
DigestProxy hash -> PBEParameter -> Word8 -> Salt -> Int -> bout
pkcs12Derive DigestProxy hash
hashAlg PBEParameter
pbeParam Word8
3 Salt
pwdUCS2 Int
keyLen :: Key
            in Key -> MACAlgorithm -> Salt -> result
macFn Key
key MACAlgorithm
macAlg Salt
bs

passwordNotUTF8 :: StoreError
passwordNotUTF8 :: StoreError
passwordNotUTF8 = String -> StoreError
InvalidPassword String
"Provided password is not valid UTF-8"

pkcs12Derive :: (Hash.HashAlgorithm hash, ByteArray bout)
             => DigestProxy hash
             -> PBEParameter
             -> Word8
             -> ByteString -- password (UCS2)
             -> Int
             -> bout
pkcs12Derive :: DigestProxy hash -> PBEParameter -> Word8 -> Salt -> Int -> bout
pkcs12Derive DigestProxy hash
hashAlg PBEParameter{Int
Salt
pbeIterationCount :: Int
pbeSalt :: Salt
pbeIterationCount :: PBEParameter -> Int
pbeSalt :: PBEParameter -> Salt
..} Word8
idByte Salt
pwdUCS2 Int
n =
    Int -> bout -> bout
forall bs. ByteArray bs => Int -> bs -> bs
B.take Int
n (bout -> bout) -> bout -> bout
forall a b. (a -> b) -> a -> b
$ [Digest hash] -> bout
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat ([Digest hash] -> bout) -> [Digest hash] -> bout
forall a b. (a -> b) -> a -> b
$ Int -> [Digest hash] -> [Digest hash]
forall a. Int -> [a] -> [a]
take Int
c ([Digest hash] -> [Digest hash]) -> [Digest hash] -> [Digest hash]
forall a b. (a -> b) -> a -> b
$ Context hash -> Salt -> [Digest hash]
forall hash.
HashAlgorithm hash =>
Context hash -> Salt -> [Digest hash]
loop Context hash
t (Salt
s Salt -> Salt -> Salt
forall bs. ByteArray bs => bs -> bs -> bs
`B.append` Salt
p)
  where
    a :: hash
a = DigestProxy hash -> hash
forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy DigestProxy hash
hashAlg
    v :: Int
v = DigestAlgorithm -> Int
getV (DigestProxy hash -> DigestAlgorithm
forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy hash
hashAlg)
    u :: Int
u = hash -> Int
forall a. HashAlgorithm a => a -> Int
Hash.hashDigestSize hash
a

    c :: Int
c = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
u
    d :: Bytes
d = Int -> Word8 -> Bytes
forall ba. ByteArray ba => Int -> Word8 -> ba
B.replicate Int
v Word8
idByte :: B.Bytes
    t :: Context hash
t = Context hash -> Bytes -> Context hash
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
Hash.hashUpdate (hash -> Context hash
forall alg. HashAlgorithm alg => alg -> Context alg
Hash.hashInitWith hash
a) Bytes
d

    p :: Salt
p = Salt
pwdUCS2 Salt -> Int -> Salt
forall ba. ByteArray ba => ba -> Int -> ba
`extendedToMult` Int
v
    s :: Salt
s = Salt
pbeSalt Salt -> Int -> Salt
forall ba. ByteArray ba => ba -> Int -> ba
`extendedToMult` Int
v

    loop :: Hash.HashAlgorithm hash
         => Hash.Context hash -> ByteString -> [Hash.Digest hash]
    loop :: Context hash -> Salt -> [Digest hash]
loop Context hash
x Salt
i = let z :: Digest hash
z  = Context hash -> Digest hash
forall a. HashAlgorithm a => Context a -> Digest a
Hash.hashFinalize (Context hash -> Salt -> Context hash
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
Hash.hashUpdate Context hash
x Salt
i)
                   ai :: Digest hash
ai = (Digest hash -> Digest hash) -> Digest hash -> [Digest hash]
forall a. (a -> a) -> a -> [a]
iterate Digest hash -> Digest hash
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Hash.hash Digest hash
z [Digest hash] -> Int -> Digest hash
forall a. [a] -> Int -> a
!! Int -> Int
forall a. Enum a => a -> a
pred Int
pbeIterationCount
                   b :: Salt
b  = Digest hash
ai Digest hash -> Int -> Salt
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> Int -> bout
`extendedTo` Int
v
                   j :: Salt
j  = [Salt] -> Salt
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat ([Salt] -> Salt) -> [Salt] -> Salt
forall a b. (a -> b) -> a -> b
$ (Salt -> Salt) -> [Salt] -> [Salt]
forall a b. (a -> b) -> [a] -> [b]
map (Salt -> Salt -> Salt
add1 Salt
b) (Int -> Salt -> [Salt]
forall ba. ByteArray ba => Int -> ba -> [ba]
chunks Int
v Salt
i)
                in Digest hash
ai Digest hash -> [Digest hash] -> [Digest hash]
forall a. a -> [a] -> [a]
: Context hash -> Salt -> [Digest hash]
forall hash.
HashAlgorithm hash =>
Context hash -> Salt -> [Digest hash]
loop Context hash
x Salt
j

getV :: DigestAlgorithm -> Int
getV :: DigestAlgorithm -> Int
getV (DigestAlgorithm DigestProxy hashAlg
MD2)    = Int
64
getV (DigestAlgorithm DigestProxy hashAlg
MD4)    = Int
64
getV (DigestAlgorithm DigestProxy hashAlg
MD5)    = Int
64
getV (DigestAlgorithm DigestProxy hashAlg
SHA1)   = Int
64
getV (DigestAlgorithm DigestProxy hashAlg
SHA224) = Int
64
getV (DigestAlgorithm DigestProxy hashAlg
SHA256) = Int
64
getV (DigestAlgorithm DigestProxy hashAlg
SHA384) = Int
128
getV (DigestAlgorithm DigestProxy hashAlg
SHA512) = Int
128
getV DigestAlgorithm
t                        = String -> Int
forall a. HasCallStack => String -> a
error (String
"pkcs12Derive: unsupported hash: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DigestAlgorithm -> String
forall a. Show a => a -> String
show DigestAlgorithm
t)

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

-- Split in chunks of size 'n'
chunks :: ByteArray ba => Int -> ba -> [ba]
chunks :: Int -> ba -> [ba]
chunks Int
n ba
bs
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n   = let (ba
c, ba
cs) = Int -> ba -> (ba, ba)
forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt Int
n ba
bs in ba
c ba -> [ba] -> [ba]
forall a. a -> [a] -> [a]
: Int -> ba -> [ba]
forall ba. ByteArray ba => Int -> ba -> [ba]
chunks Int
n ba
cs
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0   = [ba
bs]
    | Bool
otherwise = []
  where
    len :: Int
len = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs

-- Concatenate copies of input 'bs' to create output of length 'n'
-- bytes (the final copy may be truncated)
extendedTo :: (ByteArrayAccess bin, ByteArray bout) => bin -> Int -> bout
bin
bs extendedTo :: bin -> Int -> bout
`extendedTo` Int
n =
    Int -> (Ptr Any -> IO ()) -> bout
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
n ((Ptr Any -> IO ()) -> bout) -> (Ptr Any -> IO ()) -> bout
forall a b. (a -> b) -> a -> b
$ \Ptr Any
pout ->
        bin -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray bin
bs ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pin -> do
            (Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Int
off -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memCopy (Ptr Any
pout Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off) Ptr Word8
pin Int
len)
                  (Int -> Int -> Int -> [Int]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo Int
0 Int
len (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len))
            Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memCopy (Ptr Any
pout Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r)) Ptr Word8
pin Int
r
  where
    len :: Int
len = bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
bs
    r :: Int
r   = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
len
{-# NOINLINE extendedTo #-}

-- Concatenate copies of input 'bs' to create output whose length is a
-- multiple of 'n' bytes (the final copy may be truncated).  If input
-- is the empty string, so is the output.
extendedToMult :: ByteArray ba => ba -> Int -> ba
ba
bs extendedToMult :: ba -> Int -> ba
`extendedToMult` Int
n
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n   = ba
bs ba -> ba -> ba
forall bs. ByteArray bs => bs -> bs -> bs
`B.append` Int -> ba -> ba
forall bs. ByteArray bs => Int -> bs -> bs
B.take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n) ba
bs
    | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n  = ba
bs
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0   = ba
bs ba -> Int -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> Int -> bout
`extendedTo` Int
n
    | Bool
otherwise = ba
forall a. ByteArray a => a
B.empty
  where
    len :: Int
len = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs

-- Add two bytearrays (considered as big-endian integers) and increment the
-- result.  Output has size of the first bytearray.
add1 :: ByteString -> ByteString -> ByteString
add1 :: Salt -> Salt -> Salt
add1 Salt
a Salt
b =
    Int -> (Ptr Word8 -> IO ()) -> Salt
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
alen ((Ptr Word8 -> IO ()) -> Salt) -> (Ptr Word8 -> IO ()) -> Salt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pc ->
        Salt -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray Salt
a ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pa ->
        Salt -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray Salt
b ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pb ->
            Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> Int -> Word8 -> IO ()
loop3 Ptr Word8
pa Ptr Word8
pb Ptr Word8
pc Int
alen Int
blen Word8
1
  where
    alen :: Int
alen = Salt -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length Salt
a
    blen :: Int
blen = Salt -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length Salt
b

    -- main loop when both 'a' and 'b' have remaining bytes
    loop3 :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> Int -> Word8 -> IO ()
loop3 !Ptr Word8
pa !Ptr Word8
pb !Ptr Word8
pc !Int
ma !Int
mb !Word8
c
        | Int
ma Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Int
mb Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   = Ptr Word8 -> Ptr Word8 -> Int -> Word8 -> IO ()
loop2 Ptr Word8
pa Ptr Word8
pc Int
ma Word8
c
        | Bool
otherwise = do
            let na :: Int
na = Int -> Int
forall a. Enum a => a -> a
pred Int
ma
                nb :: Int
nb = Int -> Int
forall a. Enum a => a -> a
pred Int
mb
            Word8
ba <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
pa Int
na
            Word8
bb <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
pb Int
nb
            let (Word8
cc, Word8
bc) = Word8 -> Word8 -> Word8 -> (Word8, Word8)
carryAdd3 Word8
c Word8
ba Word8
bb
            Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
pc Int
na Word8
bc
            Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> Int -> Word8 -> IO ()
loop3 Ptr Word8
pa Ptr Word8
pb Ptr Word8
pc Int
na Int
nb Word8
cc

    -- when 'b' is smaller and bytes are exhausted we propagate
    -- carry on 'a' alone
    loop2 :: Ptr Word8 -> Ptr Word8 -> Int -> Word8 -> IO ()
loop2 !Ptr Word8
pa !Ptr Word8
pc !Int
ma !Word8
c
        | Int
ma Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = do
            let na :: Int
na = Int -> Int
forall a. Enum a => a -> a
pred Int
ma
            Word8
ba <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
pa Int
na
            let (Word8
cc, Word8
bc) = Word8 -> Word8 -> (Word8, Word8)
carryAdd2 Word8
c Word8
ba
            Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
pc Int
na Word8
bc
            Ptr Word8 -> Ptr Word8 -> Int -> Word8 -> IO ()
loop2 Ptr Word8
pa Ptr Word8
pc Int
na Word8
cc

split16 :: Word16 -> (Word8, Word8)
split16 :: Word16 -> (Word8, Word8)
split16 Word16
x = (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
x Int
8), Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x)

carryAdd2 :: Word8 -> Word8 -> (Word8, Word8)
carryAdd2 :: Word8 -> Word8 -> (Word8, Word8)
carryAdd2 Word8
a Word8
b = Word16 -> (Word8, Word8)
split16 (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b)

carryAdd3 :: Word8 -> Word8 -> Word8 -> (Word8, Word8)
carryAdd3 :: Word8 -> Word8 -> Word8 -> (Word8, Word8)
carryAdd3 Word8
a Word8
b Word8
c = Word16 -> (Word8, Word8)
split16 (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c)