{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE PackageImports             #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeApplications           #-}

module Data.KeyStore.KS.Crypto
  ( sizeAesIV
  , sizeOAE
  , defaultEncryptedCopyKS
  , saveKS
  , restoreKS
  , mkAESKeyKS
  , encryptKS
  , decryptKS
  , decryptE
  , encodeRSASecretData
  , decodeRSASecretData
  , decodeRSASecretData_
  , encryptRSAKS
  , decryptRSAKS
  , decryptRSAE
  , oaep
  , signKS
  , verifyKS
  , pssp
  , encryptAESKS
  , encryptAES
  , decryptAES
  , randomAESKeyKS
  , randomIVKS
  , hashKS
  , defaultHashParams
  , defaultHashParamsKS
  , hashKS_
  , generateKeysKS
  , generateKeysKS_
  , decodePrivateKeyDERE
  , decodePublicKeyDERE
  , encodePrivateKeyDER
  , encodePublicKeyDER
  , decodeDERE
  , encodeDER
  -- testing
  , test_crypto
  ) where


import           Data.KeyStore.KS.KS
import           Data.KeyStore.KS.Opt
import           Data.KeyStore.Types
import           Data.API.Types
import qualified Data.ASN1.Encoding             as A
import qualified Data.ASN1.BinaryEncoding       as A
import qualified Data.ASN1.Types                as A
import qualified Data.ByteString.Lazy.Char8     as LBS
import qualified Data.ByteString.Char8          as B
import           Data.Coerce
import           Data.Maybe
import           Data.Typeable
import           Crypto.Error
import           Crypto.Hash.Algorithms
import           Crypto.PubKey.RSA
import qualified Crypto.PubKey.RSA.OAEP         as OAEP
import qualified Crypto.PubKey.RSA.PSS          as PSS
import           Crypto.PubKey.MaskGenFunction
import           Crypto.Cipher.AES
import qualified Crypto.Types.PubKey.RSA        as CPT

-- avoiding class with crypto-pubkey-types which we are using for DER generation
import qualified "crypton" Crypto.Cipher.Types as CCT


sizeAesIV, sizeOAE :: Octets
sizeAesIV :: Octets
sizeAesIV = Octets
16
sizeOAE :: Octets
sizeOAE   = Octets
256


--
-- smoke tests
--

test_crypto :: Bool
test_crypto :: Bool
test_crypto = Bool
test_oaep Bool -> Bool -> Bool
&& Bool
test_pss

test_oaep :: Bool
test_oaep :: Bool
test_oaep = forall a. KS a -> a
trun forall a b. (a -> b) -> a -> b
$
 do (PublicKey
puk,PrivateKey
prk) <- KS (PublicKey, PrivateKey)
generateKeysKS
    ClearText
tm'       <- PublicKey -> ClearText -> KS RSASecretData
encryptKS PublicKey
puk ClearText
tm forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PrivateKey -> RSASecretData -> KS ClearText
decryptKS PrivateKey
prk
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ClearText
tm' forall a. Eq a => a -> a -> Bool
== ClearText
tm
  where
    tm :: ClearText
tm = Binary -> ClearText
ClearText forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
"test message"

test_pss :: Bool
test_pss :: Bool
test_pss = forall a. KS a -> a
trun forall a b. (a -> b) -> a -> b
$
 do (PublicKey
puk,PrivateKey
prk) <- KS (PublicKey, PrivateKey)
generateKeysKS
    RSASignature
sig  <- PrivateKey -> ClearText -> KS RSASignature
signKS PrivateKey
prk ClearText
tm
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PublicKey -> ClearText -> RSASignature -> Bool
verifyKS PublicKey
puk ClearText
tm  RSASignature
sig Bool -> Bool -> Bool
&& Bool -> Bool
not (PublicKey -> ClearText -> RSASignature -> Bool
verifyKS PublicKey
puk ClearText
tm' RSASignature
sig)
  where
    tm :: ClearText
tm  = Binary -> ClearText
ClearText forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
"hello"
    tm' :: ClearText
tm' = Binary -> ClearText
ClearText forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
"gello"


--
-- defaultEncryptedCopy
--

defaultEncryptedCopyKS :: Safeguard -> KS EncrypedCopy
defaultEncryptedCopyKS :: Safeguard -> KS EncrypedCopy
defaultEncryptedCopyKS Safeguard
sg =
 do Cipher
ciphr <- forall a. Show a => Opt a -> KS a
lookupOpt Opt Cipher
opt__crypt_cipher
    HashPRF
prf   <- forall a. Show a => Opt a -> KS a
lookupOpt Opt HashPRF
opt__crypt_prf
    Iterations
itrns <- forall a. Show a => Opt a -> KS a
lookupOpt Opt Iterations
opt__crypt_iterations
    Octets
st_sz <- forall a. Show a => Opt a -> KS a
lookupOpt Opt Octets
opt__crypt_salt_octets
    Salt
slt   <- forall a. Octets -> (ByteString -> a) -> KS a
randomBytes Octets
st_sz (Binary -> Salt
Salt forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary)
    forall (m :: * -> *) a. Monad m => a -> m a
return
        EncrypedCopy
            { _ec_safeguard :: Safeguard
_ec_safeguard   = Safeguard
sg
            , _ec_cipher :: Cipher
_ec_cipher      = Cipher
ciphr
            , _ec_prf :: HashPRF
_ec_prf         = HashPRF
prf
            , _ec_iterations :: Iterations
_ec_iterations  = Iterations
itrns
            , _ec_salt :: Salt
_ec_salt        = Salt
slt
            , _ec_secret_data :: EncrypedCopyData
_ec_secret_data = Void -> EncrypedCopyData
ECD_no_data Void
void_
            }


--
-- saving and restoring secret copies
--

saveKS :: EncryptionKey -> ClearText -> KS EncrypedCopyData
saveKS :: EncryptionKey -> ClearText -> KS EncrypedCopyData
saveKS EncryptionKey
ek ClearText
ct =
    case EncryptionKey
ek of
      EK_public    PublicKey
puk -> RSASecretData -> EncrypedCopyData
ECD_rsa   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PublicKey -> ClearText -> KS RSASecretData
encryptKS PublicKey
puk ClearText
ct
      EK_private   PrivateKey
_   -> forall a. [Char] -> KS a
errorKS [Char]
"Crypto.Save: saving with private key"
      EK_symmetric AESKey
aek -> AESSecretData -> EncrypedCopyData
ECD_aes   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AESKey -> ClearText -> KS AESSecretData
encryptAESKS AESKey
aek ClearText
ct
      EK_none      Void
_   -> ClearText -> EncrypedCopyData
ECD_clear forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Monad m => a -> m a
return ClearText
ct

restoreKS :: EncrypedCopyData -> EncryptionKey -> KS ClearText
restoreKS :: EncrypedCopyData -> EncryptionKey -> KS ClearText
restoreKS EncrypedCopyData
ecd EncryptionKey
ek =
    case (EncrypedCopyData
ecd,EncryptionKey
ek) of
      (ECD_rsa     RSASecretData
rsd,EK_private   PrivateKey
prk) -> PrivateKey -> RSASecretData -> KS ClearText
decryptKS PrivateKey
prk RSASecretData
rsd
      (ECD_aes     AESSecretData
asd,EK_symmetric AESKey
aek) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AESKey -> AESSecretData -> ClearText
decryptAES AESKey
aek AESSecretData
asd
      (ECD_clear   ClearText
ct ,EK_none      Void
_  ) -> forall (m :: * -> *) a. Monad m => a -> m a
return ClearText
ct
      (ECD_no_data Void
_  ,EncryptionKey
_               ) -> forall a. [Char] -> KS a
errorKS [Char]
"restore: no data!"
      (EncrypedCopyData, EncryptionKey)
_                                  -> forall a. [Char] -> KS a
errorKS [Char]
"unexpected EncrypedCopy/EncryptionKey combo"


--
-- making up an AESKey from a list of source texts
--

mkAESKeyKS :: EncrypedCopy -> [ClearText] -> KS AESKey
mkAESKeyKS :: EncrypedCopy -> [ClearText] -> KS AESKey
mkAESKeyKS EncrypedCopy
_              []  = forall a. HasCallStack => [Char] -> a
error [Char]
"mkAESKey: no texts"
mkAESKeyKS EncrypedCopy{Safeguard
Salt
Iterations
HashPRF
Cipher
EncrypedCopyData
_ec_secret_data :: EncrypedCopyData
_ec_salt :: Salt
_ec_iterations :: Iterations
_ec_prf :: HashPRF
_ec_cipher :: Cipher
_ec_safeguard :: Safeguard
_ec_secret_data :: EncrypedCopy -> EncrypedCopyData
_ec_salt :: EncrypedCopy -> Salt
_ec_iterations :: EncrypedCopy -> Iterations
_ec_prf :: EncrypedCopy -> HashPRF
_ec_cipher :: EncrypedCopy -> Cipher
_ec_safeguard :: EncrypedCopy -> Safeguard
..} [ClearText]
cts = Cipher -> AESKey
p2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Show a => Opt a -> KS a
lookupOpt Opt Cipher
opt__crypt_cipher
  where
    p2 :: Cipher -> AESKey
p2 Cipher
ciphr = forall a.
HashPRF
-> ClearText
-> Salt
-> Iterations
-> Octets
-> (ByteString -> a)
-> a
pbkdf HashPRF
_ec_prf ClearText
ct Salt
_ec_salt Iterations
_ec_iterations (Cipher -> Octets
keyWidth Cipher
ciphr) forall a b. (a -> b) -> a -> b
$ Binary -> AESKey
AESKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary

    ct :: ClearText
ct       = Binary -> ClearText
ClearText forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Binary -> ByteString
_Binaryforall b c a. (b -> c) -> (a -> b) -> a -> c
.ClearText -> Binary
_ClearText) [ClearText]
cts


