{-# 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 "cryptonite" 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 = KS Bool -> Bool
forall a. KS a -> a
trun (KS Bool -> Bool) -> KS Bool -> Bool
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 KS RSASecretData -> (RSASecretData -> KS ClearText) -> KS ClearText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PrivateKey -> RSASecretData -> KS ClearText
decryptKS PrivateKey
prk
    Bool -> KS Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> KS Bool) -> Bool -> KS Bool
forall a b. (a -> b) -> a -> b
$ ClearText
tm' ClearText -> ClearText -> Bool
forall a. Eq a => a -> a -> Bool
== ClearText
tm
  where
    tm :: ClearText
tm = Binary -> ClearText
ClearText (Binary -> ClearText) -> Binary -> ClearText
forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
"test message"

test_pss :: Bool
test_pss :: Bool
test_pss = KS Bool -> Bool
forall a. KS a -> a
trun (KS Bool -> Bool) -> KS Bool -> Bool
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
    Bool -> KS Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> KS Bool) -> Bool -> KS Bool
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 (Binary -> ClearText) -> Binary -> ClearText
forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
"hello"
    tm' :: ClearText
tm' = Binary -> ClearText
ClearText (Binary -> ClearText) -> Binary -> 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 <- Opt Cipher -> KS Cipher
forall a. Show a => Opt a -> KS a
lookupOpt Opt Cipher
opt__crypt_cipher
    HashPRF
prf   <- Opt HashPRF -> KS HashPRF
forall a. Show a => Opt a -> KS a
lookupOpt Opt HashPRF
opt__crypt_prf
    Iterations
itrns <- Opt Iterations -> KS Iterations
forall a. Show a => Opt a -> KS a
lookupOpt Opt Iterations
opt__crypt_iterations
    Octets
st_sz <- Opt Octets -> KS Octets
forall a. Show a => Opt a -> KS a
lookupOpt Opt Octets
opt__crypt_salt_octets
    Salt
slt   <- Octets -> (ByteString -> Salt) -> KS Salt
forall a. Octets -> (ByteString -> a) -> KS a
randomBytes Octets
st_sz (Binary -> Salt
Salt (Binary -> Salt) -> (ByteString -> Binary) -> ByteString -> Salt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary)
    EncrypedCopy -> KS EncrypedCopy
forall (m :: * -> *) a. Monad m => a -> m a
return
        EncrypedCopy :: Safeguard
-> Cipher
-> HashPRF
-> Iterations
-> Salt
-> EncrypedCopyData
-> EncrypedCopy
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   (RSASecretData -> EncrypedCopyData)
-> KS RSASecretData -> KS EncrypedCopyData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PublicKey -> ClearText -> KS RSASecretData
encryptKS PublicKey
puk ClearText
ct
      EK_private   PrivateKey
_   -> String -> KS EncrypedCopyData
forall a. String -> KS a
errorKS String
"Crypto.Save: saving with private key"
      EK_symmetric AESKey
aek -> AESSecretData -> EncrypedCopyData
ECD_aes   (AESSecretData -> EncrypedCopyData)
-> KS AESSecretData -> KS EncrypedCopyData
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 (ClearText -> EncrypedCopyData)
-> KS ClearText -> KS EncrypedCopyData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClearText -> KS ClearText
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) -> ClearText -> KS ClearText
forall (m :: * -> *) a. Monad m => a -> m a
return (ClearText -> KS ClearText) -> ClearText -> KS ClearText
forall a b. (a -> b) -> a -> b
$ AESKey -> AESSecretData -> ClearText
decryptAES AESKey
aek AESSecretData
asd
      (ECD_clear   ClearText
ct ,EK_none      Void
_  ) -> ClearText -> KS ClearText
forall (m :: * -> *) a. Monad m => a -> m a
return ClearText
ct
      (ECD_no_data Void
_  ,EncryptionKey
_               ) -> String -> KS ClearText
forall a. String -> KS a
errorKS String
"restore: no data!"
      (EncrypedCopyData, EncryptionKey)
