{-# 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
, 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
import qualified "crypton" Crypto.Cipher.Types as CCT
sizeAesIV, sizeOAE :: Octets
sizeAesIV :: Octets
sizeAesIV = Octets
16
sizeOAE :: Octets
sizeOAE = Octets
256
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"
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_
}
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"
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
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
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"
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
}
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
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
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)
}
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
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
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