-- |
-- 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
    , ProtectionPassword
    , emptyNotTerminated
    , fromProtectionPassword
    , toProtectionPassword
    , toProtectionPasswords
    , 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.String (IsString(..))
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

-- | A password stored as a sequence of UTF-8 bytes.
--
-- Some key-derivation functions add restrictions to what characters
-- are supported.
--
-- The data type provides a special value 'emptyNotTerminated' that is used
-- as alternate representation of empty passwords on some systems and that
-- produces encryption results different than an empty bytearray.
--
-- Conversion to/from a regular sequence of bytes is possible with functions
-- 'toProtectionPassword' and 'fromProtectionPassword'.
--
-- Beware: the 'fromString' implementation correctly handles multi-byte
-- characters, so here is not equivalent to the 'ByteString' counterpart.
data ProtectionPassword = NullPassword | PasswordUTF8 ByteString
    deriving ProtectionPassword -> ProtectionPassword -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtectionPassword -> ProtectionPassword -> Bool
$c/= :: ProtectionPassword -> ProtectionPassword -> Bool
== :: ProtectionPassword -> ProtectionPassword -> Bool
$c== :: ProtectionPassword -> ProtectionPassword -> Bool
Eq

instance Show ProtectionPassword where
    showsPrec :: Int -> ProtectionPassword -> ShowS
showsPrec Int
_ ProtectionPassword
NullPassword     = String -> ShowS
showString String
"emptyNotTerminated"
    showsPrec Int
d (PasswordUTF8 ByteString
b) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"toProtectionPassword " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ByteString
b

instance IsString ProtectionPassword where
    fromString :: String -> ProtectionPassword
fromString = ByteString -> ProtectionPassword
PasswordUTF8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> String -> UArray Word8
S.toBytes Encoding
S.UTF8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

instance ByteArrayAccess ProtectionPassword where
    length :: ProtectionPassword -> Int
length = forall a. a -> (ByteString -> a) -> ProtectionPassword -> a
applyPP Int
0 forall ba. ByteArrayAccess ba => ba -> Int
B.length
    withByteArray :: forall p a. ProtectionPassword -> (Ptr p -> IO a) -> IO a
withByteArray = forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtectionPassword -> ByteString
fromProtectionPassword

applyPP :: a -> (ByteString -> a) -> ProtectionPassword -> a
applyPP :: forall a. a -> (ByteString -> a) -> ProtectionPassword -> a
applyPP a
d ByteString -> a
_ ProtectionPassword
NullPassword     = a
d
applyPP a
_ ByteString -> a
f (PasswordUTF8 ByteString
b) = ByteString -> a
f ByteString
b

-- | A value denoting an empty password, but having a special encoding when
-- deriving a symmetric key on some systems, like the certificate export
-- wizard on Windows.
--
-- This value is different from @'toProtectionPassword ""'@ and can be tried
-- when decrypting content with a password known to be empty.
emptyNotTerminated :: ProtectionPassword
emptyNotTerminated :: ProtectionPassword
emptyNotTerminated = ProtectionPassword
NullPassword

-- | Extract the UTF-8 bytes in a password value.
fromProtectionPassword :: ProtectionPassword -> ByteString
fromProtectionPassword :: ProtectionPassword -> ByteString
fromProtectionPassword = forall a. a -> (ByteString -> a) -> ProtectionPassword -> a
applyPP forall a. ByteArray a => a
B.empty forall a. a -> a
id

-- | Build a password value from a sequence of UTF-8 bytes.
--
-- When the password is empty, the special value 'emptyNotTerminated' may
-- be tried as well.
toProtectionPassword :: ByteString -> ProtectionPassword
toProtectionPassword :: ByteString -> ProtectionPassword
toProtectionPassword = ByteString -> ProtectionPassword
PasswordUTF8

toProtectionPasswords :: ByteString -> [ProtectionPassword]
toProtectionPasswords :: ByteString -> [ProtectionPassword]
toProtectionPasswords ByteString
bs
    | forall a. ByteArrayAccess a => a -> Bool
B.null ByteString
bs = [ByteString -> ProtectionPassword
PasswordUTF8 forall a. ByteArray a => a
B.empty, ProtectionPassword
NullPassword]
    | Bool
otherwise = [ByteString -> ProtectionPassword
PasswordUTF8 ByteString
bs]

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