_                                  -> String -> KS ClearText
forall a. String -> KS a
errorKS String
"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
_              []  = String -> KS AESKey
forall a. HasCallStack => String -> a
error String
"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 (Cipher -> AESKey) -> KS Cipher -> KS AESKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Opt Cipher -> KS Cipher
forall a. Show a => Opt a -> KS a
lookupOpt Opt Cipher
opt__crypt_cipher
  where
    p2 :: Cipher -> AESKey
p2 Cipher
ciphr = HashPRF
-> ClearText
-> Salt
-> Iterations
-> Octets
-> (ByteString -> AESKey)
-> AESKey
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) ((ByteString -> AESKey) -> AESKey)
-> (ByteString -> AESKey) -> AESKey
forall a b. (a -> b) -> a -> b
$ Binary -> AESKey
AESKey (Binary -> AESKey)
-> (ByteString -> Binary) -> ByteString -> AESKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary

    ct :: ClearText
ct       = Binary -> ClearText
ClearText (Binary -> ClearText) -> Binary -> ClearText
forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary (ByteString -> Binary) -> ByteString -> Binary
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ClearText -> ByteString) -> [ClearText] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Binary -> ByteString
_Binary(Binary -> ByteString)
-> (ClearText -> Binary) -> ClearText -> ByteString
forall 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 <- Opt Cipher -> KS Cipher
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
    RSASecretData -> KS RSASecretData
forall (m :: * -> *) a. Monad m => a -> m a
return
        RSASecretData :: RSAEncryptedKey -> AESSecretData -> RSASecretData
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 = E ClearText -> KS ClearText
forall a. E a -> KS a
e2ks (E ClearText -> KS ClearText) -> E ClearText -> KS ClearText
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
    ClearText -> E ClearText
forall (m :: * -> *) a. Monad m => a -> m a
return (ClearText -> E ClearText) -> ClearText -> E ClearText
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 (Binary -> RSASecretBytes) -> Binary -> RSASecretBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary (ByteString -> Binary) -> ByteString -> Binary
forall a b. (a -> b) -> a -> b
$
        [ByteString] -> ByteString
B.concat
            [ Binary -> ByteString
_Binary (Binary -> ByteString) -> Binary -> ByteString
forall a b. (a -> b) -> a -> b
$ RSAEncryptedKey -> Binary
_RSAEncryptedKey RSAEncryptedKey
_rsd_encrypted_key
            , Binary -> ByteString
_Binary (Binary -> ByteString) -> Binary -> ByteString
forall a b. (a -> b) -> a -> b
$ IV -> Binary
_IV              IV
_asd_iv
            , Binary -> ByteString
_Binary (Binary -> ByteString) -> Binary -> ByteString
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) = E RSASecretData -> KS RSASecretData
forall a. E a -> KS a
e2ks (E RSASecretData -> KS RSASecretData)
-> E RSASecretData -> KS RSASecretData
forall a b. (a -> b) -> a -> b
$ ByteString -> E RSASecretData
decodeRSASecretData_ (ByteString -> E RSASecretData) -> ByteString -> E RSASecretData
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)
forall a.
Error a =>
Octets -> ByteString -> Either a (ByteString, ByteString)
slice Octets
sizeOAE   ByteString
dat0
    (ByteString
iv ,ByteString
edat) <- Octets -> ByteString -> Either Reason (ByteString, ByteString)
forall a.
Error a =>
Octets -> ByteString -> Either a (ByteString, ByteString)
slice Octets
sizeAesIV ByteString
dat1
    RSASecretData -> E RSASecretData
forall (m :: * -> *) a. Monad m => a -> m a
return
        RSASecretData :: RSAEncryptedKey -> AESSecretData -> RSASecretData
RSASecretData
            { _rsd_encrypted_key :: RSAEncryptedKey
_rsd_encrypted_key    = Binary -> RSAEncryptedKey
RSAEncryptedKey (Binary -> RSAEncryptedKey) -> Binary -> RSAEncryptedKey
forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
eky
            , _rsd_aes_secret_data :: AESSecretData
_rsd_aes_secret_data =
                AESSecretData :: IV -> SecretData -> AESSecretData
AESSecretData
                    { _asd_iv :: IV
_asd_iv           = Binary -> IV
IV         (Binary -> IV) -> Binary -> IV
forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
iv
                    , _asd_secret_data :: SecretData
_asd_secret_data  = Binary -> SecretData
SecretData (Binary -> SecretData) -> Binary -> SecretData
forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
edat
                    }
            }
  where
    slice :: Octets -> ByteString -> Either a (ByteString, ByteString)
