-- |
-- 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(..)
    , privkeyToAlg
    ) where

import Control.Applicative ((<$>), pure)
import Data.Maybe (fromMaybe)
import Data.Word (Word)

import Data.ByteArray (ByteArrayAccess, convert)
import qualified Data.ByteString as B

import Data.ASN1.Types
import Data.ASN1.Encoding
import Data.ASN1.BinaryEncoding
import Data.ASN1.BitArray
import Data.ASN1.Stream (getConstructedEnd)

import Data.X509.AlgorithmIdentifier
import Data.X509.PublicKey (SerializedPoint(..))
import Data.X509.OID (lookupByOID, lookupOID, curvesOIDTable)

import Crypto.Error (CryptoFailable(..))
import Crypto.Number.Serialize (i2osp, os2ip)
import qualified Crypto.PubKey.RSA as RSA
import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.ECC.Types as ECC
import qualified Crypto.PubKey.Curve25519 as X25519
import qualified Crypto.PubKey.Curve448   as X448
import qualified Crypto.PubKey.Ed25519    as Ed25519
import qualified Crypto.PubKey.Ed448      as Ed448

-- | 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 (ASN1Tag -> PrivKeyEC -> ShowS
[PrivKeyEC] -> ShowS
PrivKeyEC -> String
forall a.
(ASN1Tag -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrivKeyEC] -> ShowS
$cshowList :: [PrivKeyEC] -> ShowS
show :: PrivKeyEC -> String
$cshow :: PrivKeyEC -> String
showsPrec :: ASN1Tag -> PrivKeyEC -> ShowS
$cshowsPrec :: ASN1Tag -> PrivKeyEC -> ShowS
Show,PrivKeyEC -> PrivKeyEC -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrivKeyEC -> PrivKeyEC -> Bool
$c/= :: PrivKeyEC -> PrivKeyEC -> Bool
== :: PrivKeyEC -> PrivKeyEC -> Bool
$c== :: PrivKeyEC -> PrivKeyEC -> Bool
Eq)

-- | Private key types known and used in X.509
data PrivKey =
      PrivKeyRSA RSA.PrivateKey -- ^ RSA private key
    | PrivKeyDSA DSA.PrivateKey -- ^ DSA private key
    | PrivKeyEC  PrivKeyEC      -- ^ EC private key
    | PrivKeyX25519 X25519.SecretKey   -- ^ X25519 private key
    | PrivKeyX448 X448.SecretKey       -- ^ X448 private key
    | PrivKeyEd25519 Ed25519.SecretKey -- ^ Ed25519 private key
    | PrivKeyEd448 Ed448.SecretKey     -- ^ Ed448 private key
    deriving (ASN1Tag -> PrivKey -> ShowS
[PrivKey] -> ShowS
PrivKey -> String
forall a.
(ASN1Tag -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrivKey] -> ShowS
$cshowList :: [PrivKey] -> ShowS
show :: PrivKey -> String
$cshow :: PrivKey -> String
showsPrec :: ASN1Tag -> PrivKey -> ShowS
$cshowsPrec :: ASN1Tag -> PrivKey -> ShowS
Show,PrivKey -> PrivKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrivKey -> PrivKey -> Bool
$c/= :: PrivKey -> PrivKey -> Bool
== :: PrivKey -> PrivKey -> Bool
$c== :: PrivKey -> PrivKey -> Bool
Eq)

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 =
  (forall {t} {a} {b}. (t -> a) -> (t, b) -> (a, b)
mapFst PrivateKey -> PrivKey
PrivKeyRSA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ASN1] -> Either String (PrivateKey, [ASN1])
rsaFromASN1 [ASN1]
asn1) forall {a} {b}. Either a b -> Either a b -> Either a b
<!>
  (forall {t} {a} {b}. (t -> a) -> (t, b) -> (a, b)
mapFst PrivateKey -> PrivKey
PrivKeyDSA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ASN1] -> Either String (PrivateKey, [ASN1])
dsaFromASN1 [ASN1]
asn1) forall {a} {b}. Either a b -> Either a b -> Either a b
<!>
  (forall {t} {a} {b}. (t -> a) -> (t, b) -> (a, b)
mapFst PrivKeyEC -> PrivKey
PrivKeyEC forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ASN1] -> Either String (PrivKeyEC, [ASN1])
ecdsaFromASN1 [ASN1]
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) = 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 (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 forall a b. (Num a, Integral b) => a -> b -> a
^ (t
i forall a. Num a => a -> a -> a
* t
8) forall a. Ord a => a -> a -> Bool
> t
m = t
i
        | Bool
otherwise = t -> t -> t
go t
m (t
i 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 <- forall a0 a1 b. (a0 -> a1) -> Either a0 b -> Either a1 b
mapLeft ASN1Error -> String
failure (forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
bytes)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const [ASN1]
as) 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: " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
rsaFromASN1 [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) =
        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 forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
bytes of
        Right [IntVal Integer
x] -> 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]
_ -> forall a b. a -> Either a b
Left String
"DSA.PrivateKey.fromASN1: unexpected format"
        Left ASN1Error