--
-- encrypting & decrypting
--

encryptKS :: PublicKey -> ClearText -> KS RSASecretData
encryptKS :: PublicKey -> ClearText -> KS RSASecretData
encryptKS PublicKey
pk ClearText
ct =
 do Cipher
cip <- forall a. Show a => Opt a -> KS a
lookupOpt Opt Cipher
opt__crypt_cipher
    AESKey
aek <- Cipher -> KS AESKey
randomAESKeyKS Cipher
cip
    RSAEncryptedKey
rek <- PublicKey -> AESKey -> KS RSAEncryptedKey
encryptRSAKS PublicKey
pk AESKey
aek
    AESSecretData
asd <- AESKey -> ClearText -> KS AESSecretData
encryptAESKS AESKey
aek ClearText
ct
    forall (m :: * -> *) a. Monad m => a -> m a
return
        RSASecretData
            { _rsd_encrypted_key :: RSAEncryptedKey
_rsd_encrypted_key    = RSAEncryptedKey
rek
            , _rsd_aes_secret_data :: AESSecretData
_rsd_aes_secret_data = AESSecretData
asd
            }

decryptKS :: PrivateKey -> RSASecretData -> KS ClearText
decryptKS :: PrivateKey -> RSASecretData -> KS ClearText
decryptKS PrivateKey
pk RSASecretData
dat = forall a. E a -> KS a
e2ks forall a b. (a -> b) -> a -> b
$ PrivateKey -> RSASecretData -> E ClearText
decryptE PrivateKey
pk RSASecretData
dat