slice Octets
sz ByteString
bs =
        case ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Octets -> Int
_Octets Octets
sz of
          Bool
True  -> (ByteString, ByteString) -> Either a (ByteString, ByteString)
forall a b. b -> Either a b
Right ((ByteString, ByteString) -> Either a (ByteString, ByteString))
-> (ByteString, ByteString) -> Either a (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Octets -> Int
_Octets Octets
sz) ByteString
bs
          Bool
False -> a -> Either a (ByteString, ByteString)
forall a b. a -> Either a b
Left  (a -> Either a (ByteString, ByteString))
-> a -> Either a (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. Error a => String -> a
strMsg String
"decrypt: not enough bytes"


--
-- RSA encrypting & decrypting
--

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

decryptRSAKS :: PrivateKey -> RSAEncryptedKey -> KS AESKey
decryptRSAKS :: PrivateKey -> RSAEncryptedKey -> KS AESKey
decryptRSAKS PrivateKey
pk RSAEncryptedKey
rek = (Reason -> KS AESKey)
-> (AESKey -> KS AESKey) -> E AESKey -> KS AESKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Reason -> KS AESKey
forall a. Reason -> KS a
throwKS AESKey -> KS AESKey
forall (m :: * -> *) a. Monad m => a -> m a
return (E AESKey -> KS AESKey) -> E AESKey -> KS AESKey
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 = Either Error AESKey -> E AESKey
forall a. Either Error a -> E a
rsa2e (Either Error AESKey -> E AESKey)
-> Either Error AESKey -> E AESKey
forall a b. (a -> b) -> a -> b
$ (ByteString -> AESKey)
-> Either Error ByteString -> Either Error AESKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Binary -> AESKey
AESKey (Binary -> AESKey)
-> (ByteString -> Binary) -> ByteString -> AESKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary) (Either Error ByteString -> Either Error AESKey)
-> Either Error ByteString -> Either Error AESKey
forall a b. (a -> b) -> a -> b
$
    Maybe Blinder
-> OAEPParams SHA512 ByteString ByteString
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hash.
HashAlgorithm hash =>
Maybe Blinder
-> OAEPParams hash ByteString ByteString
-> PrivateKey
-> ByteString
-> Either Error ByteString
OAEP.decrypt Maybe Blinder
forall a. Maybe a
Nothing OAEPParams SHA512 ByteString ByteString
oaep PrivateKey
pk (ByteString -> Either Error ByteString)
-> ByteString -> Either Error ByteString
forall a b. (a -> b) -> a -> b
$ Binary -> ByteString
_Binary (Binary -> ByteString) -> Binary -> ByteString
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 SHA512 ByteString ByteString
oaep = OAEPParams :: forall hash seed output.
hash
-> MaskGenAlgorithm seed output
-> Maybe ByteString
-> OAEPParams hash seed output
OAEP.OAEPParams
    { oaepHash :: SHA512
OAEP.oaepHash       = SHA512
SHA512
    , oaepMaskGenAlg :: MaskGenAlgorithm ByteString ByteString
OAEP.oaepMaskGenAlg = SHA512 -> MaskGenAlgorithm ByteString ByteString
forall seed output hashAlg.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hashAlg) =>
hashAlg -> seed -> Int -> output
mgf1 SHA512
SHA512
    , oaepLabel :: Maybe ByteString
OAEP.oaepLabel      = Maybe ByteString
forall a. Maybe a
Nothing
    }


--
-- signing & verifying
--

signKS :: PrivateKey -> ClearText -> KS RSASignature
signKS :: PrivateKey -> ClearText -> KS RSASignature
signKS PrivateKey
pk ClearText
dat =
    (ByteString -> RSASignature) -> KS ByteString -> KS RSASignature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Binary -> RSASignature