e -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"DSA.PrivateKey.fromASN1: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ASN1Error
e
dsaFromASN1 [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: " 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 forall a. [a] -> [a] -> [a]
++ [ASN1]
acc)
        case [ASN1]
rest'' of
            End ASN1ConstructionType
Sequence : [ASN1]
rest''' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrivKeyEC
key, [ASN1]
rest''')
            [ASN1]
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ShowS
failing String
"unexpected EC format"
      where
        d :: Integer
d = 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]
_) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {b}. Either String b
failure forall {a}. CurveName -> Either a PrivKeyEC
success Maybe CurveName
mcurve
          where
            failure :: Either String b
failure = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ShowS
failing forall a b. (a -> b) -> a -> b
$ String
"unknown curve " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show OID
oid_
            success :: CurveName -> Either a PrivKeyEC
success = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip CurveName -> Integer -> PrivKeyEC
PrivKeyEC_Named Integer
d
            mcurve :: Maybe CurveName
mcurve = 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]
_) =
                forall (f :: * -> *) a. Applicative f => a -> f a
pure 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' = forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
a
            b' :: Integer
b' = forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
b
            g' :: SerializedPoint
g' = ByteString -> SerializedPoint
SerializedPoint ByteString
g
            s' :: Integer
s' = forall ba. ByteArrayAccess ba => ba -> Integer
os2ip 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 [] = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ShowS
failing String
"curve is missing"
        subgo [ASN1]
_ = forall a b. a -> Either a b
Left 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 <- forall a0 a1 b. (a0 -> a1) -> Either a0 b -> Either a1 b
mapLeft (ShowS
failing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) (forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
bytes)
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const [ASN1]
rest'') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ASN1] -> [ASN1] -> Either String (PrivKeyEC, [ASN1])
go ([ASN1]
oid forall a. [a] -> [a] -> [a]
++ [ASN1]
acc) [ASN1]
asn1
            [ASN1]
_ -> forall a b. a -> Either a b
Left 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]
_ = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ShowS
failing String
"unexpected EC format"

    spanEnd :: Word -> [ASN1] -> ([ASN1], [ASN1])
    spanEnd :: Word -> [ASN1] -> ([ASN1], [ASN1])
spanEnd = forall {t} {a}.
(Num t, Eq t) =>
([ASN1] -> a) -> t -> [ASN1] -> (a, [ASN1])
loop 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ASN1
a forall a. a -> [a] -> [a]
:)) (t
n 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ASN1
a forall a. a -> [a] -> [a]
:)) (t
n 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ASN1
a 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 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)
    | 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 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 = forall a b. a -> Either a b
Left (String
name forall a. [a] -> [a] -> [a]
++ String
".SecretKey.fromASN1: " forall a. [a] -> [a] -> [a]
++ String
s)
                        case 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 -> forall a b. b -> Either a b
Right (PrivKey
s, [ASN1]
zs)
                                    CryptoFailed CryptoError
e -> forall {b}. String -> Either String b
err (String
"invalid secret key: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CryptoError
e)
                            Right [ASN1]
_ -> forall {b}. String -> Either String b
err String
"unexpected inner format"
                            Left  ASN1Error
e -> forall {b}. String -> Either String b
err (forall a. Show a => a -> String
show ASN1Error
e)
                    Maybe (String, ByteString -> CryptoFailable PrivKey)
Nothing -> forall a b. a -> Either a b
Left (String
"newcurveFromASN1: unexpected OID " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show OID
oid)
            (Maybe ByteString, [ASN1])
_ -> forall a b. a -> Either a b
Left String
"newcurveFromASN1: unexpected end format"
    | Bool
