-- |
-- 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 -> Integer
privkeyEC_priv :: Integer
        , PrivKeyEC -> Integer
privkeyEC_a :: Integer
        , PrivKeyEC -> Integer
privkeyEC_b :: Integer
        , PrivKeyEC -> Integer
privkeyEC_prime :: Integer
        , PrivKeyEC -> SerializedPoint
privkeyEC_generator :: SerializedPoint
        , PrivKeyEC -> Integer
privkeyEC_order :: Integer
        , PrivKeyEC -> Integer
privkeyEC_cofactor :: Integer
        , PrivKeyEC -> Integer
privkeyEC_seed :: Integer
        }
    | PrivKeyEC_Named
        { PrivKeyEC -> CurveName
privkeyEC_name :: ECC.CurveName
        , privkeyEC_priv :: Integer
        }
    deriving (PrivKeyEC -> PrivKeyEC -> Bool
(PrivKeyEC -> PrivKeyEC -> Bool)
-> (PrivKeyEC -> PrivKeyEC -> Bool) -> Eq PrivKeyEC
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrivKeyEC -> PrivKeyEC -> Bool
== :: PrivKeyEC -> PrivKeyEC -> Bool
$c/= :: PrivKeyEC -> PrivKeyEC -> Bool
/= :: PrivKeyEC -> PrivKeyEC -> Bool
Eq)

-- | The curve is shown; @privkeyEC_priv@ is not.  Use
-- 'Crypto.Debug.debugShow' to see it.
instance Show PrivKeyEC where
    showsPrec :: ASN1Tag -> PrivKeyEC -> ShowS
showsPrec = ShowS -> ASN1Tag -> PrivKeyEC -> ShowS
showsPrivKeyEC (String -> ShowS
showString String
"<secret>")

instance DebugShow PrivKeyEC where
    debugShow :: PrivKeyEC -> String
debugShow PrivKeyEC
k = ShowS -> ASN1Tag -> PrivKeyEC -> ShowS
showsPrivKeyEC (Integer -> ShowS
forall a. Show a => a -> ShowS
shows (Integer -> ShowS) -> Integer -> ShowS
forall a b. (a -> b) -> a -> b
$ PrivKeyEC -> Integer
privkeyEC_priv PrivKeyEC
k) ASN1Tag
0 PrivKeyEC
k String
""

-- | 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 :: ShowS -> ASN1Tag -> PrivKeyEC -> ShowS
showsPrivKeyEC ShowS
priv ASN1Tag
d (PrivKeyEC_Prime Integer
_ Integer
a Integer
b Integer
p SerializedPoint
g Integer
o Integer
c Integer
s) =
    Bool -> ShowS -> ShowS