-- | PBES1 parameters.
data PBEParameter = PBEParameter
    { PBEParameter -> ByteString
pbeSalt           :: Salt -- ^ 8-octet salt value
    , PBEParameter -> Int
pbeIterationCount :: Int  -- ^ Iteration count
    }
    deriving (Int -> PBEParameter -> ShowS
[PBEParameter] -> ShowS
PBEParameter -> String
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
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
ByteString
pbeIterationCount :: Int
pbeSalt :: ByteString
pbeIterationCount :: PBEParameter -> Int
pbeSalt :: PBEParameter -> ByteString
..} =
        let salt :: ASN1Stream e
salt  = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
pbeSalt
            iters :: ASN1Stream e
iters = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (forall a. Integral a => a -> Integer
toInteger Int
pbeIterationCount)
         in forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
salt 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 = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
        OctetString ByteString
salt <- forall e. Monoid e => ParseASN1 e ASN1
getNext
        IntVal Integer
iters <- forall e. Monoid e => ParseASN1 e ASN1
getNext
        forall (m :: * -> *) a. Monad m => a -> m a
return PBEParameter { pbeSalt :: ByteString
pbeSalt = ByteString
salt
                            , pbeIterationCount :: Int
pbeIterationCount = forall a. Num a => Integer -> a
fromInteger Integer
iters }

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

rc2cbcWith :: ByteArrayAccess iv => Int -> iv -> ContentEncryptionParams
rc2cbcWith :: forall iv.
ByteArrayAccess iv =>
Int -> iv -> ContentEncryptionParams
rc2cbcWith Int
len iv
iv = Int -> IV RC2 -> ContentEncryptionParams
ParamsCBCRC2 Int
len IV RC2
getIV
  where
    getIV :: IV RC2
getIV = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"PKCS5: bad RC2 initialization vector") (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 :: forall key ba.
(ByteArrayAccess key, ByteArray ba) =>
key -> ba -> Either StoreError ba
rc4Combine key
key = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba. ByteArray ba => State -> ba -> (State, ba)
RC4.combine (forall key. ByteArrayAccess key => key -> State
RC4.initialize key
key)

-- | Conversion to UCS2 from UTF-8, ignoring non-BMP bits.
toUCS2 :: ByteArray bucs2 => ProtectionPassword -> Maybe bucs2
toUCS2 :: forall bucs2. ByteArray bucs2 => ProtectionPassword -> Maybe bucs2
toUCS2 ProtectionPassword
NullPassword = forall a. a -> Maybe a
Just forall a. ByteArray a => a
B.empty
toUCS2 (PasswordUTF8 ByteString
pwdUTF8)
    | forall a. ByteArrayAccess a => a -> Bool
B.null UArray Word8
r  = forall a. a -> Maybe a
Just bucs2
pwdUCS2
    | Bool
otherwise = 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 forall a b. (a -> b) -> a -> b
$ forall a. ByteArray a => a -> Word8 -> a
B.snoc (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ByteString
pwdUTF8) Word8
0
    pwdBlock :: Block (BE Word16)
pwdBlock  = forall l. IsList l => [Item l] -> l
fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> BE Word16
ucs2 forall a b. (a -> b) -> a -> b
$ forall l. IsList l => l -> [Item l]
toList String
p :: Block (BE Word16)
    pwdUCS2 :: bucs2
pwdUCS2   = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert Block (BE Word16)
pwdBlock

    ucs2 :: Char -> BE Word16
    ucs2 :: Char -> BE Word16
ucs2 = forall a. ByteSwap a => a -> BE a
toBE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
      => (StoreError -> result)
      -> (Key -> ContentEncryptionParams -> ByteString -> result)
      -> DigestProxy hash
      -> ContentEncryptionCipher cipher
      -> PBEParameter
      -> ByteString
      -> ProtectionPassword
      -> result
pkcs5 :: forall hash cipher result.
(HashAlgorithm hash, BlockCipher cipher) =>
(StoreError -> result)
-> (Key -> ContentEncryptionParams -> ByteString -> result)
-> DigestProxy hash
-> ContentEncryptionCipher cipher
-> PBEParameter
-> ByteString
-> ProtectionPassword
-> result
pkcs5 StoreError -> result
failure Key -> ContentEncryptionParams -> ByteString -> result
encdec DigestProxy hash
hashAlg ContentEncryptionCipher cipher
cec PBEParameter
pbeParam ByteString
bs ProtectionPassword
pwd
    | forall cipher (proxy :: * -> *).
BlockCipher cipher =>
proxy cipher -> Int
proxyBlockSize ContentEncryptionCipher cipher
cec forall a. Eq a => a -> a -> Bool
/= Int
8 = StoreError -> result
failure (String -> StoreError
InvalidParameter String
"Invalid cipher block size")
    | Bool
otherwise =
        case forall hash password out.
(HashAlgorithm hash, ByteArrayAccess password, ByteArray out) =>
DigestProxy hash
-> password -> PBEParameter -> Int -> Either StoreError out
pbkdf1 DigestProxy hash
hashAlg (ProtectionPassword -> ByteString
fromProtectionPassword ProtectionPassword
pwd) PBEParameter
pbeParam Int
16 of
            Left StoreError
err -> StoreError -> result
failure StoreError
err
            Right Key
dk ->
                let (Key
key, Key
iv) = forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt Int
8 (Key
dk :: Key)
                 in Key -> ContentEncryptionParams -> ByteString -> result
encdec Key
key (forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
ContentEncryptionCipher cipher -> iv -> ContentEncryptionParams
cbcWith ContentEncryptionCipher cipher
cec Key
iv) ByteString
bs


-- PBKDF1, RFC 8018 section 5.1

pbkdf1 :: (Hash.HashAlgorithm hash, ByteArrayAccess password, ByteArray out)
       => DigestProxy hash
       -> password
       -> PBEParameter
       -> Int
       -> Either StoreError out
pbkdf1 :: 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{Int
ByteString
pbeIterationCount :: Int
pbeSalt :: ByteString
pbeIterationCount :: PBEParameter -> Int
pbeSalt :: PBEParameter -> ByteString
..} Int
dkLen
    | Int
dkLen forall a. Ord a => a -> a -> Bool
> forall ba. ByteArrayAccess ba => ba -> Int
B.length Digest hash
t1 = forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"Derived key too long")
    | Bool
