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 (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)
data PrivKey =
PrivKeyRSA RSA.PrivateKey
| PrivKeyDSA DSA.PrivateKey
| PrivKeyEC PrivKeyEC
| PrivKeyX25519 X25519.SecretKey
| PrivKeyX448 X448.SecretKey
| PrivKeyEd25519 Ed25519.SecretKey
| PrivKeyEd448 Ed448.SecretKey
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]
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 f :: t -> a
f (a :: t
a, b :: b
b) = (t -> a
f t
a, b
b)
Left _ <!> :: Either a b -> Either a b -> Either a b
<!> b :: Either a b
b = Either a b
b
a :: Either a b
a <!> _ = Either a b
a
rsaFromASN1 :: [ASN1] -> Either String (RSA.PrivateKey, [ASN1])
rsaFromASN1 :: [ASN1] -> Either String (PrivateKey, [ASN1])
rsaFromASN1 (Start Sequence : IntVal 0 : IntVal n :: Integer
n : IntVal e :: Integer
e : IntVal d :: Integer
d
: IntVal p :: Integer
p : IntVal q :: Integer
q : IntVal dP :: Integer
dP : IntVal dQ :: Integer
dQ : IntVal qinv :: Integer
qinv
: End Sequence : as :: [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 1) Integer
n Integer
e) Integer
d Integer
p Integer
q Integer
dP Integer
dQ Integer
qinv
go :: t -> t -> t
go m :: t
m i :: t
i
| 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
* 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
+ 1)
rsaFromASN1 (Start Sequence : IntVal 0 : Start Sequence
: OID [1, 2, 840, 113549, 1, 1, 1] : Null : End Sequence
: OctetString bytes :: ByteString
bytes : End Sequence : as :: [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 = ("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 _ = String -> Either String (PrivateKey, [ASN1])
forall a b. a -> Either a b
Left "rsaFromASN1: unexpected format"
dsaFromASN1 :: [ASN1] -> Either String (DSA.PrivateKey, [ASN1])
dsaFromASN1 :: [ASN1] -> Either String (PrivateKey, [ASN1])
dsaFromASN1 (Start Sequence : IntVal 0 : IntVal p :: Integer
p : IntVal q :: Integer
q : IntVal g :: Integer
g
: IntVal _ : IntVal x :: Integer
x : End Sequence : as :: [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 Sequence : IntVal 0 : Start Sequence
: OID [1, 2, 840, 10040, 4, 1] : Start Sequence : IntVal p :: Integer
p : IntVal q :: Integer
q
: IntVal g :: Integer
g : End Sequence : End Sequence : OctetString bytes :: ByteString
bytes
: End Sequence : as :: [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 x :: 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 _ -> String -> Either String (PrivateKey, [ASN1])
forall a b. a -> Either a b
Left "DSA.PrivateKey.fromASN1: unexpected format"
Left e :: 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
$ "DSA.PrivateKey.fromASN1: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ASN1Error -> String
forall a. Show a => a -> String
show ASN1Error
e
dsaFromASN1 _ = String -> Either String (PrivateKey, [ASN1])
forall a b. a -> Either a b
Left "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 = ("ECDSA.PrivateKey.fromASN1: " String -> ShowS
forall a. [a] -> [a] -> [a]
++)
go :: [ASN1] -> [ASN1] -> Either String (PrivKeyEC, [ASN1])
go acc :: [ASN1]
acc (Start Sequence : IntVal 1 : OctetString bytes :: ByteString
bytes : rest :: [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 Sequence : rest''' :: [ASN1]
rest''' -> (PrivKeyEC, [ASN1]) -> Either String (PrivKeyEC, [ASN1])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrivKeyEC
key, [ASN1]
rest''')
_ -> 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 "unexpected EC format"
where
d :: Integer
d = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
bytes
(oid :: [ASN1]
oid, rest' :: [ASN1]
rest') = Int -> [ASN1] -> ([ASN1], [ASN1])
spanTag 0 [ASN1]
rest
(_, rest'' :: [ASN1]
rest'') = Int -> [ASN1] -> ([ASN1], [ASN1])
spanTag 1 [ASN1]
rest'
subgo :: [ASN1] -> Either String PrivKeyEC
subgo (OID oid_ :: OID
oid_ : _) = 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
$ "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 Sequence : IntVal 1 : Start Sequence
: OID [1, 2, 840, 10045, 1, 1] : IntVal p :: Integer
p : End Sequence
: Start Sequence : OctetString a :: ByteString
a : OctetString b :: ByteString
b : BitString s :: BitArray
s
: End Sequence : OctetString g :: ByteString
g : IntVal o :: Integer
o : IntVal c :: Integer
c
: End Sequence : _) =
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 (Null : rest_ :: [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 "curve is missing"
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 "unexpected curve format"
go acc :: [ASN1]
acc (Start Sequence : IntVal 0 : Start Sequence
: OID [1, 2, 840, 10045, 2, 1] : rest :: [ASN1]
rest) = case [ASN1]
rest' of
(OctetString bytes :: ByteString
bytes : rest'' :: [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
_ -> 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 "unexpected EC format"
where
(oid :: [ASN1]
oid, rest' :: [ASN1]
rest') = Word -> [ASN1] -> ([ASN1], [ASN1])
spanEnd 0 [ASN1]
rest
go _ _ = 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 "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 dlist :: [ASN1] -> c
dlist n :: a
n (a :: ASN1
a@(Start _) : as :: [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
+ 1) [ASN1]
as
loop dlist :: [ASN1] -> c
dlist 0 (End _ : as :: [ASN1]
as) = ([ASN1] -> c
dlist [], [ASN1]
as)
loop dlist :: [ASN1] -> c
dlist n :: a
n (a :: ASN1
a@(End _) : as :: [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
- 1) [ASN1]
as
loop dlist :: [ASN1] -> c
dlist n :: a
n (a :: ASN1
a : as :: [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 dlist :: [ASN1] -> c
dlist _ [] = ([ASN1] -> c
dlist [], [])
spanTag :: Int -> [ASN1] -> ([ASN1], [ASN1])
spanTag :: Int -> [ASN1] -> ([ASN1], [ASN1])
spanTag a :: Int
a (Start (Container _ b :: Int
b) : as :: [ASN1]
as) | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b = Word -> [ASN1] -> ([ASN1], [ASN1])
spanEnd 0 [ASN1]
as
spanTag _ as :: [ASN1]
as = ([], [ASN1]
as)
newcurveFromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1])
newcurveFromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1])
newcurveFromASN1 ( Start Sequence
: IntVal v :: Integer
v
: Start Sequence
: OID oid :: OID
oid
: End Sequence
: OctetString bs :: ByteString
bs
: xs :: [ASN1]
xs)
| Integer -> Bool
forall a. (Ord a, Num a) => a -> Bool
isValidVersion Integer
v = do
let (_, ys :: [ASN1]
ys) = Int -> [ASN1] -> ([ASN1], [ASN1])
containerWithTag 0 [ASN1]
xs
case Int -> [ASN1] -> (Maybe ByteString, [ASN1])
primitiveWithTag 1 [ASN1]
ys of
(_, End Sequence : zs :: [ASN1]
zs) ->
case OID -> Maybe (String, ByteString -> CryptoFailable PrivKey)
forall a bs.
(Eq a, Num a, ByteArrayAccess bs) =>
[a] -> Maybe (String, bs -> CryptoFailable PrivKey)
getP OID
oid of
Just (name :: String
name, parse :: ByteString -> CryptoFailable PrivKey
parse) -> do
let err :: String -> Either String b
err s :: String
s = String -> Either String b
forall a b. a -> Either a b
Left (String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ ".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 key :: ByteString
key] ->
case ByteString -> CryptoFailable PrivKey
parse ByteString
key of
CryptoPassed s :: PrivKey
s -> (PrivKey, [ASN1]) -> Either String (PrivKey, [ASN1])
forall a b. b -> Either a b
Right (PrivKey
s, [ASN1]
zs)
CryptoFailed e :: CryptoError
e -> String -> Either String (PrivKey, [ASN1])
forall b. String -> Either String b
err ("invalid secret key: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e)
Right _ -> String -> Either String (PrivKey, [ASN1])
forall b. String -> Either String b
err "unexpected inner format"
Left e :: 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)
Nothing -> String -> Either String (PrivKey, [ASN1])
forall a b. a -> Either a b
Left ("newcurveFromASN1: unexpected OID " String -> ShowS
forall a. [a] -> [a] -> [a]
++ OID -> String
forall a. Show a => a -> String
show OID
oid)
_ -> String -> Either String (PrivKey, [ASN1])
forall a b. a -> Either a b
Left "newcurveFromASN1: unexpected end format"
| Bool
otherwise = String -> Either String (PrivKey, [ASN1])
forall a b. a -> Either a b
Left ("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 [1,3,101,110] = (String, bs -> CryptoFailable PrivKey)
-> Maybe (String, bs -> CryptoFailable PrivKey)
forall a. a -> Maybe a
Just ("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 [1,3,101,111] = (String, bs -> CryptoFailable PrivKey)
-> Maybe (String, bs -> CryptoFailable PrivKey)
forall a. a -> Maybe a
Just ("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 [1,3,101,112] = (String, bs -> CryptoFailable PrivKey)
-> Maybe (String, bs -> CryptoFailable PrivKey)
forall a. a -> Maybe a
Just ("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 [1,3,101,113] = (String, bs -> CryptoFailable PrivKey)
-> Maybe (String, bs -> CryptoFailable PrivKey)
forall a. a -> Maybe a
Just ("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 _ = Maybe (String, bs -> CryptoFailable PrivKey)
forall a. Maybe a
Nothing
isValidVersion :: a -> Bool
isValidVersion version :: a
version = a
version a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& a
version a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 1
newcurveFromASN1 _ =
String -> Either String (PrivKey, [ASN1])
forall a b. a -> Either a b
Left "newcurveFromASN1: unexpected format"
containerWithTag :: ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
containerWithTag :: Int -> [ASN1] -> ([ASN1], [ASN1])
containerWithTag etag :: Int
etag (Start (Container _ atag :: Int
atag) : xs :: [ASN1]
xs)
| Int
etag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
atag = Int -> [ASN1] -> ([ASN1], [ASN1])
getConstructedEnd 0 [ASN1]
xs
containerWithTag _ xs :: [ASN1]
xs = ([], [ASN1]
xs)
primitiveWithTag :: ASN1Tag -> [ASN1] -> (Maybe B.ByteString, [ASN1])
primitiveWithTag :: Int -> [ASN1] -> (Maybe ByteString, [ASN1])
primitiveWithTag etag :: Int
etag (Other _ atag :: Int
atag bs :: ByteString
bs : xs :: [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 _ xs :: [ASN1]
xs = (Maybe ByteString
forall a. Maybe a
Nothing, [ASN1]
xs)
privkeyToASN1 :: PrivKey -> ASN1S
privkeyToASN1 :: PrivKey -> ASN1S
privkeyToASN1 (PrivKeyRSA rsa :: PrivateKey
rsa) = PrivateKey -> ASN1S
rsaToASN1 PrivateKey
rsa
privkeyToASN1 (PrivKeyDSA dsa :: PrivateKey
dsa) = PrivateKey -> ASN1S
dsaToASN1 PrivateKey
dsa
privkeyToASN1 (PrivKeyEC ecdsa :: PrivKeyEC
ecdsa) = PrivKeyEC -> ASN1S
ecdsaToASN1 PrivKeyEC
ecdsa
privkeyToASN1 (PrivKeyX25519 k :: SecretKey
k) = OID -> SecretKey -> ASN1S
forall key. ByteArrayAccess key => OID -> key -> ASN1S
newcurveToASN1 [1,3,101,110] SecretKey
k
privkeyToASN1 (PrivKeyX448 k :: SecretKey
k) = OID -> SecretKey -> ASN1S
forall key. ByteArrayAccess key => OID -> key -> ASN1S
newcurveToASN1 [1,3,101,111] SecretKey
k
privkeyToASN1 (PrivKeyEd25519 k :: SecretKey
k) = OID -> SecretKey -> ASN1S
forall key. ByteArrayAccess key => OID -> key -> ASN1S
newcurveToASN1 [1,3,101,112] SecretKey
k
privkeyToASN1 (PrivKeyEd448 k :: SecretKey
k) = OID -> SecretKey -> ASN1S
forall key. ByteArrayAccess key => OID -> key -> ASN1S
newcurveToASN1 [1,3,101,113] SecretKey
k
rsaToASN1 :: RSA.PrivateKey -> ASN1S
rsaToASN1 :: PrivateKey -> ASN1S
rsaToASN1 key :: PrivateKey
key = [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
(++)
[ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence, Integer -> ASN1
IntVal 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 _ n :: Integer
n e :: Integer
e) d :: Integer
d p :: Integer
p q :: Integer
q dP :: Integer
dP dQ :: Integer
dQ qinv :: Integer
qinv = PrivateKey
key
dsaToASN1 :: DSA.PrivateKey -> ASN1S
dsaToASN1 :: PrivateKey -> ASN1S
dsaToASN1 (DSA.PrivateKey params :: Params
params@(DSA.Params p :: Integer
p g :: Integer
g q :: Integer
q) y :: Integer
y) = [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
(++)
[ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence, Integer -> ASN1
IntVal 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
curveName d :: Integer
d) = [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
(++)
[ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence, Integer -> ASN1
IntVal 1, ByteString -> ASN1
OctetString (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
d)
, ASN1ConstructionType -> ASN1
Start (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context 0), OID -> ASN1
OID OID
oid, ASN1ConstructionType -> ASN1
End (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context 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
. ("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
$ "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 d :: Integer
d a :: Integer
a b :: Integer
b p :: Integer
p g :: SerializedPoint
g o :: Integer
o c :: Integer
c s :: Integer
s) = [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
(++)
[ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence, Integer -> ASN1
IntVal 1, ByteString -> ASN1
OctetString (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
d)
, ASN1ConstructionType -> ASN1
Start (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context 0), ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence, Integer -> ASN1
IntVal 1
, ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence, OID -> ASN1
OID [1, 2, 840, 10045, 1, 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 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 g' :: ByteString
g' = SerializedPoint
g
s' :: BitArray
s' = Word64 -> ByteString -> BitArray
BitArray (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 :: OID -> key -> ASN1S
newcurveToASN1 oid :: OID
oid key :: key
key = [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
(++)
[ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence, Integer -> ASN1
IntVal 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 :: (a0 -> a1) -> Either a0 b -> Either a1 b
mapLeft f :: a0 -> a1
f (Left x :: a0
x) = a1 -> Either a1 b
forall a b. a -> Either a b
Left (a0 -> a1
f a0
x)
mapLeft _ (Right x :: b
x) = b -> Either a1 b
forall a b. b -> Either a b
Right b
x
privkeyToAlg :: PrivKey -> PubKeyALG
privkeyToAlg :: PrivKey -> PubKeyALG
privkeyToAlg (PrivKeyRSA _) = PubKeyALG
PubKeyALG_RSA
privkeyToAlg (PrivKeyDSA _) = PubKeyALG
PubKeyALG_DSA
privkeyToAlg (PrivKeyEC _) = PubKeyALG
PubKeyALG_EC
privkeyToAlg (PrivKeyX25519 _) = PubKeyALG
PubKeyALG_X25519
privkeyToAlg (PrivKeyX448 _) = PubKeyALG
PubKeyALG_X448
privkeyToAlg (PrivKeyEd25519 _) = PubKeyALG
PubKeyALG_Ed25519
privkeyToAlg (PrivKeyEd448 _) = PubKeyALG
PubKeyALG_Ed448