Crypto.hs

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_HADDOCK hide #-}

module Network.TLS.Crypto (
    HashContext,
    HashCtx,
    hashInit,
    hashUpdate,
    hashUpdates,
    hashUpdateSSL,
    hashFinal,
    module Network.TLS.Crypto.DH,
    module Network.TLS.Crypto.IES,
    module Network.TLS.Crypto.Types,

    -- * Hash
    hash,
    hashChunks,
    Hash (..),
    hashName,
    hashDigestSize,
    hashBlockSize,

    -- * key exchange generic interface
    PubKey (..),
    PrivKey (..),
    PublicKey,
    PrivateKey,
    SignatureParams (..),
    isKeyExchangeSignatureKey,
    findKeyExchangeSignatureAlg,
    findFiniteFieldGroup,
    findEllipticCurveGroup,
    kxEncrypt,
    kxDecrypt,
    kxSign,
    kxVerify,
    kxCanUseRSApkcs1,
    kxCanUseRSApss,
    kxSupportedPrivKeyEC,
    KxError (..),
    RSAEncoding (..),
) where

import qualified Crypto.ECC as ECDSA
import Crypto.Error
import qualified Crypto.Hash as H
import Crypto.Number.Basic (numBits)
import qualified Crypto.PubKey.DH as DH
import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA_ECC
import qualified Crypto.PubKey.ECC.Types as ECC
import qualified Crypto.PubKey.ECDSA as ECDSA
import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Crypto.PubKey.Ed448 as Ed448
import qualified Crypto.PubKey.MLDSA as MLDSA
import qualified Crypto.PubKey.RSA as RSA
import qualified Crypto.PubKey.RSA.PKCS15 as RSA
import qualified Crypto.PubKey.RSA.PSS as PSS
import Crypto.Random
import Data.ASN1.BinaryEncoding (DER (..))
import Data.ASN1.Encoding
import Data.ASN1.Types
import Data.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes, convert)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import Data.Proxy
import Data.X509 (
    PrivKey (..),
    PrivKeyEC (..),
    PubKey (..),
    PubKeyEC (..),
    SerializedPoint (..),
    privkeyMLDSA_key,
 )
import Data.X509.EC (ecPrivKeyCurveName, ecPubKeyCurveName, unserializePoint)

import Network.TLS.Crypto.DH
import Network.TLS.Crypto.IES
import Network.TLS.Crypto.Types
import Network.TLS.Imports

----------------------------------------------------------------