otherwise           = forall a b. b -> Either a b
Right (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert forall a b. (a -> b) -> a -> b
$ forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
B.takeView Digest hash
tc Int
dkLen)
  where
    a :: hash
a  = forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy DigestProxy hash
hashAlg
    t1 :: Digest hash
t1 = forall a. HashAlgorithm a => Context a -> Digest a
Hash.hashFinalize (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
Hash.hashUpdate (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
Hash.hashUpdate (forall alg. HashAlgorithm alg => alg -> Context alg
Hash.hashInitWith hash
a) password
pwd) ByteString
pbeSalt)
    tc :: Digest hash
tc = forall a. (a -> a) -> a -> [a]
iterate (forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
Hash.hashWith hash
a) Digest hash
t1 forall a. [a] -> Int -> a
!! 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)
       => (StoreError -> result)
       -> (Key -> ContentEncryptionParams -> ByteString -> result)
       -> DigestProxy hash
       -> ContentEncryptionCipher cipher
       -> PBEParameter
       -> ByteString
       -> ProtectionPassword
       -> result
pkcs12 :: forall hash cipher result.
(HashAlgorithm hash, BlockCipher cipher) =>
(StoreError -> result)
-> (Key -> ContentEncryptionParams -> ByteString -> result)
-> DigestProxy hash
-> ContentEncryptionCipher cipher
-> PBEParameter
-> ByteString
-> ProtectionPassword
-> result
pkcs12 StoreError -> result
failure Key -> ContentEncryptionParams -> ByteString -> result
encdec DigestProxy hash
hashAlg ContentEncryptionCipher cipher
cec PBEParameter
pbeParam ByteString
bs ProtectionPassword
pwdUTF8 =
    case forall bucs2. ByteArray bucs2 => ProtectionPassword -> Maybe bucs2
toUCS2 ProtectionPassword
pwdUTF8 of
        Maybe ByteString
Nothing      -> StoreError -> result
failure StoreError
passwordNotUTF8
        Just ByteString
pwdUCS2 ->
            let ivLen :: Int
ivLen   = forall cipher (proxy :: * -> *).
BlockCipher cipher =>
proxy cipher -> Int
proxyBlockSize ContentEncryptionCipher cipher
cec
                iv :: Bytes