RSASignature (Binary -> RSASignature)
-> (ByteString -> Binary) -> ByteString -> RSASignature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary) (KS ByteString -> KS RSASignature)
-> KS ByteString -> KS RSASignature
forall a b. (a -> b) -> a -> b
$
          KS (Either Error ByteString) -> KS ByteString
forall a. KS (Either Error a) -> KS a
rsaErrorKS (KS (Either Error ByteString) -> KS ByteString)
-> KS (Either Error ByteString) -> KS ByteString
forall a b. (a -> b) -> a -> b
$ Maybe Blinder
-> PSSParams SHA512 ByteString ByteString
-> PrivateKey
-> ByteString
-> KS (Either Error ByteString)
forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
Maybe Blinder
-> PSSParams hash ByteString ByteString
-> PrivateKey
-> ByteString
-> m (Either Error ByteString)
PSS.sign Maybe Blinder
forall a. Maybe a
Nothing PSSParams SHA512 ByteString ByteString
pssp PrivateKey
pk (ByteString -> KS (Either Error ByteString))
-> ByteString -> KS (Either Error ByteString)
forall a b. (a -> b) -> a -> b
$ Binary -> ByteString
_Binary (Binary -> ByteString) -> Binary -> ByteString
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)) = PSSParams SHA512 ByteString ByteString
-> PublicKey -> ByteString -> ByteString -> Bool
forall hash.
HashAlgorithm hash =>
PSSParams hash ByteString ByteString
-> PublicKey -> ByteString -> ByteString -> Bool
PSS.verify PSSParams SHA512 ByteString ByteString
pssp PublicKey
pk ByteString
dat ByteString
sig

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

pssp :: PSSparams
pssp :: PSSParams SHA512 ByteString ByteString
pssp = SHA512 -> PSSParams SHA512 ByteString ByteString
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
    AESSecretData -> KS AESSecretData