showParen (ASN1Tag
d ASN1Tag -> ASN1Tag -> Bool
forall a. Ord a => a -> a -> Bool
> ASN1Tag
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"PrivKeyEC_Prime {privkeyEC_priv = "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
priv
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", privkeyEC_a = "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ShowS
forall a. Show a => a -> ShowS
shows Integer
a
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", privkeyEC_b = "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ShowS
forall a. Show a => a -> ShowS
shows Integer
b
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", privkeyEC_prime = "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ShowS
forall a. Show a => a -> ShowS
shows Integer
p
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", privkeyEC_generator = "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerializedPoint -> ShowS
forall a. Show a => a -> ShowS
shows SerializedPoint
g
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", privkeyEC_order = "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ShowS
forall a. Show a => a -> ShowS
shows Integer
o
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", privkeyEC_cofactor = "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ShowS
forall a. Show a => a -> ShowS
shows Integer
c
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", privkeyEC_seed = "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ShowS
forall a. Show a => a -> ShowS
shows Integer
s
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'
showsPrivKeyEC ShowS
priv ASN1Tag
d (PrivKeyEC_Named CurveName
n Integer
_) =
    Bool -> ShowS -> ShowS
showParen (ASN1Tag
d ASN1Tag -> ASN1Tag -> Bool
forall a. Ord a => a -> a -> Bool
> ASN1Tag
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"PrivKeyEC_Named {privkeyEC_name = "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CurveName -> ShowS
forall a. Show a => a -> ShowS
shows CurveName
n
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", privkeyEC_priv = "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
priv
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | 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 (ASN1Tag -> MLDSAKeyForm -> ShowS
[MLDSAKeyForm] -> ShowS
MLDSAKeyForm -> String
(ASN1Tag -> MLDSAKeyForm -> ShowS)
-> (MLDSAKeyForm -> String)
-> ([MLDSAKeyForm] -> ShowS)
-> Show MLDSAKeyForm
forall a.
(ASN1Tag -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: ASN1Tag -> MLDSAKeyForm -> ShowS
showsPrec :: ASN1Tag -> MLDSAKeyForm -> ShowS
$cshow :: MLDSAKeyForm -> String
show :: MLDSAKeyForm -> String
$cshowList :: [MLDSAKeyForm] -> ShowS
showList :: [MLDSAKeyForm] -> ShowS
Show, MLDSAKeyForm -> MLDSAKeyForm -> Bool
(MLDSAKeyForm -> MLDSAKeyForm -> Bool)
-> (MLDSAKeyForm -> MLDSAKeyForm -> Bool) -> Eq MLDSAKeyForm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MLDSAKeyForm -> MLDSAKeyForm -> Bool
== :: MLDSAKeyForm -> MLDSAKeyForm -> Bool
$c/= :: MLDSAKeyForm -> MLDSAKeyForm -> Bool
/= :: MLDSAKeyForm -> MLDSAKeyForm -> Bool
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 (PrivKeyMLDSA p -> PrivKeyMLDSA p -> Bool
(PrivKeyMLDSA p -> PrivKeyMLDSA p -> Bool)
-> (PrivKeyMLDSA p -> PrivKeyMLDSA p -> Bool)
-> Eq (PrivKeyMLDSA p)
forall p. PrivKeyMLDSA p -> PrivKeyMLDSA p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall p. PrivKeyMLDSA p -> PrivKeyMLDSA p -> Bool
== :: PrivKeyMLDSA p -> PrivKeyMLDSA p -> Bool
$c/= :: forall p. PrivKeyMLDSA p -> PrivKeyMLDSA p -> Bool
/= :: PrivKeyMLDSA p -> PrivKeyMLDSA p -> Bool
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 :: forall p.
(ScrubbedBytes -> String)
-> (SigningKey p -> String) -> PrivKeyMLDSA p -> String
showsPrivKeyMLDSA ScrubbedBytes -> String
seed SigningKey p -> String
key PrivKeyMLDSA p
k = case PrivKeyMLDSA p
k of
    PrivKeyMLDSA_Seed ScrubbedBytes
s SigningKey p
sk -> String -> [String] -> String
con String
"PrivKeyMLDSA_Seed" [ScrubbedBytes -> String
seed ScrubbedBytes
s, SigningKey p -> String
key SigningKey p
sk]
    PrivKeyMLDSA_Expanded SigningKey p
sk -> String -> [String] -> String
con String
"PrivKeyMLDSA_Expanded" [SigningKey p -> String
key SigningKey p
sk]
    PrivKeyMLDSA_Both ScrubbedBytes
s SigningKey p
sk -> String -> [String] -> String
con String
"PrivKeyMLDSA_Both" [ScrubbedBytes -> String
seed ScrubbedBytes
s, SigningKey p -> String
key SigningKey p
sk]
  where
    con :: String -> [String] -> String
con String
name [String]
as = [String] -> String
unwords (String
name String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
a -> String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")") [String]
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 :: PrivKeyMLDSA p -> String
show = (ScrubbedBytes -> String)
-> (SigningKey p -> String) -> PrivKeyMLDSA p -> String
forall p.
(ScrubbedBytes -> String)
-> (SigningKey p -> String) -> PrivKeyMLDSA p -> String
showsPrivKeyMLDSA (String -> ScrubbedBytes -> String
forall a b. a -> b -> a
const String
"<secret>") SigningKey p -> String
forall a. Show a => a -> String
show

instance DebugShow (PrivKeyMLDSA p) where
    debugShow :: PrivKeyMLDSA p -> String
debugShow = (ScrubbedBytes -> String)
-> (SigningKey p -> String) -> PrivKeyMLDSA p -> String
forall p.
(ScrubbedBytes -> String)
-> (SigningKey p -> String) -> PrivKeyMLDSA p -> String
showsPrivKeyMLDSA (String -> ScrubbedBytes -> String
forall ba. ByteArrayAccess ba => String -> ba -> String
debugShowBytes String
"seed") SigningKey p -> String
forall a. DebugShow a => a -> String
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 :: forall p ba (proxy :: * -> *).
(MLDSA p, ByteArrayAccess ba) =>
proxy p -> MLDSAKeyForm -> ba -> CryptoFailable (PrivKeyMLDSA p)
privkeyMLDSAFromSeed proxy p
p MLDSAKeyForm
form ba
bs = case proxy p -> ba -> CryptoFailable (VerificationKey p, SigningKey p)
forall p (proxy :: * -> *) ba.
(MLDSA p, ByteArrayAccess ba) =>
proxy p -> ba -> CryptoFailable (VerificationKey p, SigningKey p)
MLDSA.keyPairFromSeed proxy p
p ba
bs of
    CryptoFailed CryptoError
e -> CryptoError -> CryptoFailable (PrivKeyMLDSA p)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
e
    CryptoPassed (VerificationKey p
_, SigningKey p
sk) ->
        PrivKeyMLDSA p -> CryptoFailable (PrivKeyMLDSA p)
forall a. a -> CryptoFailable a
CryptoPassed (PrivKeyMLDSA p -> CryptoFailable (PrivKeyMLDSA p))
-> PrivKeyMLDSA p -> CryptoFailable (PrivKeyMLDSA p)
forall a b. (a -> b) -> a -> b
$ case MLDSAKeyForm
form of
            MLDSAKeyForm
MLDSAKeySeed -> ScrubbedBytes -> SigningKey p -> PrivKeyMLDSA p
forall p. ScrubbedBytes -> SigningKey p -> PrivKeyMLDSA p
PrivKeyMLDSA_Seed ScrubbedBytes
seed SigningKey p
sk
            MLDSAKeyForm
MLDSAKeyExpanded -> SigningKey p -> PrivKeyMLDSA p
forall p. SigningKey p -> PrivKeyMLDSA p
PrivKeyMLDSA_Expanded SigningKey p
sk
            MLDSAKeyForm
MLDSAKeyBoth -> ScrubbedBytes -> SigningKey p -> PrivKeyMLDSA p
forall p. ScrubbedBytes -> SigningKey p -> PrivKeyMLDSA p
PrivKeyMLDSA_Both ScrubbedBytes
seed SigningKey p
sk
  where
    seed :: ScrubbedBytes
seed = ba -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ba
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 :: forall p. SigningKey p -> PrivKeyMLDSA p
privkeyMLDSAFromKey = SigningKey p -> PrivKeyMLDSA p
forall p. SigningKey p -> PrivKeyMLDSA p
PrivKeyMLDSA_Expanded

-- | The expanded key, whatever form the key is in.
privkeyMLDSA_key :: PrivKeyMLDSA p -> MLDSA.SigningKey p
privkeyMLDSA_key :: forall p. PrivKeyMLDSA p -> SigningKey p
privkeyMLDSA_key (PrivKeyMLDSA_Seed ScrubbedBytes
_ SigningKey p
sk) = SigningKey p
sk
privkeyMLDSA_key (PrivKeyMLDSA_Expanded SigningKey p
sk) = SigningKey p
sk
privkeyMLDSA_key (PrivKeyMLDSA_Both ScrubbedBytes
_ SigningKey p
sk) = SigningKey p
sk

-- | The seed, for a key that has one.
privkeyMLDSA_seed :: PrivKeyMLDSA p -> Maybe ScrubbedBytes
privkeyMLDSA_seed :: forall p. PrivKeyMLDSA p -> Maybe ScrubbedBytes
privkeyMLDSA_seed (PrivKeyMLDSA_Seed ScrubbedBytes
s SigningKey p
_) = ScrubbedBytes -> Maybe ScrubbedBytes
forall a. a -> Maybe a
Just ScrubbedBytes
s
privkeyMLDSA_seed (PrivKeyMLDSA_Expanded SigningKey p
_) = Maybe ScrubbedBytes
forall a. Maybe a
Nothing
privkeyMLDSA_seed (PrivKeyMLDSA_Both ScrubbedBytes
s SigningKey p
_) = ScrubbedBytes -> Maybe ScrubbedBytes
forall a. a -> Maybe a
Just ScrubbedBytes
s

-- | The form the key will be written out in.
privkeyMLDSA_form :: PrivKeyMLDSA p -> MLDSAKeyForm
privkeyMLDSA_form :: forall p. PrivKeyMLDSA p -> MLDSAKeyForm
privkeyMLDSA_form (PrivKeyMLDSA_Seed ScrubbedBytes
_ SigningKey p
_) = MLDSAKeyForm
MLDSAKeySeed
privkeyMLDSA_form (PrivKeyMLDSA_Expanded SigningKey p
_) = MLDSAKeyForm
MLDSAKeyExpanded
privkeyMLDSA_form (PrivKeyMLDSA_Both ScrubbedBytes
_ SigningKey p
_) = MLDSAKeyForm
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 (ASN1Tag -> PrivKey -> ShowS
[PrivKey] -> ShowS
PrivKey -> String
(ASN1Tag -> PrivKey -> ShowS)
-> (PrivKey -> String) -> ([PrivKey] -> ShowS) -> Show PrivKey
forall a.
(ASN1Tag -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: ASN1Tag -> PrivKey -> ShowS
showsPrec :: ASN1Tag -> PrivKey -> ShowS
$cshow :: PrivKey -> String
show :: PrivKey -> String
$cshowList :: [PrivKey] -> ShowS
showList :: [PrivKey] -> ShowS
Show, PrivKey -> PrivKey -> Bool
(PrivKey -> PrivKey -> Bool)
-> (PrivKey -> PrivKey -> Bool) -> Eq PrivKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrivKey -> PrivKey -> Bool
== :: PrivKey -> PrivKey -> Bool
$c/= :: PrivKey -> PrivKey -> Bool
/= :: PrivKey -> PrivKey -> Bool
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 :: PrivKey -> String
debugShow PrivKey
k = case PrivKey
k of
        PrivKeyRSA PrivateKey
p -> String -> ShowS
con String
"PrivKeyRSA" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ PrivateKey -> String
forall a. DebugShow a => a -> String
debugShow PrivateKey
p
        PrivKeyDSA PrivateKey
p -> String -> ShowS
con String
"PrivKeyDSA" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ PrivateKey -> String
forall a. DebugShow a => a -> String
debugShow PrivateKey
p
        PrivKeyEC PrivKeyEC
p -> String -> ShowS
con String
"PrivKeyEC" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ PrivKeyEC -> String
forall a. DebugShow a => a -> String
debugShow PrivKeyEC
p
        PrivKeyX25519 SecretKey
p -> String -> ShowS
con String
"PrivKeyX25519" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ SecretKey -> String
forall a. DebugShow a => a -> String
debugShow SecretKey
p
        PrivKeyX448 SecretKey
p -> String -> ShowS
con String
"PrivKeyX448" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ SecretKey -> String
forall a. DebugShow a => a -> String
debugShow SecretKey
p
        PrivKeyEd25519 SecretKey
p -> String -> ShowS
con String
"PrivKeyEd25519" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ SecretKey -> String
forall a. DebugShow a => a -> String
debugShow SecretKey
p
        PrivKeyEd448 SecretKey
p -> String -> ShowS
con String
"PrivKeyEd448" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ SecretKey -> String
forall a. DebugShow a => a -> String
debugShow SecretKey
p
        PrivKeyMLDSA44 PrivKeyMLDSA MLDSA44
p -> String -> ShowS
con String
"PrivKeyMLDSA44" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ PrivKeyMLDSA MLDSA44 -> String
forall a. DebugShow a => a -> String
debugShow PrivKeyMLDSA MLDSA44
p
        PrivKeyMLDSA65 PrivKeyMLDSA MLDSA65
p -> String -> ShowS
con String
"PrivKeyMLDSA65" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ PrivKeyMLDSA MLDSA65 -> String
forall a. DebugShow a => a -> String
debugShow PrivKeyMLDSA MLDSA65
p
        PrivKeyMLDSA87 PrivKeyMLDSA MLDSA87
p -> String -> ShowS
con String
"PrivKeyMLDSA87" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ PrivKeyMLDSA MLDSA87 -> String
forall a. DebugShow a => a -> String
debugShow PrivKeyMLDSA MLDSA87
p
      where
        con :: String -> ShowS
con String
name String
body = String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
body String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance ASN1Object PrivKey where
    fromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1])
fromASN1 = [ASN1] -> Either String (PrivKey, [ASN1])
privkeyFromASN1
    toASN1 :: PrivKey -> ASN1S
toASN1 = PrivKey -> ASN1S
privkeyToASN1

privkeyFromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1])
privkeyFromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1])
privkeyFromASN1 [ASN1]
asn1 =
    ((PrivateKey -> PrivKey)
-> (PrivateKey, [ASN1]) -> (PrivKey, [ASN1])
forall {t} {a} {b}. (t -> a) -> (t, b) -> (a, b)
mapFst PrivateKey -> PrivKey
PrivKeyRSA ((PrivateKey, [ASN1]) -> (PrivKey, [ASN1]))
-> Either String (PrivateKey, [ASN1])
-> Either String (PrivKey, [ASN1])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ASN1] -> Either String (PrivateKey, [ASN1])
rsaFromASN1 [ASN1]
asn1)
        Either String (PrivKey, [ASN1])