iv      = forall hash bout.
(HashAlgorithm hash, ByteArray bout) =>
DigestProxy hash
-> PBEParameter -> Word8 -> ByteString -> Int -> bout
pkcs12Derive DigestProxy hash
hashAlg PBEParameter
pbeParam Word8
2 ByteString
pwdUCS2 Int
ivLen :: B.Bytes
                eScheme :: ContentEncryptionParams
eScheme = forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
ContentEncryptionCipher cipher -> iv -> ContentEncryptionParams
cbcWith ContentEncryptionCipher cipher
cec Bytes
iv
                keyLen :: Int
keyLen  = forall params. HasKeySize params => params -> Int
getMaximumKeySize ContentEncryptionParams
eScheme
                key :: Key
key     = forall hash bout.
(HashAlgorithm hash, ByteArray bout) =>
DigestProxy hash
-> PBEParameter -> Word8 -> ByteString -> Int -> bout
pkcs12Derive DigestProxy hash
hashAlg PBEParameter
pbeParam Word8
1 ByteString
pwdUCS2 Int
keyLen :: Key
            in Key -> ContentEncryptionParams -> ByteString -> result
encdec Key
key ContentEncryptionParams
eScheme ByteString
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
          => (StoreError -> result)
          -> (Key -> ContentEncryptionParams -> ByteString -> result)
          -> DigestProxy hash
          -> Int
          -> PBEParameter
          -> ByteString
          -> ProtectionPassword
          -> result
pkcs12rc2 :: forall hash result.
HashAlgorithm hash =>
(StoreError -> result)
-> (Key -> ContentEncryptionParams -> ByteString -> result)
-> DigestProxy hash
-> Int
-> PBEParameter
-> ByteString
-> ProtectionPassword
-> result
pkcs12rc2 StoreError -> result
failure Key -> ContentEncryptionParams -> ByteString -> result
encdec DigestProxy hash
hashAlg Int
len PBEParameter
pbeParam ByteString
bs ProtectionPassword
pwdUTF8 =
    case forall bucs2. ByteArray bucs2 => ProtectionPassword -> Maybe bucs2
toUCS2 ProtectionPassword
pwdUTF8 of
        Maybe ByteString
Nothing      -> StoreError -> result
failure StoreError
passwordNotUTF8
        Just ByteString
pwdUCS2 ->
            let ivLen :: Int
ivLen   = Int
8
                iv :: Bytes
iv      = forall hash bout.
(HashAlgorithm hash, ByteArray bout) =>
DigestProxy hash
-> PBEParameter -> Word8 -> ByteString -> Int -> bout
pkcs12Derive DigestProxy hash
hashAlg PBEParameter
pbeParam Word8
2 ByteString
pwdUCS2 Int
ivLen :: B.Bytes
                eScheme :: ContentEncryptionParams
eScheme = forall iv.
ByteArrayAccess iv =>
Int -> iv -> ContentEncryptionParams
rc2cbcWith Int
len Bytes
iv
                keyLen :: Int
keyLen  = forall params. HasKeySize params => params -> Int
getMaximumKeySize ContentEncryptionParams
eScheme
                key :: Key
key     = forall hash bout.
(HashAlgorithm hash, ByteArray bout) =>
DigestProxy hash
-> PBEParameter -> Word8 -> ByteString -> Int -> bout
pkcs12Derive DigestProxy hash
hashAlg PBEParameter
pbeParam Word8
1 ByteString
pwdUCS2 Int
keyLen :: Key
            in Key -> ContentEncryptionParams -> ByteString -> result
encdec Key
key ContentEncryptionParams
eScheme ByteString
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
             => (StoreError -> result)
             -> (Key -> ByteString -> result)
             -> DigestProxy hash
             -> Int
             -> PBEParameter
             -> ByteString
             -> ProtectionPassword
             -> result
pkcs12stream :: forall hash result.
HashAlgorithm hash =>
(StoreError -> result)
-> (Key -> ByteString -> result)
-> DigestProxy hash
-> Int
-> PBEParameter
-> ByteString
-> ProtectionPassword
-> result
pkcs12stream StoreError -> result
failure Key -> ByteString -> result
encdec DigestProxy hash
hashAlg Int
keyLen PBEParameter
pbeParam ByteString
bs ProtectionPassword
pwdUTF8 =
    case forall bucs2. ByteArray bucs2 => ProtectionPassword -> Maybe bucs2