decryptE :: PrivateKey -> RSASecretData -> E ClearText
decryptE :: PrivateKey -> RSASecretData -> E ClearText
decryptE PrivateKey
pk RSASecretData{RSAEncryptedKey
AESSecretData
_rsd_aes_secret_data :: AESSecretData
_rsd_encrypted_key :: RSAEncryptedKey
_rsd_aes_secret_data :: RSASecretData -> AESSecretData
_rsd_encrypted_key :: RSASecretData -> RSAEncryptedKey
..} =
 do AESKey
aek <- PrivateKey -> RSAEncryptedKey -> E AESKey
decryptRSAE PrivateKey
pk RSAEncryptedKey
_rsd_encrypted_key
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AESKey -> AESSecretData -> ClearText
decryptAES AESKey
aek AESSecretData
_rsd_aes_secret_data


--
-- Serializing RSASecretData
--

encodeRSASecretData :: RSASecretData -> RSASecretBytes
encodeRSASecretData :: RSASecretData -> RSASecretBytes
encodeRSASecretData RSASecretData{RSAEncryptedKey
AESSecretData
_rsd_aes_secret_data :: AESSecretData
_rsd_encrypted_key :: RSAEncryptedKey
_rsd_aes_secret_data :: RSASecretData -> AESSecretData
_rsd_encrypted_key :: RSASecretData -> RSAEncryptedKey
..} =
    Binary -> RSASecretBytes
RSASecretBytes forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary forall a b. (a -> b) -> a -> b
$
        [ByteString] -> ByteString
B.concat
            [ Binary -> ByteString
_Binary forall a b. (a -> b) -> a -> b
$ RSAEncryptedKey -> Binary
_RSAEncryptedKey RSAEncryptedKey
_rsd_encrypted_key
            , Binary -> ByteString
_Binary forall a b. (a -> b) -> a -> b
$ IV -> Binary
_IV              IV
_asd_iv
            , Binary -> ByteString
_Binary forall a b. (a -> b) -> a -> b
$ SecretData -> Binary
_SecretData      SecretData
_asd_secret_data
            ]
  where
    AESSecretData{SecretData
IV
_asd_secret_data :: AESSecretData -> SecretData
_asd_iv :: AESSecretData -> IV
_asd_secret_data :: SecretData
_asd_iv :: IV
..} = AESSecretData
_rsd_aes_secret_data

