crypton-x509-1.10.0: Data/X509/PrivateKey.hs
-- |
-- Module : Data.X509.PublicKey
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
-- Private key handling in X.509 infrastructure
module Data.X509.PrivateKey (
PrivKey (..),
PrivKeyEC (..),
PrivKeyMLDSA,
MLDSAKeyForm (..),
privkeyMLDSAFromSeed,
privkeyMLDSAFromKey,
privkeyMLDSA_key,
privkeyMLDSA_seed,
privkeyMLDSA_form,
privkeyToAlg,
) where
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy (..))
import Data.ByteArray (ByteArrayAccess, ScrubbedBytes, convert)
import qualified Data.ByteString as B
import Data.ASN1.BinaryEncoding
import Data.ASN1.BitArray
import Data.ASN1.Encoding
import Data.ASN1.Stream (getConstructedEnd)
import Data.ASN1.Types
import Data.X509.AlgorithmIdentifier
import Data.X509.OID (curvesOIDTable, lookupByOID, lookupOID)
import Data.X509.PublicKey (SerializedPoint (..))
import Crypto.Debug (DebugShow (..), debugShowBytes)
import Crypto.Error (CryptoFailable (..))
import Crypto.Number.Serialize (i2osp, os2ip)
import qualified Crypto.PubKey.Curve25519 as X25519
import qualified Crypto.PubKey.Curve448 as X448
import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.ECC.Types as ECC
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
-- | Elliptic Curve Private Key
--
-- TODO: missing support for binary curve.
data PrivKeyEC
= PrivKeyEC_Prime
{ privkeyEC_priv :: Integer
, privkeyEC_a :: Integer
, privkeyEC_b :: Integer
, privkeyEC_prime :: Integer
, privkeyEC_generator :: SerializedPoint
, privkeyEC_order :: Integer
, privkeyEC_cofactor :: Integer
, privkeyEC_seed :: Integer
}
| PrivKeyEC_Named
{ privkeyEC_name :: ECC.CurveName
, privkeyEC_priv :: Integer
}
deriving (Eq)
-- | The curve is shown; @privkeyEC_priv@ is not. Use
-- 'Crypto.Debug.debugShow' to see it.
instance Show PrivKeyEC where
showsPrec = showsPrivKeyEC (showString "<secret>")
instance DebugShow PrivKeyEC where
debugShow k = showsPrivKeyEC (shows $ privkeyEC_priv k) 0 k ""
-- | What the two instances above share, so that a field added to
-- 'PrivKeyEC' cannot reach one of them and not the other. The first
-- argument renders @privkeyEC_priv@; everything else is what @deriving
-- Show@ used to write.
showsPrivKeyEC :: ShowS -> Int -> PrivKeyEC -> ShowS
showsPrivKeyEC priv d (PrivKeyEC_Prime _ a b p g o c s) =
showParen (d > 10) $
showString "PrivKeyEC_Prime {privkeyEC_priv = "
. priv
. showString ", privkeyEC_a = "
. shows a
. showString ", privkeyEC_b = "
. shows b
. showString ", privkeyEC_prime = "
. shows p
. showString ", privkeyEC_generator = "
. shows g
. showString ", privkeyEC_order = "
. shows o
. showString ", privkeyEC_cofactor = "
. shows c
. showString ", privkeyEC_seed = "
. shows s
. showChar '}'
showsPrivKeyEC priv d (PrivKeyEC_Named n _) =
showParen (d > 10) $
showString "PrivKeyEC_Named {privkeyEC_name = "
. shows n
. showString ", privkeyEC_priv = "
. priv
. showChar '}'
-- | Which of the three forms of RFC 9881 Section 6 a private key was read
-- as, and is written back out as.
data MLDSAKeyForm
= -- | The seed alone, @seed@, which Section 6 recommends.
MLDSAKeySeed
| -- | The expanded key alone, @expandedKey@.
MLDSAKeyExpanded
| -- | Both together, @both@.
MLDSAKeyBoth
deriving (Show, Eq)
-- | An ML-DSA private key.
--
-- RFC 9881 Section 6 writes one as the seed it was derived from, as the
-- expanded key, or as both, and which of the three it was is part of the
-- key here. A key read from a file is therefore written back out as the
-- same thing it came in as, rather than as whichever form this module
-- happens to prefer.
--
-- The expanded key is there whatever the form: a seed is expanded as it is
-- read, so 'privkeyMLDSA_key' always answers. The seed is not, since a
-- key written as @expandedKey@ does not carry one; 'privkeyMLDSA_seed' is
-- a 'Maybe' for that reason, and a key whose seed was never on the wire
-- cannot be given one back -- @crypton@'s
-- @Crypto.PubKey.MLDSA.generateKeyPairAndSeed@ is where a seed that is to
-- be kept has to be caught.
--
-- The constructors are not exported: a seed and an expanded key that do
-- not belong together would be a key that signs with one and claims the
-- other, so the only ways in are 'privkeyMLDSAFromSeed', which expands the
-- seed itself, and 'privkeyMLDSAFromKey', which has no seed to disagree
-- with.
--
-- Two keys are equal when they hold the same thing /in the same form/: the
-- same key as a seed and as an expanded key are two different files, and
-- the encoding round trip says so.
data PrivKeyMLDSA p
= PrivKeyMLDSA_Seed ScrubbedBytes (MLDSA.SigningKey p)
| PrivKeyMLDSA_Expanded (MLDSA.SigningKey p)
| PrivKeyMLDSA_Both ScrubbedBytes (MLDSA.SigningKey p)
deriving (Eq)
-- | What the two instances below share, so that a form added to
-- 'PrivKeyMLDSA' cannot reach one of them and not the other. The
-- arguments render the seed and the key.
showsPrivKeyMLDSA
:: (ScrubbedBytes -> String)
-> (MLDSA.SigningKey p -> String)
-> PrivKeyMLDSA p
-> String
showsPrivKeyMLDSA seed key k = case k of
PrivKeyMLDSA_Seed s sk -> con "PrivKeyMLDSA_Seed" [seed s, key sk]
PrivKeyMLDSA_Expanded sk -> con "PrivKeyMLDSA_Expanded" [key sk]
PrivKeyMLDSA_Both s sk -> con "PrivKeyMLDSA_Both" [seed s, key sk]
where
con name as = unwords (name : map (\a -> "(" ++ a ++ ")") as)
-- | The form is shown; neither the seed nor the key is. Use
-- 'Crypto.Debug.debugShow' to see them.
instance Show (PrivKeyMLDSA p) where
show = showsPrivKeyMLDSA (const "<secret>") show
instance DebugShow (PrivKeyMLDSA p) where
debugShow = showsPrivKeyMLDSA (debugShowBytes "seed") debugShow
-- | Build a key from its seed, to be written back out in the given form.
--
-- The expanded key is derived here, so it cannot fail to be the one the
-- seed belongs to. Passing 'MLDSAKeyExpanded' throws the seed away, which
-- is the way to turn a seed into a key that will be written without one.
privkeyMLDSAFromSeed
:: (MLDSA.MLDSA p, ByteArrayAccess ba)
=> proxy p -> MLDSAKeyForm -> ba -> CryptoFailable (PrivKeyMLDSA p)
privkeyMLDSAFromSeed p form bs = case MLDSA.keyPairFromSeed p bs of
CryptoFailed e -> CryptoFailed e
CryptoPassed (_, sk) ->
CryptoPassed $ case form of
MLDSAKeySeed -> PrivKeyMLDSA_Seed seed sk
MLDSAKeyExpanded -> PrivKeyMLDSA_Expanded sk
MLDSAKeyBoth -> PrivKeyMLDSA_Both seed sk
where
seed = convert bs :: ScrubbedBytes
-- | Build a key from the expanded key alone, which is what a key that was
-- generated without keeping its seed has to be.
privkeyMLDSAFromKey :: MLDSA.SigningKey p -> PrivKeyMLDSA p
privkeyMLDSAFromKey = PrivKeyMLDSA_Expanded
-- | The expanded key, whatever form the key is in.
privkeyMLDSA_key :: PrivKeyMLDSA p -> MLDSA.SigningKey p
privkeyMLDSA_key (PrivKeyMLDSA_Seed _ sk) = sk
privkeyMLDSA_key (PrivKeyMLDSA_Expanded sk) = sk
privkeyMLDSA_key (PrivKeyMLDSA_Both _ sk) = sk
-- | The seed, for a key that has one.
privkeyMLDSA_seed :: PrivKeyMLDSA p -> Maybe ScrubbedBytes
privkeyMLDSA_seed (PrivKeyMLDSA_Seed s _) = Just s
privkeyMLDSA_seed (PrivKeyMLDSA_Expanded _) = Nothing
privkeyMLDSA_seed (PrivKeyMLDSA_Both s _) = Just s
-- | The form the key will be written out in.
privkeyMLDSA_form :: PrivKeyMLDSA p -> MLDSAKeyForm
privkeyMLDSA_form (PrivKeyMLDSA_Seed _ _) = MLDSAKeySeed
privkeyMLDSA_form (PrivKeyMLDSA_Expanded _) = MLDSAKeyExpanded
privkeyMLDSA_form (PrivKeyMLDSA_Both _ _) = MLDSAKeyBoth
-- | Private key types known and used in X.509
data PrivKey
= -- | RSA private key
PrivKeyRSA RSA.PrivateKey
| -- | DSA private key
PrivKeyDSA DSA.PrivateKey
| -- | EC private key
PrivKeyEC PrivKeyEC
| -- | X25519 private key
PrivKeyX25519 X25519.SecretKey
| -- | X448 private key
PrivKeyX448 X448.SecretKey
| -- | Ed25519 private key
PrivKeyEd25519 Ed25519.SecretKey
| -- | Ed448 private key
PrivKeyEd448 Ed448.SecretKey
| -- | ML-DSA-44 private key
PrivKeyMLDSA44 (PrivKeyMLDSA MLDSA.MLDSA44)
| -- | ML-DSA-65 private key
PrivKeyMLDSA65 (PrivKeyMLDSA MLDSA.MLDSA65)
| -- | ML-DSA-87 private key
PrivKeyMLDSA87 (PrivKeyMLDSA MLDSA.MLDSA87)
deriving (Show, Eq)
-- | Rendering a private key with the key material in it, for the times when
-- that is what is meant. Each arm is @crypton@'s own 'debugShow' for that
-- key type, except the EC one, which is this module's.
instance DebugShow PrivKey where
debugShow k = case k of
PrivKeyRSA p -> con "PrivKeyRSA" $ debugShow p
PrivKeyDSA p -> con "PrivKeyDSA" $ debugShow p
PrivKeyEC p -> con "PrivKeyEC" $ debugShow p
PrivKeyX25519 p -> con "PrivKeyX25519" $ debugShow p
PrivKeyX448 p -> con "PrivKeyX448" $ debugShow p
PrivKeyEd25519 p -> con "PrivKeyEd25519" $ debugShow p
PrivKeyEd448 p -> con "PrivKeyEd448" $ debugShow p
PrivKeyMLDSA44 p -> con "PrivKeyMLDSA44" $ debugShow p
PrivKeyMLDSA65 p -> con "PrivKeyMLDSA65" $ debugShow p
PrivKeyMLDSA87 p -> con "PrivKeyMLDSA87" $ debugShow p
where
con name body = name ++ " (" ++ body ++ ")"
instance ASN1Object PrivKey where
fromASN1 = privkeyFromASN1
toASN1 = privkeyToASN1
privkeyFromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1])
privkeyFromASN1 asn1 =
(mapFst PrivKeyRSA <$> rsaFromASN1 asn1)
<!> (mapFst PrivKeyDSA <$> dsaFromASN1 asn1)
<!> (mapFst PrivKeyEC <$> ecdsaFromASN1 asn1)
<!> newcurveFromASN1 asn1
where
mapFst f (a, b) = (f a, b)
Left _ <!> b = b
a <!> _ = a
rsaFromASN1 :: [ASN1] -> Either String (RSA.PrivateKey, [ASN1])
rsaFromASN1
( Start Sequence : IntVal 0 : IntVal n : IntVal e : IntVal d
: IntVal p
: IntVal q
: IntVal dP
: IntVal dQ
: IntVal qinv
: End Sequence
: as
) = pure (key, as)
where
key = RSA.PrivateKey (RSA.PublicKey (go n 1) n e) d p q dP dQ qinv
go m i
| 2 ^ (i * 8) > m = i
| otherwise = go m (i + 1)
rsaFromASN1
( Start Sequence : IntVal 0 : Start Sequence
: OID [1, 2, 840, 113549, 1, 1, 1]
: Null
: End Sequence
: OctetString bytes
: End Sequence
: as
) = do
asn1 <- mapLeft failure (decodeASN1' BER bytes)
fmap (const as) <$> rsaFromASN1 asn1
where
failure = ("rsaFromASN1: " ++) . show
rsaFromASN1 _ = Left "rsaFromASN1: unexpected format"
dsaFromASN1 :: [ASN1] -> Either String (DSA.PrivateKey, [ASN1])
dsaFromASN1
( Start Sequence : IntVal 0 : IntVal p : IntVal q : IntVal g
: IntVal _
: IntVal x
: End Sequence
: as
) =
pure (DSA.PrivateKey (DSA.Params p g q) x, as)
dsaFromASN1
( Start Sequence : IntVal 0 : Start Sequence
: OID [1, 2, 840, 10040, 4, 1]
: Start Sequence
: IntVal p
: IntVal q
: IntVal g
: End Sequence
: End Sequence
: OctetString bytes
: End Sequence
: as
) = case decodeASN1' BER bytes of
Right [IntVal x] -> pure (DSA.PrivateKey (DSA.Params p g q) x, as)
Right _ -> Left "DSA.PrivateKey.fromASN1: unexpected format"
Left e -> Left $ "DSA.PrivateKey.fromASN1: " ++ show e
dsaFromASN1 _ = Left "DSA.PrivateKey.fromASN1: unexpected format"
ecdsaFromASN1 :: [ASN1] -> Either String (PrivKeyEC, [ASN1])
ecdsaFromASN1 = go []
where
failing = ("ECDSA.PrivateKey.fromASN1: " ++)
go acc (Start Sequence : IntVal 1 : OctetString bytes : rest) = do
key <- subgo (oid ++ acc)
case rest'' of
End Sequence : rest''' -> pure (key, rest''')
_ -> Left $ failing "unexpected EC format"
where
d = os2ip bytes
(oid, rest') = spanTag 0 rest
(_, rest'') = spanTag 1 rest'
subgo (OID oid_ : _) = maybe failure success mcurve
where
failure = Left $ failing $ "unknown curve " ++ show oid_
success = Right . flip PrivKeyEC_Named d
mcurve = lookupByOID curvesOIDTable oid_
subgo
( Start Sequence : IntVal 1 : Start Sequence
: OID [1, 2, 840, 10045, 1, 1]
: IntVal p
: End Sequence
: Start Sequence
: OctetString a
: OctetString b
: BitString s
: End Sequence
: OctetString g
: IntVal o
: IntVal c
: End Sequence
: _
) =
pure $ PrivKeyEC_Prime d a' b' p g' o c s'
where
a' = os2ip a
b' = os2ip b
g' = SerializedPoint g
s' = os2ip $ bitArrayGetData s
subgo (Null : rest_) = subgo rest_
subgo [] = Left $ failing "curve is missing"
subgo _ = Left $ failing "unexpected curve format"
go
acc
( Start Sequence : IntVal 0 : Start Sequence
: OID [1, 2, 840, 10045, 2, 1]
: rest
) = case rest' of
(OctetString bytes : rest'') -> do
asn1 <- mapLeft (failing . show) (decodeASN1' BER bytes)
fmap (const rest'') <$> go (oid ++ acc) asn1
_ -> Left $ failing "unexpected EC format"
where
(oid, rest') = spanEnd 0 rest
go _ _ = Left $ failing "unexpected EC format"
spanEnd :: Word -> [ASN1] -> ([ASN1], [ASN1])
spanEnd = loop id
where
loop dlist n (a@(Start _) : as) = loop (dlist . (a :)) (n + 1) as
loop dlist 0 (End _ : as) = (dlist [], as)
loop dlist n (a@(End _) : as) = loop (dlist . (a :)) (n - 1) as
loop dlist n (a : as) = loop (dlist . (a :)) n as
loop dlist _ [] = (dlist [], [])
spanTag :: Int -> [ASN1] -> ([ASN1], [ASN1])
spanTag a (Start (Container _ b) : as) | a == b = spanEnd 0 as
spanTag _ as = ([], as)
newcurveFromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1])
newcurveFromASN1
( Start Sequence
: IntVal v
: Start Sequence
: OID oid
: End Sequence
: OctetString bs
: xs
)
| isValidVersion v = do
let (_, ys) = containerWithTag 0 xs
case primitiveWithTag 1 ys of
(_, End Sequence : zs) ->
case getP oid of
Just (name, parse) -> do
let err s = Left (name ++ ".SecretKey.fromASN1: " ++ s)
case decodeASN1' BER bs of
Right [OctetString key] ->
case parse key of
CryptoPassed s -> Right (s, zs)
CryptoFailed e -> err ("invalid secret key: " ++ show e)
Right _ -> err "unexpected inner format"
Left e -> err (show e)
Nothing -> case getMLDSA oid of
Just (name, parse) ->
case decodeASN1' BER bs of
Right inner -> (\k -> (k, zs)) <$> parse inner
Left e -> Left (name ++ ".SigningKey.fromASN1: " ++ show e)
Nothing -> Left ("newcurveFromASN1: unexpected OID " ++ show oid)
_ -> Left "newcurveFromASN1: unexpected end format"
| otherwise = Left ("newcurveFromASN1: unexpected version: " ++ show v)
where
getP [1, 3, 101, 110] = Just ("X25519", fmap PrivKeyX25519 . X25519.secretKey)
getP [1, 3, 101, 111] = Just ("X448", fmap PrivKeyX448 . X448.secretKey)
getP [1, 3, 101, 112] = Just ("Ed25519", fmap PrivKeyEd25519 . Ed25519.secretKey)
getP [1, 3, 101, 113] = Just ("Ed448", fmap PrivKeyEd448 . Ed448.secretKey)
getP _ = Nothing
getMLDSA [2, 16, 840, 1, 101, 3, 4, 3, 17] =
Just
( "ML-DSA-44"
, mldsaFromASN1 (Proxy :: Proxy MLDSA.MLDSA44) PrivKeyMLDSA44 "ML-DSA-44"
)
getMLDSA [2, 16, 840, 1, 101, 3, 4, 3, 18] =
Just
( "ML-DSA-65"
, mldsaFromASN1 (Proxy :: Proxy MLDSA.MLDSA65) PrivKeyMLDSA65 "ML-DSA-65"
)
getMLDSA [2, 16, 840, 1, 101, 3, 4, 3, 19] =
Just
( "ML-DSA-87"
, mldsaFromASN1 (Proxy :: Proxy MLDSA.MLDSA87) PrivKeyMLDSA87 "ML-DSA-87"
)
getMLDSA _ = Nothing
isValidVersion version = version >= 0 && version <= 1
newcurveFromASN1 _ =
Left "newcurveFromASN1: unexpected format"
-- | The private key of RFC 9881 Section 6: a CHOICE of the seed, tagged
-- [0], the expanded key, or both. A seed is expanded into the key; with
-- both, the expanded key must be what the seed expands to. Which of the
-- three it was is kept, so that 'mldsaToASN1' writes back what was read.
mldsaFromASN1
:: MLDSA.MLDSA p
=> proxy p
-> (PrivKeyMLDSA p -> PrivKey)
-> String
-> [ASN1]
-> Either String PrivKey
mldsaFromASN1 p con name inner = case inner of
[Other Context 0 seed] -> con <$> fromSeed MLDSAKeySeed seed
[OctetString expanded] -> con . privkeyMLDSAFromKey <$> fromExpanded expanded
[Start Sequence, OctetString seed, OctetString expanded, End Sequence] -> do
k <- fromSeed MLDSAKeyBoth seed
sk <- fromExpanded expanded
if privkeyMLDSA_key k == sk
then Right (con k)
else err "seed and expandedKey do not match"
_ -> err "unexpected inner format"
where
err s = Left (name ++ ".SigningKey.fromASN1: " ++ s)
fromSeed form seed = case privkeyMLDSAFromSeed p form seed of
CryptoPassed k -> Right k
CryptoFailed e -> err ("invalid seed: " ++ show e)
fromExpanded expanded = case MLDSA.signingKey expanded of
CryptoPassed sk -> Right sk
CryptoFailed e -> err ("invalid expandedKey: " ++ show e)
containerWithTag :: ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
containerWithTag etag (Start (Container _ atag) : xs)
| etag == atag = getConstructedEnd 0 xs
containerWithTag _ xs = ([], xs)
primitiveWithTag :: ASN1Tag -> [ASN1] -> (Maybe B.ByteString, [ASN1])
primitiveWithTag etag (Other _ atag bs : xs)
| etag == atag = (Just bs, xs)
primitiveWithTag _ xs = (Nothing, xs)
privkeyToASN1 :: PrivKey -> ASN1S
privkeyToASN1 (PrivKeyRSA rsa) = rsaToASN1 rsa
privkeyToASN1 (PrivKeyDSA dsa) = dsaToASN1 dsa
privkeyToASN1 (PrivKeyEC ecdsa) = ecdsaToASN1 ecdsa
privkeyToASN1 (PrivKeyX25519 k) = newcurveToASN1 [1, 3, 101, 110] k
privkeyToASN1 (PrivKeyX448 k) = newcurveToASN1 [1, 3, 101, 111] k
privkeyToASN1 (PrivKeyEd25519 k) = newcurveToASN1 [1, 3, 101, 112] k
privkeyToASN1 (PrivKeyEd448 k) = newcurveToASN1 [1, 3, 101, 113] k
privkeyToASN1 (PrivKeyMLDSA44 k) = mldsaToASN1 (getObjectID PubKeyALG_MLDSA44) k
privkeyToASN1 (PrivKeyMLDSA65 k) = mldsaToASN1 (getObjectID PubKeyALG_MLDSA65) k
privkeyToASN1 (PrivKeyMLDSA87 k) = mldsaToASN1 (getObjectID PubKeyALG_MLDSA87) k
rsaToASN1 :: RSA.PrivateKey -> ASN1S
rsaToASN1 key =
(++)
[ Start Sequence
, IntVal 0
, IntVal n
, IntVal e
, IntVal d
, IntVal p
, IntVal q
, IntVal dP
, IntVal dQ
, IntVal qinv
, End Sequence
]
where
RSA.PrivateKey (RSA.PublicKey _ n e) d p q dP dQ qinv = key
dsaToASN1 :: DSA.PrivateKey -> ASN1S
dsaToASN1 (DSA.PrivateKey params@(DSA.Params p g q) y) =
(++)
[ Start Sequence
, IntVal 0
, IntVal p
, IntVal q
, IntVal g
, IntVal x
, IntVal y
, End Sequence
]
where
x = DSA.calculatePublic params y
ecdsaToASN1 :: PrivKeyEC -> ASN1S
ecdsaToASN1 (PrivKeyEC_Named curveName d) =
(++)
[ Start Sequence
, IntVal 1
, OctetString (i2osp d)
, Start (Container Context 0)
, OID oid
, End (Container Context 0)
, End Sequence
]
where
err = error . ("ECDSA.PrivateKey.toASN1: " ++)
oid =
fromMaybe
(err $ "missing named curve " ++ show curveName)
(lookupOID curvesOIDTable curveName)
ecdsaToASN1 (PrivKeyEC_Prime d a b p g o c s) =
(++)
[ Start Sequence
, IntVal 1
, OctetString (i2osp d)
, Start (Container Context 0)
, Start Sequence
, IntVal 1
, Start Sequence
, OID [1, 2, 840, 10045, 1, 1]
, IntVal p
, End Sequence
, Start Sequence
, OctetString a'
, OctetString b'
, BitString s'
, End Sequence
, OctetString g'
, IntVal o
, IntVal c
, End Sequence
, End (Container Context 0)
, End Sequence
]
where
a' = i2osp a
b' = i2osp b
SerializedPoint g' = g
s' = BitArray (8 * fromIntegral (B.length bytes)) bytes
where
bytes = i2osp s
newcurveToASN1 :: ByteArrayAccess key => OID -> key -> ASN1S
newcurveToASN1 oid key =
(++)
[ Start Sequence
, IntVal 0
, Start Sequence
, OID oid
, End Sequence
, OctetString (encodeASN1' DER [OctetString $ convert key])
, End Sequence
]
-- | The inverse of 'mldsaFromASN1': the form the key is in is the form it
-- is written in, so reading a key and writing it again gives back the
-- bytes it came from.
mldsaToASN1 :: OID -> PrivKeyMLDSA p -> ASN1S
mldsaToASN1 oid k =
(++)
[ Start Sequence
, IntVal 0
, Start Sequence
, OID oid
, End Sequence
, OctetString (encodeASN1' DER inner)
, End Sequence
]
where
inner = case k of
PrivKeyMLDSA_Seed s _ -> [Other Context 0 (convert s)]
PrivKeyMLDSA_Expanded sk -> [OctetString (convert sk)]
PrivKeyMLDSA_Both s sk ->
[ Start Sequence
, OctetString (convert s)
, OctetString (convert sk)
, End Sequence
]
mapLeft :: (a0 -> a1) -> Either a0 b -> Either a1 b
mapLeft f (Left x) = Left (f x)
mapLeft _ (Right x) = Right x
-- | Convert a Private key to the Public Key Algorithm type
privkeyToAlg :: PrivKey -> PubKeyALG
privkeyToAlg (PrivKeyRSA _) = PubKeyALG_RSA
privkeyToAlg (PrivKeyDSA _) = PubKeyALG_DSA
privkeyToAlg (PrivKeyEC _) = PubKeyALG_EC
privkeyToAlg (PrivKeyX25519 _) = PubKeyALG_X25519
privkeyToAlg (PrivKeyX448 _) = PubKeyALG_X448
privkeyToAlg (PrivKeyEd25519 _) = PubKeyALG_Ed25519
privkeyToAlg (PrivKeyEd448 _) = PubKeyALG_Ed448
privkeyToAlg (PrivKeyMLDSA44 _) = PubKeyALG_MLDSA44
privkeyToAlg (PrivKeyMLDSA65 _) = PubKeyALG_MLDSA65
privkeyToAlg (PrivKeyMLDSA87 _) = PubKeyALG_MLDSA87