toUCS2 ProtectionPassword
pwdUTF8 of
        Maybe ByteString
Nothing      -> StoreError -> result
failure StoreError
passwordNotUTF8
        Just ByteString
pwdUCS2 ->
            let key :: Key
key = forall hash bout.
(HashAlgorithm hash, ByteArray bout) =>
DigestProxy hash
-> PBEParameter -> Word8 -> ByteString -> Int -> bout
pkcs12Derive DigestProxy hash
hashAlg PBEParameter
pbeParam Word8
1 ByteString
pwdUCS2 Int
keyLen :: Key
             in Key -> ByteString -> result
encdec Key
key ByteString
bs

-- | Apply PKCS #12 derivation on the specified password and run a MAC function
-- on some input using derived key.
pkcs12mac :: Hash.HashAlgorithm hash
          => (StoreError -> result)
          -> (Key -> MACAlgorithm -> ByteString -> result)
          -> DigestProxy hash
          -> PBEParameter
          -> ByteString
          -> ProtectionPassword
          -> result
pkcs12mac :: forall hash result.
HashAlgorithm hash =>
(StoreError -> result)
-> (Key -> MACAlgorithm -> ByteString -> result)
-> DigestProxy hash
-> PBEParameter
-> ByteString
-> ProtectionPassword
-> result
pkcs12mac StoreError -> result
failure Key -> MACAlgorithm -> ByteString -> result
macFn DigestProxy hash
hashAlg PBEParameter
pbeParam ByteString
bs ProtectionPassword
pwdUTF8 =
    case forall bucs2. ByteArray bucs2 => ProtectionPassword -> Maybe bucs2
toUCS2 ProtectionPassword
pwdUTF8 of
        Maybe ByteString
Nothing      -> StoreError -> result
failure StoreError
passwordNotUTF8
        Just ByteString
pwdUCS2 ->
            let macAlg :: MACAlgorithm
macAlg = forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> MACAlgorithm
HMAC DigestProxy hash
hashAlg
                keyLen :: Int
keyLen = forall params. HasKeySize params => params -> Int
getMaximumKeySize MACAlgorithm
macAlg
                key :: Key
key    = forall hash bout.
(HashAlgorithm hash, ByteArray bout) =>
DigestProxy hash
-> PBEParameter -> Word8 -> ByteString -> Int -> bout
pkcs12Derive DigestProxy hash
hashAlg PBEParameter
pbeParam Word8
3 ByteString
pwdUCS2 Int
keyLen :: Key
            in Key -> MACAlgorithm -> ByteString -> result
macFn Key
key MACAlgorithm
macAlg ByteString
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 :: forall hash bout.
(HashAlgorithm hash, ByteArray bout) =>
DigestProxy hash
-> PBEParameter -> Word8 -> ByteString -> Int -> bout
pkcs12Derive DigestProxy hash
hashAlg PBEParameter{Int
ByteString
pbeIterationCount :: Int
pbeSalt :: ByteString
pbeIterationCount :: PBEParameter -> Int
pbeSalt :: PBEParameter -> ByteString
..} Word8
idByte ByteString
pwdUCS2 Int
n =
    forall bs. ByteArray bs => Int -> bs -> bs
B.take Int
n forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
c forall a b. (a -> b) -> a -> b
$ forall hash.
HashAlgorithm hash =>
Context hash -> ByteString -> [Digest hash]
loop Context hash
t (ByteString
s forall bs. ByteArray bs => bs -> bs -> bs
`B.append` ByteString
p)
  where
    a :: hash
a = forall (proxy :: * -> *) a. proxy a -> a
hashFromProxy DigestProxy hash
hashAlg
    v :: Int
v = DigestAlgorithm -> Int
getV (forall hashAlg.
HashAlgorithm hashAlg =>
DigestProxy hashAlg -> DigestAlgorithm
DigestAlgorithm DigestProxy hash
hashAlg)
    u :: Int
u = forall a. HashAlgorithm a => a -> Int
Hash.hashDigestSize hash
a

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

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

    loop :: Hash.HashAlgorithm hash
         => Hash.Context hash -> ByteString -> [Hash.Digest hash]
    loop :: forall hash.