decodeRSASecretData :: RSASecretBytes -> KS RSASecretData
decodeRSASecretData :: RSASecretBytes -> KS RSASecretData
decodeRSASecretData (RSASecretBytes Binary
dat) = forall a. E a -> KS a
e2ks forall a b. (a -> b) -> a -> b
$ ByteString -> E RSASecretData
decodeRSASecretData_ forall a b. (a -> b) -> a -> b
$ Binary -> ByteString
_Binary Binary
dat

decodeRSASecretData_ :: B.ByteString -> E RSASecretData
decodeRSASecretData_ :: ByteString -> E RSASecretData
decodeRSASecretData_ ByteString
dat0 =
 do (ByteString
eky,ByteString
dat1) <- Octets -> ByteString -> Either Reason (ByteString, ByteString)
slice Octets
sizeOAE   ByteString
dat0
    (ByteString
iv ,ByteString
edat) <- Octets -> ByteString -> Either Reason (ByteString, ByteString)
slice Octets
sizeAesIV ByteString
dat1
    forall (m :: * -> *) a. Monad m => a -> m a
return
        RSASecretData
            { _rsd_encrypted_key :: RSAEncryptedKey
_rsd_encrypted_key    = Binary -> RSAEncryptedKey
RSAEncryptedKey forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
eky
            , _rsd_aes_secret_data :: AESSecretData
_rsd_aes_secret_data =
                AESSecretData
                    { _asd_iv :: IV
_asd_iv           = Binary -> IV
IV         forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
iv
                    , _asd_secret_data :: SecretData
_asd_secret_data  = Binary -> SecretData
SecretData forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
edat
                    }
            }
  where
    slice :: Octets -> ByteString -> Either Reason (ByteString, ByteString)
slice Octets
sz ByteString
bs =
        case ByteString -> Int
B.length ByteString
bs forall a. Ord a => a -> a -> Bool
>= Octets -> Int
_Octets Octets
sz of
          Bool
True  -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Octets -> Int
_Octets Octets
sz) ByteString
bs
          Bool
False -> forall a b. a -> Either a b
Left  forall a b. (a -> b) -> a -> b
$ [Char] -> Reason
strMsg [Char]
"decrypt: not enough bytes"


--
-- RSA encrypting & decrypting
--

encryptRSAKS :: PublicKey -> AESKey -> KS RSAEncryptedKey
encryptRSAKS :: PublicKey -> AESKey -> KS RSAEncryptedKey
encryptRSAKS PublicKey
pk (AESKey (Binary ByteString
dat)) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Binary -> RSAEncryptedKey
RSAEncryptedKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary) forall a b. (a -> b) -> a -> b
$ forall a. KS (Either Error a) -> KS a
rsaErrorKS forall a b. (a -> b) -> a -> b
$ forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
OAEPParams hash ByteString ByteString
-> PublicKey -> ByteString -> m (Either Error ByteString)
OAEP.encrypt OAEPparams
oaep PublicKey
pk ByteString
dat

decryptRSAKS :: PrivateKey -> RSAEncryptedKey -> KS AESKey
decryptRSAKS :: PrivateKey -> RSAEncryptedKey -> KS AESKey
decryptRSAKS PrivateKey
pk RSAEncryptedKey
rek = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Reason -> KS a
throwKS forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PrivateKey -> RSAEncryptedKey -> E AESKey
decryptRSAE PrivateKey
pk RSAEncryptedKey
rek

decryptRSAE :: PrivateKey -> RSAEncryptedKey -> E AESKey
decryptRSAE :: PrivateKey -> RSAEncryptedKey -> E AESKey
decryptRSAE PrivateKey
pk RSAEncryptedKey
rek = forall a. Either Error a -> E a
rsa2e forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Binary -> AESKey
AESKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary) forall a b. (a -> b) -> a -> b
$
    forall hash.
HashAlgorithm hash =>
Maybe Blinder
-> OAEPParams hash ByteString ByteString
-> PrivateKey
-> ByteString
-> Either Error ByteString
OAEP.decrypt forall a. Maybe a
Nothing OAEPparams
oaep PrivateKey
pk forall a b. (a -> b) -> a -> b
$ Binary -> ByteString
_Binary forall a b. (a -> b) -> a -> b
$ RSAEncryptedKey -> Binary
_RSAEncryptedKey RSAEncryptedKey
rek

type OAEPparams = OAEP.OAEPParams SHA512 B.ByteString B.ByteString

oaep :: OAEPparams
oaep :: OAEPparams
oaep = OAEP.OAEPParams
    { oaepHash :: SHA512
OAEP.oaepHash       = SHA512
SHA512
    , oaepMaskGenAlg :: MaskGenAlgorithm ByteString ByteString
OAEP.oaepMaskGenAlg = forall seed output hashAlg.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hashAlg) =>
hashAlg -> seed -> Int -> output
mgf1 SHA512
SHA512
    , oaepLabel :: Maybe ByteString