forall (m :: * -> *) a. Monad m => a -> m a
return (AESSecretData -> KS AESSecretData)
-> AESSecretData -> KS AESSecretData
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 :: IV -> SecretData -> AESSecretData
AESSecretData
        { _asd_iv :: IV
_asd_iv          = IV
iv
        , _asd_secret_data :: SecretData
_asd_secret_data = Binary -> SecretData
SecretData (Binary -> SecretData) -> Binary -> SecretData
forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary (ByteString -> Binary) -> ByteString -> 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 (Binary -> ClearText) -> Binary -> ClearText
forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary (ByteString -> Binary) -> ByteString -> Binary
forall a b. (a -> b) -> a -> b
$
        AESKey -> IV -> ByteString -> ByteString
encryptCTR AESKey
aek IV
_asd_iv (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Binary -> ByteString
_Binary (Binary -> ByteString) -> Binary -> ByteString
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 = Octets -> (ByteString -> AESKey) -> KS AESKey
forall a. Octets -> (ByteString -> a) -> KS a
randomBytes (Cipher -> Octets
keyWidth Cipher
cip) ((ByteString -> AESKey) -> KS AESKey)
-> (ByteString -> AESKey) -> KS AESKey
forall a b. (a -> b) -> a -> b
$ Binary -> AESKey
AESKey (Binary -> AESKey)
-> (ByteString -> Binary) -> ByteString -> AESKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary

randomIVKS :: KS IV
randomIVKS :: KS IV
randomIVKS = Octets -> (ByteString -> IV) -> KS IV
forall a. Octets -> (ByteString -> a) -> KS a
randomBytes Octets
sizeAesIV ((ByteString -> IV) -> KS IV) -> (ByteString -> IV) -> KS IV
forall a b. (a -> b) -> a -> b
$ Binary -> IV
IV (Binary -> IV) -> (ByteString -> Binary) -> ByteString -> 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 (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ AESKey -> ByteString
coerce AESKey
aek of
    Int
16 -> Proxy AES128 -> AESKey -> IV -> ByteString -> ByteString
forall k.
(BlockCipher k, Typeable k) =>
Proxy k -> AESKey -> IV -> ByteString -> ByteString
aes_ctr (Proxy AES128
forall k (t :: k). Proxy t
Proxy @AES128) AESKey
aek
    Int
24 -> Proxy AES192 -> AESKey -> IV -> ByteString -> ByteString
forall k.
(BlockCipher k, Typeable k) =>
Proxy k -> AESKey -> IV -> ByteString -> ByteString
aes_ctr (Proxy AES192
forall k (t :: k). Proxy t
Proxy @AES192) AESKey
aek
    Int
32 -> Proxy AES256 -> AESKey -> IV -> ByteString -> ByteString
forall k.
(BlockCipher k, Typeable k) =>
Proxy k -> AESKey -> IV -> ByteString -> ByteString
aes_ctr (Proxy AES256
forall k (t :: k). Proxy t
Proxy @AES256) AESKey
aek
    Int
ln -> String -> IV -> ByteString -> ByteString
forall a. HasCallStack => String -> a
error (String -> IV -> ByteString -> ByteString)
-> String -> IV -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"aek_from_key: unexpected AES key size: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ln

aes_ctr :: forall k . (CCT.BlockCipher k,Typeable k)
        => Proxy k -> AESKey -> IV -> B.ByteString -> B.ByteString
aes_ctr :: Proxy k -> AESKey -> IV -> ByteString -> ByteString
aes_ctr Proxy k
pxy AESKey
aek IV
iv ByteString
msg = k -> IV k -> ByteString -> ByteString
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 ByteString -> CryptoFailable k
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
CCT.cipherInit ByteString
ky_b of
      CryptoFailed CryptoError
_ -> String -> k
forall a. String -> a
oops String
"key"
      CryptoPassed k
z -> k
z

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

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

    tynm :: String
    tynm :: String
tynm = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy k -> TypeRep
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 = (HashDescription -> ClearText -> Hash)
-> ClearText -> HashDescription -> Hash
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashDescription -> ClearText -> Hash
hashKS_ ClearText
ct (HashDescription -> Hash) -> KS HashDescription -> KS Hash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KS HashDescription
defaultHashParamsKS

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

defaultHashParamsKS :: KS HashDescription
defaultHashParamsKS :: KS HashDescription
defaultHashParamsKS =
 do Comment
h_cmt <- Opt Comment -> KS Comment
forall a. Show a => Opt a -> KS a
lookupOpt Opt Comment
opt__hash_comment
    HashPRF
h_prf <- Opt HashPRF -> KS HashPRF
forall a. Show a => Opt a -> KS a
lookupOpt Opt HashPRF
opt__hash_prf
    Iterations
itrns <- Opt Iterations -> KS Iterations
forall a. Show a => Opt a -> KS a
lookupOpt Opt Iterations
opt__hash_iterations
    Octets
hs_wd <- Opt Octets -> KS Octets
forall a. Show a => Opt a -> KS a
lookupOpt Opt Octets
opt__hash_width_octets
    Octets
st_wd <- Opt Octets -> KS Octets
forall a. Show a => Opt a -> KS a
lookupOpt Opt Octets
opt__hash_salt_octets
    Salt
st    <- Octets -> (ByteString -> Salt) -> KS Salt
forall a. Octets -> (ByteString -> a) -> KS a
randomBytes Octets
st_wd (Binary -> Salt
Salt (Binary -> Salt) -> (ByteString -> Binary) -> ByteString -> Salt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary)
    HashDescription -> KS HashDescription
forall (m :: * -> *) a. Monad m => a -> m a
return (HashDescription -> KS HashDescription)
-> HashDescription -> KS HashDescription
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 :: Comment
-> HashPRF
-> Iterations
-> Octets
-> Octets
-> Salt
-> HashDescription
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 :: HashDescription -> HashData -> Hash
Hash
        { _hash_description :: HashDescription
_hash_description = HashDescription
hd
        , _hash_hash :: HashData
_hash_hash        = HashPRF
-> ClearText
-> Salt
-> Iterations
-> Octets
-> (ByteString -> HashData)
-> HashData
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 (Binary -> HashData)
-> (ByteString -> Binary) -> ByteString -> 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 Int -> Int -> Int
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 = Int -> Integer -> KS (PublicKey, PrivateKey)
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 = ByteString -> E PrivateKey
forall a. ASN1 a => ByteString -> E a
decodeDERE (ByteString -> E PrivateKey)
-> (ClearText -> ByteString) -> ClearText -> E PrivateKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binary -> ByteString
_Binary (Binary -> ByteString)
-> (ClearText -> Binary) -> ClearText -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClearText -> Binary
_ClearText

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

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

encodePublicKeyDER :: PublicKey -> ClearText
encodePublicKeyDER :: PublicKey -> ClearText
encodePublicKeyDER = Binary -> ClearText
ClearText (Binary -> ClearText)
-> (PublicKey -> Binary) -> PublicKey -> ClearText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary (ByteString -> Binary)
-> (PublicKey -> ByteString) -> PublicKey -> Binary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> ByteString
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 = (PrivateKey -> PrivateKey)
-> Either Reason PrivateKey -> E PrivateKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrivateKey -> PrivateKey
privateFromCPT (Either Reason PrivateKey -> E PrivateKey)
-> (ByteString -> Either Reason PrivateKey)
-> ByteString
-> E PrivateKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Reason PrivateKey
forall a. ASN1Object a => ByteString -> E a
decodeDERE_
  encodeDER :: PrivateKey -> ByteString
encodeDER  = PrivateKey -> ByteString
forall a. ASN1Object a => a -> ByteString
encodeDER_ (PrivateKey -> ByteString)
-> (PrivateKey -> PrivateKey) -> PrivateKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> PrivateKey
privateIntoCPT

instance ASN1 PublicKey  where
  decodeDERE :: ByteString -> E PublicKey
decodeDERE = (PublicKey -> PublicKey) -> Either Reason PublicKey -> E PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PublicKey -> PublicKey
publicFromCPT (Either Reason PublicKey -> E PublicKey)
-> (ByteString -> Either Reason PublicKey)
-> ByteString
-> E PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Reason PublicKey
forall a. ASN1Object a => ByteString -> E a
decodeDERE_
  encodeDER :: PublicKey -> ByteString
encodeDER  = PublicKey -> ByteString
forall a. ASN1Object a => a -> ByteString
encodeDER_ (PublicKey -> ByteString)
-> (PublicKey -> PublicKey) -> PublicKey -> ByteString
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 :: PublicKey
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> PrivateKey
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
..} =
  PrivateKey :: PublicKey
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> PrivateKey
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 -> Integer -> PublicKey
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
..} = PublicKey :: Int -> Integer -> Integer -> PublicKey
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_ :: ByteString -> E a
decodeDERE_ ByteString
bs =
    case DER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
A.decodeASN1 DER
A.DER (ByteString -> Either ASN1Error [ASN1])
-> ByteString -> Either ASN1Error [ASN1]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
lzy ByteString
bs of
      Left ASN1Error
err -> Reason -> E a
forall a b. a -> Either a b
Left (Reason -> E a) -> Reason -> E a
forall a b. (a -> b) -> a -> b
$ String -> Reason
forall a. Error a => String -> a
strMsg (String -> Reason) -> String -> Reason
forall a b. (a -> b) -> a -> b
$ ASN1Error -> String
forall a. Show a => a -> String
show ASN1Error
err
      Right [ASN1]
as ->
        case [ASN1] -> Either String (a, [ASN1])
forall a. ASN1Object a => [ASN1] -> Either String (a, [ASN1])
A.fromASN1 [ASN1]
as of
          Left String
err -> Reason -> E a
forall a b. a -> Either a b
Left (Reason -> E a) -> Reason -> E a
forall a b. (a -> b) -> a -> b
$ String -> Reason
forall a. Error a => String -> a
strMsg (String -> Reason) -> String -> Reason
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
err
          Right (a, [ASN1])
pr ->
            case (a, [ASN1])
pr of
              (a
pk,[]) -> a -> E a
forall (m :: * -> *) a. Monad m => a -> m a
return a
pk
              (a, [ASN1])
_       -> Reason -> E a
forall a b. a -> Either a b
Left (Reason -> E a) -> Reason -> E a
forall a b. (a -> b) -> a -> b
$ String -> Reason
forall a. Error a => String -> a
strMsg String
"residual data"
  where
    lzy :: ByteString -> ByteString
lzy = String -> ByteString
LBS.pack (String -> ByteString)
-> (ByteString -> String) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack

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



--
-- Helpers
--

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