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
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
(ASN1Tag -> PrivKeyEC -> ShowS)
-> (PrivKeyEC -> String)
-> ([PrivKeyEC] -> ShowS)
-> Show PrivKeyEC
forall a.
(ASN1Tag -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: ASN1Tag -> PrivKeyEC -> ShowS
showsPrec :: ASN1Tag -> PrivKeyEC -> ShowS
$cshow :: PrivKeyEC -> String
show :: PrivKeyEC -> String
$cshowList :: [PrivKeyEC] -> ShowS
showList :: [PrivKeyEC] -> ShowS
Show,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)
data PrivKey =
PrivKeyRSA RSA.PrivateKey
| PrivKeyDSA DSA.PrivateKey
| PrivKeyEC PrivKeyEC
| PrivKeyX25519 X25519.SecretKey
| PrivKeyX448 X448.SecretKey
| PrivKeyEd25519 Ed25519.SecretKey
| PrivKeyEd448 Ed448.SecretKey
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)
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 -> 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
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 :: 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
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
]
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
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