-- |
-- 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
    , passwordToString
    , pkcs5
    , pkcs12
    , pkcs12rc2
    , pkcs12stream
    , pkcs12mac
    , rc4Combine
    ) where

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.ByteString.Builder (Builder, toLazyByteString, word16BE)
import           Data.ByteString.Lazy (toStrict)
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
import Crypto.Store.Utf8

-- | 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
(ProtectionPassword -> ProtectionPassword -> Bool)
-> (ProtectionPassword -> ProtectionPassword -> Bool)
-> Eq ProtectionPassword
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtectionPassword -> ProtectionPassword -> Bool
== :: ProtectionPassword -> ProtectionPassword -> Bool
$c/= :: ProtectionPassword -> ProtectionPassword -> Bool
/= :: 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"toProtectionPassword " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ByteString
b

instance IsString ProtectionPassword where
    fromString :: String -> ProtectionPassword
fromString = ByteString -> ProtectionPassword
PasswordUTF8 (ByteString -> ProtectionPassword)
-> (String -> ByteString) -> String -> ProtectionPassword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
stringToUTF8

instance ByteArrayAccess ProtectionPassword where
    length :: ProtectionPassword -> Int
length = Int -> (ByteString -> Int) -> ProtectionPassword -> Int
forall a. a -> (ByteString -> a) -> ProtectionPassword -> a
applyPP Int
0 ByteString -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length
    withByteArray :: forall p a. ProtectionPassword -> (Ptr p -> IO a) -> IO a
withByteArray = ByteString -> (Ptr p -> IO a) -> IO a
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ByteString -> (Ptr p -> IO a) -> IO a
B.withByteArray (ByteString -> (Ptr p -> IO a) -> IO a)
-> (ProtectionPassword -> ByteString)
-> ProtectionPassword
-> (Ptr p -> IO a)
-> IO a
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 = ByteString
-> (ByteString -> ByteString) -> ProtectionPassword -> ByteString
forall a. a -> (ByteString -> a) -> ProtectionPassword -> a
applyPP ByteString
forall a. ByteArray a => a
B.empty ByteString -> ByteString
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
    | ByteString -> Bool
forall a. ByteArrayAccess a => a -> Bool
B.null ByteString
bs = [ByteString -> ProtectionPassword
PasswordUTF8 ByteString
forall a. ByteArray a => a
B.empty, ProtectionPassword
NullPassword]
    | Bool
otherwise = [ByteString -> ProtectionPassword
PasswordUTF8 ByteString
bs]

-- | Convert a password value to a Haskell string, or return 'Nothing' if the
-- input was not proper UTF-8.
passwordToString :: ProtectionPassword -> Maybe String
passwordToString :: ProtectionPassword -> Maybe String
passwordToString ProtectionPassword
NullPassword = String -> Maybe String
forall a. a -> Maybe a
Just String
""
passwordToString (PasswordUTF8 ByteString
bs)
    | ByteString -> Bool
forall a. ByteArrayAccess a => a -> Bool
B.null ByteString
r  = String -> Maybe String
forall a. a -> Maybe a
Just String
p
    | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing
  where (String
p, ByteString
r) = ByteString -> (String, ByteString)
stringFromUTF8 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
(Int -> PBEParameter -> ShowS)
-> (PBEParameter -> String)
-> ([PBEParameter] -> ShowS)
-> Show PBEParameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PBEParameter -> ShowS
showsPrec :: Int -> PBEParameter -> ShowS
$cshow :: PBEParameter -> String
show :: PBEParameter -> String
$cshowList :: [PBEParameter] -> ShowS
showList :: [PBEParameter] -> ShowS
Show,PBEParameter -> PBEParameter -> Bool
(PBEParameter -> PBEParameter -> Bool)
-> (PBEParameter -> PBEParameter -> Bool) -> Eq PBEParameter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PBEParameter -> PBEParameter -> Bool
== :: PBEParameter -> PBEParameter -> Bool
$c/= :: PBEParameter -> PBEParameter -> Bool
/= :: PBEParameter -> PBEParameter -> Bool
Eq)