OAEP.oaepLabel      = forall a. Maybe a
Nothing
    }


--
-- signing & verifying
--

signKS :: PrivateKey -> ClearText -> KS RSASignature
signKS :: PrivateKey -> ClearText -> KS RSASignature
signKS PrivateKey
pk ClearText
dat =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Binary -> RSASignature
RSASignature forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary) forall a b. (a -> b) -> a -> b
$
          forall a. KS (Either Error a) -> KS a
rsaErrorKS forall a b. (a -> b) -> a -> b
$ forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
Maybe Blinder
-> PSSParams hash ByteString ByteString
-> PrivateKey
-> ByteString
-> m (Either Error ByteString)
PSS.sign forall a. Maybe a
Nothing PSSparams
pssp PrivateKey
pk forall a b. (a -> b) -> a -> b
$ Binary -> ByteString
_Binary forall a b. (a -> b) -> a -> b
$ ClearText -> Binary
_ClearText ClearText
dat

verifyKS :: PublicKey -> ClearText -> RSASignature -> Bool
verifyKS :: PublicKey -> ClearText -> RSASignature -> Bool
verifyKS PublicKey
pk (ClearText (Binary ByteString
dat)) (RSASignature (Binary ByteString
sig)) = forall hash.
HashAlgorithm hash =>
PSSParams hash ByteString ByteString
-> PublicKey -> ByteString -> ByteString -> Bool
PSS.verify PSSparams
pssp PublicKey
pk ByteString
dat ByteString
sig

type PSSparams = PSS.PSSParams SHA512 B.ByteString B.ByteString

pssp :: PSSparams
pssp :: PSSparams
pssp = forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> PSSParams hash seed output
PSS.defaultPSSParams SHA512
SHA512


--
-- AES encrypting/decrypting
--


encryptAESKS :: AESKey -> ClearText -> KS AESSecretData
encryptAESKS :: AESKey -> ClearText -> KS AESSecretData
encryptAESKS AESKey
aek ClearText
ct =
 do IV
iv <- KS IV
randomIVKS
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AESKey -> IV -> ClearText -> AESSecretData
encryptAES AESKey
aek IV
iv ClearText
ct

encryptAES :: AESKey -> IV -> ClearText -> AESSecretData
encryptAES :: AESKey -> IV -> ClearText -> AESSecretData
encryptAES AESKey
aek IV
iv (ClearText (Binary ByteString
dat)) =
    AESSecretData
        { _asd_iv :: IV
_asd_iv          = IV
iv
        , _asd_secret_data :: SecretData
_asd_secret_data = Binary -> SecretData
SecretData forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary forall a b. (a -> b) -> a -> b
$ AESKey -> IV -> ByteString -> ByteString
encryptCTR AESKey
aek IV
iv ByteString
dat
        }

decryptAES :: AESKey -> AESSecretData -> ClearText
decryptAES :: AESKey -> AESSecretData -> ClearText
decryptAES AESKey
aek AESSecretData{SecretData
IV
_asd_secret_data :: SecretData
_asd_iv :: IV
_asd_secret_data :: AESSecretData -> SecretData
_asd_iv :: AESSecretData -> IV
..} = Binary -> ClearText
ClearText forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary forall a b. (a -> b) -> a -> b
$
        AESKey -> IV -> ByteString -> ByteString
encryptCTR AESKey
aek IV
_asd_iv forall a b. (a -> b) -> a -> b
$ Binary -> ByteString
_Binary forall a b. (a -> b) -> a -> b
$ SecretData -> Binary
_SecretData SecretData
_asd_secret_data

randomAESKeyKS :: Cipher -> KS AESKey
randomAESKeyKS :: Cipher -> KS AESKey
randomAESKeyKS Cipher
cip = forall a. Octets -> (ByteString -> a) -> KS a
randomBytes (Cipher -> Octets
keyWidth Cipher
cip) forall a b. (a -> b) -> a -> b
$ Binary -> AESKey
AESKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary

randomIVKS :: KS IV
randomIVKS :: KS IV
randomIVKS = forall a. Octets -> (ByteString -> a) -> KS a
randomBytes Octets
sizeAesIV forall a b. (a -> b) -> a -> b
$ Binary -> IV
IV forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary

encryptCTR :: AESKey -> IV -> B.ByteString -> B.ByteString
encryptCTR :: AESKey -> IV -> ByteString -> ByteString
encryptCTR AESKey
aek = case ByteString -> Int
B.length forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce AESKey
aek of
    Int
16 -> forall k.
(BlockCipher k, Typeable k) =>
Proxy k -> AESKey -> IV -> ByteString -> ByteString
aes_ctr (forall {k} (t :: k). Proxy t
Proxy @AES128) AESKey
aek
    Int
