summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorVincentHanquez <>2018-09-13 21:16:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-09-13 21:16:00 (GMT)
commitf213210ad8c45571abdab9f6e682dc0f79da8bdc (patch)
tree276201dfda014e35ba1057f7a9dacc93a5967e08
parent94d9dc5cd2e60a04226e2bf91693571e576f6d00 (diff)
version 1.7.4HEAD1.7.4master
-rw-r--r--Data/X509/PrivateKey.hs198
-rw-r--r--x509.cabal4
2 files changed, 199 insertions, 3 deletions
diff --git a/Data/X509/PrivateKey.hs b/Data/X509/PrivateKey.hs
index 3f17bbb..a66de8a 100644
--- a/Data/X509/PrivateKey.hs
+++ b/Data/X509/PrivateKey.hs
@@ -13,8 +13,21 @@ module Data.X509.PrivateKey
, privkeyToAlg
) where
+import Control.Applicative ((<$>), pure)
+import Data.Word (Word)
+
+import qualified Data.ByteString as B
+
+import Data.ASN1.Types
+import Data.ASN1.Encoding
+import Data.ASN1.BinaryEncoding
+import Data.ASN1.BitArray
+
import Data.X509.AlgorithmIdentifier
import Data.X509.PublicKey (SerializedPoint(..))
+import Data.X509.OID (lookupByOID, curvesOIDTable)
+
+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
@@ -46,9 +59,192 @@ data PrivKey =
| PrivKeyEC PrivKeyEC -- ^ EC private key
deriving (Show,Eq)
+instance ASN1Object PrivKey where
+ fromASN1 = privkeyFromASN1
+ toASN1 = privkeyToASN1
+
+privkeyFromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1])
+privkeyFromASN1 asn1 =
+ (mapFst PrivKeyRSA <$> rsaFromASN1 asn1) <!>
+ (mapFst PrivKeyDSA <$> dsaFromASN1 asn1) <!>
+ (mapFst PrivKeyEC <$> ecdsaFromASN1 asn1)
+ where
+ mapFst f (a, b) = (f a, b)
+
+ Left _ <!> b = b
+ a <!> _ = a
+
+rsaFromASN1 :: [ASN1] -> Either String (RSA.PrivateKey, [ASN1])
+rsaFromASN1 (Start Sequence : IntVal 0 : IntVal n : IntVal e : IntVal d
+ : IntVal p : IntVal q : IntVal dP : IntVal dQ : IntVal qinv
+ : End Sequence : as) = pure (key, as)
+ where
+ key = RSA.PrivateKey (RSA.PublicKey (go n 1) n e) d p q dP dQ qinv
+ go m i
+ | 2 ^ (i * 8) > m = i
+ | otherwise = go m (i + 1)
+rsaFromASN1 (Start Sequence : IntVal 0 : Start Sequence
+ : OID [1, 2, 840, 113549, 1, 1, 1] : Null : End Sequence
+ : OctetString bytes : End Sequence : as) = do
+ asn1 <- mapLeft failure (decodeASN1' BER bytes)
+ fmap (const as) <$> rsaFromASN1 asn1
+ where
+ failure = ("rsaFromASN1: " ++) . show
+rsaFromASN1 _ = Left "rsaFromASN1: unexpected format"
+
+dsaFromASN1 :: [ASN1] -> Either String (DSA.PrivateKey, [ASN1])
+dsaFromASN1 (Start Sequence : IntVal 0 : IntVal p : IntVal q : IntVal g
+ : IntVal _ : IntVal x : End Sequence : as) =
+ pure (DSA.PrivateKey (DSA.Params p g q) x, as)
+dsaFromASN1 (Start Sequence : IntVal 0 : Start Sequence
+ : OID [1, 2, 840, 10040, 4, 1] : Start Sequence : IntVal p : IntVal q
+ : IntVal g : End Sequence : End Sequence : OctetString bytes
+ : End Sequence : as) = case decodeASN1' BER bytes of
+ Right [IntVal x] -> pure (DSA.PrivateKey (DSA.Params p g q) x, as)
+ Right _ -> Left "DSA.PrivateKey.fromASN1: unexpected format"
+ Left e -> Left $ "DSA.PrivateKey.fromASN1: " ++ show e
+dsaFromASN1 _ = Left "DSA.PrivateKey.fromASN1: unexpected format"
+
+ecdsaFromASN1 :: [ASN1] -> Either String (PrivKeyEC, [ASN1])
+ecdsaFromASN1 = go []
+ where
+ failing = ("ECDSA.PrivateKey.fromASN1: " ++)
+
+ go acc (Start Sequence : IntVal 1 : OctetString bytes : rest) = do
+ key <- subgo (oid ++ acc)
+ case rest'' of
+ End Sequence : rest''' -> pure (key, rest''')
+ _ -> Left $ failing "unexpected EC format"
+ where
+ d = os2ip bytes
+ (oid, rest') = spanTag 0 rest
+ (_, rest'') = spanTag 1 rest'
+ subgo (OID oid_ : _) = maybe failure success mcurve
+ where
+ failure = Left $ failing $ "unknown curve " ++ show oid_
+ success = Right . flip PrivKeyEC_Named d
+ mcurve = lookupByOID curvesOIDTable oid_
+ subgo (Start Sequence : IntVal 1 : Start Sequence
+ : OID [1, 2, 840, 10045, 1, 1] : IntVal p : End Sequence
+ : Start Sequence : OctetString a : OctetString b : BitString s
+ : End Sequence : OctetString g : IntVal o : IntVal c
+ : End Sequence : _) =
+ pure $ PrivKeyEC_Prime d a' b' p g' o c s'
+ where
+ a' = os2ip a
+ b' = os2ip b
+ g' = SerializedPoint g
+ s' = os2ip $ bitArrayGetData s
+ subgo (Null : rest_) = subgo rest_
+ subgo [] = Left $ failing "curve is missing"
+ subgo _ = Left $ failing "unexpected curve format"
+ go acc (Start Sequence : IntVal 0 : Start Sequence
+ : OID [1, 2, 840, 10045, 2, 1] : rest) = case rest' of
+ (OctetString bytes : rest'') -> do
+ asn1 <- mapLeft (failing . show) (decodeASN1' BER bytes)
+ fmap (const rest'') <$> go (oid ++ acc) asn1
+ _ -> Left $ failing "unexpected EC format"
+ where
+ (oid, rest') = spanEnd 0 rest
+ go _ _ = Left $ failing "unexpected EC format"
+
+ spanEnd :: Word -> [ASN1] -> ([ASN1], [ASN1])
+ spanEnd = loop id
+ where
+ loop dlist n (a@(Start _) : as) = loop (dlist . (a :)) (n + 1) as
+ loop dlist 0 (End _ : as) = (dlist [], as)
+ loop dlist n (a@(End _) : as) = loop (dlist . (a :)) (n - 1) as
+ loop dlist n (a : as) = loop (dlist . (a :)) n as
+ loop dlist _ [] = (dlist [], [])
+
+ spanTag :: Int -> [ASN1] -> ([ASN1], [ASN1])
+ spanTag a (Start (Container _ b) : as) | a == b = spanEnd 0 as
+ spanTag _ as = ([], as)
+
+privkeyToASN1 :: PrivKey -> ASN1S
+privkeyToASN1 (PrivKeyRSA rsa) = rsaToASN1 rsa
+privkeyToASN1 (PrivKeyDSA dsa) = dsaToASN1 dsa
+privkeyToASN1 (PrivKeyEC ecdsa) = ecdsaToASN1 ecdsa
+
+rsaToASN1 :: RSA.PrivateKey -> ASN1S
+rsaToASN1 key = (++)
+ [ Start Sequence, IntVal 0, IntVal n, IntVal e, IntVal d, IntVal p
+ , IntVal q, IntVal dP, IntVal dQ, IntVal qinv, End Sequence
+ ]
+ where
+ RSA.PrivateKey (RSA.PublicKey _ n e) d p q dP dQ qinv = key
+
+dsaToASN1 :: DSA.PrivateKey -> ASN1S
+dsaToASN1 (DSA.PrivateKey params@(DSA.Params p g q) y) = (++)
+ [ Start Sequence, IntVal 0, IntVal p, IntVal q, IntVal g, IntVal x
+ , IntVal y, End Sequence
+ ]
+ where
+ x = DSA.calculatePublic params y
+
+ecdsaToASN1 :: PrivKeyEC -> ASN1S
+ecdsaToASN1 (PrivKeyEC_Named curveName d) = (++)
+ [ Start Sequence, IntVal 1, OctetString (i2osp d)
+ , Start (Container Context 0), OID oid, End (Container Context 0)
+ , End Sequence
+ ]
+ where
+ oid = case curveName of
+ ECC.SEC_p112r1 -> [1, 3, 132, 0, 6]
+ ECC.SEC_p112r2 -> [1, 3, 132, 0, 7]
+ ECC.SEC_p128r1 -> [1, 3, 132, 0, 28]
+ ECC.SEC_p128r2 -> [1, 3, 132, 0, 29]
+ ECC.SEC_p160k1 -> [1, 3, 132, 0, 9]
+ ECC.SEC_p160r1 -> [1, 3, 132, 0, 8]
+ ECC.SEC_p160r2 -> [1, 3, 132, 0, 30]
+ ECC.SEC_p192k1 -> [1, 3, 132, 0, 31]
+ ECC.SEC_p192r1 -> [1, 2, 840, 10045, 3, 1, 1]
+ ECC.SEC_p224k1 -> [1, 3, 132, 0, 32]
+ ECC.SEC_p224r1 -> [1, 3, 132, 0, 33]
+ ECC.SEC_p256k1 -> [1, 3, 132, 0, 10]
+ ECC.SEC_p256r1 -> [1, 2, 840, 10045, 3, 1, 7]
+ ECC.SEC_p384r1 -> [1, 3, 132, 0, 34]
+ ECC.SEC_p521r1 -> [1, 3, 132, 0, 35]
+ ECC.SEC_t113r1 -> [1, 3, 132, 0, 4]
+ ECC.SEC_t113r2 -> [1, 3, 132, 0, 5]
+ ECC.SEC_t131r1 -> [1, 3, 132, 0, 22]
+ ECC.SEC_t131r2 -> [1, 3, 132, 0, 23]
+ ECC.SEC_t163k1 -> [1, 3, 132, 0, 1]
+ ECC.SEC_t163r1 -> [1, 3, 132, 0, 2]
+ ECC.SEC_t163r2 -> [1, 3, 132, 0, 15]
+ ECC.SEC_t193r1 -> [1, 3, 132, 0, 24]
+ ECC.SEC_t193r2 -> [1, 3, 132, 0, 25]
+ ECC.SEC_t233k1 -> [1, 3, 132, 0, 26]
+ ECC.SEC_t233r1 -> [1, 3, 132, 0, 27]
+ ECC.SEC_t239k1 -> [1, 3, 132, 0, 3]
+ ECC.SEC_t283k1 -> [1, 3, 132, 0, 16]
+ ECC.SEC_t283r1 -> [1, 3, 132, 0, 17]
+ ECC.SEC_t409k1 -> [1, 3, 132, 0, 36]
+ ECC.SEC_t409r1 -> [1, 3, 132, 0, 37]
+ ECC.SEC_t571k1 -> [1, 3, 132, 0, 38]
+ ECC.SEC_t571r1 -> [1, 3, 132, 0, 39]
+ecdsaToASN1 (PrivKeyEC_Prime d a b p g o c s) = (++)
+ [ Start Sequence, IntVal 1, OctetString (i2osp d)
+ , Start (Container Context 0), Start Sequence, IntVal 1
+ , Start Sequence, OID [1, 2, 840, 10045, 1, 1], IntVal p, End Sequence
+ , Start Sequence, OctetString a', OctetString b', BitString s'
+ , End Sequence, OctetString g' , IntVal o, IntVal c, End Sequence
+ , End (Container Context 0), End Sequence
+ ]
+ where
+ a' = i2osp a
+ b' = i2osp b
+ SerializedPoint g' = g
+ s' = BitArray (8 * fromIntegral (B.length bytes)) bytes
+ where
+ bytes = i2osp s
+
+mapLeft :: (a0 -> a1) -> Either a0 b -> Either a1 b
+mapLeft f (Left x) = Left (f x)
+mapLeft _ (Right x) = Right x
+
-- | Convert a Private key to the Public Key Algorithm type
privkeyToAlg :: PrivKey -> PubKeyALG
privkeyToAlg (PrivKeyRSA _) = PubKeyALG_RSA
privkeyToAlg (PrivKeyDSA _) = PubKeyALG_DSA
privkeyToAlg (PrivKeyEC _) = PubKeyALG_EC
-
diff --git a/x509.cabal b/x509.cabal
index c633101..948f553 100644
--- a/x509.cabal
+++ b/x509.cabal
@@ -1,6 +1,6 @@
Name: x509
-version: 1.7.3
-Description: X509 reader and writer
+version: 1.7.4
+Description: X509 reader and writer. please see README
License: BSD3
License-file: LICENSE
Copyright: Vincent Hanquez <vincent@snarc.org>