-> Either String (PrivKey, [ASN1])
-> Either String (PrivKey, [ASN1])
forall {a} {b}. Either a b -> Either a b -> Either a b
<!> ((PrivateKey -> PrivKey)
-> (PrivateKey, [ASN1]) -> (PrivKey, [ASN1])
forall {t} {a} {b}. (t -> a) -> (t, b) -> (a, b)
mapFst PrivateKey -> PrivKey
PrivKeyDSA ((PrivateKey, [ASN1]) -> (PrivKey, [ASN1]))
-> Either String (PrivateKey, [ASN1])
-> Either String (PrivKey, [ASN1])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ASN1] -> Either String (PrivateKey, [ASN1])
dsaFromASN1 [ASN1]
asn1)
        Either String (PrivKey, [ASN1])
-> Either String (PrivKey, [ASN1])
-> Either String (PrivKey, [ASN1])
forall {a} {b}. Either a b -> Either a b -> Either a b
<!> ((PrivKeyEC -> PrivKey) -> (PrivKeyEC, [ASN1]) -> (PrivKey, [ASN1])
forall {t} {a} {b}. (t -> a) -> (t, b) -> (a, b)
mapFst PrivKeyEC -> PrivKey
PrivKeyEC ((PrivKeyEC, [ASN1]) -> (PrivKey, [ASN1]))
-> Either String (PrivKeyEC, [ASN1])
-> Either String (PrivKey, [ASN1])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ASN1] -> Either String (PrivKeyEC, [ASN1])
ecdsaFromASN1 [ASN1]
asn1)
        Either String (PrivKey, [ASN1])
-> Either String (PrivKey, [ASN1])
-> Either String (PrivKey, [ASN1])
forall {a} {b}. Either a b -> Either a b -> Either a b
<!> [ASN1] -> Either String (PrivKey, [ASN1])
newcurveFromASN1 [ASN1]
asn1
  where
    mapFst :: (t -> a) -> (t, b) -> (a, b)
mapFst t -> a
f (t
a, b
b) = (t -> a
f t
a, b
b)

    Left a
_ <!> :: Either a b -> Either a b -> Either a b
<!> Either a b
b = Either a b
b
    Either a b
a <!> Either a b
_ = Either a b
a

rsaFromASN1 :: [ASN1] -> Either String (RSA.PrivateKey, [ASN1])
rsaFromASN1 :: [ASN1] -> Either String (PrivateKey, [ASN1])
rsaFromASN1
    ( Start ASN1ConstructionType
Sequence : IntVal Integer
0 : IntVal Integer
n : IntVal Integer
e : IntVal Integer
d
            : IntVal Integer
p
            : IntVal Integer
q
            : IntVal Integer
dP
            : IntVal Integer
dQ
            : IntVal Integer
qinv
            : End ASN1ConstructionType
Sequence
            : [ASN1]
as
        ) = (PrivateKey, [ASN1]) -> Either String (PrivateKey, [ASN1])
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrivateKey
key, [ASN1]
as)
      where
        key :: PrivateKey
key = PublicKey
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> PrivateKey
RSA.PrivateKey (ASN1Tag -> Integer -> Integer -> PublicKey
RSA.PublicKey (Integer -> ASN1Tag -> ASN1Tag
forall {t} {t}. (Integral t, Num t, Ord t) => t -> t -> t
go Integer
n ASN1Tag
1) Integer
n Integer
e) Integer
d Integer
p Integer
q Integer
dP Integer
dQ Integer
qinv
        go :: t -> t -> t
go t
m t
i
            | t
2 t -> t -> t
forall a b. (Num a, Integral b) => a -> b -> a
^ (t
i t -> t -> t
forall a. Num a => a -> a -> a
* t
8) t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
m = t
i
            | Bool
otherwise = t -> t -> t
go t
m (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
rsaFromASN1
    ( Start ASN1ConstructionType
Sequence : IntVal Integer
0 : Start ASN1ConstructionType
Sequence
            : OID [Integer
1, Integer
2, Integer
840, Integer
113549, Integer
1, Integer
1, Integer
1]
            : ASN1
Null
            : End ASN1ConstructionType
Sequence
            : OctetString ByteString
bytes
            : End ASN1ConstructionType
Sequence
            : [ASN1]
as
        ) = do
        [ASN1]
asn1 <- (ASN1Error -> String)
-> Either ASN1Error [ASN1] -> Either String [ASN1]
forall a0 a1 b. (a0 -> a1) -> Either a0 b -> Either a1 b
mapLeft ASN1Error -> String
failure (BER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
bytes)
        ASN1S -> (PrivateKey, [ASN1]) -> (PrivateKey, [ASN1])
forall a b. (a -> b) -> (PrivateKey, a) -> (PrivateKey, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ASN1] -> ASN1S
forall a b. a -> b -> a
const [ASN1]
as) ((PrivateKey, [ASN1]) -> (PrivateKey, [ASN1]))
-> Either String (PrivateKey, [ASN1])
-> Either String (PrivateKey, [ASN1])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ASN1] -> Either String (PrivateKey, [ASN1])
rsaFromASN1 [ASN1]
asn1
      where
        failure :: ASN1Error -> String
failure = (String
"rsaFromASN1: " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (ASN1Error -> String) -> ASN1Error -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Error -> String
forall a. Show a => a -> String
show
rsaFromASN1 [ASN1]
_ = String -> Either String (PrivateKey, [ASN1])
forall a b. a -> Either a b
Left String
"rsaFromASN1: unexpected format"

dsaFromASN1 :: [ASN1] -> Either String (DSA.PrivateKey, [ASN1])
dsaFromASN1 :: [ASN1] -> Either String (PrivateKey, [ASN1])
dsaFromASN1
    ( Start ASN1ConstructionType
Sequence : IntVal Integer
0 : IntVal Integer
p : IntVal Integer
q : IntVal Integer
g
            : IntVal Integer
_
            : IntVal Integer
x
            : End ASN1ConstructionType
Sequence
            : [ASN1]
as
        ) =
        (PrivateKey, [ASN1]) -> Either String (PrivateKey, [ASN1])
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Params -> Integer -> PrivateKey
DSA.PrivateKey (Integer -> Integer -> Integer -> Params
DSA.Params Integer
p Integer
g Integer
q) Integer
x, [ASN1]
as)
dsaFromASN1
    ( Start ASN1ConstructionType
Sequence : IntVal Integer
0 : Start ASN1ConstructionType
Sequence
            : OID [Integer
1, Integer
2, Integer
840, Integer
10040, Integer
4, Integer
1]
            : Start ASN1ConstructionType
Sequence
            : IntVal Integer
p
            : IntVal Integer
q
            : IntVal Integer
g
            : End ASN1ConstructionType
Sequence
            : End ASN1ConstructionType
Sequence
            : OctetString ByteString
bytes
            : End ASN1ConstructionType
Sequence
            : [ASN1]
as
        ) = case BER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