24 -> forall k.
(BlockCipher k, Typeable k) =>
Proxy k -> AESKey -> IV -> ByteString -> ByteString
aes_ctr (forall {k} (t :: k). Proxy t
Proxy @AES192) AESKey
aek
    Int
32 -> forall k.
(BlockCipher k, Typeable k) =>
Proxy k -> AESKey -> IV -> ByteString -> ByteString
aes_ctr (forall {k} (t :: k). Proxy t
Proxy @AES256) AESKey
aek
    Int
ln -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"aek_from_key: unexpected AES key size: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
ln

aes_ctr :: forall k . (CCT.BlockCipher k,Typeable k)
        => Proxy k -> AESKey -> IV -> B.ByteString -> B.ByteString
aes_ctr :: forall k.
(BlockCipher k, Typeable k) =>
Proxy k -> AESKey -> IV -> ByteString -> ByteString
aes_ctr Proxy k
pxy AESKey
aek IV
iv ByteString
msg = forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
CCT.ctrCombine k
ky_ IV k
iv_ ByteString
msg
  where
    ky_ :: k
    ky_ :: k
ky_ = case forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
CCT.cipherInit ByteString
ky_b of
      CryptoFailed CryptoError
_ -> forall a. [Char] -> a
oops [Char]
"key"
      CryptoPassed k
z -> k
z

    iv_ :: CCT.IV k
    iv_ :: IV k
iv_ = forall a. a -> Maybe a -> a
fromMaybe (forall a. [Char] -> a
oops [Char]
"IV") forall a b. (a -> b) -> a -> b
$ forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
CCT.makeIV ByteString
iv_b

    oops :: String -> a
    oops :: forall a. [Char] -> a
oops [Char]
thg = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
tynm forall a. [a] -> [a] -> [a]
++ [Char]
" cryption error: mismatched size of "forall a. [a] -> [a] -> [a]
++[Char]
thg

    tynm :: String
    tynm :: [Char]
tynm = forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy k
pxy

    AESKey (Binary ByteString
ky_b) = AESKey
aek
    IV     (Binary ByteString
iv_b) = IV
iv


--
-- hashing
--


hashKS :: ClearText -> KS Hash
hashKS :: ClearText -> KS Hash
hashKS ClearText
ct = forall a b c. (a -> b -> c) -> b -> a -> c
flip HashDescription -> ClearText -> Hash
hashKS_ ClearText
ct forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KS HashDescription
defaultHashParamsKS

defaultHashParams :: HashDescription
defaultHashParams :: HashDescription
defaultHashParams = forall a. KS a -> a
trun KS HashDescription
defaultHashParamsKS

defaultHashParamsKS :: KS HashDescription
defaultHashParamsKS :: KS HashDescription
defaultHashParamsKS =
 do Comment
h_cmt <- forall a. Show a => Opt a -> KS a
lookupOpt Opt Comment
opt__hash_comment
    HashPRF
h_prf <- forall a. Show a => Opt a -> KS a
lookupOpt Opt HashPRF
opt__hash_prf
    Iterations
itrns <- forall a. Show a => Opt a -> KS a
lookupOpt Opt Iterations
opt__hash_iterations
    Octets
hs_wd <- forall a. Show a => Opt a -> KS a
lookupOpt Opt Octets
opt__hash_width_octets
    Octets
st_wd <- forall a. Show a => Opt a -> KS a
lookupOpt Opt Octets
opt__hash_salt_octets
    Salt