HashAlgorithm hash =>
Context hash -> ByteString -> [Digest hash]
loop Context hash
x ByteString
i = let z :: Digest hash
z  = forall a. HashAlgorithm a => Context a -> Digest a
Hash.hashFinalize (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
Hash.hashUpdate Context hash
x ByteString
i)
                   ai :: Digest hash
ai = forall a. (a -> a) -> a -> [a]
iterate forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Hash.hash Digest hash
z forall a. [a] -> Int -> a
!! forall a. Enum a => a -> a
pred Int
pbeIterationCount
                   b :: ByteString
b  = Digest hash
ai forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> Int -> bout
`extendedTo` Int
v
                   j :: ByteString
j  = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> ByteString -> ByteString
add1 ByteString
b) (forall ba. ByteArray ba => Int -> ba -> [ba]
chunks Int
v ByteString
i)
                in Digest hash
ai forall a. a -> [a] -> [a]
: forall hash.
HashAlgorithm hash =>
Context hash -> ByteString -> [Digest hash]
loop Context hash
x ByteString
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                        = forall a. HasCallStack => String -> a
error (String
"pkcs12Derive: unsupported hash: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show DigestAlgorithm
t)

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

-- Split in chunks of size 'n'
chunks :: ByteArray ba => Int -> ba -> [ba]
chunks :: forall ba. ByteArray ba => Int -> ba -> [ba]
chunks Int
n ba
bs
    | Int
len forall a. Ord a => a -> a -> Bool
> Int
n   = let (ba
c, ba
cs) = forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt Int
n ba
bs in ba
c forall a. a -> [a] -> [a]
: forall ba. ByteArray ba => Int -> ba -> [ba]
chunks Int
n ba
cs
    | Int
len forall a. Ord a => a -> a -> Bool
> Int
0   = [ba
bs]
    | Bool
otherwise = []
  where
    len :: Int
len = 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 :: forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> Int -> bout
`extendedTo` Int
n =
    forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
n forall a b. (a -> b) -> a -> b
$ \Ptr Any
pout ->
        forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray bin
bs forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pin -> do
            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 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off) Ptr Word8
pin Int
len)
                  (forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo Int
0 Int
len (Int
n forall a. Num a => a -> a -> a
- Int
len))
            Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memCopy (Ptr Any
pout forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
n forall a. Num a => a -> a -> a
- Int
r)) Ptr Word8
pin Int
r
  where
    len :: Int
len = forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
bs
    r :: Int
r   = Int
n 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 :: forall ba. ByteArray ba => ba -> Int -> ba
`extendedToMult` Int
n
    | Int
len forall a. Ord a => a -> a -> Bool
> Int
n   = ba
bs forall bs. ByteArray bs => bs -> bs -> bs
`B.append` forall bs. ByteArray bs => Int -> bs -> bs
B.take (Int
n forall a. Num a => a -> a -> a
- Int
len forall a. Integral a => a -> a -> a
`mod` Int
n) ba
bs
    | Int
len forall a. Eq a => a -> a -> Bool
== Int
n  = ba
bs
    | Int
len forall a. Ord a => a -> a -> Bool
> Int
0   = ba
bs forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> Int -> bout
`extendedTo` Int
n
    | Bool
otherwise = forall a. ByteArray a => a
B.empty
  where
    len :: Int
len = 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 :: ByteString -> ByteString -> ByteString
add1 ByteString
a ByteString
b =
    forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
alen forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pc ->
        forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ByteString
a forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pa ->
        forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ByteString
b 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 = forall ba. ByteArrayAccess ba => ba -> Int
B.length ByteString
a
    blen :: Int
blen = forall ba. ByteArrayAccess ba => ba -> Int
B.length ByteString
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 forall a. Eq a => a -> a -> Bool
== Int
0   = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Int
mb 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 = forall a. Enum a => a -> a
pred Int
ma
                nb :: Int
nb = forall a. Enum a => a -> a
pred Int
mb
            Word8
ba <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
pa Int
na
            Word8
bb <- 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
            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 forall a. Eq a => a -> a -> Bool
== Int
0   = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = do
            let na :: Int
na = forall a. Enum a => a -> a
pred Int
ma
            Word8
ba <- 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
            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 = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word16
x Int
8), 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a forall a. Num a => a -> a -> a
+ 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c)