bytes of
        Right [IntVal Integer
x] -> (PrivateKey, [ASN1]) -> Either String (PrivateKey, [ASN1])
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Params -> Integer -> PrivateKey
DSA.PrivateKey (Integer -> Integer -> Integer -> Params
DSA.Params Integer
p Integer
g Integer
q) Integer
x, [ASN1]
as)
        Right [ASN1]
_ -> String -> Either String (PrivateKey, [ASN1])
forall a b. a -> Either a b
Left String
"DSA.PrivateKey.fromASN1: unexpected format"
        Left ASN1Error
e -> String -> Either String (PrivateKey, [ASN1])
forall a b. a -> Either a b
Left (String -> Either String (PrivateKey, [ASN1]))
-> String -> Either String (PrivateKey, [ASN1])
forall a b. (a -> b) -> a -> b
$ String
"DSA.PrivateKey.fromASN1: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ASN1Error -> String
forall a. Show a => a -> String
show ASN1Error
e
dsaFromASN1 [ASN1]
_ = String -> Either String (PrivateKey, [ASN1])
forall a b. a -> Either a b
Left String
"DSA.PrivateKey.fromASN1: unexpected format"

ecdsaFromASN1 :: [ASN1] -> Either String (PrivKeyEC, [ASN1])
ecdsaFromASN1 :: [ASN1] -> Either String (PrivKeyEC, [ASN1])
ecdsaFromASN1 = [ASN1] -> [ASN1] -> Either String (PrivKeyEC, [ASN1])
go []
  where
    failing :: ShowS
failing = (String
"ECDSA.PrivateKey.fromASN1: " String -> ShowS
forall a. [a] -> [a] -> [a]
++)

    go :: [ASN1] -> [ASN1] -> Either String (PrivKeyEC, [ASN1])
go [ASN1]
acc (Start ASN1ConstructionType
Sequence : IntVal Integer
1 : OctetString ByteString
bytes : [ASN1]
rest) = do
        PrivKeyEC
key <- [ASN1] -> Either String PrivKeyEC
subgo ([ASN1]
oid [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
++ [ASN1]
acc)
        case [ASN1]
rest'' of
            End ASN1ConstructionType
Sequence : [ASN1]
rest''' -> (PrivKeyEC, [ASN1]) -> Either String (PrivKeyEC, [ASN1])
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrivKeyEC
key, [ASN1]
rest''')
            [ASN1]
_ -> String -> Either String (PrivKeyEC, [ASN1])
forall a b. a -> Either a b
Left (String -> Either String (PrivKeyEC, [ASN1]))
-> String -> Either String (PrivKeyEC, [ASN1])
forall a b. (a -> b) -> a -> b
$ ShowS
failing String
"unexpected EC format"
      where
        d :: Integer
d = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
bytes
        ([ASN1]
oid, [ASN1]
rest') = ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
spanTag ASN1Tag
0 [ASN1]
rest
        ([ASN1]
_, [ASN1]
rest'') = ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
spanTag ASN1Tag
1 [ASN1]
rest'
        subgo :: [ASN1] -> Either String PrivKeyEC
subgo (OID OID
oid_ : [ASN1]
_) = Either String PrivKeyEC
-> (CurveName -> Either String PrivKeyEC)
-> Maybe CurveName
-> Either String PrivKeyEC
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either String PrivKeyEC
forall {b}. Either String b
failure CurveName -> Either String PrivKeyEC
forall {a}. CurveName -> Either a PrivKeyEC
success Maybe CurveName
mcurve
          where
            failure :: Either String b
failure = String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ ShowS
failing ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"unknown curve " String -> ShowS
forall a. [a] -> [a] -> [a]
++ OID -> String
forall a. Show a => a -> String
show OID
oid_
            success :: CurveName -> Either a PrivKeyEC
success = PrivKeyEC -> Either a PrivKeyEC
forall a b. b -> Either a b
Right (PrivKeyEC -> Either a PrivKeyEC)
-> (CurveName -> PrivKeyEC) -> CurveName -> Either a PrivKeyEC
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CurveName -> Integer -> PrivKeyEC)
-> Integer -> CurveName -> PrivKeyEC
forall a b c. (a -> b -> c) -> b -> a -> c
flip CurveName -> Integer -> PrivKeyEC
PrivKeyEC_Named Integer
d
            mcurve :: Maybe CurveName
mcurve = OIDTable CurveName -> OID -> Maybe CurveName
forall a. OIDTable a -> OID -> Maybe a
lookupByOID OIDTable CurveName
curvesOIDTable OID
oid_
        subgo
            ( Start ASN1ConstructionType
Sequence : IntVal Integer
1 : Start ASN1ConstructionType
Sequence
                    : OID [Integer
1, Integer
2, Integer
840, Integer
10045, Integer
1, Integer
1]
                    : IntVal Integer
p
                    : End ASN1ConstructionType
Sequence
                    : Start ASN1ConstructionType
Sequence
                    : OctetString ByteString
a
                    : OctetString ByteString
b
                    : BitString BitArray
s
                    : End ASN1ConstructionType
Sequence
                    : OctetString ByteString
g
                    : IntVal Integer
o
                    : IntVal Integer
c
                    : End ASN1ConstructionType
Sequence
                    : [ASN1]
_
                ) =
                PrivKeyEC -> Either String PrivKeyEC
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrivKeyEC -> Either String PrivKeyEC)
-> PrivKeyEC -> Either String PrivKeyEC
forall a b. (a -> b) -> a -> b
$ Integer
-> Integer
-> Integer
-> Integer
-> SerializedPoint
-> Integer
-> Integer
-> Integer
-> PrivKeyEC
PrivKeyEC_Prime Integer
d Integer
a' Integer
b' Integer
p SerializedPoint
g' Integer
o Integer
c Integer
s'
              where
                a' :: Integer
a' = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
a
                b' :: Integer
b' = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
b
                g' :: SerializedPoint
g' = ByteString -> SerializedPoint
SerializedPoint ByteString
g
                s' :: Integer
s' = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ BitArray -> ByteString
bitArrayGetData BitArray
s
        subgo (ASN1
Null : [ASN1]
rest_) = [ASN1] -> Either String PrivKeyEC
subgo [ASN1]
rest_
        subgo [] = String -> Either String PrivKeyEC
forall a b. a -> Either a b
Left (String -> Either String PrivKeyEC)
-> String -> Either String PrivKeyEC
forall a b. (a -> b) -> a -> b
$ ShowS
failing String
"curve is missing"
        subgo [ASN1]
_ = String -> Either String PrivKeyEC
forall a b. a -> Either a b
Left (String -> Either String PrivKeyEC)
-> String -> Either String PrivKeyEC
forall a b. (a -> b) -> a -> b
$ ShowS
failing String
"unexpected curve format"
    go
        [ASN1]
acc
        ( Start ASN1ConstructionType
Sequence : IntVal Integer
0 : Start ASN1ConstructionType
Sequence
                : OID [Integer
1, Integer
2, Integer
840, Integer
10045, Integer
2, Integer
1]
                : [ASN1]
rest
            ) = case [ASN1]
rest' of
            (OctetString ByteString
bytes : [ASN1]
rest'') -> do
                [ASN1]
asn1 <- (ASN1Error -> String)
-> Either ASN1Error [ASN1] -> Either String [ASN1]
forall a0 a1 b. (a0 -> a1) -> Either a0 b -> Either a1 b
mapLeft (ShowS
failing ShowS -> (ASN1Error -> String) -> ASN1Error -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Error -> String
forall a. Show a => a -> String
show) (BER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
bytes)
                ASN1S -> (PrivKeyEC, [ASN1]) -> (PrivKeyEC, [ASN1])