instance ASN1Elem e => ProduceASN1Object e PBEParameter where
    asn1s :: PBEParameter -> ASN1Stream e
asn1s PBEParameter{Int
ByteString
pbeSalt :: PBEParameter -> ByteString
pbeIterationCount :: PBEParameter -> Int
pbeSalt :: ByteString
pbeIterationCount :: Int
..} =
        let salt :: ASN1Stream e
salt  = ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
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 <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        IntVal iters <- getNext
        return PBEParameter { pbeSalt = salt
                            , pbeIterationCount = fromInteger 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 = 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 :: 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 = 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 :: forall key ba.
(ByteArrayAccess key, ByteArray ba) =>
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, failing for malformed input or code points
-- found outside the Basic Multilingual Plane.
toUCS2 :: ProtectionPassword -> Either String ByteString
toUCS2 :: ProtectionPassword -> Either String ByteString
toUCS2 ProtectionPassword
NullPassword = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
forall a. ByteArray a => a
B.empty
toUCS2 (PasswordUTF8 ByteString
pwdUTF8)
    | Bool -> Bool
not (ByteString -> Bool
forall a. ByteArrayAccess a => a -> Bool
B.null ByteString
r) = String -> Either String ByteString
forall a b. a -> Either a b
Left String
"Provided password is not valid UTF-8"
    | Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
bmp String
p) = String -> Either String ByteString
forall a b. a -> Either a b
Left String
"Password is not compatible with UCS-2"
    | Bool
otherwise = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
pwdUCS2
  where
    (String
p, ByteString
r)    = ByteString -> (String, ByteString)
stringFromUTF8 (ByteString -> Word8 -> ByteString
forall a. ByteArray a => a -> Word8 -> a
B.snoc ByteString
pwdUTF8 Word8
0)
    pwdUCS2 :: ByteString
pwdUCS2   = LazyByteString -> ByteString
toStrict (LazyByteString -> ByteString) -> LazyByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> LazyByteString
toLazyByteString ((Char -> Builder) -> String -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> Builder
ucs2 String
p)

    bmp :: Char -> Bool
    bmp :: Char -> Bool
bmp Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x10000'

    ucs2 :: Char -> Builder
    ucs2 :: Char -> Builder
ucs2 = Word16 -> Builder
word16BE (Word16 -> Builder) -> (Char -> Word16) -> Char -> Builder
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)
      => (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
    | 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
-> ByteString -> 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 (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) = Int -> Key -> (Key, Key)
forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt Int
8 (Key
dk :: Key)
                 in Key -> ContentEncryptionParams -> ByteString -> 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) 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