{-# DEPRECATED PublicKey "use PubKey" #-}
type PublicKey = PubKey
{-# DEPRECATED PrivateKey "use PrivKey" #-}
type PrivateKey = PrivKey

data KxError
    = RSAError RSA.Error
    | KxUnsupported
    deriving (Show)

isKeyExchangeSignatureKey :: KeyExchangeSignatureAlg -> PubKey -> Bool
isKeyExchangeSignatureKey = f
  where
    f KX_RSA (PubKeyRSA _) = True
    f KX_DSA (PubKeyDSA _) = True
    f KX_ECDSA (PubKeyEC _) = True
    f KX_ECDSA (PubKeyEd25519 _) = True
    f KX_ECDSA (PubKeyEd448 _) = True
    f _ _ = False

findKeyExchangeSignatureAlg
    :: (PubKey, PrivKey) -> Maybe KeyExchangeSignatureAlg
findKeyExchangeSignatureAlg keyPair =
    case keyPair of
        (PubKeyRSA _, PrivKeyRSA _) -> Just KX_RSA
        (PubKeyDSA _, PrivKeyDSA _) -> Just KX_DSA
        (PubKeyEC _, PrivKeyEC _) -> Just KX_ECDSA
        (PubKeyEd25519 _, PrivKeyEd25519 _) -> Just KX_ECDSA
        (PubKeyEd448 _, PrivKeyEd448 _) -> Just KX_ECDSA
        _ -> Nothing

findFiniteFieldGroup :: DH.Params -> Maybe Group
findFiniteFieldGroup params = lookup (pg params) table
  where
    pg (DH.Params p g _) = (p, g)

    table =
        [ (pg prms, grp)
        | grp <- availableFFGroups
        , let prms = fromJust $ dhParamsForGroup grp
        ]

findEllipticCurveGroup :: PubKeyEC -> Maybe Group
findEllipticCurveGroup ecPub =
    case ecPubKeyCurveName ecPub of
        Just ECC.SEC_p256r1 -> Just P256
        Just ECC.SEC_p384r1 -> Just P384
        Just ECC.SEC_p521r1 -> Just P521
        _ -> Nothing

-- functions to use the hidden class.
hashInit :: Hash -> HashContext
hashInit MD5 = HashContext $ ContextSimple (H.hashInit :: H.Context H.MD5)
hashInit SHA1 = HashContext $ ContextSimple (H.hashInit :: H.Context H.SHA1)
hashInit SHA224 = HashContext $ ContextSimple (H.hashInit :: H.Context H.SHA224)
hashInit SHA256 = HashContext $ ContextSimple (H.hashInit :: H.Context H.SHA256)
hashInit SHA384 = HashContext $ ContextSimple (H.hashInit :: H.Context H.SHA384)
hashInit SHA512 = HashContext $ ContextSimple (H.hashInit :: H.Context H.SHA512)
hashInit SHA1_MD5 = HashContextSSL H.hashInit H.hashInit

hashUpdate :: HashContext -> ByteString -> HashCtx
hashUpdate (HashContext (ContextSimple h)) b = HashContext $ ContextSimple (H.hashUpdate h b)
hashUpdate (HashContextSSL sha1Ctx md5Ctx) b =
    HashContextSSL (H.hashUpdate sha1Ctx b) (H.hashUpdate md5Ctx b)

hashUpdates :: HashContext -> [ByteString] -> HashCtx
hashUpdates (HashContext (ContextSimple h)) xs = HashContext $ ContextSimple (H.hashUpdates h xs)
hashUpdates (HashContextSSL sha1Ctx md5Ctx) xs =
    HashContextSSL (H.hashUpdates sha1Ctx xs) (H.hashUpdates md5Ctx xs)

hashChunks :: Hash -> [ByteString] -> ByteString
hashChunks h xs = hashFinal $ hashUpdates (hashInit h) xs

hashUpdateSSL
    :: HashCtx
    -> (ByteString, ByteString)
    -- ^ (for the md5 context, for the sha1 context)
    -> HashCtx
hashUpdateSSL (HashContext _) _ = error "internal error: update SSL without a SSL Context"
hashUpdateSSL (HashContextSSL sha1Ctx md5Ctx) (b1, b2) =
    HashContextSSL (H.hashUpdate sha1Ctx b2) (H.hashUpdate md5Ctx b1)

hashFinal :: HashCtx -> ByteString
hashFinal (HashContext (ContextSimple h)) = convert $ H.hashFinalize h
hashFinal (HashContextSSL sha1Ctx md5Ctx) =
    B.concat [convert (H.hashFinalize md5Ctx), convert (H.hashFinalize sha1Ctx)]

data Hash = MD5 | SHA1 | SHA224 | SHA256 | SHA384 | SHA512 | SHA1_MD5
    deriving (Show, Eq)

data HashContext
    = HashContext ContextSimple
    | HashContextSSL (H.Context H.SHA1) (H.Context H.MD5)

instance Show HashContext where
    show _ = "hash-context"

data ContextSimple
    = forall alg. H.HashAlgorithm alg => ContextSimple (H.Context alg)

type HashCtx = HashContext

hash :: (ByteArray ba, ByteArrayAccess ba) => Hash -> ba -> ba
hash MD5 b = convert (H.hash b :: H.Digest H.MD5)
hash SHA1 b = convert (H.hash b :: H.Digest H.SHA1)
hash SHA224 b = convert (H.hash b :: H.Digest H.SHA224)
hash SHA256 b = convert (H.hash b :: H.Digest H.SHA256)
hash SHA384 b = convert (H.hash b :: H.Digest H.SHA384)
hash SHA512 b = convert (H.hash b :: H.Digest H.SHA512)
hash SHA1_MD5 b = BA.concat [hash MD5 b, hash SHA1 b]

hashName :: Hash -> String
hashName = show

-- | Digest size in bytes.
hashDigestSize :: Hash -> Int
hashDigestSize MD5 = 16
hashDigestSize SHA1 = 20
hashDigestSize SHA224 = 28
hashDigestSize SHA256 = 32
hashDigestSize SHA384 = 48
hashDigestSize SHA512 = 64
hashDigestSize SHA1_MD5 = 36

hashBlockSize :: Hash -> Int
hashBlockSize MD5 = 64
hashBlockSize SHA1 = 64
hashBlockSize SHA224 = 64
hashBlockSize SHA256 = 64
hashBlockSize SHA384 = 128
hashBlockSize SHA512 = 128
hashBlockSize SHA1_MD5 = 64

{- key exchange methods encrypt and decrypt for each supported algorithm -}

generalizeRSAError :: Either RSA.Error a -> Either KxError a
generalizeRSAError (Left e) = Left (RSAError e)
generalizeRSAError (Right x) = Right x

kxEncrypt
    :: MonadRandom r => PublicKey -> ScrubbedBytes -> r (Either KxError ByteString)
kxEncrypt (PubKeyRSA pk) b = generalizeRSAError <$> RSA.encrypt pk b
kxEncrypt _ _ = return (Left KxUnsupported)

kxDecrypt
    :: MonadRandom r => PrivateKey -> ByteString -> r (Either KxError ScrubbedBytes)
kxDecrypt (PrivKeyRSA pk) b = generalizeRSAError <$> RSA.decryptSafer pk b
kxDecrypt _ _ = return (Left KxUnsupported)

data RSAEncoding = RSApkcs1 | RSApss deriving (Show, Eq)

-- | Test the RSASSA-PKCS1 length condition described in RFC 8017 section 9.2,
-- i.e. @emLen >= tLen + 11@.  Lengths are in bytes.
kxCanUseRSApkcs1 :: RSA.PublicKey -> Hash -> Bool
kxCanUseRSApkcs1 pk h = RSA.public_size pk >= tLen + 11
  where
    tLen = prefixSize h + hashDigestSize h

    prefixSize MD5 = 18
    prefixSize SHA1 = 15
    prefixSize SHA224 = 19
    prefixSize SHA256 = 19
    prefixSize SHA384 = 19
    prefixSize SHA512 = 19
    prefixSize _ = error (show h ++ " is not supported for RSASSA-PKCS1")

-- | Test the RSASSA-PSS length condition described in RFC 8017 section 9.1.1,
-- i.e. @emBits >= 8hLen + 8sLen + 9@.  Lengths are in bits.
kxCanUseRSApss :: RSA.PublicKey -> Hash -> Bool
kxCanUseRSApss pk h = numBits (RSA.public_n pk) >= 16 * hashDigestSize h + 10

-- Signature algorithm and associated parameters.
--
-- FIXME add RSAPSSParams
data SignatureParams
    = RSAParams Hash RSAEncoding
    | DSAParams
    | ECDSAParams Hash
    | Ed25519Params
    | Ed448Params
    | -- | Pure ML-DSA with an empty context, which is what
      -- draft-ietf-tls-mldsa uses.  One constructor per parameter set,
      -- since the key fixes it and a signature made under one does not
      -- verify under another.
      MLDSA44Params
    | MLDSA65Params
    | MLDSA87Params
    deriving (Show, Eq)

-- Verify that the signature matches the given message, using the
-- public key.
--

kxVerify :: PublicKey -> SignatureParams -> ByteString -> ByteString -> Bool
kxVerify (PubKeyRSA pk) (RSAParams alg RSApkcs1) msg sign = rsaVerifyHash alg pk msg sign
kxVerify (PubKeyRSA pk) (RSAParams alg RSApss) msg sign = rsapssVerifyHash alg pk msg sign
kxVerify (PubKeyDSA pk) DSAParams msg signBS =
    case decodeSignatureRS signBS of
        Just (r, s) -> DSA.verify H.SHA1 pk DSA.Signature{DSA.sign_r = r, DSA.sign_s = s} msg
        _ -> False
kxVerify (PubKeyEC key) (ECDSAParams alg) msg sigBS =
    fromMaybe False $
        join $
            withPubKeyEC key verifyProxy verifyClassic Nothing
  where
    verifyProxy prx pubkey = do
        rs <- decodeSignatureRS sigBS
        signature <- maybeCryptoError $ ECDSA.signatureFromIntegers prx rs
        verifyF <- withAlg (ECDSA.verify prx)
        return $ verifyF pubkey signature msg
    verifyClassic pubkey = do
        signature <- uncurry ECDSA_ECC.Signature <$> decodeSignatureRS sigBS
        verifyF <- withAlg ECDSA_ECC.verify
        return $ verifyF pubkey signature msg
    withAlg :: (forall hash. H.HashAlgorithm hash => hash -> a) -> Maybe a
    withAlg f = case alg of
        MD5 -> Just (f H.MD5)
        SHA1 -> Just (f H.SHA1)
        SHA224 -> Just (f H.SHA224)
        SHA256 -> Just (f H.SHA256)
        SHA384 -> Just (f H.SHA384)
        SHA512 -> Just (f H.SHA512)
        _ -> Nothing
kxVerify (PubKeyEd25519 key) Ed25519Params msg sigBS =
    case Ed25519.signature sigBS of
        CryptoPassed sig -> Ed25519.verify key msg sig
        _ -> False
kxVerify (PubKeyEd448 key) Ed448Params msg sigBS =
    case Ed448.signature sigBS of
        CryptoPassed sig -> Ed448.verify key msg sig
        _ -> False
-- A signature of the wrong length is refused by the smart constructor, and
-- one of the right length that does not verify returns False.  Neither
-- throws, which is what a peer sending a damaged CertificateVerify has to
-- meet with decrypt_error rather than with a crash.
kxVerify (PubKeyMLDSA44 key) MLDSA44Params msg sigBS = mldsaVerify key msg sigBS
kxVerify (PubKeyMLDSA65 key) MLDSA65Params msg sigBS = mldsaVerify key msg sigBS
kxVerify (PubKeyMLDSA87 key) MLDSA87Params msg sigBS = mldsaVerify key msg sigBS
kxVerify _ _ _ _ = False

mldsaVerify
    :: MLDSA.MLDSA p
    => MLDSA.VerificationKey p -> ByteString -> ByteString -> Bool
mldsaVerify key msg sigBS = case MLDSA.signature sigBS of
    CryptoPassed sig -> MLDSA.verify key MLDSA.emptyContext msg sig
    _ -> False

-- | Decode a DSA or ECDSA signature: a DER SEQUENCE of two INTEGERs, r
-- and s (RFC 3279 Sections 2.2.2 and 2.2.3).  This is done here rather
-- than with crypton-asn1-encoding, whose 'decodeASN1'' throws on some
-- malformed input rather than returning 'Left'.  Only DER is accepted:
-- definite lengths in their shortest form, non-negative INTEGERs in
-- theirs, and nothing after the SEQUENCE.
decodeSignatureRS :: ByteString -> Maybe (Integer, Integer)
decodeSignatureRS bs = do
    (0x30, body) <- whole bs
    (0x02, rbs, rest) <- tlv body
    (0x02, sbs) <- whole rest
    (,) <$> derInteger rbs <*> derInteger sbs
  where
    whole b = do
        (t, v, rest) <- tlv b
        guard $ B.null rest
        return (t, v)
    tlv b = do
        (t, b1) <- B.uncons b
        (l0, b2) <- B.uncons b1
        (len, b3) <- case l0 of
            _ | l0 < 0x80 -> Just (fromIntegral l0, b2)
            0x81 -> do
                (l1, b3) <- B.uncons b2
                guard $ l1 >= 0x80
                Just (fromIntegral l1, b3)
            0x82 -> do
                (l1, b3) <- B.uncons b2
                (l2, b4) <- B.uncons b3
                let n = fromIntegral l1 * 256 + fromIntegral l2 :: Int
                guard $ n >= 0x100
                Just (n, b4)
            _ -> Nothing
        guard $ B.length b3 >= len
        let (v, rest) = B.splitAt len b3
        return (t, v, rest)
    derInteger v = do
        (h, t) <- B.uncons v
        guard $ h < 0x80
        case B.uncons t of
            Just (h2, _) | h == 0 -> guard $ h2 >= 0x80
            _ -> return ()
        return $ B.foldl' (\acc w -> acc * 256 + fromIntegral w) 0 v

-- Sign the given message using the private key.
--
kxSign
    :: MonadRandom r
    => PrivateKey
    -> PublicKey
    -> SignatureParams
    -> ByteString
    -> r (Either KxError ByteString)
kxSign (PrivKeyRSA pk) (PubKeyRSA _) (RSAParams hashAlg RSApkcs1) msg =
    generalizeRSAError <$> rsaSignHash hashAlg pk msg
kxSign (PrivKeyRSA pk) (PubKeyRSA _) (RSAParams hashAlg RSApss) msg =
    generalizeRSAError <$> rsapssSignHash hashAlg pk msg
kxSign (PrivKeyDSA pk) (PubKeyDSA _) DSAParams msg = do
    sign <- DSA.sign pk H.SHA1 msg
    return (Right $ encodeASN1' DER $ dsaSequence sign)
  where
    dsaSequence sign =
        [ Start Sequence
        , IntVal (DSA.sign_r sign)
        , IntVal (DSA.sign_s sign)
        , End Sequence
        ]
kxSign (PrivKeyEC pk) (PubKeyEC _) (ECDSAParams hashAlg) msg =
    case withPrivKeyEC pk doSign (const unsupported) unsupported of
        Nothing -> unsupported
        Just run -> fmap encode <$> run
  where
    encode (r, s) =
        encodeASN1'
            DER
            [Start Sequence, IntVal r, IntVal s, End Sequence]
    doSign prx privkey = do
        msig <- ecdsaSignHash prx hashAlg privkey msg
        return $ case msig of
            Nothing -> Left KxUnsupported
            Just sign -> Right (ECDSA.signatureToIntegers prx sign)
    unsupported = return $ Left KxUnsupported
kxSign (PrivKeyEd25519 pk) (PubKeyEd25519 pub) Ed25519Params msg =
    return $ Right $ convert $ Ed25519.sign pk pub msg
kxSign (PrivKeyEd448 pk) (PubKeyEd448 pub) Ed448Params msg =
    return $ Right $ convert $ Ed448.sign pk pub msg
kxSign (PrivKeyMLDSA44 pk) (PubKeyMLDSA44 _) MLDSA44Params msg =
    Right . convert <$> MLDSA.sign (privkeyMLDSA_key pk) MLDSA.emptyContext msg
kxSign (PrivKeyMLDSA65 pk) (PubKeyMLDSA65 _) MLDSA65Params msg =
    Right . convert <$> MLDSA.sign (privkeyMLDSA_key pk) MLDSA.emptyContext msg
kxSign (PrivKeyMLDSA87 pk) (PubKeyMLDSA87 _) MLDSA87Params msg =
    Right . convert <$> MLDSA.sign (privkeyMLDSA_key pk) MLDSA.emptyContext msg
kxSign _ _ _ _ =
    return (Left KxUnsupported)

rsaSignHash
    :: MonadRandom m
    => Hash
    -> RSA.PrivateKey
    -> ByteString
    -> m (Either RSA.Error ByteString)
rsaSignHash SHA1_MD5 pk msg = RSA.signSafer noHash pk msg
rsaSignHash MD5 pk msg = RSA.signSafer (Just H.MD5) pk msg
rsaSignHash SHA1 pk msg = RSA.signSafer (Just H.SHA1) pk msg
rsaSignHash SHA224 pk msg = RSA.signSafer (Just H.SHA224) pk msg
rsaSignHash SHA256 pk msg = RSA.signSafer (Just H.SHA256) pk msg
rsaSignHash SHA384 pk msg = RSA.signSafer (Just H.SHA384) pk msg
rsaSignHash SHA512 pk msg = RSA.signSafer (Just H.SHA512) pk msg

rsapssSignHash
    :: MonadRandom m
    => Hash
    -> RSA.PrivateKey
    -> ByteString
    -> m (Either RSA.Error ByteString)
rsapssSignHash SHA256 pk msg = PSS.signSafer (PSS.defaultPSSParams H.SHA256) pk msg
rsapssSignHash SHA384 pk msg = PSS.signSafer (PSS.defaultPSSParams H.SHA384) pk msg
rsapssSignHash SHA512 pk msg = PSS.signSafer (PSS.defaultPSSParams H.SHA512) pk msg
rsapssSignHash _ _ _ = error "rsapssSignHash: unsupported hash"

rsaVerifyHash :: Hash -> RSA.PublicKey -> ByteString -> ByteString -> Bool
rsaVerifyHash SHA1_MD5 = RSA.verify noHash
rsaVerifyHash MD5 = RSA.verify (Just H.MD5)
rsaVerifyHash SHA1 = RSA.verify (Just H.SHA1)
rsaVerifyHash SHA224 = RSA.verify (Just H.SHA224)
rsaVerifyHash SHA256 = RSA.verify (Just H.SHA256)
rsaVerifyHash SHA384 = RSA.verify (Just H.SHA384)
rsaVerifyHash SHA512 = RSA.verify (Just H.SHA512)

rsapssVerifyHash :: Hash -> RSA.PublicKey -> ByteString -> ByteString -> Bool
rsapssVerifyHash SHA256 = PSS.verify (PSS.defaultPSSParams H.SHA256)
rsapssVerifyHash SHA384 = PSS.verify (PSS.defaultPSSParams H.SHA384)
rsapssVerifyHash SHA512 = PSS.verify (PSS.defaultPSSParams H.SHA512)
rsapssVerifyHash _ = error "rsapssVerifyHash: unsupported hash"

noHash :: Maybe H.MD5
noHash = Nothing

ecdsaSignHash
    :: (MonadRandom m, ECDSA.EllipticCurveECDSA curve)
    => proxy curve
    -> Hash
    -> ECDSA.Scalar curve
    -> ByteString
    -> m (Maybe (ECDSA.Signature curve))
ecdsaSignHash prx SHA1 pk msg = Just <$> ECDSA.sign prx pk H.SHA1 msg
ecdsaSignHash prx SHA224 pk msg = Just <$> ECDSA.sign prx pk H.SHA224 msg
ecdsaSignHash prx SHA256 pk msg = Just <$> ECDSA.sign prx pk H.SHA256 msg
ecdsaSignHash prx SHA384 pk msg = Just <$> ECDSA.sign prx pk H.SHA384 msg
ecdsaSignHash prx SHA512 pk msg = Just <$> ECDSA.sign prx pk H.SHA512 msg
ecdsaSignHash _ _ _ _ = return Nothing

-- Currently we generate ECDSA signatures in constant time for P256 only.
kxSupportedPrivKeyEC :: PrivKeyEC -> Bool
kxSupportedPrivKeyEC privkey =
    case ecPrivKeyCurveName privkey of
        Just ECC.SEC_p256r1 -> True
        Just ECC.SEC_p384r1 -> True
        Just ECC.SEC_p521r1 -> True
        _ -> False

-- Perform a public-key operation with a parameterized ECC implementation when
-- available, otherwise fallback to the classic ECC implementation.
withPubKeyEC
    :: PubKeyEC
    -> ( forall curve
          . ECDSA.EllipticCurveECDSA curve
         => Proxy curve
         -> ECDSA.PublicKey curve
         -> a
       )
    -> (ECDSA_ECC.PublicKey -> a)
    -> a
    -> Maybe a
withPubKeyEC pubkey withProxy withClassic whenUnknown =
    case ecPubKeyCurveName pubkey of
        Nothing -> Just whenUnknown
        Just ECC.SEC_p256r1 ->
            maybeCryptoError $ withProxy p256 <$> ECDSA.decodePublic p256 bs
        Just ECC.SEC_p384r1 ->
            maybeCryptoError $ withProxy p384 <$> ECDSA.decodePublic p384 bs
        Just ECC.SEC_p521r1 ->
            maybeCryptoError $ withProxy p521 <$> ECDSA.decodePublic p521 bs
        Just curveName ->
            let curve = ECC.getCurveByName curveName
                pub = unserializePoint curve pt
             in withClassic . ECDSA_ECC.PublicKey curve <$> pub
  where
    pt@(SerializedPoint bs) = pubkeyEC_pub pubkey

-- Perform a private-key operation with a parameterized ECC implementation when
-- available.  Calls for an unsupported curve can be prevented with
-- kxSupportedEcPrivKey.
withPrivKeyEC
    :: PrivKeyEC
    -> ( forall curve
          . ECDSA.EllipticCurveECDSA curve
         => Proxy curve
         -> ECDSA.PrivateKey curve
         -> a
       )
    -> (ECC.CurveName -> a)
    -> a
    -> Maybe a
withPrivKeyEC privkey withProxy withUnsupported whenUnknown =
    case ecPrivKeyCurveName privkey of
        Nothing -> Just whenUnknown
        Just ECC.SEC_p256r1 ->
            -- Private key should rather be stored as bytearray and converted
            -- using ECDSA.decodePrivate, unfortunately the data type chosen in
            -- x509 was Integer.
            maybeCryptoError $ withProxy p256 <$> ECDSA.scalarFromInteger p256 d
        Just ECC.SEC_p384r1 ->
            maybeCryptoError $ withProxy p384 <$> ECDSA.scalarFromInteger p384 d
        Just ECC.SEC_p521r1 ->
            maybeCryptoError $ withProxy p521 <$> ECDSA.scalarFromInteger p521 d
        Just curveName -> Just $ withUnsupported curveName
  where
    d = privkeyEC_priv privkey

p256 :: Proxy ECDSA.Curve_P256R1
p256 = Proxy
p384 :: Proxy ECDSA.Curve_P384R1
p384 = Proxy
p521 :: Proxy ECDSA.Curve_P521R1
p521 = Proxy