forall a b. (a -> b) -> (PrivKeyEC, a) -> (PrivKeyEC, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ASN1] -> ASN1S
forall a b. a -> b -> a
const [ASN1]
rest'') ((PrivKeyEC, [ASN1]) -> (PrivKeyEC, [ASN1]))
-> Either String (PrivKeyEC, [ASN1])
-> Either String (PrivKeyEC, [ASN1])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ASN1] -> [ASN1] -> Either String (PrivKeyEC, [ASN1])
go ([ASN1]
oid [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
++ [ASN1]
acc) [ASN1]
asn1
            [ASN1]
_ -> String -> Either String (PrivKeyEC, [ASN1])
forall a b. a -> Either a b
Left (String -> Either String (PrivKeyEC, [ASN1]))
-> String -> Either String (PrivKeyEC, [ASN1])
forall a b. (a -> b) -> a -> b
$ ShowS
failing String
"unexpected EC format"
          where
            ([ASN1]
oid, [ASN1]
rest') = Word -> [ASN1] -> ([ASN1], [ASN1])
spanEnd Word
0 [ASN1]
rest
    go [ASN1]
_ [ASN1]
_ = String -> Either String (PrivKeyEC, [ASN1])
forall a b. a -> Either a b
Left (String -> Either String (PrivKeyEC, [ASN1]))
-> String -> Either String (PrivKeyEC, [ASN1])
forall a b. (a -> b) -> a -> b
$ ShowS
failing String
"unexpected EC format"

    spanEnd :: Word -> [ASN1] -> ([ASN1], [ASN1])
    spanEnd :: Word -> [ASN1] -> ([ASN1], [ASN1])
spanEnd = ASN1S -> Word -> [ASN1] -> ([ASN1], [ASN1])
forall {t} {a}.
(Num t, Eq t) =>
([ASN1] -> a) -> t -> [ASN1] -> (a, [ASN1])
loop ASN1S
forall a. a -> a
id
      where
        loop :: ([ASN1] -> a) -> t -> [ASN1] -> (a, [ASN1])
loop [ASN1] -> a
dlist t
n (a :: ASN1
a@(Start ASN1ConstructionType
_) : [ASN1]
as) = ([ASN1] -> a) -> t -> [ASN1] -> (a, [ASN1])
loop ([ASN1] -> a
dlist ([ASN1] -> a) -> ASN1S -> [ASN1] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ASN1
a ASN1 -> ASN1S
forall a. a -> [a] -> [a]
:)) (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) [ASN1]
as
        loop [ASN1] -> a
dlist t
0 (End ASN1ConstructionType
_ : [ASN1]
as) = ([ASN1] -> a
dlist [], [ASN1]
as)
        loop [ASN1] -> a
dlist t
n (a :: ASN1
a@(End ASN1ConstructionType
_) : [ASN1]
as) = ([ASN1] -> a) -> t -> [ASN1] -> (a, [ASN1])
loop ([ASN1] -> a
dlist ([ASN1] -> a) -> ASN1S -> [ASN1] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ASN1
a ASN1 -> ASN1S
forall a. a -> [a] -> [a]
:)) (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) [ASN1]
as
        loop [ASN1] -> a
dlist t
n (ASN1
a : [ASN1]
as) = ([ASN1] -> a) -> t -> [ASN1] -> (a, [ASN1])
loop ([ASN1] -> a
dlist ([ASN1] -> a) -> ASN1S -> [ASN1] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ASN1
a ASN1 -> ASN1S
forall a. a -> [a] -> [a]
:)) t
n [ASN1]
as
        loop [ASN1] -> a
dlist t
_ [] = ([ASN1] -> a
dlist [], [])

    spanTag :: Int -> [ASN1] -> ([ASN1], [ASN1])
    spanTag :: ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
spanTag ASN1Tag
a (Start (Container ASN1Class
_ ASN1Tag
b) : [ASN1]
as) | ASN1Tag
a ASN1Tag -> ASN1Tag -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1Tag
b = Word -> [ASN1] -> ([ASN1], [ASN1])
spanEnd Word
0 [ASN1]
as
    spanTag ASN1Tag
_ [ASN1]
as = ([], [ASN1]
as)

newcurveFromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1])
newcurveFromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1])
newcurveFromASN1
    ( Start ASN1ConstructionType
Sequence
            : IntVal Integer
v
            : Start ASN1ConstructionType
Sequence
            : OID OID
oid
            : End ASN1ConstructionType
Sequence
            : OctetString ByteString
bs
            : [ASN1]
xs
        )
        | Integer -> Bool
forall {a}. (Ord a, Num a) => a -> Bool
isValidVersion Integer
v = do
            let ([ASN1]
_, [ASN1]
ys) = ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
containerWithTag ASN1Tag
0 [ASN1]
xs
            case ASN1Tag -> [ASN1] -> (Maybe ByteString, [ASN1])
primitiveWithTag ASN1Tag
1 [ASN1]
ys of
                (Maybe ByteString
_, End ASN1ConstructionType
Sequence : [ASN1]
zs) ->
                    case OID -> Maybe (String, ByteString -> CryptoFailable PrivKey)
forall {a} {a}.
(Eq a, Num a, ByteArrayAccess a) =>
[a] -> Maybe (String, a -> CryptoFailable PrivKey)
getP OID
oid of
                        Just (String
name, ByteString -> CryptoFailable PrivKey
parse) -> do
                            let err :: String -> Either String b