st    <- forall a. Octets -> (ByteString -> a) -> KS a
randomBytes Octets
st_wd (Binary -> Salt
Salt forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Comment
-> HashPRF
-> Iterations
-> Octets
-> Octets
-> Salt
-> HashDescription
hashd Comment
h_cmt HashPRF
h_prf Iterations
itrns Octets
hs_wd Octets
st_wd Salt
st
  where
    hashd :: Comment
-> HashPRF
-> Iterations
-> Octets
-> Octets
-> Salt
-> HashDescription
hashd  Comment
h_cmt HashPRF
h_prf Iterations
itrns Octets
hs_wd Octets
st_wd Salt
st =
        HashDescription
            { _hashd_comment :: Comment
_hashd_comment      = Comment
h_cmt
            , _hashd_prf :: HashPRF
_hashd_prf          = HashPRF
h_prf
            , _hashd_iterations :: Iterations
_hashd_iterations   = Iterations
itrns
            , _hashd_width_octets :: Octets
_hashd_width_octets = Octets
hs_wd
            , _hashd_salt_octets :: Octets
_hashd_salt_octets  = Octets
st_wd
            , _hashd_salt :: Salt
_hashd_salt         = Salt
st
            }

hashKS_ :: HashDescription -> ClearText -> Hash
hashKS_ :: HashDescription -> ClearText -> Hash
hashKS_ hd :: HashDescription
hd@HashDescription{Salt
Comment
Octets
Iterations
HashPRF
_hashd_salt :: Salt
_hashd_salt_octets :: Octets
_hashd_width_octets :: Octets
_hashd_iterations :: Iterations
_hashd_prf :: HashPRF
_hashd_comment :: Comment
_hashd_salt :: HashDescription -> Salt
_hashd_salt_octets :: HashDescription -> Octets
_hashd_width_octets :: HashDescription -> Octets
_hashd_iterations :: HashDescription -> Iterations
_hashd_prf :: HashDescription -> HashPRF
_hashd_comment :: HashDescription -> Comment
..} ClearText
ct =
    Hash
        { _hash_description :: HashDescription
_hash_description = HashDescription
hd
        , _hash_hash :: HashData
_hash_hash        = forall a.
HashPRF
-> ClearText
-> Salt
-> Iterations
-> Octets
-> (ByteString -> a)
-> a
pbkdf HashPRF
_hashd_prf ClearText
ct Salt
_hashd_salt Iterations
_hashd_iterations
                                        Octets
_hashd_width_octets (Binary -> HashData
HashData forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary)
        }

--
-- Generating a private/public key pair
--

default_e :: Integer
default_e :: Integer
default_e = Integer
0x10001

default_key_size :: Int
default_key_size :: Int
default_key_size = Int
2048 forall a. Integral a => a -> a -> a
`div` Int
8

generateKeysKS :: KS (PublicKey,PrivateKey)
generateKeysKS :: KS (PublicKey, PrivateKey)
generateKeysKS = Int -> KS (PublicKey, PrivateKey)
generateKeysKS_ Int
default_key_size

generateKeysKS_ :: Int -> KS (PublicKey,PrivateKey)
generateKeysKS_ :: Int -> KS (PublicKey, PrivateKey)
generateKeysKS_ Int
ksz = forall (m :: * -> *).
MonadRandom m =>
Int -> Integer -> m (PublicKey, PrivateKey)
generate Int
ksz Integer
default_e


--
-- Encoding & decoding private & public keys
--

decodePrivateKeyDERE :: ClearText -> E PrivateKey
decodePrivateKeyDERE :: ClearText -> E PrivateKey
decodePrivateKeyDERE = forall a. ASN1 a => ByteString -> E a
decodeDERE forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binary -> ByteString
_Binary forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClearText -> Binary
_ClearText

decodePublicKeyDERE :: ClearText -> E PublicKey
decodePublicKeyDERE :: ClearText -> E PublicKey
decodePublicKeyDERE = forall a. ASN1 a => ByteString -> E a
decodeDERE forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binary -> ByteString
_Binary forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClearText -> Binary
_ClearText

encodePrivateKeyDER :: PrivateKey -> ClearText
encodePrivateKeyDER :: PrivateKey -> ClearText
encodePrivateKeyDER = Binary -> ClearText
ClearText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ASN1 a => a -> ByteString
encodeDER

encodePublicKeyDER :: PublicKey -> ClearText
encodePublicKeyDER :: PublicKey -> ClearText
encodePublicKeyDER = Binary -> ClearText
ClearText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ASN1 a => a -> ByteString
encodeDER


class ASN1 a where
  decodeDERE :: B.ByteString -> E a
  encodeDER  :: a -> B.ByteString


instance ASN1 PrivateKey where
  decodeDERE :: ByteString -> E PrivateKey
decodeDERE = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrivateKey -> PrivateKey
privateFromCPT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ASN1Object a => ByteString -> E a
decodeDERE_
  encodeDER :: PrivateKey -> ByteString
encodeDER  = forall a. ASN1Object a => a -> ByteString
encodeDER_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> PrivateKey
privateIntoCPT

instance ASN1 PublicKey  where
  decodeDERE :: ByteString -> E PublicKey
decodeDERE = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PublicKey -> PublicKey
publicFromCPT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ASN1Object a => ByteString -> E a
decodeDERE_
  encodeDER :: PublicKey -> ByteString
encodeDER  = forall a. ASN1Object a => a -> ByteString
encodeDER_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> PublicKey
publicIntoCPT

privateFromCPT :: CPT.PrivateKey -> PrivateKey
privateFromCPT :: PrivateKey -> PrivateKey
privateFromCPT CPT.PrivateKey{Integer
PublicKey
private_pub :: PrivateKey -> PublicKey
private_d :: PrivateKey -> Integer
private_p :: PrivateKey -> Integer
private_q :: PrivateKey -> Integer
private_dP :: PrivateKey -> Integer
private_dQ :: PrivateKey -> Integer
private_qinv :: PrivateKey -> Integer
private_qinv :: Integer
private_dQ :: Integer
private_dP :: Integer
private_q :: Integer
private_p :: Integer
private_d :: Integer
private_pub :: PublicKey
..} =
  PrivateKey
    { private_pub :: PublicKey
private_pub  = PublicKey -> PublicKey
publicFromCPT PublicKey
private_pub
    , Integer
private_d :: Integer
private_p :: Integer
private_q :: Integer
private_dP :: Integer
private_dQ :: Integer
private_qinv :: Integer
private_qinv :: Integer
private_dQ :: Integer
private_dP :: Integer
private_q :: Integer
private_p :: Integer
private_d :: Integer
..
    }

privateIntoCPT :: PrivateKey -> CPT.PrivateKey
privateIntoCPT :: PrivateKey -> PrivateKey
privateIntoCPT PrivateKey{Integer
PublicKey
private_qinv :: Integer
private_dQ :: Integer
private_dP :: Integer
private_q :: Integer
private_p :: Integer
private_d :: Integer
private_pub :: PublicKey
private_d :: PrivateKey -> Integer
private_p :: PrivateKey -> Integer
private_q :: PrivateKey -> Integer
private_dP :: PrivateKey -> Integer
private_dQ :: PrivateKey -> Integer
private_qinv :: PrivateKey -> Integer
private_pub :: PrivateKey -> PublicKey
..} =
  CPT.PrivateKey
    { private_pub :: PublicKey
private_pub  = PublicKey -> PublicKey
publicIntoCPT PublicKey
private_pub
    , Integer
private_qinv :: Integer
private_dQ :: Integer
private_dP :: Integer
private_q :: Integer
private_p :: Integer
private_d :: Integer
private_d :: Integer
private_p :: Integer
private_q :: Integer
private_dP :: Integer
private_dQ :: Integer
private_qinv :: Integer
..
    }

publicFromCPT :: CPT.PublicKey -> PublicKey
publicFromCPT :: PublicKey -> PublicKey
publicFromCPT CPT.PublicKey{Int
Integer
public_size :: PublicKey -> Int
public_n :: PublicKey -> Integer
public_e :: PublicKey -> Integer
public_e :: Integer
public_n :: Integer
public_size :: Int
..} = PublicKey{Int
Integer
public_size :: Int
public_n :: Integer
public_e :: Integer
public_e :: Integer
public_n :: Integer
public_size :: Int
..}

publicIntoCPT :: PublicKey -> CPT.PublicKey
publicIntoCPT :: PublicKey -> PublicKey
publicIntoCPT PublicKey{Int
Integer
public_e :: Integer
public_n :: Integer
public_size :: Int
public_size :: PublicKey -> Int
public_n :: PublicKey -> Integer
public_e :: PublicKey -> Integer
..} = CPT.PublicKey{Int
Integer
public_e :: Integer
public_n :: Integer
public_size :: Int
public_size :: Int
public_n :: Integer
public_e :: Integer
..}


decodeDERE_ :: A.ASN1Object a => B.ByteString -> E a
decodeDERE_ :: forall a. ASN1Object a => ByteString -> E a
decodeDERE_ ByteString
bs =
    case forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
A.decodeASN1 DER
A.DER forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
lzy ByteString
bs of
      Left ASN1Error
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char] -> Reason
strMsg forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show ASN1Error
err
      Right [ASN1]
as ->
        case forall a. ASN1Object a => [ASN1] -> Either [Char] (a, [ASN1])
A.fromASN1 [ASN1]
as of
          Left [Char]
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char] -> Reason
strMsg forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show [Char]
err
          Right (a, [ASN1])
pr ->
            case (a, [ASN1])
pr of
              (a
pk,[]) -> forall (m :: * -> *) a. Monad m => a -> m a
return a
pk
              (a, [ASN1])
_       -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char] -> Reason
strMsg [Char]
"residual data"
  where
    lzy :: ByteString -> ByteString
lzy = [Char] -> ByteString
LBS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
B.unpack

encodeDER_ :: A.ASN1Object a => a -> B.ByteString
encodeDER_ :: forall a. ASN1Object a => a -> ByteString
encodeDER_ = ByteString -> ByteString
egr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
A.encodeASN1 DER
A.DER  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. ASN1Object a => a -> ASN1S
A.toASN1 []
  where
    egr :: ByteString -> ByteString
egr = [Char] -> ByteString
B.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
LBS.unpack



--
-- Helpers
--

rsa2e :: Either Error a -> E a
rsa2e :: forall a. Either Error a -> E a
rsa2e = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Reason
rsaError) forall a b. b -> Either a b
Right