otherwise = forall a b. a -> Either a b
Left (String
"newcurveFromASN1: unexpected version: " forall a. [a] -> [a] -> [a]
++ 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] = forall a. a -> Maybe a
Just (String
"X25519", forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> PrivKey
PrivKeyX25519 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bs. ByteArrayAccess bs => bs -> CryptoFailable SecretKey
X25519.secretKey)
    getP [a
1,a
3,a
101,a
111] = forall a. a -> Maybe a
Just (String
"X448", forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> PrivKey
PrivKeyX448 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bs. ByteArrayAccess bs => bs -> CryptoFailable SecretKey
X448.secretKey)
    getP [a
1,a
3,a
101,a
112] = forall a. a -> Maybe a
Just (String
"Ed25519", forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> PrivKey
PrivKeyEd25519 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey)
    getP [a
1,a
3,a
101,a
113] = forall a. a -> Maybe a
Just (String
"Ed448", forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> PrivKey
PrivKeyEd448 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey)
    getP [a]
_             = forall a. Maybe a
Nothing
    isValidVersion :: a -> Bool
isValidVersion a
version = a
version forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&& a
version forall a. Ord a => a -> a -> Bool
<= a
1
newcurveFromASN1 [ASN1]
_ =
    forall a b. a -> Either a b
Left String
"newcurveFromASN1: unexpected format"

containerWithTag :: ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
containerWithTag :: ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
containerWithTag ASN1Tag
etag (Start (Container ASN1Class
_ ASN1Tag
atag) : [ASN1]
xs)
    | ASN1Tag
etag 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 forall a. Eq a => a -> a -> Bool
== ASN1Tag
atag = (forall a. a -> Maybe a
Just ByteString
bs, [ASN1]
xs)
primitiveWithTag ASN1Tag
_    [ASN1]
xs = (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)  = forall key. ByteArrayAccess key => OID -> key -> ASN1S
newcurveToASN1 [Integer
1,Integer
3,Integer
101,Integer
110] SecretKey
k
privkeyToASN1 (PrivKeyX448 SecretKey
k)    = forall key. ByteArrayAccess key => OID -> key -> ASN1S
newcurveToASN1 [Integer
1,Integer
3,Integer
101,Integer
111] SecretKey
k
privkeyToASN1 (PrivKeyEd25519 SecretKey
k) = forall key. ByteArrayAccess key => OID -> key -> ASN1S
newcurveToASN1 [Integer
1,Integer
3,Integer
101,Integer
112] SecretKey
k
privkeyToASN1 (PrivKeyEd448 SecretKey
k)   = forall key. ByteArrayAccess key => OID -> key -> ASN1S
newcurveToASN1 [Integer
1,Integer
3,Integer
101,Integer
113] SecretKey
k

rsaToASN1 :: RSA.PrivateKey -> ASN1S
rsaToASN1 :: PrivateKey -> ASN1S
rsaToASN1 PrivateKey
key = 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) = 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) = forall a. [a] -> [a] -> [a]
(++)
    [ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence, Integer -> ASN1
IntVal Integer
1, ByteString -> ASN1
OctetString (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 = forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"ECDSA.PrivateKey.toASN1: " forall a. [a] -> [a] -> [a]
++)
    oid :: OID
oid = forall a. a -> Maybe a -> a
fromMaybe (forall {c}. String -> c
err forall a b. (a -> b) -> a -> b
$ String
"missing named curve " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CurveName
curveName)
                    (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) = forall a. [a] -> [a] -> [a]
(++)
    [ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence, Integer -> ASN1
IntVal Integer
1, ByteString -> ASN1
OctetString (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' = forall ba. ByteArray ba => Integer -> ba
i2osp Integer
a
    b' :: ByteString
b' = forall ba. ByteArray ba => Integer -> ba
i2osp Integer
b
    SerializedPoint ByteString
g' = SerializedPoint
g
    s' :: BitArray
s' = Word64 -> ByteString -> BitArray
BitArray (Word64
8 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> ASN1Tag
B.length ByteString
bytes)) ByteString
bytes
      where
        bytes :: ByteString
bytes = 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 = 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 (forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1' DER
DER [ByteString -> ASN1
OctetString forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert key
key])
    , 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) = forall a b. a -> Either a b
Left (a0 -> a1
f a0
x)
mapLeft a0 -> a1
_ (Right b
x) = 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