err String
s = String -> Either String b
forall a b. a -> Either a b
Left (String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".SecretKey.fromASN1: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
                            case BER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
bs of
                                Right [OctetString ByteString
key] ->
                                    case ByteString -> CryptoFailable PrivKey
parse ByteString
key of
                                        CryptoPassed PrivKey
s -> (PrivKey, [ASN1]) -> Either String (PrivKey, [ASN1])
forall a b. b -> Either a b
Right (PrivKey
s, [ASN1]
zs)
                                        CryptoFailed CryptoError
e -> String -> Either String (PrivKey, [ASN1])
forall {b}. String -> Either String b
err (String
"invalid secret key: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e)
                                Right [ASN1]
_ -> String -> Either String (PrivKey, [ASN1])
forall {b}. String -> Either String b
err String
"unexpected inner format"
                                Left ASN1Error
e -> String -> Either String (PrivKey, [ASN1])
forall {b}. String -> Either String b
err (ASN1Error -> String
forall a. Show a => a -> String
show ASN1Error
e)
                        Maybe (String, ByteString -> CryptoFailable PrivKey)
Nothing -> case OID -> Maybe (String, [ASN1] -> Either String PrivKey)
forall {a}.
(Eq a, Num a) =>
[a] -> Maybe (String, [ASN1] -> Either String PrivKey)
getMLDSA OID
oid of
                            Just (String
name, [ASN1] -> Either String PrivKey
parse) ->
                                case BER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
bs of
                                    Right [ASN1]
inner -> (\PrivKey
k -> (PrivKey
k, [ASN1]
zs)) (PrivKey -> (PrivKey, [ASN1]))
-> Either String PrivKey -> Either String (PrivKey, [ASN1])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ASN1] -> Either String PrivKey
parse [ASN1]
inner
                                    Left ASN1Error
e -> String -> Either String (PrivKey, [ASN1])
forall a b. a -> Either a b
Left (String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".SigningKey.fromASN1: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ASN1Error -> String
forall a. Show a => a -> String
show ASN1Error
e)
                            Maybe (String, [ASN1] -> Either String PrivKey)
Nothing -> String -> Either String (PrivKey, [ASN1])
forall a b. a -> Either a b
Left (String
"newcurveFromASN1: unexpected OID " String -> ShowS
forall a. [a] -> [a] -> [a]
++ OID -> String
forall a. Show a => a -> String
show OID
oid)
                (Maybe ByteString, [ASN1])
_ -> String -> Either String (PrivKey, [ASN1])
forall a b. a -> Either a b
Left String
"newcurveFromASN1: unexpected end format"
        | Bool
otherwise = String -> Either String (PrivKey, [ASN1])
forall a b. a -> Either a b
Left (String
"newcurveFromASN1: unexpected version: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
v)
      where
        getP :: [a] -> Maybe (String, a -> CryptoFailable PrivKey)
getP [a
1, a
3, a
101, a
110] = (String, a -> CryptoFailable PrivKey)
-> Maybe (String, a -> CryptoFailable PrivKey)
forall a. a -> Maybe a
Just (String
"X25519", (SecretKey -> PrivKey)
-> CryptoFailable SecretKey -> CryptoFailable PrivKey
forall a b. (a -> b) -> CryptoFailable a -> CryptoFailable b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> PrivKey
PrivKeyX25519 (CryptoFailable SecretKey -> CryptoFailable PrivKey)
-> (a -> CryptoFailable SecretKey) -> a -> CryptoFailable PrivKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CryptoFailable SecretKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable SecretKey
X25519.secretKey)
        getP [a
1, a
3, a
101, a
111] = (String, a -> CryptoFailable PrivKey)
-> Maybe (String, a -> CryptoFailable PrivKey)
forall a. a -> Maybe a
Just (String
"X448", (SecretKey -> PrivKey)
-> CryptoFailable SecretKey -> CryptoFailable PrivKey
forall a b. (a -> b) -> CryptoFailable a -> CryptoFailable b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> PrivKey
PrivKeyX448 (CryptoFailable SecretKey -> CryptoFailable PrivKey)
-> (a -> CryptoFailable SecretKey) -> a -> CryptoFailable PrivKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CryptoFailable SecretKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable SecretKey
X448.secretKey)
        getP [a
1, a
3, a
101, a
112] = (String, a -> CryptoFailable PrivKey)
-> Maybe (String, a -> CryptoFailable PrivKey)
forall a. a -> Maybe a
Just (String
"Ed25519", (SecretKey -> PrivKey)
-> CryptoFailable SecretKey -> CryptoFailable PrivKey
forall a b. (a -> b) -> CryptoFailable a -> CryptoFailable b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> PrivKey
PrivKeyEd25519 (CryptoFailable SecretKey -> CryptoFailable PrivKey)
-> (a -> CryptoFailable SecretKey) -> a -> CryptoFailable PrivKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey)
        getP [a
1, a
3, a
101, a
113] = (String, a -> CryptoFailable PrivKey)
-> Maybe (String, a -> CryptoFailable PrivKey)
forall a. a -> Maybe a
Just (String
"Ed448", (SecretKey -> PrivKey)
-> CryptoFailable SecretKey -> CryptoFailable PrivKey
forall a b. (a -> b) -> CryptoFailable a -> CryptoFailable b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> PrivKey
PrivKeyEd448 (CryptoFailable SecretKey -> CryptoFailable PrivKey)
-> (a -> CryptoFailable SecretKey) -> a -> CryptoFailable PrivKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey)
        getP [a]
_ = Maybe (String, a -> CryptoFailable PrivKey)
forall a. Maybe a
Nothing
        getMLDSA :: [a] -> Maybe (String, [ASN1] -> Either String PrivKey)
getMLDSA [a
2, a
16, a
840, a
1, a
101, a
3, a
4, a
3, a
17] =
            (String, [ASN1] -> Either String PrivKey)
-> Maybe (String, [ASN1] -> Either String PrivKey)
forall a. a -> Maybe a
Just
                ( String
"ML-DSA-44"
                , Proxy MLDSA44
-> (PrivKeyMLDSA MLDSA44 -> PrivKey)
-> String
-> [ASN1]
-> Either String PrivKey
forall p (proxy :: * -> *).
MLDSA p =>
proxy p
-> (PrivKeyMLDSA p -> PrivKey)
-> String
-> [ASN1]
-> Either String PrivKey
mldsaFromASN1 (Proxy MLDSA44
forall {k} (t :: k). Proxy t
Proxy :: Proxy MLDSA.MLDSA44) PrivKeyMLDSA MLDSA44 -> PrivKey
PrivKeyMLDSA44 String
"ML-DSA-44"
                )
        getMLDSA [a
2, a
16, a
840, a
1, a
101, a
3, a
4, a
3, a
18] =
            (String, [ASN1] -> Either String PrivKey)
-> Maybe (String, [ASN1] -> Either String PrivKey)
forall a. a -> Maybe a
Just
                ( String
"ML-DSA-65"
                , Proxy MLDSA65
-> (PrivKeyMLDSA MLDSA65 -> PrivKey)
-> String
-> [ASN1]
-> Either String PrivKey
forall p (proxy :: * -> *).
MLDSA p =>
proxy p
-> (PrivKeyMLDSA p -> PrivKey)
-> String
-> [ASN1]
-> Either String PrivKey
mldsaFromASN1 (Proxy MLDSA65
forall {k} (t :: k). Proxy t
Proxy :: Proxy MLDSA.MLDSA65) PrivKeyMLDSA MLDSA65 -> PrivKey
PrivKeyMLDSA65 String
"ML-DSA-65"
                )
        getMLDSA [a
2, a
16, a
840, a
1, a
101, a
3, a
4, a
3, a
19] =
            (String, [ASN1] -> Either String PrivKey)
-> Maybe (String, [ASN1] -> Either String PrivKey)
forall a. a -> Maybe a
Just
                ( String
"ML-DSA-87"
                , Proxy MLDSA87
-> (PrivKeyMLDSA MLDSA87 -> PrivKey)
-> String
-> [ASN1]
-> Either String PrivKey
forall p (proxy :: * -> *).
MLDSA p =>
proxy p
-> (PrivKeyMLDSA p -> PrivKey)
-> String
-> [ASN1]
-> Either String PrivKey
mldsaFromASN1 (Proxy MLDSA87
forall {k} (t :: k). Proxy t
Proxy :: Proxy MLDSA.MLDSA87) PrivKeyMLDSA MLDSA87 -> PrivKey
PrivKeyMLDSA87 String
"ML-DSA-87"
                )
        getMLDSA [a]
_ = Maybe (String, [ASN1] -> Either String PrivKey)
forall a. Maybe a
Nothing
        isValidVersion :: a -> Bool
isValidVersion a
version = a
version a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&& a
version a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
1
newcurveFromASN1 [ASN1]
_ =
    String -> Either String (PrivKey, [ASN1])
forall a b. a -> Either a b
Left String
"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 :: forall p (proxy :: * -> *).
MLDSA p =>
proxy p
-> (PrivKeyMLDSA p -> PrivKey)
-> String
-> [ASN1]
-> Either String PrivKey
mldsaFromASN1 proxy p
p PrivKeyMLDSA p -> PrivKey
con String
name [ASN1]
inner = case [ASN1]
inner of
    [Other ASN1Class
Context ASN1Tag
0 ByteString
seed] -> PrivKeyMLDSA p -> PrivKey
con (PrivKeyMLDSA p -> PrivKey)
-> Either String (PrivKeyMLDSA p) -> Either String PrivKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MLDSAKeyForm -> ByteString -> Either String (PrivKeyMLDSA p)
forall {ba}.
ByteArrayAccess ba =>
MLDSAKeyForm -> ba -> Either String (PrivKeyMLDSA p)
fromSeed MLDSAKeyForm
MLDSAKeySeed ByteString
seed
    [OctetString ByteString
expanded] -> PrivKeyMLDSA p -> PrivKey
con (PrivKeyMLDSA p -> PrivKey)
-> (SigningKey p -> PrivKeyMLDSA p) -> SigningKey p -> PrivKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey p -> PrivKeyMLDSA p
forall p. SigningKey p -> PrivKeyMLDSA p
privkeyMLDSAFromKey (SigningKey p -> PrivKey)
-> Either String (SigningKey p) -> Either String PrivKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String (SigningKey p)
forall {p} {ba}.
(MLDSA p, ByteArrayAccess ba) =>
ba -> Either String (SigningKey p)
fromExpanded ByteString
expanded
    [Start ASN1ConstructionType
Sequence, OctetString ByteString
seed, OctetString ByteString
expanded, End ASN1ConstructionType
Sequence] -> do
        PrivKeyMLDSA p
k <- MLDSAKeyForm -> ByteString -> Either String (PrivKeyMLDSA p)
forall {ba}.
ByteArrayAccess ba =>
MLDSAKeyForm -> ba -> Either String (PrivKeyMLDSA p)
fromSeed MLDSAKeyForm
MLDSAKeyBoth ByteString
seed
        SigningKey p
sk <- ByteString -> Either String (SigningKey p)
forall {p} {ba}.
(MLDSA p, ByteArrayAccess ba) =>
ba -> Either String (SigningKey p)
fromExpanded ByteString
expanded
        if PrivKeyMLDSA p -> SigningKey p
forall p. PrivKeyMLDSA p -> SigningKey p
privkeyMLDSA_key PrivKeyMLDSA p
k SigningKey p -> SigningKey p -> Bool
forall a. Eq a => a -> a -> Bool
== SigningKey p
sk
            then PrivKey -> Either String PrivKey
forall a b. b -> Either a b
Right (PrivKeyMLDSA p -> PrivKey
con PrivKeyMLDSA p
k)
            else String -> Either String PrivKey
forall {b}. String -> Either String b
err String
"seed and expandedKey do not match"
    [ASN1]
_ -> String -> Either String PrivKey
forall {b}. String -> Either String b
err String
"unexpected inner format"
  where
    err :: String -> Either String b
err String
s = String -> Either String b
forall a b. a -> Either a b
Left (String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".SigningKey.fromASN1: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
    fromSeed :: MLDSAKeyForm -> ba -> Either String (PrivKeyMLDSA p)
fromSeed MLDSAKeyForm
form ba
seed = case proxy p -> MLDSAKeyForm -> ba -> CryptoFailable (PrivKeyMLDSA p)
forall p ba (proxy :: * -> *).
(MLDSA p, ByteArrayAccess ba) =>
proxy p -> MLDSAKeyForm -> ba -> CryptoFailable (PrivKeyMLDSA p)
privkeyMLDSAFromSeed proxy p
p MLDSAKeyForm
form ba
seed of
        CryptoPassed PrivKeyMLDSA p
k -> PrivKeyMLDSA p -> Either String (PrivKeyMLDSA p)
forall a b. b -> Either a b
Right PrivKeyMLDSA p
k
        CryptoFailed CryptoError
e -> String -> Either String (PrivKeyMLDSA p)
forall {b}. String -> Either String b
err (String
"invalid seed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e)
    fromExpanded :: ba -> Either String (SigningKey p)
fromExpanded ba
expanded = case ba -> CryptoFailable (SigningKey p)
forall p ba.
(MLDSA p, ByteArrayAccess ba) =>
ba -> CryptoFailable (SigningKey p)
MLDSA.signingKey ba
expanded of
        CryptoPassed SigningKey p
sk -> SigningKey p -> Either String (SigningKey p)
forall a b. b -> Either a b
Right SigningKey p
sk
        CryptoFailed CryptoError
e -> String -> Either String (SigningKey p)
forall {b}. String -> Either String b
err (String
"invalid expandedKey: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e)

containerWithTag :: ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
containerWithTag :: ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
containerWithTag ASN1Tag
etag (Start (Container ASN1Class
_ ASN1Tag
atag) : [ASN1]
xs)
    | ASN1Tag
etag ASN1Tag -> ASN1Tag -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1Tag
atag = ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
getConstructedEnd ASN1Tag
0 [ASN1]
xs
containerWithTag ASN1Tag
_ [ASN1]
xs = ([], [ASN1]
xs)

primitiveWithTag :: ASN1Tag -> [ASN1] -> (Maybe B.ByteString, [ASN1])
primitiveWithTag :: ASN1Tag -> [ASN1] -> (Maybe ByteString, [ASN1])
primitiveWithTag ASN1Tag
etag (Other ASN1Class
_ ASN1Tag
atag ByteString
bs : [ASN1]
xs)
    | ASN1Tag
etag ASN1Tag -> ASN1Tag -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1Tag
atag = (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs, [ASN1]
xs)
primitiveWithTag ASN1Tag
_ [ASN1]
xs = (Maybe ByteString
forall a. Maybe a
Nothing, [ASN1]
xs)

privkeyToASN1 :: PrivKey -> ASN1S
privkeyToASN1 :: PrivKey -> ASN1S
privkeyToASN1 (PrivKeyRSA PrivateKey
rsa) = PrivateKey -> ASN1S
rsaToASN1 PrivateKey
rsa
privkeyToASN1 (PrivKeyDSA PrivateKey
dsa) = PrivateKey -> ASN1S
dsaToASN1 PrivateKey
dsa
privkeyToASN1 (PrivKeyEC PrivKeyEC
ecdsa) = PrivKeyEC -> ASN1S
ecdsaToASN1 PrivKeyEC
ecdsa
privkeyToASN1 (PrivKeyX25519 SecretKey
k) = OID -> SecretKey -> ASN1S
forall key. ByteArrayAccess key => OID -> key -> ASN1S
newcurveToASN1 [Integer
1, Integer
3, Integer
101, Integer
110] SecretKey
k
privkeyToASN1 (PrivKeyX448 SecretKey
k) = OID -> SecretKey -> ASN1S
forall key. ByteArrayAccess key => OID -> key -> ASN1S
newcurveToASN1 [Integer
1, Integer
3, Integer
101, Integer
111] SecretKey
k
privkeyToASN1 (PrivKeyEd25519 SecretKey
k) = OID -> SecretKey -> ASN1S
forall key. ByteArrayAccess key => OID -> key -> ASN1S
newcurveToASN1 [Integer
1, Integer
3, Integer
101, Integer
112] SecretKey
k
privkeyToASN1 (PrivKeyEd448 SecretKey
k) = OID -> SecretKey -> ASN1S
forall key. ByteArrayAccess key => OID -> key -> ASN1S
newcurveToASN1 [Integer
1, Integer
3, Integer
101, Integer
113] SecretKey
k
privkeyToASN1 (PrivKeyMLDSA44 PrivKeyMLDSA MLDSA44
k) = OID -> PrivKeyMLDSA MLDSA44 -> ASN1S
forall p. OID -> PrivKeyMLDSA p -> ASN1S
mldsaToASN1 (PubKeyALG -> OID
forall a. OIDable a => a -> OID
getObjectID PubKeyALG
PubKeyALG_MLDSA44) PrivKeyMLDSA MLDSA44
k
privkeyToASN1 (PrivKeyMLDSA65 PrivKeyMLDSA MLDSA65
k) = OID -> PrivKeyMLDSA MLDSA65 -> ASN1S
forall p. OID -> PrivKeyMLDSA p -> ASN1S
mldsaToASN1 (PubKeyALG -> OID
forall a. OIDable a => a -> OID
getObjectID PubKeyALG
PubKeyALG_MLDSA65) PrivKeyMLDSA MLDSA65
k
privkeyToASN1 (PrivKeyMLDSA87 PrivKeyMLDSA MLDSA87
k) = OID -> PrivKeyMLDSA MLDSA87 -> ASN1S
forall p. OID -> PrivKeyMLDSA p -> ASN1S
mldsaToASN1 (PubKeyALG -> OID
forall a. OIDable a => a -> OID
getObjectID PubKeyALG
PubKeyALG_MLDSA87) PrivKeyMLDSA MLDSA87
k

rsaToASN1 :: RSA.PrivateKey -> ASN1S
rsaToASN1 :: PrivateKey -> ASN1S
rsaToASN1 PrivateKey
key =
    [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
(++)
        [ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
        , Integer -> ASN1
IntVal Integer
0
        , Integer -> ASN1
IntVal Integer
n
        , Integer -> ASN1
IntVal Integer
e
        , Integer -> ASN1
IntVal Integer
d
        , Integer -> ASN1
IntVal Integer
p
        , Integer -> ASN1
IntVal Integer
q
        , Integer -> ASN1
IntVal Integer
dP
        , Integer -> ASN1
IntVal Integer
dQ
        , Integer -> ASN1
IntVal Integer
qinv
        , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
        ]
  where
    RSA.PrivateKey (RSA.PublicKey ASN1Tag
_ Integer
n Integer
e) Integer
d Integer
p Integer
q Integer
dP Integer
dQ Integer
qinv = PrivateKey
key

dsaToASN1 :: DSA.PrivateKey -> ASN1S
dsaToASN1 :: PrivateKey -> ASN1S
dsaToASN1 (DSA.PrivateKey params :: Params
params@(DSA.Params Integer
p Integer
g Integer
q) Integer
y) =
    [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
(++)
        [ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
        , Integer -> ASN1
IntVal Integer
0
        , Integer -> ASN1
IntVal Integer
p
        , Integer -> ASN1
IntVal Integer
q
        , Integer -> ASN1
IntVal Integer
g
        , Integer -> ASN1
IntVal Integer
x
        , Integer -> ASN1
IntVal Integer
y
        , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
        ]
  where
    x :: Integer
x = Params -> Integer -> Integer
DSA.calculatePublic Params
params Integer
y

ecdsaToASN1 :: PrivKeyEC -> ASN1S
ecdsaToASN1 :: PrivKeyEC -> ASN1S
ecdsaToASN1 (PrivKeyEC_Named CurveName
curveName Integer
d) =
    [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
(++)
        [ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
        , Integer -> ASN1
IntVal Integer
1
        , ByteString -> ASN1
OctetString (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
d)
        , ASN1ConstructionType -> ASN1
Start (ASN1Class -> ASN1Tag -> ASN1ConstructionType
Container ASN1Class
Context ASN1Tag
0)
        , OID -> ASN1
OID OID
oid
        , ASN1ConstructionType -> ASN1
End (ASN1Class -> ASN1Tag -> ASN1ConstructionType
Container ASN1Class
Context ASN1Tag
0)
        , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
        ]
  where
    err :: String -> c
err = String -> c
forall a. HasCallStack => String -> a
error (String -> c) -> ShowS -> String -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"ECDSA.PrivateKey.toASN1: " String -> ShowS
forall a. [a] -> [a] -> [a]
++)
    oid :: OID
oid =
        OID -> Maybe OID -> OID
forall a. a -> Maybe a -> a
fromMaybe
            (String -> OID
forall {c}. String -> c
err (String -> OID) -> String -> OID
forall a b. (a -> b) -> a -> b
$ String
"missing named curve " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CurveName -> String
forall a. Show a => a -> String
show CurveName
curveName)
            (OIDTable CurveName -> CurveName -> Maybe OID
forall a. Eq a => OIDTable a -> a -> Maybe OID
lookupOID OIDTable CurveName
curvesOIDTable CurveName
curveName)
ecdsaToASN1 (PrivKeyEC_Prime Integer
d Integer
a Integer
b Integer
p SerializedPoint
g Integer
o Integer
c Integer
s) =
    [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
(++)
        [ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
        , Integer -> ASN1
IntVal Integer
1
        , ByteString -> ASN1
OctetString (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
d)
        , ASN1ConstructionType -> ASN1
Start (ASN1Class -> ASN1Tag -> ASN1ConstructionType
Container ASN1Class
Context ASN1Tag
0)
        , ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
        , Integer -> ASN1
IntVal Integer
1
        , ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
        , OID -> ASN1
OID [Integer
1, Integer
2, Integer
840, Integer
10045, Integer
1, Integer
1]
        , Integer -> ASN1
IntVal Integer
p
        , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
        , ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
        , ByteString -> ASN1
OctetString ByteString
a'
        , ByteString -> ASN1
OctetString ByteString
b'
        , BitArray -> ASN1
BitString BitArray
s'
        , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
        , ByteString -> ASN1
OctetString ByteString
g'
        , Integer -> ASN1
IntVal Integer
o
        , Integer -> ASN1
IntVal Integer
c
        , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
        , ASN1ConstructionType -> ASN1
End (ASN1Class -> ASN1Tag -> ASN1ConstructionType
Container ASN1Class
Context ASN1Tag
0)
        , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
        ]
  where
    a' :: ByteString
a' = Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
a
    b' :: ByteString
b' = Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
b
    SerializedPoint ByteString
g' = SerializedPoint
g
    s' :: BitArray
s' = Word64 -> ByteString -> BitArray
BitArray (Word64
8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* ASN1Tag -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> ASN1Tag
B.length ByteString
bytes)) ByteString
bytes
      where
        bytes :: ByteString
bytes = Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
s

newcurveToASN1 :: ByteArrayAccess key => OID -> key -> ASN1S
newcurveToASN1 :: forall key. ByteArrayAccess key => OID -> key -> ASN1S
newcurveToASN1 OID
oid key
key =
    [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
(++)
        [ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
        , Integer -> ASN1
IntVal Integer
0
        , ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
        , OID -> ASN1
OID OID
oid
        , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
        , ByteString -> ASN1
OctetString (DER -> [ASN1] -> ByteString
forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1' DER
DER [ByteString -> ASN1
OctetString (ByteString -> ASN1) -> ByteString -> ASN1
forall a b. (a -> b) -> a -> b
$ key -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert key
key])
        , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
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 :: forall p. OID -> PrivKeyMLDSA p -> ASN1S
mldsaToASN1 OID
oid PrivKeyMLDSA p
k =
    [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
(++)
        [ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
        , Integer -> ASN1
IntVal Integer
0
        , ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
        , OID -> ASN1
OID OID
oid
        , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
        , ByteString -> ASN1
OctetString (DER -> [ASN1] -> ByteString
forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1' DER
DER [ASN1]
inner)
        , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
        ]
  where
    inner :: [ASN1]
inner = case PrivKeyMLDSA p
k of
        PrivKeyMLDSA_Seed ScrubbedBytes
s SigningKey p
_ -> [ASN1Class -> ASN1Tag -> ByteString -> ASN1
Other ASN1Class
Context ASN1Tag
0 (ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ScrubbedBytes
s)]
        PrivKeyMLDSA_Expanded SigningKey p
sk -> [ByteString -> ASN1
OctetString (SigningKey p -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert SigningKey p
sk)]
        PrivKeyMLDSA_Both ScrubbedBytes
s SigningKey p
sk ->
            [ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
            , ByteString -> ASN1
OctetString (ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ScrubbedBytes
s)
            , ByteString -> ASN1
OctetString (SigningKey p -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert SigningKey p
sk)
            , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
            ]

mapLeft :: (a0 -> a1) -> Either a0 b -> Either a1 b
mapLeft :: forall a0 a1 b. (a0 -> a1) -> Either a0 b -> Either a1 b
mapLeft a0 -> a1
f (Left a0
x) = a1 -> Either a1 b
forall a b. a -> Either a b
Left (a0 -> a1
f a0
x)
mapLeft a0 -> a1
_ (Right b
x) = b -> Either a1 b
forall a b. b -> Either a b
Right b
x

-- | Convert a Private key to the Public Key Algorithm type
privkeyToAlg :: PrivKey -> PubKeyALG
privkeyToAlg :: PrivKey -> PubKeyALG
privkeyToAlg (PrivKeyRSA PrivateKey
_) = PubKeyALG
PubKeyALG_RSA
privkeyToAlg (PrivKeyDSA PrivateKey
_) = PubKeyALG
PubKeyALG_DSA
privkeyToAlg (PrivKeyEC PrivKeyEC
_) = PubKeyALG
PubKeyALG_EC
privkeyToAlg (PrivKeyX25519 SecretKey
_) = PubKeyALG
PubKeyALG_X25519
privkeyToAlg (PrivKeyX448 SecretKey
_) = PubKeyALG
PubKeyALG_X448
privkeyToAlg (PrivKeyEd25519 SecretKey
_) = PubKeyALG
PubKeyALG_Ed25519
privkeyToAlg (PrivKeyEd448 SecretKey
_) = PubKeyALG
PubKeyALG_Ed448
privkeyToAlg (PrivKeyMLDSA44 PrivKeyMLDSA MLDSA44
_) = PubKeyALG
PubKeyALG_MLDSA44
privkeyToAlg (PrivKeyMLDSA65 PrivKeyMLDSA MLDSA65
_) = PubKeyALG
PubKeyALG_MLDSA65
privkeyToAlg (PrivKeyMLDSA87 PrivKeyMLDSA MLDSA87
_) = PubKeyALG
PubKeyALG_MLDSA87