pbeSalt :: PBEParameter -> ByteString
pbeIterationCount :: PBEParameter -> Int
pbeSalt :: ByteString
pbeIterationCount :: Int
..} 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 -> ByteString -> 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) ByteString
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. HasCallStack => [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)
       => (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 ProtectionPassword -> Either String ByteString
toUCS2 ProtectionPassword
pwdUTF8 of
        Left String
msg      -> StoreError -> result
failure (String -> StoreError
InvalidPassword String
msg)
        Right ByteString
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 -> ByteString -> Int -> Bytes
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 = 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 -> ByteString -> Int -> 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 ProtectionPassword -> Either String ByteString
toUCS2 ProtectionPassword
pwdUTF8 of
        Left String
msg      -> StoreError -> result
failure (String -> StoreError
InvalidPassword String
msg)
        Right ByteString
pwdUCS2 ->
            let ivLen :: Int
ivLen   = Int
8
                iv :: Bytes
iv      = DigestProxy hash
-> PBEParameter -> Word8 -> ByteString -> Int -> Bytes
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 = 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 -> ByteString -> Int -> 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 ProtectionPassword -> Either String ByteString
toUCS2 ProtectionPassword
pwdUTF8 of
        Left String
msg      -> StoreError -> result
failure (String -> StoreError
InvalidPassword String
msg)
        Right ByteString
pwdUCS2 ->
            let key :: Key
key = DigestProxy hash
-> PBEParameter -> Word8 -> ByteString -> Int -> 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 ProtectionPassword -> Either String ByteString
toUCS2 ProtectionPassword
pwdUTF8 of
        Left String
msg      -> StoreError -> result
failure (String -> StoreError
InvalidPassword String
msg)
        Right ByteString
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 -> ByteString -> Int -> 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

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
pbeSalt :: PBEParameter -> ByteString
pbeIterationCount :: PBEParameter -> Int
pbeSalt :: ByteString
pbeIterationCount :: Int
..} Word8
idByte ByteString
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 -> ByteString -> [Digest hash]
forall hash.
HashAlgorithm hash =>
Context hash -> ByteString -> [Digest hash]
loop Context hash
t (ByteString
s ByteString -> ByteString -> ByteString
forall bs. ByteArray bs => bs -> bs -> bs
`B.append` ByteString
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 :: ByteString
p = ByteString
pwdUCS2 ByteString -> Int -> ByteString
forall ba. ByteArray ba => ba -> Int -> ba
`extendedToMult` Int
v
    s :: ByteString
s = ByteString
pbeSalt ByteString -> Int -> ByteString
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  = Context hash -> Digest hash
forall a. HashAlgorithm a => Context a -> Digest a
Hash.hashFinalize (Context hash -> ByteString -> Context hash
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
Hash.hashUpdate Context hash
x ByteString
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. HasCallStack => [a] -> Int -> a
!! Int -> Int
forall a. Enum a => a -> a
pred Int
pbeIterationCount
                   b :: ByteString
b  = Digest hash
ai Digest hash -> Int -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> Int -> bout
`extendedTo` Int
v
                   j :: ByteString
j  = [ByteString] -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> ByteString -> ByteString
add1 ByteString
b) (Int -> ByteString -> [ByteString]
forall ba. ByteArray ba => Int -> ba -> [ba]
chunks Int
v ByteString
i)
                in Digest hash
ai Digest hash -> [Digest hash] -> [Digest hash]
forall a. a -> [a] -> [a]
: Context hash -> ByteString -> [Digest hash]
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                        = 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 :: forall (proxy :: * -> *) a. 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 :: forall ba. ByteArray ba => 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 :: forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> Int -> bout
`extendedTo` Int
n =
    Int -> (Ptr (ZonkAny 0) -> IO ()) -> bout
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
n ((Ptr (ZonkAny 0) -> IO ()) -> bout)
-> (Ptr (ZonkAny 0) -> IO ()) -> bout
forall a b. (a -> b) -> a -> b
$ \Ptr (ZonkAny 0)
pout ->
        bin -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. bin -> (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 (ZonkAny 0)
pout Ptr (ZonkAny 0) -> 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 (ZonkAny 0)
pout Ptr (ZonkAny 0) -> 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 :: forall ba. ByteArray ba => 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 :: ByteString -> ByteString -> ByteString
add1 ByteString
a ByteString
b =
    Int -> (Ptr Word8 -> IO ()) -> ByteString
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
alen ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pc ->
        ByteString -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ByteString -> (Ptr p -> IO a) -> IO a
B.withByteArray ByteString
a ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pa ->
        ByteString -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ByteString -> (Ptr p -> IO a) -> IO a
B.withByteArray ByteString
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 = ByteString -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ByteString
a
    blen :: Int
blen = ByteString -> Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   = () -> IO ()
forall a. a -> IO a
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
            ba <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
pa Int
na
            bb <- peekElemOff pb nb
            let (cc, bc) = carryAdd3 c ba bb
            pokeElemOff pc na bc
            loop3 pa pb pc na nb 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 a. a -> IO a
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
            ba <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
pa Int
na
            let (cc, bc) = carryAdd2 c ba
            pokeElemOff pc na bc
            loop2 pa pc na 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)