-- |
-- 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 (Int -> PrivKeyEC -> ShowS
[PrivKeyEC] -> ShowS
PrivKeyEC -> String
(Int -> PrivKeyEC -> ShowS)
-> (PrivKeyEC -> String)
-> ([PrivKeyEC] -> ShowS)
-> Show PrivKeyEC
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrivKeyEC] -> ShowS
$cshowList :: [PrivKeyEC] -> ShowS
show :: PrivKeyEC -> String
$cshow :: PrivKeyEC -> String
showsPrec :: Int -> PrivKeyEC -> ShowS
$cshowsPrec :: Int -> PrivKeyEC -> ShowS
Show,PrivKeyEC -> PrivKeyEC -> Bool
(PrivKeyEC -> PrivKeyEC -> Bool)
-> (PrivKeyEC -> PrivKeyEC -> Bool) -> Eq PrivKeyEC
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 (Int -> PrivKey -> ShowS
[PrivKey] -> ShowS
PrivKey -> String
(Int -> PrivKey -> ShowS)
-> (PrivKey -> String) -> ([PrivKey] -> ShowS) -> Show PrivKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrivKey] -> ShowS
$cshowList :: [PrivKey] -> ShowS
show :: PrivKey -> String
$cshow :: PrivKey -> String
showsPrec :: Int -> PrivKey -> ShowS
$cshowsPrec :: Int -> PrivKey -> ShowS
Show,PrivKey -> PrivKey -> Bool
(PrivKey -> PrivKey -> Bool)
-> (PrivKey -> PrivKey -> Bool) -> Eq PrivKey
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 =
  ((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 (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 (Int -> Integer -> Integer -> PublicKey
RSA.PublicKey (Integer -> Int -> Int
forall t t. (Integral t, Num t, Ord t) => t -> t -> t
go Integer
n Int
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 (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 (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 (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 (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') = Int -> [ASN1] -> ([ASN1], [ASN1])
spanTag Int
0 [ASN1]
rest
        ([ASN1]
_, [ASN1]
rest'') = Int -> [ASN1] -> ([ASN1], [ASN1])
spanTag Int
1 [ASN1]
rest'
        subgo :: [ASN1] -> Either String PrivKeyEC
subgo (OID [Integer]
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]
++ [Integer] -> String
forall a. Show a => a -> String
show [Integer]
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 -> [Integer] -> Maybe CurveName
forall a. OIDTable a -> [Integer] -> Maybe a
lookupByOID OIDTable CurveName
curvesOIDTable [Integer]
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 (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 (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 a c.
(Num a, Eq a) =>
([ASN1] -> c) -> a -> [ASN1] -> (c, [ASN1])
loop ASN1S
forall a. a -> a
id
      where
        loop :: ([ASN1] -> c) -> a -> [ASN1] -> (c, [ASN1])
loop [ASN1] -> c
dlist a
n (a :: ASN1
a@(Start ASN1ConstructionType
_) : [ASN1]
as) = ([ASN1] -> c) -> a -> [ASN1] -> (c, [ASN1])
loop ([ASN1] -> c
dlist ([ASN1] -> c) -> ASN1S -> [ASN1] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ASN1
a ASN1 -> ASN1S
forall a. a -> [a] -> [a]
:)) (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) [ASN1]
as
        loop [ASN1] -> c
dlist a
0 (End ASN1ConstructionType
_ : [ASN1]
as) = ([ASN1] -> c
dlist [], [ASN1]
as)
        loop [ASN1] -> c
dlist a
n (a :: ASN1
a@(End ASN1ConstructionType
_) : [ASN1]
as) = ([ASN1] -> c) -> a -> [ASN1] -> (c, [ASN1])
loop ([ASN1] -> c
dlist ([ASN1] -> c) -> ASN1S -> [ASN1] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ASN1
a ASN1 -> ASN1S
forall a. a -> [a] -> [a]
:)) (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1) [ASN1]
as
        loop [ASN1] -> c
dlist a
n (ASN1
a : [ASN1]
as) = ([ASN1] -> c) -> a -> [ASN1] -> (c, [ASN1])
loop ([ASN1] -> c
dlist ([ASN1] -> c) -> ASN1S -> [ASN1] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ASN1
a ASN1 -> ASN1S
forall a. a -> [a] -> [a]
:)) a
n [ASN1]
as
        loop [ASN1] -> c
dlist a
_ [] = ([ASN1] -> c
dlist [], [])

    spanTag :: Int -> [ASN1] -> ([ASN1], [ASN1])
    spanTag :: Int -> [ASN1] -> ([ASN1], [ASN1])
spanTag Int
a (Start (Container ASN1Class
_ Int
b) : [ASN1]
as) | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b = Word -> [ASN1] -> ([ASN1], [ASN1])
spanEnd Word
0 [ASN1]
as
    spanTag Int
_ [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 [Integer]
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) = Int -> [ASN1] -> ([ASN1], [ASN1])
containerWithTag Int
0 [ASN1]
xs
        case Int -> [ASN1] -> (Maybe ByteString, [ASN1])
primitiveWithTag Int
1 [ASN1]
ys of
            (Maybe ByteString
_, End ASN1ConstructionType
Sequence : [ASN1]
zs) ->
                case [Integer] -> Maybe (String, ByteString -> CryptoFailable PrivKey)
forall a bs.
(Eq a, Num a, ByteArrayAccess bs) =>
[a] -> Maybe (String, bs -> CryptoFailable PrivKey)
getP [Integer]
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 -> String -> Either String (PrivKey, [ASN1])
forall a b. a -> Either a b
Left (String
"newcurveFromASN1: unexpected OID " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Integer] -> String
forall a. Show a => a -> String
show [Integer]
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, bs -> CryptoFailable PrivKey)
getP [a
1,a
3,a
101,a
110] = (String, bs -> CryptoFailable PrivKey)
-> Maybe (String, bs -> CryptoFailable PrivKey)
forall a. a -> Maybe a
Just (String
"X25519", (SecretKey -> PrivKey)
-> CryptoFailable SecretKey -> CryptoFailable PrivKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> PrivKey
PrivKeyX25519 (CryptoFailable SecretKey -> CryptoFailable PrivKey)
-> (bs -> CryptoFailable SecretKey) -> bs -> CryptoFailable PrivKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. bs -> CryptoFailable SecretKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable SecretKey
X25519.secretKey)
    getP [a
1,a
3,a
101,a
111] = (String, bs -> CryptoFailable PrivKey)
-> Maybe (String, bs -> CryptoFailable PrivKey)
forall a. a -> Maybe a
Just (String
"X448", (SecretKey -> PrivKey)
-> CryptoFailable SecretKey -> CryptoFailable PrivKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> PrivKey
PrivKeyX448 (CryptoFailable SecretKey -> CryptoFailable PrivKey)
-> (bs -> CryptoFailable SecretKey) -> bs -> CryptoFailable PrivKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. bs -> CryptoFailable SecretKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable SecretKey
X448.secretKey)
    getP [a
1,a
3,a
101,a
112] = (String, bs -> CryptoFailable PrivKey)
-> Maybe (String, bs -> CryptoFailable PrivKey)
forall a. a -> Maybe a
Just (String
"Ed25519", (SecretKey -> PrivKey)
-> CryptoFailable SecretKey -> CryptoFailable PrivKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> PrivKey
PrivKeyEd25519 (CryptoFailable SecretKey -> CryptoFailable PrivKey)
-> (bs -> CryptoFailable SecretKey) -> bs -> CryptoFailable PrivKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. bs -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey)
    getP [a
1,a
3,a
101,a
113] = (String, bs -> CryptoFailable PrivKey)
-> Maybe (String, bs -> CryptoFailable PrivKey)
forall a. a -> Maybe a
Just (String
"Ed448", (SecretKey -> PrivKey)
-> CryptoFailable SecretKey -> CryptoFailable PrivKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> PrivKey
PrivKeyEd448 (CryptoFailable SecretKey -> CryptoFailable PrivKey)
-> (bs -> CryptoFailable SecretKey) -> bs -> CryptoFailable PrivKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. bs -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey)
    getP [a]
_             = Maybe (String, bs -> CryptoFailable 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"

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

primitiveWithTag :: ASN1Tag -> [ASN1] -> (Maybe B.ByteString, [ASN1])
primitiveWithTag :: Int -> [ASN1] -> (Maybe ByteString, [ASN1])
primitiveWithTag Int
etag (Other ASN1Class
_ Int
atag ByteString
bs : [ASN1]
xs)
    | Int
etag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
atag = (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs, [ASN1]
xs)
primitiveWithTag Int
_    [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)  = [Integer] -> SecretKey -> ASN1S
forall key. ByteArrayAccess key => [Integer] -> key -> ASN1S
newcurveToASN1 [Integer
1,Integer
3,Integer
101,Integer
110] SecretKey
k
privkeyToASN1 (PrivKeyX448 SecretKey
k)    = [Integer] -> SecretKey -> ASN1S
forall key. ByteArrayAccess key => [Integer] -> key -> ASN1S
newcurveToASN1 [Integer
1,Integer
3,Integer
101,Integer
111] SecretKey
k
privkeyToASN1 (PrivKeyEd25519 SecretKey
k) = [Integer] -> SecretKey -> ASN1S
forall key. ByteArrayAccess key => [Integer] -> key -> ASN1S
newcurveToASN1 [Integer
1,Integer
3,Integer
101,Integer
112] SecretKey
k
privkeyToASN1 (PrivKeyEd448 SecretKey
k)   = [Integer] -> SecretKey -> ASN1S
forall key. ByteArrayAccess key => [Integer] -> key -> ASN1S
newcurveToASN1 [Integer
1,Integer
3,Integer
101,Integer
113] SecretKey
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 Int
_ 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 -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0), [Integer] -> ASN1
OID [Integer]
oid, ASN1ConstructionType -> ASN1
End (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
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 :: [Integer]
oid = [Integer] -> Maybe [Integer] -> [Integer]
forall a. a -> Maybe a -> a
fromMaybe (String -> [Integer]
forall c. String -> c
err (String -> [Integer]) -> String -> [Integer]
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 [Integer]
forall a. Eq a => OIDTable a -> a -> Maybe [Integer]
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 -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0), ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence, Integer -> ASN1
IntVal Integer
1
    , ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence, [Integer] -> 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 -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
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
* Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
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 :: [Integer] -> key -> ASN1S
newcurveToASN1 [Integer]
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, [Integer] -> ASN1
OID [Integer]
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
    ]

mapLeft :: (a0 -> a1) -> Either a0 b -> Either a1 b
mapLeft :: (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