crypton-x509 1.7.7 → 1.8.0
raw patch · 18 files changed
+1593/−1170 lines, 18 filesdep +crypton-asn1-encodingdep +crypton-asn1-parsedep +crypton-asn1-typesdep −asn1-encodingdep −asn1-parsedep −asn1-typessetup-changedPVP ok
version bump matches the API change (PVP)
Dependencies added: crypton-asn1-encoding, crypton-asn1-parse, crypton-asn1-types, crypton-pem, time-hourglass
Dependencies removed: asn1-encoding, asn1-parse, asn1-types, hourglass, pem
API changes (from Hackage documentation)
- Data.X509: data () => ASN1CharacterString
+ Data.X509: data ASN1CharacterString
- Data.X509: extensionDecode :: forall a. Extension a => ExtensionRaw -> Maybe (Either String a)
+ Data.X509: extensionDecode :: Extension a => ExtensionRaw -> Maybe (Either String a)
- Data.X509: extensionEncode :: forall a. Extension a => Bool -> a -> ExtensionRaw
+ Data.X509: extensionEncode :: Extension a => Bool -> a -> ExtensionRaw
Files
- ChangeLog.md +14/−0
- Data/X509.hs +64/−57
- Data/X509/AlgorithmIdentifier.hs +143/−68
- Data/X509/CRL.hs +62/−52
- Data/X509/Cert.hs +100/−77
- Data/X509/CertificateChain.hs +17/−15
- Data/X509/DistinguishedName.hs +37/−29
- Data/X509/EC.hs +48/−46
- Data/X509/Ext.hs +198/−165
- Data/X509/ExtensionRaw.hs +36/−24
- Data/X509/Internal.hs +10/−10
- Data/X509/OID.hs +40/−41
- Data/X509/PrivateKey.hs +243/−148
- Data/X509/PublicKey.hs +208/−161
- Data/X509/Signed.hs +130/−99
- Setup.hs +1/−0
- Tests/Tests.hs +174/−117
- crypton-x509.cabal +68/−61
+ ChangeLog.md view
@@ -0,0 +1,14 @@+# ChangeLog for crypton-x509++## 1.8.0++* Depend on package `time-hourglass`, rather than `hourglass`. Date and+ time-related types and classes are now those from the former package.+ [#18](https://github.com/kazu-yamamoto/crypton-certificate/pull/18)+* Depend on package `crypton-asn1-types >= 0.4.1` rather than `asn1-types`.+ ASN.1-related types and classes are now those from the former package.++## 1.7.7++* Bump requirements to GHC 7.8 and transformers 0.4 series [#130](https://github.com/haskell-tls/hs-certificate/pull/130)+
Data/X509.hs view
@@ -8,75 +8,73 @@ -- Read/Write X509 Certificate, CRL and their signed equivalents. -- -- Follows RFC5280 / RFC6818----module Data.X509- (+module Data.X509 ( -- * Types- SignedCertificate- , SignedCRL- , Certificate(..)- , PubKey(..)- , PubKeyEC(..)- , SerializedPoint(..)- , PrivKey(..)- , PrivKeyEC(..)- , pubkeyToAlg- , privkeyToAlg- , module Data.X509.AlgorithmIdentifier- , module Data.X509.Ext- , module Data.X509.ExtensionRaw+ SignedCertificate,+ SignedCRL,+ Certificate (..),+ PubKey (..),+ PubKeyEC (..),+ SerializedPoint (..),+ PrivKey (..),+ PrivKeyEC (..),+ pubkeyToAlg,+ privkeyToAlg,+ module Data.X509.AlgorithmIdentifier,+ module Data.X509.Ext,+ module Data.X509.ExtensionRaw, -- * Certificate Revocation List (CRL)- , module Data.X509.CRL+ module Data.X509.CRL, -- * Naming- , DistinguishedName(..)- , DnElement(..)- , ASN1CharacterString(..)- , getDnElement+ DistinguishedName (..),+ DnElement (..),+ ASN1CharacterString (..),+ getDnElement, -- * Certificate Chain- , module Data.X509.CertificateChain+ module Data.X509.CertificateChain, -- * Signed types and marshalling- , Signed(..)- , SignedExact- , getSigned- , getSignedData- , objectToSignedExact- , objectToSignedExactF- , encodeSignedObject- , decodeSignedObject+ Signed (..),+ SignedExact,+ getSigned,+ getSignedData,+ objectToSignedExact,+ objectToSignedExactF,+ encodeSignedObject,+ decodeSignedObject, -- * Parametrized Signed accessor- , getCertificate- , getCRL- , decodeSignedCertificate- , decodeSignedCRL+ getCertificate,+ getCRL,+ decodeSignedCertificate,+ decodeSignedCRL, -- * Hash distinguished names related function- , hashDN- , hashDN_old- ) where+ hashDN,+ hashDN_old,+) where import Control.Arrow (second) -import Data.ASN1.Types-import Data.ASN1.Encoding import Data.ASN1.BinaryEncoding-import qualified Data.ByteString as B+import Data.ASN1.Encoding+import Data.ASN1.Types import qualified Data.ByteArray as BA+import qualified Data.ByteString as B -import Data.X509.Cert-import Data.X509.Ext-import Data.X509.ExtensionRaw+import Data.X509.AlgorithmIdentifier import Data.X509.CRL+import Data.X509.Cert import Data.X509.CertificateChain import Data.X509.DistinguishedName-import Data.X509.Signed-import Data.X509.PublicKey+import Data.X509.Ext+import Data.X509.ExtensionRaw import Data.X509.PrivateKey-import Data.X509.AlgorithmIdentifier+import Data.X509.PublicKey+import Data.X509.Signed import Crypto.Hash @@ -84,7 +82,7 @@ type SignedCertificate = SignedExact Certificate -- | A Signed CRL-type SignedCRL = SignedExact CRL+type SignedCRL = SignedExact CRL -- | Get the Certificate associated to a SignedCertificate getCertificate :: SignedCertificate -> Certificate@@ -107,19 +105,28 @@ -- OpenSSL algorithm is odd, and has been replicated here somewhat. -- only lower the case of ascii character. hashDN :: DistinguishedName -> B.ByteString-hashDN = shorten . hashWith SHA1 . encodeASN1' DER . flip toASN1 [] . DistinguishedNameInner . dnLowerUTF8- where dnLowerUTF8 (DistinguishedName l) = DistinguishedName $ map (second toLowerUTF8) l- toLowerUTF8 (ASN1CharacterString _ s) = ASN1CharacterString UTF8 (B.map asciiToLower s)- asciiToLower c- | c >= w8A && c <= w8Z = fromIntegral (fromIntegral c - fromEnum 'A' + fromEnum 'a')- | otherwise = c- w8A = fromIntegral $ fromEnum 'A'- w8Z = fromIntegral $ fromEnum 'Z'+hashDN =+ shorten+ . hashWith SHA1+ . encodeASN1' DER+ . flip toASN1 []+ . DistinguishedNameInner+ . dnLowerUTF8+ where+ dnLowerUTF8 (DistinguishedName l) = DistinguishedName $ map (second toLowerUTF8) l+ toLowerUTF8 (ASN1CharacterString _ s) = ASN1CharacterString UTF8 (B.map asciiToLower s)+ asciiToLower c+ | c >= w8A && c <= w8Z =+ fromIntegral (fromIntegral c - fromEnum 'A' + fromEnum 'a')+ | otherwise = c+ w8A = fromIntegral $ fromEnum 'A'+ w8Z = fromIntegral $ fromEnum 'Z' -- | Create an openssl style old hash of distinguished name hashDN_old :: DistinguishedName -> B.ByteString hashDN_old = shorten . hashWith MD5 . encodeASN1' DER . flip toASN1 [] shorten :: Digest a -> B.ByteString-shorten b = B.pack $ map i [3,2,1,0]- where i n = BA.index b n+shorten b = B.pack $ map i [3, 2, 1, 0]+ where+ i n = BA.index b n
Data/X509/AlgorithmIdentifier.hs view
@@ -4,93 +4,104 @@ -- Maintainer : Vincent Hanquez <vincent@snarc.org> -- Stability : experimental -- Portability : unknown----module Data.X509.AlgorithmIdentifier- ( HashALG(..)- , PubKeyALG(..)- , SignatureALG(..)- ) where+module Data.X509.AlgorithmIdentifier (+ HashALG (..),+ PubKeyALG (..),+ SignatureALG (..),+) where import Data.ASN1.Types import Data.List (find) -- | Hash Algorithm-data HashALG =- HashMD2+data HashALG+ = HashMD2 | HashMD5 | HashSHA1 | HashSHA224 | HashSHA256 | HashSHA384 | HashSHA512- deriving (Show,Eq)+ deriving (Show, Eq) -- | Public Key Algorithm-data PubKeyALG =- PubKeyALG_RSA -- ^ RSA Public Key algorithm- | PubKeyALG_RSAPSS -- ^ RSA PSS Key algorithm (RFC 3447)- | PubKeyALG_DSA -- ^ DSA Public Key algorithm- | PubKeyALG_EC -- ^ ECDSA & ECDH Public Key algorithm- | PubKeyALG_X25519 -- ^ ECDH 25519 key agreement- | PubKeyALG_X448 -- ^ ECDH 448 key agreement- | PubKeyALG_Ed25519 -- ^ EdDSA 25519 signature algorithm- | PubKeyALG_Ed448 -- ^ EdDSA 448 signature algorithm- | PubKeyALG_DH -- ^ Diffie Hellman Public Key algorithm- | PubKeyALG_Unknown OID -- ^ Unknown Public Key algorithm- deriving (Show,Eq)+data PubKeyALG+ = -- | RSA Public Key algorithm+ PubKeyALG_RSA+ | -- | RSA PSS Key algorithm (RFC 3447)+ PubKeyALG_RSAPSS+ | -- | DSA Public Key algorithm+ PubKeyALG_DSA+ | -- | ECDSA & ECDH Public Key algorithm+ PubKeyALG_EC+ | -- | ECDH 25519 key agreement+ PubKeyALG_X25519+ | -- | ECDH 448 key agreement+ PubKeyALG_X448+ | -- | EdDSA 25519 signature algorithm+ PubKeyALG_Ed25519+ | -- | EdDSA 448 signature algorithm+ PubKeyALG_Ed448+ | -- | Diffie Hellman Public Key algorithm+ PubKeyALG_DH+ | -- | Unknown Public Key algorithm+ PubKeyALG_Unknown OID+ deriving (Show, Eq) -- | Signature Algorithm, often composed of a public key algorithm and a hash -- algorithm. For some signature algorithms the hash algorithm is intrinsic to -- the public key algorithm and is not needed in the data type.-data SignatureALG =- SignatureALG HashALG PubKeyALG+data SignatureALG+ = SignatureALG HashALG PubKeyALG | SignatureALG_IntrinsicHash PubKeyALG | SignatureALG_Unknown OID- deriving (Show,Eq)+ deriving (Show, Eq) instance OIDable PubKeyALG where- getObjectID PubKeyALG_RSA = [1,2,840,113549,1,1,1]- getObjectID PubKeyALG_RSAPSS = [1,2,840,113549,1,1,10]- getObjectID PubKeyALG_DSA = [1,2,840,10040,4,1]- getObjectID PubKeyALG_EC = [1,2,840,10045,2,1]- getObjectID PubKeyALG_X25519 = [1,3,101,110]- getObjectID PubKeyALG_X448 = [1,3,101,111]- getObjectID PubKeyALG_Ed25519 = [1,3,101,112]- getObjectID PubKeyALG_Ed448 = [1,3,101,113]- getObjectID PubKeyALG_DH = [1,2,840,10046,2,1]+ getObjectID PubKeyALG_RSA = [1, 2, 840, 113549, 1, 1, 1]+ getObjectID PubKeyALG_RSAPSS = [1, 2, 840, 113549, 1, 1, 10]+ getObjectID PubKeyALG_DSA = [1, 2, 840, 10040, 4, 1]+ getObjectID PubKeyALG_EC = [1, 2, 840, 10045, 2, 1]+ getObjectID PubKeyALG_X25519 = [1, 3, 101, 110]+ getObjectID PubKeyALG_X448 = [1, 3, 101, 111]+ getObjectID PubKeyALG_Ed25519 = [1, 3, 101, 112]+ getObjectID PubKeyALG_Ed448 = [1, 3, 101, 113]+ getObjectID PubKeyALG_DH = [1, 2, 840, 10046, 2, 1] getObjectID (PubKeyALG_Unknown oid) = oid -sig_table :: [ (OID, SignatureALG) ]+sig_table :: [(OID, SignatureALG)] sig_table =- [ ([1,2,840,113549,1,1,5], SignatureALG HashSHA1 PubKeyALG_RSA)- , ([1,2,840,113549,1,1,4], SignatureALG HashMD5 PubKeyALG_RSA)- , ([1,2,840,113549,1,1,2], SignatureALG HashMD2 PubKeyALG_RSA)- , ([1,2,840,113549,1,1,11], SignatureALG HashSHA256 PubKeyALG_RSA)- , ([1,2,840,113549,1,1,12], SignatureALG HashSHA384 PubKeyALG_RSA)- , ([1,2,840,113549,1,1,13], SignatureALG HashSHA512 PubKeyALG_RSA)- , ([1,2,840,113549,1,1,14], SignatureALG HashSHA224 PubKeyALG_RSA)- , ([1,2,840,10040,4,3], SignatureALG HashSHA1 PubKeyALG_DSA)- , ([1,2,840,10045,4,1], SignatureALG HashSHA1 PubKeyALG_EC)- , ([1,2,840,10045,4,3,1], SignatureALG HashSHA224 PubKeyALG_EC)- , ([1,2,840,10045,4,3,2], SignatureALG HashSHA256 PubKeyALG_EC)- , ([1,2,840,10045,4,3,3], SignatureALG HashSHA384 PubKeyALG_EC)- , ([1,2,840,10045,4,3,4], SignatureALG HashSHA512 PubKeyALG_EC)- , ([2,16,840,1,101,3,4,2,1], SignatureALG HashSHA256 PubKeyALG_RSAPSS)- , ([2,16,840,1,101,3,4,2,2], SignatureALG HashSHA384 PubKeyALG_RSAPSS)- , ([2,16,840,1,101,3,4,2,3], SignatureALG HashSHA512 PubKeyALG_RSAPSS)- , ([2,16,840,1,101,3,4,2,4], SignatureALG HashSHA224 PubKeyALG_RSAPSS)- , ([2,16,840,1,101,3,4,3,1], SignatureALG HashSHA224 PubKeyALG_DSA)- , ([2,16,840,1,101,3,4,3,2], SignatureALG HashSHA256 PubKeyALG_DSA)- , ([1,3,101,112], SignatureALG_IntrinsicHash PubKeyALG_Ed25519)- , ([1,3,101,113], SignatureALG_IntrinsicHash PubKeyALG_Ed448)- ]+ [ ([1, 2, 840, 113549, 1, 1, 5], SignatureALG HashSHA1 PubKeyALG_RSA)+ , ([1, 2, 840, 113549, 1, 1, 4], SignatureALG HashMD5 PubKeyALG_RSA)+ , ([1, 2, 840, 113549, 1, 1, 2], SignatureALG HashMD2 PubKeyALG_RSA)+ , ([1, 2, 840, 113549, 1, 1, 11], SignatureALG HashSHA256 PubKeyALG_RSA)+ , ([1, 2, 840, 113549, 1, 1, 12], SignatureALG HashSHA384 PubKeyALG_RSA)+ , ([1, 2, 840, 113549, 1, 1, 13], SignatureALG HashSHA512 PubKeyALG_RSA)+ , ([1, 2, 840, 113549, 1, 1, 14], SignatureALG HashSHA224 PubKeyALG_RSA)+ , ([1, 2, 840, 10040, 4, 3], SignatureALG HashSHA1 PubKeyALG_DSA)+ , ([1, 2, 840, 10045, 4, 1], SignatureALG HashSHA1 PubKeyALG_EC)+ , ([1, 2, 840, 10045, 4, 3, 1], SignatureALG HashSHA224 PubKeyALG_EC)+ , ([1, 2, 840, 10045, 4, 3, 2], SignatureALG HashSHA256 PubKeyALG_EC)+ , ([1, 2, 840, 10045, 4, 3, 3], SignatureALG HashSHA384 PubKeyALG_EC)+ , ([1, 2, 840, 10045, 4, 3, 4], SignatureALG HashSHA512 PubKeyALG_EC)+ , ([2, 16, 840, 1, 101, 3, 4, 2, 1], SignatureALG HashSHA256 PubKeyALG_RSAPSS)+ , ([2, 16, 840, 1, 101, 3, 4, 2, 2], SignatureALG HashSHA384 PubKeyALG_RSAPSS)+ , ([2, 16, 840, 1, 101, 3, 4, 2, 3], SignatureALG HashSHA512 PubKeyALG_RSAPSS)+ , ([2, 16, 840, 1, 101, 3, 4, 2, 4], SignatureALG HashSHA224 PubKeyALG_RSAPSS)+ , ([2, 16, 840, 1, 101, 3, 4, 3, 1], SignatureALG HashSHA224 PubKeyALG_DSA)+ , ([2, 16, 840, 1, 101, 3, 4, 3, 2], SignatureALG HashSHA256 PubKeyALG_DSA)+ , ([1, 3, 101, 112], SignatureALG_IntrinsicHash PubKeyALG_Ed25519)+ , ([1, 3, 101, 113], SignatureALG_IntrinsicHash PubKeyALG_Ed448)+ ] oidSig :: OID -> SignatureALG oidSig oid = maybe (SignatureALG_Unknown oid) id $ lookup oid sig_table sigOID :: SignatureALG -> OID sigOID (SignatureALG_Unknown oid) = oid-sigOID sig = maybe (error ("unknown OID for " ++ show sig)) fst $ find ((==) sig . snd) sig_table+sigOID sig =+ maybe (error ("unknown OID for " ++ show sig)) fst $+ find ((==) sig . snd) sig_table -- | PSS salt length. Always assume ``-sigopt rsa_pss_saltlen:-1`` saltLen :: HashALG -> Integer@@ -98,23 +109,87 @@ saltLen HashSHA384 = 48 saltLen HashSHA512 = 64 saltLen HashSHA224 = 28-saltLen _ = error "toASN1: X509.SignatureAlg.HashAlg: Unknown hash"+saltLen _ = error "toASN1: X509.SignatureAlg.HashAlg: Unknown hash" instance ASN1Object SignatureALG where- fromASN1 (Start Sequence:OID oid:Null:End Sequence:xs) =+ fromASN1 (Start Sequence : OID oid : Null : End Sequence : xs) = case oidSig oid of SignatureALG_IntrinsicHash _ -> Left "fromASN1: X509.SignatureALG: EdDSA requires absent parameter" signatureAlg -> Right (signatureAlg, xs)- fromASN1 (Start Sequence:OID oid:End Sequence:xs) =+ fromASN1 (Start Sequence : OID oid : End Sequence : xs) = Right (oidSig oid, xs)- fromASN1 (Start Sequence:OID [1,2,840,113549,1,1,10]:Start Sequence:Start _:Start Sequence:OID hash1:End Sequence:End _:Start _:Start Sequence:OID [1,2,840,113549,1,1,8]:Start Sequence:OID _hash2:End Sequence:End Sequence:End _:Start _: IntVal _iv: End _: End Sequence : End Sequence:xs) =- Right (oidSig hash1, xs)- fromASN1 (Start Sequence:OID [1,2,840,113549,1,1,10]:Start Sequence:Start _:Start Sequence:OID hash1:Null:End Sequence:End _:Start _:Start Sequence:OID [1,2,840,113549,1,1,8]:Start Sequence:OID _hash2:Null:End Sequence:End Sequence:End _:Start _: IntVal _iv: End _: End Sequence : End Sequence:xs) =- Right (oidSig hash1, xs)+ fromASN1+ ( Start Sequence : OID [1, 2, 840, 113549, 1, 1, 10] : Start Sequence : Start _+ : Start Sequence+ : OID hash1+ : End Sequence+ : End _+ : Start _+ : Start Sequence+ : OID [1, 2, 840, 113549, 1, 1, 8]+ : Start Sequence+ : OID _hash2+ : End Sequence+ : End Sequence+ : End _+ : Start _+ : IntVal _iv+ : End _+ : End Sequence+ : End Sequence+ : xs+ ) =+ Right (oidSig hash1, xs)+ fromASN1+ ( Start Sequence : OID [1, 2, 840, 113549, 1, 1, 10] : Start Sequence : Start _+ : Start Sequence+ : OID hash1+ : Null+ : End Sequence+ : End _+ : Start _+ : Start Sequence+ : OID [1, 2, 840, 113549, 1, 1, 8]+ : Start Sequence+ : OID _hash2+ : Null+ : End Sequence+ : End Sequence+ : End _+ : Start _+ : IntVal _iv+ : End _+ : End Sequence+ : End Sequence+ : xs+ ) =+ Right (oidSig hash1, xs) fromASN1 _ = Left "fromASN1: X509.SignatureALG: unknown format"- toASN1 (SignatureALG_Unknown oid) = \xs -> Start Sequence:OID oid:Null:End Sequence:xs- toASN1 signatureAlg@(SignatureALG hashAlg PubKeyALG_RSAPSS) = \xs -> Start Sequence:OID [1,2,840,113549,1,1,10]:Start Sequence:Start (Container Context 0):Start Sequence:OID (sigOID signatureAlg):End Sequence:End (Container Context 0):Start (Container Context 1): Start Sequence:OID [1,2,840,113549,1,1,8]:Start Sequence:OID (sigOID signatureAlg):End Sequence:End Sequence:End (Container Context 1):Start (Container Context 2):IntVal (saltLen hashAlg):End (Container Context 2):End Sequence:End Sequence:xs- toASN1 signatureAlg@(SignatureALG_IntrinsicHash _) = \xs -> Start Sequence:OID (sigOID signatureAlg):End Sequence:xs- toASN1 signatureAlg = \xs -> Start Sequence:OID (sigOID signatureAlg):Null:End Sequence:xs+ toASN1 (SignatureALG_Unknown oid) = \xs -> Start Sequence : OID oid : Null : End Sequence : xs+ toASN1 signatureAlg@(SignatureALG hashAlg PubKeyALG_RSAPSS) = \xs ->+ Start Sequence+ : OID [1, 2, 840, 113549, 1, 1, 10]+ : Start Sequence+ : Start (Container Context 0)+ : Start Sequence+ : OID (sigOID signatureAlg)+ : End Sequence+ : End (Container Context 0)+ : Start (Container Context 1)+ : Start Sequence+ : OID [1, 2, 840, 113549, 1, 1, 8]+ : Start Sequence+ : OID (sigOID signatureAlg)+ : End Sequence+ : End Sequence+ : End (Container Context 1)+ : Start (Container Context 2)+ : IntVal (saltLen hashAlg)+ : End (Container Context 2)+ : End Sequence+ : End Sequence+ : xs+ toASN1 signatureAlg@(SignatureALG_IntrinsicHash _) = \xs -> Start Sequence : OID (sigOID signatureAlg) : End Sequence : xs+ toASN1 signatureAlg = \xs -> Start Sequence : OID (sigOID signatureAlg) : Null : End Sequence : xs
Data/X509/CRL.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleContexts #-}+ -- | -- Module : Data.X509.CRL -- License : BSD-style@@ -8,89 +10,92 @@ -- Read and Write X509 Certificate Revocation List (CRL). -- -- follows RFC5280 / RFC6818.----{-# LANGUAGE FlexibleContexts #-}--module Data.X509.CRL- ( CRL(..)- , RevokedCertificate(..)- ) where+module Data.X509.CRL (+ CRL (..),+ RevokedCertificate (..),+) where import Control.Applicative -import Data.Hourglass (DateTime, TimezoneOffset(..)) import Data.ASN1.Types+import Data.Hourglass (DateTime, TimezoneOffset (..)) -import Data.X509.DistinguishedName import Data.X509.AlgorithmIdentifier+import Data.X509.DistinguishedName import Data.X509.ExtensionRaw import Data.X509.Internal -- | Describe a Certificate revocation list data CRL = CRL- { crlVersion :: Integer- , crlSignatureAlg :: SignatureALG- , crlIssuer :: DistinguishedName- , crlThisUpdate :: DateTime- , crlNextUpdate :: Maybe DateTime+ { crlVersion :: Integer+ , crlSignatureAlg :: SignatureALG+ , crlIssuer :: DistinguishedName+ , crlThisUpdate :: DateTime+ , crlNextUpdate :: Maybe DateTime , crlRevokedCertificates :: [RevokedCertificate]- , crlExtensions :: Extensions- } deriving (Show,Eq)+ , crlExtensions :: Extensions+ }+ deriving (Show, Eq) -- | Describe a revoked certificate identifiable by serial number. data RevokedCertificate = RevokedCertificate { revokedSerialNumber :: Integer- , revokedDate :: DateTime- , revokedExtensions :: Extensions- } deriving (Show,Eq)+ , revokedDate :: DateTime+ , revokedExtensions :: Extensions+ }+ deriving (Show, Eq) instance ASN1Object CRL where toASN1 crl = encodeCRL crl fromASN1 = runParseASN1State parseCRL instance ASN1Object RevokedCertificate where- fromASN1 = runParseASN1State $- onNextContainer Sequence $- RevokedCertificate- <$> parseSerialNumber- <*> (getNext >>= toTime)- <*> getObject- where toTime (ASN1Time _ t _) = pure t- toTime _ = throwParseError "bad revocation date"+ fromASN1 =+ runParseASN1State $+ onNextContainer Sequence $+ RevokedCertificate+ <$> parseSerialNumber+ <*> (getNext >>= toTime)+ <*> getObject+ where+ toTime (ASN1Time _ t _) = pure t+ toTime _ = throwParseError "bad revocation date" toASN1 (RevokedCertificate serial time crlEntryExtensions) = \xs ->- [ Start Sequence ] ++- [ IntVal serial ] ++- [ ASN1Time TimeGeneralized time (Just (TimezoneOffset 0)) ] ++- toASN1 crlEntryExtensions [] ++- [ End Sequence ] ++- xs+ [Start Sequence]+ ++ [IntVal serial]+ ++ [ASN1Time TimeGeneralized time (Just (TimezoneOffset 0))]+ ++ toASN1 crlEntryExtensions []+ ++ [End Sequence]+ ++ xs parseSerialNumber :: ParseASN1 Integer parseSerialNumber = do n <- getNext case n of IntVal v -> return v- _ -> throwParseError ("missing serial" ++ show n)+ _ -> throwParseError ("missing serial" ++ show n) parseCRL :: ParseASN1 CRL parseCRL = do- CRL <$> (getNext >>= getVersion)+ CRL+ <$> (getNext >>= getVersion) <*> getObject <*> getObject <*> (getNext >>= getThisUpdate) <*> getNextUpdate <*> parseRevokedCertificates <*> parseCRLExtensions- where getVersion (IntVal v) = return $ fromIntegral v- getVersion _ = throwParseError "unexpected type for version"+ where+ getVersion (IntVal v) = return $ fromIntegral v+ getVersion _ = throwParseError "unexpected type for version" - getThisUpdate (ASN1Time _ t1 _) = return t1- getThisUpdate _ = throwParseError "bad this update format, expecting time"+ getThisUpdate (ASN1Time _ t1 _) = return t1+ getThisUpdate _ = throwParseError "bad this update format, expecting time" - getNextUpdate = getNextMaybe timeOrNothing+ getNextUpdate = getNextMaybe timeOrNothing - timeOrNothing (ASN1Time _ tnext _) = Just tnext- timeOrNothing _ = Nothing+ timeOrNothing (ASN1Time _ tnext _) = Just tnext+ timeOrNothing _ = Nothing parseRevokedCertificates :: ParseASN1 [RevokedCertificate] parseRevokedCertificates =@@ -99,19 +104,24 @@ parseCRLExtensions :: ParseASN1 Extensions parseCRLExtensions = fmap adapt $ onNextContainerMaybe (Container Context 0) $ getObject- where adapt (Just e) = e- adapt Nothing = Extensions Nothing+ where+ adapt (Just e) = e+ adapt Nothing = Extensions Nothing encodeCRL :: CRL -> ASN1S encodeCRL crl xs =- [IntVal $ crlVersion crl] ++- toASN1 (crlSignatureAlg crl) [] ++- toASN1 (crlIssuer crl) [] ++- [ASN1Time TimeGeneralized (crlThisUpdate crl) (Just (TimezoneOffset 0))] ++- (maybe [] (\t -> [ASN1Time TimeGeneralized t (Just (TimezoneOffset 0))]) (crlNextUpdate crl)) ++- maybeRevoked (crlRevokedCertificates crl) ++- maybeCrlExts (crlExtensions crl) ++- xs+ [IntVal $ crlVersion crl]+ ++ toASN1 (crlSignatureAlg crl) []+ ++ toASN1 (crlIssuer crl) []+ ++ [ASN1Time TimeGeneralized (crlThisUpdate crl) (Just (TimezoneOffset 0))]+ ++ ( maybe+ []+ (\t -> [ASN1Time TimeGeneralized t (Just (TimezoneOffset 0))])+ (crlNextUpdate crl)+ )+ ++ maybeRevoked (crlRevokedCertificates crl)+ ++ maybeCrlExts (crlExtensions crl)+ ++ xs where maybeRevoked [] = [] maybeRevoked xs' = asn1Container Sequence $ concatMap (\e -> toASN1 e []) xs'
Data/X509/Cert.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleContexts #-}+ -- | -- Module : Data.X509.Cert -- License : BSD-style@@ -6,118 +8,139 @@ -- Portability : unknown -- -- X.509 Certificate types and functions----{-# LANGUAGE FlexibleContexts #-}--module Data.X509.Cert (Certificate(..)) where+module Data.X509.Cert (Certificate (..)) where -import Data.ASN1.Types import Control.Applicative ((<$>), (<*>))-import Data.X509.Internal-import Data.X509.PublicKey+import Data.ASN1.Types+import Data.Hourglass import Data.X509.AlgorithmIdentifier import Data.X509.DistinguishedName import Data.X509.ExtensionRaw-import Data.Hourglass+import Data.X509.Internal+import Data.X509.PublicKey -data CertKeyUsage =- CertKeyUsageDigitalSignature- | CertKeyUsageNonRepudiation- | CertKeyUsageKeyEncipherment- | CertKeyUsageDataEncipherment- | CertKeyUsageKeyAgreement- | CertKeyUsageKeyCertSign- | CertKeyUsageCRLSign- | CertKeyUsageEncipherOnly- | CertKeyUsageDecipherOnly- deriving (Show, Eq)+data CertKeyUsage+ = CertKeyUsageDigitalSignature+ | CertKeyUsageNonRepudiation+ | CertKeyUsageKeyEncipherment+ | CertKeyUsageDataEncipherment+ | CertKeyUsageKeyAgreement+ | CertKeyUsageKeyCertSign+ | CertKeyUsageCRLSign+ | CertKeyUsageEncipherOnly+ | CertKeyUsageDecipherOnly+ deriving (Show, Eq) -- | X.509 Certificate type. -- -- This type doesn't include the signature, it's describe in the RFC -- as tbsCertificate. data Certificate = Certificate- { certVersion :: Int -- ^ Version- , certSerial :: Integer -- ^ Serial number- , certSignatureAlg :: SignatureALG -- ^ Signature algorithm- , certIssuerDN :: DistinguishedName -- ^ Issuer DN- , certValidity :: (DateTime, DateTime) -- ^ Validity period (UTC)- , certSubjectDN :: DistinguishedName -- ^ Subject DN- , certPubKey :: PubKey -- ^ Public key- , certExtensions :: Extensions -- ^ Extensions- } deriving (Show,Eq)+ { certVersion :: Int+ -- ^ Version+ , certSerial :: Integer+ -- ^ Serial number+ , certSignatureAlg :: SignatureALG+ -- ^ Signature algorithm+ , certIssuerDN :: DistinguishedName+ -- ^ Issuer DN+ , certValidity :: (DateTime, DateTime)+ -- ^ Validity period (UTC)+ , certSubjectDN :: DistinguishedName+ -- ^ Subject DN+ , certPubKey :: PubKey+ -- ^ Public key+ , certExtensions :: Extensions+ -- ^ Extensions+ }+ deriving (Show, Eq) instance ASN1Object Certificate where- toASN1 certificate = \xs -> encodeCertificateHeader certificate ++ xs- fromASN1 s = runParseASN1State parseCertificate s+ toASN1 certificate = \xs -> encodeCertificateHeader certificate ++ xs+ fromASN1 s = runParseASN1State parseCertificate s parseCertHeaderVersion :: ParseASN1 Int parseCertHeaderVersion = maybe 0 id <$> onNextContainerMaybe (Container Context 0) (getNext >>= getVer)- where getVer (IntVal v) = return $ fromIntegral v- getVer _ = throwParseError "unexpected type for version"+ where+ getVer (IntVal v) = return $ fromIntegral v+ getVer _ = throwParseError "unexpected type for version" parseCertHeaderSerial :: ParseASN1 Integer parseCertHeaderSerial = do n <- getNext case n of IntVal v -> return v- _ -> throwParseError ("missing serial" ++ show n)+ _ -> throwParseError ("missing serial" ++ show n) parseCertHeaderValidity :: ParseASN1 (DateTime, DateTime) parseCertHeaderValidity = getNextContainer Sequence >>= toTimeBound- where toTimeBound [ ASN1Time _ t1 _, ASN1Time _ t2 _ ] = return (t1,t2)- toTimeBound _ = throwParseError "bad validity format"--{- | parse header structure of a x509 certificate. the structure is the following:- Version- Serial Number- Algorithm ID- Issuer- Validity- Not Before- Not After- Subject- Subject Public Key Info- Public Key Algorithm- Subject Public Key- Issuer Unique Identifier (Optional) (>= 2)- Subject Unique Identifier (Optional) (>= 2)- Extensions (Optional) (>= v3)--}+ where+ toTimeBound [ASN1Time _ t1 _, ASN1Time _ t2 _] = return (t1, t2)+ toTimeBound _ = throwParseError "bad validity format" +-- | parse header structure of a x509 certificate. the structure is the following:+-- Version+-- Serial Number+-- Algorithm ID+-- Issuer+-- Validity+-- Not Before+-- Not After+-- Subject+-- Subject Public Key Info+-- Public Key Algorithm+-- Subject Public Key+-- Issuer Unique Identifier (Optional) (>= 2)+-- Subject Unique Identifier (Optional) (>= 2)+-- Extensions (Optional) (>= v3) parseExtensions :: ParseASN1 Extensions parseExtensions = fmap adapt $ onNextContainerMaybe (Container Context 3) $ getObject- where adapt (Just e) = e- adapt Nothing = Extensions Nothing+ where+ adapt (Just e) = e+ adapt Nothing = Extensions Nothing parseCertificate :: ParseASN1 Certificate parseCertificate =- Certificate <$> parseCertHeaderVersion- <*> parseCertHeaderSerial- <*> getObject- <*> getObject- <*> parseCertHeaderValidity- <*> getObject- <*> getObject- <*> parseExtensions+ Certificate+ <$> parseCertHeaderVersion+ <*> parseCertHeaderSerial+ <*> getObject+ <*> getObject+ <*> parseCertHeaderValidity+ <*> getObject+ <*> getObject+ <*> parseExtensions encodeCertificateHeader :: Certificate -> [ASN1] encodeCertificateHeader cert =- eVer ++ eSerial ++ eAlgId ++ eIssuer ++ eValidity ++ eSubject ++ epkinfo ++ eexts- where eVer = asn1Container (Container Context 0) [IntVal (fromIntegral $ certVersion cert)]- eSerial = [IntVal $ certSerial cert]- eAlgId = toASN1 (certSignatureAlg cert) []- eIssuer = toASN1 (certIssuerDN cert) []- (t1, t2) = certValidity cert- eValidity = asn1Container Sequence [ASN1Time (timeType t1) t1 (Just (TimezoneOffset 0))- ,ASN1Time (timeType t2) t2 (Just (TimezoneOffset 0))]- eSubject = toASN1 (certSubjectDN cert) []- epkinfo = toASN1 (certPubKey cert) []- eexts = case certExtensions cert of- Extensions Nothing -> []- exts -> asn1Container (Container Context 3) $ toASN1 exts []- timeType t =- if t >= timeConvert (Date 2050 January 1)+ eVer+ ++ eSerial+ ++ eAlgId+ ++ eIssuer+ ++ eValidity+ ++ eSubject+ ++ epkinfo+ ++ eexts+ where+ eVer =+ asn1Container (Container Context 0) [IntVal (fromIntegral $ certVersion cert)]+ eSerial = [IntVal $ certSerial cert]+ eAlgId = toASN1 (certSignatureAlg cert) []+ eIssuer = toASN1 (certIssuerDN cert) []+ (t1, t2) = certValidity cert+ eValidity =+ asn1Container+ Sequence+ [ ASN1Time (timeType t1) t1 (Just (TimezoneOffset 0))+ , ASN1Time (timeType t2) t2 (Just (TimezoneOffset 0))+ ]+ eSubject = toASN1 (certSubjectDN cert) []+ epkinfo = toASN1 (certPubKey cert) []+ eexts = case certExtensions cert of+ Extensions Nothing -> []+ exts -> asn1Container (Container Context 3) $ toASN1 exts []+ timeType t =+ if t >= timeConvert (Date 2050 January 1) then TimeGeneralized else TimeUTC
Data/X509/CertificateChain.hs view
@@ -4,37 +4,39 @@ -- Maintainer : Vincent Hanquez <vincent@snarc.org> -- Stability : experimental -- Portability : unknown----module Data.X509.CertificateChain- ( CertificateChain(..)- , CertificateChainRaw(..)+module Data.X509.CertificateChain (+ CertificateChain (..),+ CertificateChainRaw (..),+ -- * marshall between CertificateChain and CertificateChainRaw- , decodeCertificateChain- , encodeCertificateChain- ) where+ decodeCertificateChain,+ encodeCertificateChain,+) where +import Data.ByteString (ByteString) import Data.X509.Cert (Certificate) import Data.X509.Signed (SignedExact, decodeSignedObject, encodeSignedObject)-import Data.ByteString (ByteString) -- | A chain of X.509 certificates in exact form. newtype CertificateChain = CertificateChain [SignedExact Certificate]- deriving (Show,Eq)+ deriving (Show, Eq) -- | Represent a chain of X.509 certificates in bytestring form. newtype CertificateChainRaw = CertificateChainRaw [ByteString]- deriving (Show,Eq)+ deriving (Show, Eq) -- | Decode a CertificateChainRaw into a CertificateChain if every -- raw certificate are decoded correctly, otherwise return the index of the -- failed certificate and the error associated.-decodeCertificateChain :: CertificateChainRaw -> Either (Int, String) CertificateChain+decodeCertificateChain+ :: CertificateChainRaw -> Either (Int, String) CertificateChain decodeCertificateChain (CertificateChainRaw l) = either Left (Right . CertificateChain) $ loop 0 l- where loop _ [] = Right []- loop i (r:rs) = case decodeSignedObject r of- Left err -> Left (i, err)- Right o -> either Left (Right . (o :)) $ loop (i+1) rs+ where+ loop _ [] = Right []+ loop i (r : rs) = case decodeSignedObject r of+ Left err -> Left (i, err)+ Right o -> either Left (Right . (o :)) $ loop (i + 1) rs -- | Convert a CertificateChain into a CertificateChainRaw encodeCertificateChain :: CertificateChain -> CertificateChainRaw
Data/X509/DistinguishedName.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | -- Module : Data.X509.DistinguishedName -- License : BSD-style@@ -6,16 +8,14 @@ -- Portability : unknown -- -- X.509 Distinguished names types and functions--{-# LANGUAGE CPP #-}-module Data.X509.DistinguishedName- ( DistinguishedName(..)- , DistinguishedNameInner(..)- , ASN1CharacterString(..)+module Data.X509.DistinguishedName (+ DistinguishedName (..),+ DistinguishedNameInner (..),+ ASN1CharacterString (..), -- Distinguished Name Elements- , DnElement(..)- , getDnElement- ) where+ DnElement (..),+ getDnElement,+) where import Control.Applicative #if MIN_VERSION_base(4,9,0)@@ -27,24 +27,29 @@ import Data.X509.Internal -- | A list of OID and strings.-newtype DistinguishedName = DistinguishedName { getDistinguishedElements :: [(OID, ASN1CharacterString)] }- deriving (Show,Eq,Ord)+newtype DistinguishedName = DistinguishedName {getDistinguishedElements :: [(OID, ASN1CharacterString)]}+ deriving (Show, Eq, Ord) -- | Elements commonly available in a 'DistinguishedName' structure-data DnElement =- DnCommonName -- ^ CN- | DnCountry -- ^ Country- | DnOrganization -- ^ O- | DnOrganizationUnit -- ^ OU- | DnEmailAddress -- ^ Email Address (legacy)- deriving (Show,Eq)+data DnElement+ = -- | CN+ DnCommonName+ | -- | Country+ DnCountry+ | -- | O+ DnOrganization+ | -- | OU+ DnOrganizationUnit+ | -- | Email Address (legacy)+ DnEmailAddress+ deriving (Show, Eq) instance OIDable DnElement where- getObjectID DnCommonName = [2,5,4,3]- getObjectID DnCountry = [2,5,4,6]- getObjectID DnOrganization = [2,5,4,10]- getObjectID DnOrganizationUnit = [2,5,4,11]- getObjectID DnEmailAddress = [1,2,840,113549,1,9,1]+ getObjectID DnCommonName = [2, 5, 4, 3]+ getObjectID DnCountry = [2, 5, 4, 6]+ getObjectID DnOrganization = [2, 5, 4, 10]+ getObjectID DnOrganizationUnit = [2, 5, 4, 11]+ getObjectID DnEmailAddress = [1, 2, 840, 113549, 1, 9, 1] -- | Try to get a specific element in a 'DistinguishedName' structure getDnElement :: DnElement -> DistinguishedName -> Maybe ASN1CharacterString@@ -53,7 +58,7 @@ -- | Only use to encode a DistinguishedName without including it in a -- Sequence newtype DistinguishedNameInner = DistinguishedNameInner DistinguishedName- deriving (Show,Eq)+ deriving (Show, Eq) #if MIN_VERSION_base(4,9,0) instance Semigroup DistinguishedName where@@ -61,20 +66,21 @@ #endif instance Monoid DistinguishedName where- mempty = DistinguishedName []+ mempty = DistinguishedName [] #if !(MIN_VERSION_base(4,11,0)) mappend (DistinguishedName l1) (DistinguishedName l2) = DistinguishedName (l1++l2) #endif instance ASN1Object DistinguishedName where toASN1 dn = \xs -> encodeDN dn ++ xs- fromASN1 = runParseASN1State parseDN+ fromASN1 = runParseASN1State parseDN -- FIXME parseDNInner in fromASN1 is probably wrong as we don't have a container -- and thus hasNext should be replaced by a isFinished clause. instance ASN1Object DistinguishedNameInner where toASN1 (DistinguishedNameInner dn) = \xs -> encodeDNinner dn ++ xs- fromASN1 = runParseASN1State (DistinguishedNameInner . DistinguishedName <$> parseDNInner)+ fromASN1 =+ runParseASN1State (DistinguishedNameInner . DistinguishedName <$> parseDNInner) parseDN :: ParseASN1 DistinguishedName parseDN = DistinguishedName <$> onNextContainer Sequence parseDNInner@@ -87,11 +93,13 @@ s <- getNextContainer Sequence case s of [OID oid, ASN1String cs] -> return (oid, cs)- _ -> throwParseError ("expecting [OID,String] got " ++ show s)+ _ ->+ throwParseError ("expecting [OID,String] got " ++ show s) encodeDNinner :: DistinguishedName -> [ASN1] encodeDNinner (DistinguishedName dn) = concatMap dnSet dn- where dnSet (oid, cs) = asn1Container Set $ asn1Container Sequence [OID oid, ASN1String cs]+ where+ dnSet (oid, cs) = asn1Container Set $ asn1Container Sequence [OID oid, ASN1String cs] encodeDN :: DistinguishedName -> [ASN1] encodeDN dn = asn1Container Sequence $ encodeDNinner dn
Data/X509/EC.hs view
@@ -6,27 +6,25 @@ -- Portability : unknown -- -- Utilities related to Elliptic Curve certificates and keys.----module Data.X509.EC- (- unserializePoint- , ecPubKeyCurve- , ecPubKeyCurveName- , ecPrivKeyCurve- , ecPrivKeyCurveName- , lookupCurveNameByOID- ) where+module Data.X509.EC (+ unserializePoint,+ ecPubKeyCurve,+ ecPubKeyCurveName,+ ecPrivKeyCurve,+ ecPrivKeyCurveName,+ lookupCurveNameByOID,+) where import Data.ASN1.OID import Data.List (find) import Data.X509.OID-import Data.X509.PublicKey import Data.X509.PrivateKey+import Data.X509.PublicKey -import qualified Crypto.PubKey.ECC.Prim as ECC+import Crypto.Number.Serialize (os2ip)+import qualified Crypto.PubKey.ECC.Prim as ECC import qualified Crypto.PubKey.ECC.Types as ECC-import Crypto.Number.Serialize (os2ip) import qualified Data.ByteString as B @@ -35,91 +33,95 @@ unserializePoint :: ECC.Curve -> SerializedPoint -> Maybe ECC.Point unserializePoint curve (SerializedPoint bs) = case B.uncons bs of- Nothing -> Nothing+ Nothing -> Nothing Just (ptFormat, input) -> case ptFormat of- 4 -> if B.length input /= 2 * bytes+ 4 ->+ if B.length input /= 2 * bytes then Nothing else let (x, y) = B.splitAt bytes input- p = ECC.Point (os2ip x) (os2ip y)+ p = ECC.Point (os2ip x) (os2ip y) in if ECC.isPointValid curve p then Just p else Nothing -- 2 and 3 for compressed format. _ -> Nothing- where bits = ECC.curveSizeBits curve- bytes = (bits + 7) `div` 8+ where+ bits = ECC.curveSizeBits curve+ bytes = (bits + 7) `div` 8 -- | Return the curve associated to an EC Public Key. This does not check -- if a curve in explicit format is valid: if the input is not trusted one -- should consider 'ecPubKeyCurveName' instead. ecPubKeyCurve :: PubKeyEC -> Maybe ECC.Curve ecPubKeyCurve (PubKeyEC_Named name _) = Just $ ECC.getCurveByName name-ecPubKeyCurve pub@PubKeyEC_Prime{} =+ecPubKeyCurve pub@PubKeyEC_Prime{} = fmap buildCurve $ unserializePoint (buildCurve undefined) (pubkeyEC_generator pub) where prime = pubkeyEC_prime pub buildCurve g =- let cc = ECC.CurveCommon- { ECC.ecc_a = pubkeyEC_a pub- , ECC.ecc_b = pubkeyEC_b pub- , ECC.ecc_g = g- , ECC.ecc_n = pubkeyEC_order pub- , ECC.ecc_h = pubkeyEC_cofactor pub- }+ let cc =+ ECC.CurveCommon+ { ECC.ecc_a = pubkeyEC_a pub+ , ECC.ecc_b = pubkeyEC_b pub+ , ECC.ecc_g = g+ , ECC.ecc_n = pubkeyEC_order pub+ , ECC.ecc_h = pubkeyEC_cofactor pub+ } in ECC.CurveFP (ECC.CurvePrime prime cc) -- | Return the name of a standard curve associated to an EC Public Key ecPubKeyCurveName :: PubKeyEC -> Maybe ECC.CurveName ecPubKeyCurveName (PubKeyEC_Named name _) = Just name-ecPubKeyCurveName pub@PubKeyEC_Prime{} =+ecPubKeyCurveName pub@PubKeyEC_Prime{} = find matchPrimeCurve $ enumFrom $ toEnum 0 where matchPrimeCurve c = case ECC.getCurveByName c of ECC.CurveFP (ECC.CurvePrime p cc) ->- ECC.ecc_a cc == pubkeyEC_a pub &&- ECC.ecc_b cc == pubkeyEC_b pub &&- ECC.ecc_n cc == pubkeyEC_order pub &&- p == pubkeyEC_prime pub- _ -> False+ ECC.ecc_a cc == pubkeyEC_a pub+ && ECC.ecc_b cc == pubkeyEC_b pub+ && ECC.ecc_n cc == pubkeyEC_order pub+ && p == pubkeyEC_prime pub+ _ -> False -- | Return the EC curve associated to an EC Private Key. This does not check -- if a curve in explicit format is valid: if the input is not trusted one -- should consider 'ecPrivKeyCurveName' instead. ecPrivKeyCurve :: PrivKeyEC -> Maybe ECC.Curve ecPrivKeyCurve (PrivKeyEC_Named name _) = Just $ ECC.getCurveByName name-ecPrivKeyCurve priv@PrivKeyEC_Prime{} =+ecPrivKeyCurve priv@PrivKeyEC_Prime{} = fmap buildCurve $ unserializePoint (buildCurve undefined) (privkeyEC_generator priv) where prime = privkeyEC_prime priv buildCurve g =- let cc = ECC.CurveCommon- { ECC.ecc_a = privkeyEC_a priv- , ECC.ecc_b = privkeyEC_b priv- , ECC.ecc_g = g- , ECC.ecc_n = privkeyEC_order priv- , ECC.ecc_h = privkeyEC_cofactor priv- }+ let cc =+ ECC.CurveCommon+ { ECC.ecc_a = privkeyEC_a priv+ , ECC.ecc_b = privkeyEC_b priv+ , ECC.ecc_g = g+ , ECC.ecc_n = privkeyEC_order priv+ , ECC.ecc_h = privkeyEC_cofactor priv+ } in ECC.CurveFP (ECC.CurvePrime prime cc) -- | Return the name of a standard curve associated to an EC Private Key ecPrivKeyCurveName :: PrivKeyEC -> Maybe ECC.CurveName ecPrivKeyCurveName (PrivKeyEC_Named name _) = Just name-ecPrivKeyCurveName priv@PrivKeyEC_Prime{} =+ecPrivKeyCurveName priv@PrivKeyEC_Prime{} = find matchPrimeCurve $ enumFrom $ toEnum 0 where matchPrimeCurve c = case ECC.getCurveByName c of ECC.CurveFP (ECC.CurvePrime p cc) ->- ECC.ecc_a cc == privkeyEC_a priv &&- ECC.ecc_b cc == privkeyEC_b priv &&- ECC.ecc_n cc == privkeyEC_order priv &&- p == privkeyEC_prime priv- _ -> False+ ECC.ecc_a cc == privkeyEC_a priv+ && ECC.ecc_b cc == privkeyEC_b priv+ && ECC.ecc_n cc == privkeyEC_order priv+ && p == privkeyEC_prime priv+ _ -> False -- | Return the curve name associated to an OID lookupCurveNameByOID :: OID -> Maybe ECC.CurveName
Data/X509/Ext.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+ -- | -- Module : Data.X509.Ext -- License : BSD-style@@ -6,58 +9,57 @@ -- Portability : unknown -- -- extension processing module.----{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-module Data.X509.Ext- ( Extension(..)+module Data.X509.Ext (+ Extension (..),+ -- * Common extension usually found in x509v3- , ExtBasicConstraints(..)- , ExtKeyUsage(..)- , ExtKeyUsageFlag(..)- , ExtExtendedKeyUsage(..)- , ExtKeyUsagePurpose(..)- , ExtSubjectKeyId(..)- , ExtSubjectAltName(..)- , ExtAuthorityKeyId(..)- , ExtCrlDistributionPoints(..)- , ExtNetscapeComment(..)- , AltName(..)- , DistributionPoint(..)- , ReasonFlag(..)+ ExtBasicConstraints (..),+ ExtKeyUsage (..),+ ExtKeyUsageFlag (..),+ ExtExtendedKeyUsage (..),+ ExtKeyUsagePurpose (..),+ ExtSubjectKeyId (..),+ ExtSubjectAltName (..),+ ExtAuthorityKeyId (..),+ ExtCrlDistributionPoints (..),+ ExtNetscapeComment (..),+ AltName (..),+ DistributionPoint (..),+ ReasonFlag (..),+ -- * Accessor turning extension into a specific one- , extensionGet- , extensionGetE- , extensionDecode- , extensionEncode- ) where+ extensionGet,+ extensionGetE,+ extensionDecode,+ extensionEncode,+) where -import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as BC-import Data.ASN1.Types-import Data.ASN1.Parse-import Data.ASN1.Encoding+import Control.Applicative+import Control.Monad import Data.ASN1.BinaryEncoding import Data.ASN1.BitArray-import Data.Proxy+import Data.ASN1.Encoding+import Data.ASN1.Parse+import Data.ASN1.Types+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC import Data.List (find)-import Data.X509.ExtensionRaw+import Data.Proxy import Data.X509.DistinguishedName-import Control.Applicative-import Control.Monad+import Data.X509.ExtensionRaw -- | key usage flag that is found in the key usage extension field.-data ExtKeyUsageFlag =- KeyUsage_digitalSignature -- (0)- | KeyUsage_nonRepudiation -- (1) recent X.509 ver have renamed this bit to contentCommitment- | KeyUsage_keyEncipherment -- (2)+data ExtKeyUsageFlag+ = KeyUsage_digitalSignature -- (0)+ | KeyUsage_nonRepudiation -- (1) recent X.509 ver have renamed this bit to contentCommitment+ | KeyUsage_keyEncipherment -- (2) | KeyUsage_dataEncipherment -- (3)- | KeyUsage_keyAgreement -- (4)- | KeyUsage_keyCertSign -- (5)- | KeyUsage_cRLSign -- (6)- | KeyUsage_encipherOnly -- (7)- | KeyUsage_decipherOnly -- (8)- deriving (Show,Eq,Ord,Enum)+ | KeyUsage_keyAgreement -- (4)+ | KeyUsage_keyCertSign -- (5)+ | KeyUsage_cRLSign -- (6)+ | KeyUsage_encipherOnly -- (7)+ | KeyUsage_decipherOnly -- (8)+ deriving (Show, Eq, Ord, Enum) {- -- RFC 5280@@ -76,10 +78,10 @@ -- e.g. raw ascii string. Add method to parse and encode with -- ByteString class Extension a where- extOID :: a -> OID+ extOID :: a -> OID extHasNestedASN1 :: Proxy a -> Bool- extEncode :: a -> [ASN1]- extDecode :: [ASN1] -> Either String a+ extEncode :: a -> [ASN1]+ extDecode :: [ASN1] -> Either String a extDecodeBs :: B.ByteString -> Either String a extDecodeBs = (either (Left . show) Right . decodeASN1' BER) >=> extDecode@@ -87,24 +89,25 @@ extEncodeBs :: a -> B.ByteString extEncodeBs = encodeASN1' DER . extEncode - -- | Get a specific extension from a lists of raw extensions extensionGet :: Extension a => Extensions -> Maybe a-extensionGet (Extensions Nothing) = Nothing+extensionGet (Extensions Nothing) = Nothing extensionGet (Extensions (Just l)) = findExt l- where findExt [] = Nothing- findExt (x:xs) = case extensionDecode x of- Just (Right e) -> Just e- _ -> findExt xs+ where+ findExt [] = Nothing+ findExt (x : xs) = case extensionDecode x of+ Just (Right e) -> Just e+ _ -> findExt xs -- | Get a specific extension from a lists of raw extensions extensionGetE :: Extension a => Extensions -> Maybe (Either String a)-extensionGetE (Extensions Nothing) = Nothing+extensionGetE (Extensions Nothing) = Nothing extensionGetE (Extensions (Just l)) = findExt l- where findExt [] = Nothing- findExt (x:xs) = case extensionDecode x of- Just r -> Just r- _ -> findExt xs+ where+ findExt [] = Nothing+ findExt (x : xs) = case extensionDecode x of+ Just r -> Just r+ _ -> findExt xs -- | Try to decode an ExtensionRaw. --@@ -112,90 +115,102 @@ -- * Nothing, the OID doesn't match -- * Just Left, the OID matched, but the extension couldn't be decoded -- * Just Right, the OID matched, and the extension has been succesfully decoded-extensionDecode :: forall a . Extension a => ExtensionRaw -> Maybe (Either String a)+extensionDecode+ :: forall a. Extension a => ExtensionRaw -> Maybe (Either String a) extensionDecode er@(ExtensionRaw oid _ content)- | extOID (undefined :: a) /= oid = Nothing+ | extOID (undefined :: a) /= oid = Nothing | extHasNestedASN1 (Proxy :: Proxy a) = Just (tryExtRawASN1 er >>= extDecode)- | otherwise = Just (extDecodeBs content)+ | otherwise = Just (extDecodeBs content) -- | Encode an Extension to extensionRaw-extensionEncode :: forall a . Extension a => Bool -> a -> ExtensionRaw+extensionEncode :: forall a. Extension a => Bool -> a -> ExtensionRaw extensionEncode critical ext- | extHasNestedASN1 (Proxy :: Proxy a) = ExtensionRaw (extOID ext) critical (encodeASN1' DER $ extEncode ext)- | otherwise = ExtensionRaw (extOID ext) critical (extEncodeBs ext)+ | extHasNestedASN1 (Proxy :: Proxy a) =+ ExtensionRaw (extOID ext) critical (encodeASN1' DER $ extEncode ext)+ | otherwise =+ ExtensionRaw (extOID ext) critical (extEncodeBs ext) -- | Basic Constraints data ExtBasicConstraints = ExtBasicConstraints Bool (Maybe Integer)- deriving (Show,Eq)+ deriving (Show, Eq) instance Extension ExtBasicConstraints where- extOID = const [2,5,29,19]+ extOID = const [2, 5, 29, 19] extHasNestedASN1 = const True- extEncode (ExtBasicConstraints b Nothing) = [Start Sequence,Boolean b,End Sequence]- extEncode (ExtBasicConstraints b (Just i)) = [Start Sequence,Boolean b,IntVal i,End Sequence]+ extEncode (ExtBasicConstraints b Nothing) = [Start Sequence, Boolean b, End Sequence]+ extEncode (ExtBasicConstraints b (Just i)) = [Start Sequence, Boolean b, IntVal i, End Sequence] - extDecode [Start Sequence,Boolean b,IntVal v,End Sequence]- | v >= 0 = Right (ExtBasicConstraints b (Just v))+ extDecode [Start Sequence, Boolean b, IntVal v, End Sequence]+ | v >= 0 = Right (ExtBasicConstraints b (Just v)) | otherwise = Left "invalid pathlen"- extDecode [Start Sequence,Boolean b,End Sequence] = Right (ExtBasicConstraints b Nothing)- extDecode [Start Sequence,End Sequence] = Right (ExtBasicConstraints False Nothing)+ extDecode [Start Sequence, Boolean b, End Sequence] = Right (ExtBasicConstraints b Nothing)+ extDecode [Start Sequence, End Sequence] = Right (ExtBasicConstraints False Nothing) extDecode _ = Left "unknown sequence" -- | Describe key usage data ExtKeyUsage = ExtKeyUsage [ExtKeyUsageFlag]- deriving (Show,Eq)+ deriving (Show, Eq) instance Extension ExtKeyUsage where- extOID = const [2,5,29,15]+ extOID = const [2, 5, 29, 15] extHasNestedASN1 = const True extEncode (ExtKeyUsage flags) = [BitString $ flagsToBits flags] extDecode [BitString bits] = Right $ ExtKeyUsage $ bitsToFlags bits extDecode _ = Left "unknown sequence" -- | Key usage purposes for the ExtendedKeyUsage extension-data ExtKeyUsagePurpose =- KeyUsagePurpose_ServerAuth+data ExtKeyUsagePurpose+ = KeyUsagePurpose_ServerAuth | KeyUsagePurpose_ClientAuth | KeyUsagePurpose_CodeSigning | KeyUsagePurpose_EmailProtection | KeyUsagePurpose_TimeStamping | KeyUsagePurpose_OCSPSigning | KeyUsagePurpose_Unknown OID- deriving (Show,Eq,Ord)+ deriving (Show, Eq, Ord) extKeyUsagePurposedOID :: [(OID, ExtKeyUsagePurpose)] extKeyUsagePurposedOID =- [(keyUsagePurposePrefix 1, KeyUsagePurpose_ServerAuth)- ,(keyUsagePurposePrefix 2, KeyUsagePurpose_ClientAuth)- ,(keyUsagePurposePrefix 3, KeyUsagePurpose_CodeSigning)- ,(keyUsagePurposePrefix 4, KeyUsagePurpose_EmailProtection)- ,(keyUsagePurposePrefix 8, KeyUsagePurpose_TimeStamping)- ,(keyUsagePurposePrefix 9, KeyUsagePurpose_OCSPSigning)]- where keyUsagePurposePrefix r = [1,3,6,1,5,5,7,3,r]+ [ (keyUsagePurposePrefix 1, KeyUsagePurpose_ServerAuth)+ , (keyUsagePurposePrefix 2, KeyUsagePurpose_ClientAuth)+ , (keyUsagePurposePrefix 3, KeyUsagePurpose_CodeSigning)+ , (keyUsagePurposePrefix 4, KeyUsagePurpose_EmailProtection)+ , (keyUsagePurposePrefix 8, KeyUsagePurpose_TimeStamping)+ , (keyUsagePurposePrefix 9, KeyUsagePurpose_OCSPSigning)+ ]+ where+ keyUsagePurposePrefix r = [1, 3, 6, 1, 5, 5, 7, 3, r] -- | Extended key usage extension data ExtExtendedKeyUsage = ExtExtendedKeyUsage [ExtKeyUsagePurpose]- deriving (Show,Eq)+ deriving (Show, Eq) instance Extension ExtExtendedKeyUsage where- extOID = const [2,5,29,37]+ extOID = const [2, 5, 29, 37] extHasNestedASN1 = const True extEncode (ExtExtendedKeyUsage purposes) = [Start Sequence] ++ map (OID . lookupRev) purposes ++ [End Sequence]- where lookupRev (KeyUsagePurpose_Unknown oid) = oid- lookupRev kup = maybe (error "unknown key usage purpose") fst $ find ((==) kup . snd) extKeyUsagePurposedOID- extDecode l = ExtExtendedKeyUsage `fmap` (flip runParseASN1 l $ onNextContainer Sequence $ getMany $ do- n <- getNext- case n of- OID o -> return $ maybe (KeyUsagePurpose_Unknown o) id $ lookup o extKeyUsagePurposedOID- _ -> error "invalid content in extended key usage")+ where+ lookupRev (KeyUsagePurpose_Unknown oid) = oid+ lookupRev kup =+ maybe (error "unknown key usage purpose") fst $+ find ((==) kup . snd) extKeyUsagePurposedOID+ extDecode l =+ ExtExtendedKeyUsage+ `fmap` ( flip runParseASN1 l $ onNextContainer Sequence $ getMany $ do+ n <- getNext+ case n of+ OID o ->+ return $ maybe (KeyUsagePurpose_Unknown o) id $ lookup o extKeyUsagePurposedOID+ _ -> error "invalid content in extended key usage"+ ) -- | Provide a way to identify a public key by a short hash. data ExtSubjectKeyId = ExtSubjectKeyId B.ByteString- deriving (Show,Eq)+ deriving (Show, Eq) instance Extension ExtSubjectKeyId where- extOID = const [2,5,29,14]+ extOID = const [2, 5, 29, 14] extHasNestedASN1 = const True extEncode (ExtSubjectKeyId o) = [OctetString o] extDecode [OctetString o] = Right $ ExtSubjectKeyId o@@ -209,23 +224,22 @@ -- directoryName -- ediPartyName -- registeredID----data AltName =- AltNameRFC822 String+data AltName+ = AltNameRFC822 String | AltNameDNS String | AltNameURI String- | AltNameIP B.ByteString+ | AltNameIP B.ByteString | AltNameXMPP String | AltNameDNSSRV String- deriving (Show,Eq,Ord)+ deriving (Show, Eq, Ord) -- | Provide a way to supply alternate name that can be -- used for matching host name. data ExtSubjectAltName = ExtSubjectAltName [AltName]- deriving (Show,Eq,Ord)+ deriving (Show, Eq, Ord) instance Extension ExtSubjectAltName where- extOID = const [2,5,29,17]+ extOID = const [2, 5, 29, 17] extHasNestedASN1 = const True extEncode (ExtSubjectAltName names) = encodeGeneralNames names extDecode l = runParseASN1 (ExtSubjectAltName <$> parseGeneralNames) l@@ -233,24 +247,24 @@ -- | Provide a mean to identify the public key corresponding to the private key -- used to signed a certificate. data ExtAuthorityKeyId = ExtAuthorityKeyId B.ByteString- deriving (Show,Eq)+ deriving (Show, Eq) instance Extension ExtAuthorityKeyId where- extOID _ = [2,5,29,35]+ extOID _ = [2, 5, 29, 35] extHasNestedASN1 = const True extEncode (ExtAuthorityKeyId keyid) =- [Start Sequence,Other Context 0 keyid,End Sequence]- extDecode [Start Sequence,Other Context 0 keyid,End Sequence] =+ [Start Sequence, Other Context 0 keyid, End Sequence]+ extDecode [Start Sequence, Other Context 0 keyid, End Sequence] = Right $ ExtAuthorityKeyId keyid extDecode _ = Left "unknown sequence" -- | Identify how CRL information is obtained data ExtCrlDistributionPoints = ExtCrlDistributionPoints [DistributionPoint]- deriving (Show,Eq)+ deriving (Show, Eq) -- | Reason flag for the CRL-data ReasonFlag =- Reason_Unused+data ReasonFlag+ = Reason_Unused | Reason_KeyCompromise | Reason_CACompromise | Reason_AffiliationChanged@@ -259,90 +273,109 @@ | Reason_CertificateHold | Reason_PrivilegeWithdrawn | Reason_AACompromise- deriving (Show,Eq,Ord,Enum)+ deriving (Show, Eq, Ord, Enum) -- | Distribution point as either some GeneralNames or a DN-data DistributionPoint =- DistributionPointFullName [AltName]+data DistributionPoint+ = DistributionPointFullName [AltName] | DistributionNameRelative DistinguishedName- deriving (Show,Eq)+ deriving (Show, Eq) instance Extension ExtCrlDistributionPoints where- extOID _ = [2,5,29,31]+ extOID _ = [2, 5, 29, 31] extHasNestedASN1 = const True extEncode = error "extEncode ExtCrlDistributionPoints unimplemented" extDecode = error "extDecode ExtCrlDistributionPoints unimplemented"- --extEncode (ExtCrlDistributionPoints ) +-- extEncode (ExtCrlDistributionPoints )+ parseGeneralNames :: ParseASN1 [AltName] parseGeneralNames = onNextContainer Sequence $ getMany getAddr where- getAddr = do- m <- onNextContainerMaybe (Container Context 0) getComposedAddr- case m of- Nothing -> getSimpleAddr- Just r -> return r- getComposedAddr = do- n <- getNext- case n of- OID [1,3,6,1,5,5,7,8,5] -> do -- xmpp addr- c <- getNextContainerMaybe (Container Context 0)- case c of- Just [ASN1String cs] ->- case asn1CharacterToString cs of- Nothing -> throwParseError ("GeneralNames: invalid string for XMPP Addr")- Just s -> return $ AltNameXMPP s- _ -> throwParseError ("GeneralNames: expecting string for XMPP Addr got: " ++ show c)- OID [1,3,6,1,5,5,7,8,7] -> do -- DNSSRV addr- c <- getNextContainerMaybe (Container Context 0)- case c of- Just [ASN1String cs] ->- case asn1CharacterToString cs of- Nothing -> throwParseError ("GeneralNames: invalid string for DNSSrv Addr")- Just s -> return $ AltNameDNSSRV s- _ -> throwParseError ("GeneralNames: expecting string for DNSSRV Addr got: " ++ show c)- OID unknown -> throwParseError ("GeneralNames: unknown OID " ++ show unknown)- _ -> throwParseError ("GeneralNames: expecting OID but got " ++ show n)+ getAddr = do+ m <- onNextContainerMaybe (Container Context 0) getComposedAddr+ case m of+ Nothing -> getSimpleAddr+ Just r -> return r+ getComposedAddr = do+ n <- getNext+ case n of+ OID [1, 3, 6, 1, 5, 5, 7, 8, 5] -> do+ -- xmpp addr+ c <- getNextContainerMaybe (Container Context 0)+ case c of+ Just [ASN1String cs] ->+ case asn1CharacterToString cs of+ Nothing -> throwParseError ("GeneralNames: invalid string for XMPP Addr")+ Just s -> return $ AltNameXMPP s+ _ ->+ throwParseError ("GeneralNames: expecting string for XMPP Addr got: " ++ show c)+ OID [1, 3, 6, 1, 5, 5, 7, 8, 7] -> do+ -- DNSSRV addr+ c <- getNextContainerMaybe (Container Context 0)+ case c of+ Just [ASN1String cs] ->+ case asn1CharacterToString cs of+ Nothing -> throwParseError ("GeneralNames: invalid string for DNSSrv Addr")+ Just s -> return $ AltNameDNSSRV s+ _ ->+ throwParseError+ ("GeneralNames: expecting string for DNSSRV Addr got: " ++ show c)+ OID unknown -> throwParseError ("GeneralNames: unknown OID " ++ show unknown)+ _ -> throwParseError ("GeneralNames: expecting OID but got " ++ show n) - getSimpleAddr = do- n <- getNext- case n of- (Other Context 1 b) -> return $ AltNameRFC822 $ BC.unpack b- (Other Context 2 b) -> return $ AltNameDNS $ BC.unpack b- (Other Context 6 b) -> return $ AltNameURI $ BC.unpack b- (Other Context 7 b) -> return $ AltNameIP b- _ -> throwParseError ("GeneralNames: not coping with unknown stream " ++ show n)+ getSimpleAddr = do+ n <- getNext+ case n of+ (Other Context 1 b) -> return $ AltNameRFC822 $ BC.unpack b+ (Other Context 2 b) -> return $ AltNameDNS $ BC.unpack b+ (Other Context 6 b) -> return $ AltNameURI $ BC.unpack b+ (Other Context 7 b) -> return $ AltNameIP b+ _ ->+ throwParseError ("GeneralNames: not coping with unknown stream " ++ show n) encodeGeneralNames :: [AltName] -> [ASN1] encodeGeneralNames names = [Start Sequence]- ++ concatMap encodeAltName names- ++ [End Sequence]- where encodeAltName (AltNameRFC822 n) = [Other Context 1 $ BC.pack n]- encodeAltName (AltNameDNS n) = [Other Context 2 $ BC.pack n]- encodeAltName (AltNameURI n) = [Other Context 6 $ BC.pack n]- encodeAltName (AltNameIP n) = [Other Context 7 $ n]- encodeAltName (AltNameXMPP n) = [Start (Container Context 0),OID[1,3,6,1,5,5,7,8,5]- ,Start (Container Context 0), ASN1String $ asn1CharacterString UTF8 n, End (Container Context 0)- ,End (Container Context 0)]- encodeAltName (AltNameDNSSRV n) = [Start (Container Context 0),OID[1,3,6,1,5,5,7,8,5]- ,Start (Container Context 0), ASN1String $ asn1CharacterString UTF8 n, End (Container Context 0)- ,End (Container Context 0)]+ ++ concatMap encodeAltName names+ ++ [End Sequence]+ where+ encodeAltName (AltNameRFC822 n) = [Other Context 1 $ BC.pack n]+ encodeAltName (AltNameDNS n) = [Other Context 2 $ BC.pack n]+ encodeAltName (AltNameURI n) = [Other Context 6 $ BC.pack n]+ encodeAltName (AltNameIP n) = [Other Context 7 $ n]+ encodeAltName (AltNameXMPP n) =+ [ Start (Container Context 0)+ , OID [1, 3, 6, 1, 5, 5, 7, 8, 5]+ , Start (Container Context 0)+ , ASN1String $ asn1CharacterString UTF8 n+ , End (Container Context 0)+ , End (Container Context 0)+ ]+ encodeAltName (AltNameDNSSRV n) =+ [ Start (Container Context 0)+ , OID [1, 3, 6, 1, 5, 5, 7, 8, 5]+ , Start (Container Context 0)+ , ASN1String $ asn1CharacterString UTF8 n+ , End (Container Context 0)+ , End (Container Context 0)+ ] bitsToFlags :: Enum a => BitArray -> [a]-bitsToFlags bits = concat $ flip map [0..(bitArrayLength bits-1)] $ \i -> do- let isSet = bitArrayGetBit bits i- if isSet then [toEnum $ fromIntegral i] else []+bitsToFlags bits = concat $ flip map [0 .. (bitArrayLength bits - 1)] $ \i -> do+ let isSet = bitArrayGetBit bits i+ if isSet then [toEnum $ fromIntegral i] else [] flagsToBits :: Enum a => [a] -> BitArray flagsToBits flags = foldl bitArraySetBit bitArrayEmpty $ map (fromIntegral . fromEnum) flags- where bitArrayEmpty = toBitArray (B.pack [0,0]) 7+ where+ bitArrayEmpty = toBitArray (B.pack [0, 0]) 7 data ExtNetscapeComment = ExtNetscapeComment B.ByteString- deriving (Show,Eq)+ deriving (Show, Eq) instance Extension ExtNetscapeComment where- extOID _ = [2,16,840,1,113730,1,13]+ extOID _ = [2, 16, 840, 1, 113730, 1, 13] extHasNestedASN1 = const False extEncode = error "Extension: Netscape Comment do not contain nested ASN1" extDecode = error "Extension: Netscape Comment do not contain nested ASN1"
Data/X509/ExtensionRaw.hs view
@@ -6,33 +6,41 @@ -- Portability : unknown -- -- extension marshalling----module Data.X509.ExtensionRaw- ( ExtensionRaw(..)- , tryExtRawASN1- , extRawASN1- , Extensions(..)- ) where+module Data.X509.ExtensionRaw (+ ExtensionRaw (..),+ tryExtRawASN1,+ extRawASN1,+ Extensions (..),+) where import Control.Applicative-import Data.ASN1.Types-import Data.ASN1.Encoding import Data.ASN1.BinaryEncoding-import Data.X509.Internal+import Data.ASN1.Encoding+import Data.ASN1.Types import qualified Data.ByteString as B+import Data.X509.Internal -- | An undecoded extension data ExtensionRaw = ExtensionRaw- { extRawOID :: OID -- ^ OID of this extension- , extRawCritical :: Bool -- ^ if this extension is critical- , extRawContent :: B.ByteString -- ^ undecoded content- } deriving (Show,Eq)+ { extRawOID :: OID+ -- ^ OID of this extension+ , extRawCritical :: Bool+ -- ^ if this extension is critical+ , extRawContent :: B.ByteString+ -- ^ undecoded content+ }+ deriving (Show, Eq) tryExtRawASN1 :: ExtensionRaw -> Either String [ASN1] tryExtRawASN1 (ExtensionRaw oid _ content) = case decodeASN1' BER content of- Left err -> Left $ "fromASN1: X509.ExtensionRaw: OID=" ++ show oid ++ ": cannot decode data: " ++ show err- Right r -> Right r+ Left err ->+ Left $+ "fromASN1: X509.ExtensionRaw: OID="+ ++ show oid+ ++ ": cannot decode data: "+ ++ show err+ Right r -> Right r extRawASN1 :: ExtensionRaw -> [ASN1] extRawASN1 extRaw = either error id $ tryExtRawASN1 extRaw@@ -40,25 +48,29 @@ -- | a Set of 'ExtensionRaw' newtype Extensions = Extensions (Maybe [ExtensionRaw])- deriving (Show,Eq)+ deriving (Show, Eq) instance ASN1Object Extensions where toASN1 (Extensions Nothing) = \xs -> xs toASN1 (Extensions (Just exts)) = \xs -> asn1Container Sequence (concatMap encodeExt exts) ++ xs fromASN1 s = runParseASN1State (Extensions <$> parseExtensions) s- where parseExtensions = onNextContainerMaybe Sequence (getMany getObject)+ where+ parseExtensions = onNextContainerMaybe Sequence (getMany getObject) instance ASN1Object ExtensionRaw where toASN1 extraw = \xs -> encodeExt extraw ++ xs- fromASN1 (Start Sequence:OID oid:xs) =+ fromASN1 (Start Sequence : OID oid : xs) = case xs of- Boolean b:OctetString obj:End Sequence:xs2 -> Right (ExtensionRaw oid b obj, xs2)- OctetString obj:End Sequence:xs2 -> Right (ExtensionRaw oid False obj, xs2)- _ -> Left ("fromASN1: X509.ExtensionRaw: unknown format:" ++ show xs)- fromASN1 l =+ Boolean b : OctetString obj : End Sequence : xs2 -> Right (ExtensionRaw oid b obj, xs2)+ OctetString obj : End Sequence : xs2 -> Right (ExtensionRaw oid False obj, xs2)+ _ ->+ Left ("fromASN1: X509.ExtensionRaw: unknown format:" ++ show xs)+ fromASN1 l = Left ("fromASN1: X509.ExtensionRaw: unknown format:" ++ show l) encodeExt :: ExtensionRaw -> [ASN1] encodeExt (ExtensionRaw oid critical content) =- asn1Container Sequence ([OID oid] ++ (if critical then [Boolean True] else []) ++ [OctetString content])+ asn1Container+ Sequence+ ([OID oid] ++ (if critical then [Boolean True] else []) ++ [OctetString content])
Data/X509/Internal.hs view
@@ -4,19 +4,19 @@ -- Maintainer : Vincent Hanquez <vincent@snarc.org> -- Stability : experimental -- Portability : unknown----module Data.X509.Internal- ( module Data.ASN1.Parse- , asn1Container- , OID+module Data.X509.Internal (+ module Data.ASN1.Parse,+ asn1Container,+ OID,+ -- * error handling- , ErrT- , runErrT- ) where+ ErrT,+ runErrT,+) where -import Data.ASN1.Types-import Data.ASN1.Parse import Control.Monad.Trans.Except+import Data.ASN1.Parse+import Data.ASN1.Types runErrT :: ExceptT e m a -> m (Either e a) runErrT = runExceptT
Data/X509/OID.hs view
@@ -4,20 +4,19 @@ -- Maintainer : Vincent Hanquez <vincent@snarc.org> -- Stability : experimental -- Portability : unknown----module Data.X509.OID- ( OIDTable- , lookupByOID- , lookupOID- , curvesOIDTable- ) where+module Data.X509.OID (+ OIDTable,+ lookupByOID,+ lookupOID,+ curvesOIDTable,+) where import Control.Applicative import Crypto.PubKey.ECC.Types import Data.ASN1.OID import Data.List (find) -type OIDTable a = [(a,OID)]+type OIDTable a = [(a, OID)] lookupByOID :: OIDTable a -> OID -> Maybe a lookupByOID table oid = fst <$> find ((==) oid . snd) table@@ -27,37 +26,37 @@ curvesOIDTable :: OIDTable CurveName curvesOIDTable =- [ (SEC_p112r1, [1,3,132,0,6])- , (SEC_p112r2, [1,3,132,0,7])- , (SEC_p128r1, [1,3,132,0,28])- , (SEC_p128r2, [1,3,132,0,29])- , (SEC_p160k1, [1,3,132,0,9])- , (SEC_p160r1, [1,3,132,0,8])- , (SEC_p160r2, [1,3,132,0,30])- , (SEC_p192k1, [1,3,132,0,31])- , (SEC_p192r1, [1,2,840,10045,3,1,1])- , (SEC_p224k1, [1,3,132,0,32])- , (SEC_p224r1, [1,3,132,0,33])- , (SEC_p256k1, [1,3,132,0,10])- , (SEC_p256r1, [1,2,840,10045,3,1,7])- , (SEC_p384r1, [1,3,132,0,34])- , (SEC_p521r1, [1,3,132,0,35])- , (SEC_t113r1, [1,3,132,0,4])- , (SEC_t113r2, [1,3,132,0,5])- , (SEC_t131r1, [1,3,132,0,22])- , (SEC_t131r2, [1,3,132,0,23])- , (SEC_t163k1, [1,3,132,0,1])- , (SEC_t163r1, [1,3,132,0,2])- , (SEC_t163r2, [1,3,132,0,15])- , (SEC_t193r1, [1,3,132,0,24])- , (SEC_t193r2, [1,3,132,0,25])- , (SEC_t233k1, [1,3,132,0,26])- , (SEC_t233r1, [1,3,132,0,27])- , (SEC_t239k1, [1,3,132,0,3])- , (SEC_t283k1, [1,3,132,0,16])- , (SEC_t283r1, [1,3,132,0,17])- , (SEC_t409k1, [1,3,132,0,36])- , (SEC_t409r1, [1,3,132,0,37])- , (SEC_t571k1, [1,3,132,0,38])- , (SEC_t571r1, [1,3,132,0,39])+ [ (SEC_p112r1, [1, 3, 132, 0, 6])+ , (SEC_p112r2, [1, 3, 132, 0, 7])+ , (SEC_p128r1, [1, 3, 132, 0, 28])+ , (SEC_p128r2, [1, 3, 132, 0, 29])+ , (SEC_p160k1, [1, 3, 132, 0, 9])+ , (SEC_p160r1, [1, 3, 132, 0, 8])+ , (SEC_p160r2, [1, 3, 132, 0, 30])+ , (SEC_p192k1, [1, 3, 132, 0, 31])+ , (SEC_p192r1, [1, 2, 840, 10045, 3, 1, 1])+ , (SEC_p224k1, [1, 3, 132, 0, 32])+ , (SEC_p224r1, [1, 3, 132, 0, 33])+ , (SEC_p256k1, [1, 3, 132, 0, 10])+ , (SEC_p256r1, [1, 2, 840, 10045, 3, 1, 7])+ , (SEC_p384r1, [1, 3, 132, 0, 34])+ , (SEC_p521r1, [1, 3, 132, 0, 35])+ , (SEC_t113r1, [1, 3, 132, 0, 4])+ , (SEC_t113r2, [1, 3, 132, 0, 5])+ , (SEC_t131r1, [1, 3, 132, 0, 22])+ , (SEC_t131r2, [1, 3, 132, 0, 23])+ , (SEC_t163k1, [1, 3, 132, 0, 1])+ , (SEC_t163r1, [1, 3, 132, 0, 2])+ , (SEC_t163r2, [1, 3, 132, 0, 15])+ , (SEC_t193r1, [1, 3, 132, 0, 24])+ , (SEC_t193r2, [1, 3, 132, 0, 25])+ , (SEC_t233k1, [1, 3, 132, 0, 26])+ , (SEC_t233r1, [1, 3, 132, 0, 27])+ , (SEC_t239k1, [1, 3, 132, 0, 3])+ , (SEC_t283k1, [1, 3, 132, 0, 16])+ , (SEC_t283r1, [1, 3, 132, 0, 17])+ , (SEC_t409k1, [1, 3, 132, 0, 36])+ , (SEC_t409r1, [1, 3, 132, 0, 37])+ , (SEC_t571k1, [1, 3, 132, 0, 38])+ , (SEC_t571r1, [1, 3, 132, 0, 39]) ]
Data/X509/PrivateKey.hs view
@@ -6,70 +6,76 @@ -- Portability : unknown -- -- Private key handling in X.509 infrastructure----module Data.X509.PrivateKey- ( PrivKey(..)- , PrivKeyEC(..)- , privkeyToAlg- ) where+module Data.X509.PrivateKey (+ PrivKey (..),+ PrivKeyEC (..),+ privkeyToAlg,+) where -import Control.Applicative ((<$>), pure)+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.Encoding import Data.ASN1.Stream (getConstructedEnd)+import Data.ASN1.Types import Data.X509.AlgorithmIdentifier-import Data.X509.PublicKey (SerializedPoint(..))-import Data.X509.OID (lookupByOID, lookupOID, curvesOIDTable)+import Data.X509.OID (curvesOIDTable, lookupByOID, lookupOID)+import Data.X509.PublicKey (SerializedPoint (..)) -import Crypto.Error (CryptoFailable(..))+import Crypto.Error (CryptoFailable (..)) import Crypto.Number.Serialize (i2osp, os2ip)-import qualified Crypto.PubKey.RSA as RSA+import qualified Crypto.PubKey.Curve25519 as X25519+import qualified Crypto.PubKey.Curve448 as X448 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+import qualified Crypto.PubKey.Ed25519 as Ed25519+import qualified Crypto.PubKey.Ed448 as Ed448+import qualified Crypto.PubKey.RSA as RSA -- | Elliptic Curve Private Key -- -- TODO: missing support for binary curve.-data PrivKeyEC =- PrivKeyEC_Prime- { privkeyEC_priv :: Integer- , privkeyEC_a :: Integer- , privkeyEC_b :: Integer- , privkeyEC_prime :: Integer+data PrivKeyEC+ = PrivKeyEC_Prime+ { privkeyEC_priv :: Integer+ , privkeyEC_a :: Integer+ , privkeyEC_b :: Integer+ , privkeyEC_prime :: Integer , privkeyEC_generator :: SerializedPoint- , privkeyEC_order :: Integer- , privkeyEC_cofactor :: Integer- , privkeyEC_seed :: Integer+ , privkeyEC_order :: Integer+ , privkeyEC_cofactor :: Integer+ , privkeyEC_seed :: Integer } | PrivKeyEC_Named- { privkeyEC_name :: ECC.CurveName- , privkeyEC_priv :: Integer+ { privkeyEC_name :: ECC.CurveName+ , privkeyEC_priv :: Integer }- deriving (Show,Eq)+ deriving (Show, 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 (Show,Eq)+data PrivKey+ = -- | RSA private key+ PrivKeyRSA RSA.PrivateKey+ | -- | DSA private key+ PrivKeyDSA DSA.PrivateKey+ | -- | EC private key+ PrivKeyEC PrivKeyEC+ | -- | X25519 private key+ PrivKeyX25519 X25519.SecretKey+ | -- | X448 private key+ PrivKeyX448 X448.SecretKey+ | -- | Ed25519 private key+ PrivKeyEd25519 Ed25519.SecretKey+ | -- | Ed448 private key+ PrivKeyEd448 Ed448.SecretKey+ deriving (Show, Eq) instance ASN1Object PrivKey where fromASN1 = privkeyFromASN1@@ -77,42 +83,69 @@ privkeyFromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1]) privkeyFromASN1 asn1 =- (mapFst PrivKeyRSA <$> rsaFromASN1 asn1) <!>- (mapFst PrivKeyDSA <$> dsaFromASN1 asn1) <!>- (mapFst PrivKeyEC <$> ecdsaFromASN1 asn1) <!>- newcurveFromASN1 asn1+ (mapFst PrivKeyRSA <$> rsaFromASN1 asn1)+ <!> (mapFst PrivKeyDSA <$> dsaFromASN1 asn1)+ <!> (mapFst PrivKeyEC <$> ecdsaFromASN1 asn1)+ <!> newcurveFromASN1 asn1 where mapFst f (a, b) = (f a, b) Left _ <!> b = b- a <!> _ = a+ 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+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+ 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) =+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+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@@ -137,28 +170,43 @@ 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 : _) =+ 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+ 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+ 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+ where+ (oid, rest') = spanEnd 0 rest go _ _ = Left $ failing "unexpected EC format" spanEnd :: Word -> [ASN1] -> ([ASN1], [ASN1])@@ -175,93 +223,135 @@ spanTag _ as = ([], as) newcurveFromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1])-newcurveFromASN1 ( Start Sequence- : IntVal v- : Start Sequence- : OID oid- : End Sequence- : OctetString bs- : xs)- | isValidVersion v = do- let (_, ys) = containerWithTag 0 xs- case primitiveWithTag 1 ys of- (_, End Sequence : zs) ->- case getP oid of- Just (name, parse) -> do- let err s = Left (name ++ ".SecretKey.fromASN1: " ++ s)- case decodeASN1' BER bs of- Right [OctetString key] ->- case parse key of- CryptoPassed s -> Right (s, zs)- CryptoFailed e -> err ("invalid secret key: " ++ show e)- Right _ -> err "unexpected inner format"- Left e -> err (show e)- Nothing -> Left ("newcurveFromASN1: unexpected OID " ++ show oid)- _ -> Left "newcurveFromASN1: unexpected end format"- | otherwise = Left ("newcurveFromASN1: unexpected version: " ++ show v)- where- getP [1,3,101,110] = Just ("X25519", fmap PrivKeyX25519 . X25519.secretKey)- getP [1,3,101,111] = Just ("X448", fmap PrivKeyX448 . X448.secretKey)- getP [1,3,101,112] = Just ("Ed25519", fmap PrivKeyEd25519 . Ed25519.secretKey)- getP [1,3,101,113] = Just ("Ed448", fmap PrivKeyEd448 . Ed448.secretKey)- getP _ = Nothing- isValidVersion version = version >= 0 && version <= 1+newcurveFromASN1+ ( Start Sequence+ : IntVal v+ : Start Sequence+ : OID oid+ : End Sequence+ : OctetString bs+ : xs+ )+ | isValidVersion v = do+ let (_, ys) = containerWithTag 0 xs+ case primitiveWithTag 1 ys of+ (_, End Sequence : zs) ->+ case getP oid of+ Just (name, parse) -> do+ let err s = Left (name ++ ".SecretKey.fromASN1: " ++ s)+ case decodeASN1' BER bs of+ Right [OctetString key] ->+ case parse key of+ CryptoPassed s -> Right (s, zs)+ CryptoFailed e -> err ("invalid secret key: " ++ show e)+ Right _ -> err "unexpected inner format"+ Left e -> err (show e)+ Nothing -> Left ("newcurveFromASN1: unexpected OID " ++ show oid)+ _ -> Left "newcurveFromASN1: unexpected end format"+ | otherwise = Left ("newcurveFromASN1: unexpected version: " ++ show v)+ where+ getP [1, 3, 101, 110] = Just ("X25519", fmap PrivKeyX25519 . X25519.secretKey)+ getP [1, 3, 101, 111] = Just ("X448", fmap PrivKeyX448 . X448.secretKey)+ getP [1, 3, 101, 112] = Just ("Ed25519", fmap PrivKeyEd25519 . Ed25519.secretKey)+ getP [1, 3, 101, 113] = Just ("Ed448", fmap PrivKeyEd448 . Ed448.secretKey)+ getP _ = Nothing+ isValidVersion version = version >= 0 && version <= 1 newcurveFromASN1 _ = Left "newcurveFromASN1: unexpected format" containerWithTag :: ASN1Tag -> [ASN1] -> ([ASN1], [ASN1]) containerWithTag etag (Start (Container _ atag) : xs) | etag == atag = getConstructedEnd 0 xs-containerWithTag _ xs = ([], xs)+containerWithTag _ xs = ([], xs) primitiveWithTag :: ASN1Tag -> [ASN1] -> (Maybe B.ByteString, [ASN1]) primitiveWithTag etag (Other _ atag bs : xs) | etag == atag = (Just bs, xs)-primitiveWithTag _ xs = (Nothing, xs)+primitiveWithTag _ xs = (Nothing, xs) privkeyToASN1 :: PrivKey -> ASN1S privkeyToASN1 (PrivKeyRSA rsa) = rsaToASN1 rsa privkeyToASN1 (PrivKeyDSA dsa) = dsaToASN1 dsa privkeyToASN1 (PrivKeyEC ecdsa) = ecdsaToASN1 ecdsa-privkeyToASN1 (PrivKeyX25519 k) = newcurveToASN1 [1,3,101,110] k-privkeyToASN1 (PrivKeyX448 k) = newcurveToASN1 [1,3,101,111] k-privkeyToASN1 (PrivKeyEd25519 k) = newcurveToASN1 [1,3,101,112] k-privkeyToASN1 (PrivKeyEd448 k) = newcurveToASN1 [1,3,101,113] k+privkeyToASN1 (PrivKeyX25519 k) = newcurveToASN1 [1, 3, 101, 110] k+privkeyToASN1 (PrivKeyX448 k) = newcurveToASN1 [1, 3, 101, 111] k+privkeyToASN1 (PrivKeyEd25519 k) = newcurveToASN1 [1, 3, 101, 112] k+privkeyToASN1 (PrivKeyEd448 k) = newcurveToASN1 [1, 3, 101, 113] k 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- ]+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- ]+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- ]+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 err = error . ("ECDSA.PrivateKey.toASN1: " ++)- oid = fromMaybe (err $ "missing named curve " ++ show curveName)- (lookupOID curvesOIDTable curveName)-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- ]+ oid =+ fromMaybe+ (err $ "missing named curve " ++ show curveName)+ (lookupOID curvesOIDTable curveName)+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@@ -271,11 +361,16 @@ bytes = i2osp s newcurveToASN1 :: ByteArrayAccess key => OID -> key -> ASN1S-newcurveToASN1 oid key = (++)- [ Start Sequence, IntVal 0, Start Sequence, OID oid, End Sequence- , OctetString (encodeASN1' DER [OctetString $ convert key])- , End Sequence- ]+newcurveToASN1 oid key =+ (++)+ [ Start Sequence+ , IntVal 0+ , Start Sequence+ , OID oid+ , End Sequence+ , OctetString (encodeASN1' DER [OctetString $ convert key])+ , End Sequence+ ] mapLeft :: (a0 -> a1) -> Either a0 b -> Either a1 b mapLeft f (Left x) = Left (f x)@@ -283,10 +378,10 @@ -- | 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-privkeyToAlg (PrivKeyX25519 _) = PubKeyALG_X25519-privkeyToAlg (PrivKeyX448 _) = PubKeyALG_X448-privkeyToAlg (PrivKeyEd25519 _) = PubKeyALG_Ed25519-privkeyToAlg (PrivKeyEd448 _) = PubKeyALG_Ed448+privkeyToAlg (PrivKeyRSA _) = PubKeyALG_RSA+privkeyToAlg (PrivKeyDSA _) = PubKeyALG_DSA+privkeyToAlg (PrivKeyEC _) = PubKeyALG_EC+privkeyToAlg (PrivKeyX25519 _) = PubKeyALG_X25519+privkeyToAlg (PrivKeyX448 _) = PubKeyALG_X448+privkeyToAlg (PrivKeyEd25519 _) = PubKeyALG_Ed25519+privkeyToAlg (PrivKeyEd448 _) = PubKeyALG_Ed448
Data/X509/PublicKey.hs view
@@ -6,78 +6,85 @@ -- Portability : unknown -- -- Public key handling in X.509 infrastructure----module Data.X509.PublicKey- ( PubKey(..)- , PubKeyEC(..)- , SerializedPoint(..)- , pubkeyToAlg- ) where+module Data.X509.PublicKey (+ PubKey (..),+ PubKeyEC (..),+ SerializedPoint (..),+ pubkeyToAlg,+) where -import Data.ASN1.Types-import Data.ASN1.Encoding import Data.ASN1.BinaryEncoding import Data.ASN1.BitArray+import Data.ASN1.Encoding+import Data.ASN1.Types import Data.Bits import Data.ByteArray (convert) import Data.ByteString (ByteString) +import Data.X509.AlgorithmIdentifier import Data.X509.Internal import Data.X509.OID-import Data.X509.AlgorithmIdentifier -import Crypto.Error (CryptoFailable(..))-import qualified Crypto.PubKey.RSA.Types as RSA-import qualified Crypto.PubKey.DSA as DSA-import qualified Crypto.PubKey.ECC.Types as ECC+import Crypto.Error (CryptoFailable (..))+import Crypto.Number.Basic (numBytes)+import Crypto.Number.Serialize (os2ip) 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-import Crypto.Number.Basic (numBytes)-import Crypto.Number.Serialize (os2ip)+import qualified Crypto.PubKey.Curve448 as X448+import qualified Crypto.PubKey.DSA as DSA+import qualified Crypto.PubKey.ECC.Types as ECC+import qualified Crypto.PubKey.Ed25519 as Ed25519+import qualified Crypto.PubKey.Ed448 as Ed448+import qualified Crypto.PubKey.RSA.Types as RSA import Data.Word import qualified Data.ByteString as B -- | Serialized Elliptic Curve Point newtype SerializedPoint = SerializedPoint ByteString- deriving (Show,Eq)+ deriving (Show, Eq) -- | Elliptic Curve Public Key -- -- TODO: missing support for binary curve.-data PubKeyEC =- PubKeyEC_Prime- { pubkeyEC_pub :: SerializedPoint- , pubkeyEC_a :: Integer- , pubkeyEC_b :: Integer- , pubkeyEC_prime :: Integer+data PubKeyEC+ = PubKeyEC_Prime+ { pubkeyEC_pub :: SerializedPoint+ , pubkeyEC_a :: Integer+ , pubkeyEC_b :: Integer+ , pubkeyEC_prime :: Integer , pubkeyEC_generator :: SerializedPoint- , pubkeyEC_order :: Integer- , pubkeyEC_cofactor :: Integer- , pubkeyEC_seed :: Integer+ , pubkeyEC_order :: Integer+ , pubkeyEC_cofactor :: Integer+ , pubkeyEC_seed :: Integer } | PubKeyEC_Named- { pubkeyEC_name :: ECC.CurveName- , pubkeyEC_pub :: SerializedPoint+ { pubkeyEC_name :: ECC.CurveName+ , pubkeyEC_pub :: SerializedPoint }- deriving (Show,Eq)+ deriving (Show, Eq) -- | Public key types known and used in X.509-data PubKey =- PubKeyRSA RSA.PublicKey -- ^ RSA public key- | PubKeyDSA DSA.PublicKey -- ^ DSA public key- | PubKeyDH (Integer,Integer,Integer,Maybe Integer,([Word8], Integer))- -- ^ DH format with (p,g,q,j,(seed,pgenCounter))- | PubKeyEC PubKeyEC -- ^ EC public key- | PubKeyX25519 X25519.PublicKey -- ^ X25519 public key- | PubKeyX448 X448.PublicKey -- ^ X448 public key- | PubKeyEd25519 Ed25519.PublicKey -- ^ Ed25519 public key- | PubKeyEd448 Ed448.PublicKey -- ^ Ed448 public key- | PubKeyUnknown OID B.ByteString -- ^ unrecognized format- deriving (Show,Eq)+data PubKey+ = -- | RSA public key+ PubKeyRSA RSA.PublicKey+ | -- | DSA public key+ PubKeyDSA DSA.PublicKey+ | -- | DH format with (p,g,q,j,(seed,pgenCounter))+ PubKeyDH (Integer, Integer, Integer, Maybe Integer, ([Word8], Integer))+ | -- | EC public key+ PubKeyEC PubKeyEC+ | -- | X25519 public key+ PubKeyX25519 X25519.PublicKey+ | -- | X448 public key+ PubKeyX448 X448.PublicKey+ | -- | Ed25519 public key+ PubKeyEd25519 Ed25519.PublicKey+ | -- | Ed448 public key+ PubKeyEd448 Ed448.PublicKey+ | -- | unrecognized format+ PubKeyUnknown OID B.ByteString+ deriving (Show, Eq) -- Public key are in the format: --@@ -87,109 +94,133 @@ -- BitString -- End Sequence instance ASN1Object PubKey where- fromASN1 (Start Sequence:Start Sequence:OID pkalg:xs)+ fromASN1 (Start Sequence : Start Sequence : OID pkalg : xs) | pkalg == getObjectID PubKeyALG_RSA = case removeNull xs of- End Sequence:BitString bits:End Sequence:xs2 -> decodeASN1Err "RSA" bits xs2 (toPubKeyRSA . rsaPubFromASN1)+ End Sequence : BitString bits : End Sequence : xs2 -> decodeASN1Err "RSA" bits xs2 (toPubKeyRSA . rsaPubFromASN1) _ -> Left ("fromASN1: X509.PubKey: unknown RSA format: " ++ show xs)- | pkalg == getObjectID PubKeyALG_DSA =+ | pkalg == getObjectID PubKeyALG_DSA = case xs of- Start Sequence:IntVal p:IntVal q:IntVal g:End Sequence:End Sequence:BitString bits:End Sequence:xs2 ->- decodeASN1Err "DSA" bits xs2 (\l -> case l of- [IntVal dsapub] ->- let pubkey = DSA.PublicKey { DSA.public_params = DSA.Params { DSA.params_p = p- , DSA.params_q = q- , DSA.params_g = g- }- , DSA.public_y = dsapub }- in Right (PubKeyDSA pubkey, [])- _ -> Left "fromASN1: X509.PubKey: unknown DSA format"- )+ Start Sequence : IntVal p : IntVal q : IntVal g : End Sequence : End Sequence+ : BitString bits+ : End Sequence+ : xs2 ->+ decodeASN1Err+ "DSA"+ bits+ xs2+ ( \l -> case l of+ [IntVal dsapub] ->+ let pubkey =+ DSA.PublicKey+ { DSA.public_params =+ DSA.Params+ { DSA.params_p = p+ , DSA.params_q = q+ , DSA.params_g = g+ }+ , DSA.public_y = dsapub+ }+ in Right (PubKeyDSA pubkey, [])+ _ -> Left "fromASN1: X509.PubKey: unknown DSA format"+ ) _ -> Left "fromASN1: X509.PubKey: unknown DSA format" | pkalg == getObjectID PubKeyALG_EC = case xs of- OID curveOid:End Sequence:BitString bits:End Sequence:xs2 ->+ OID curveOid : End Sequence : BitString bits : End Sequence : xs2 -> case lookupByOID curvesOIDTable curveOid of Just curveName -> Right (PubKeyEC $ PubKeyEC_Named curveName (bitArrayToPoint bits), xs2)- Nothing -> Left ("fromASN1: X509.Pubkey: EC unknown curve " ++ show curveOid)+ Nothing -> Left ("fromASN1: X509.Pubkey: EC unknown curve " ++ show curveOid) Start Sequence- :IntVal 1- :Start Sequence- :OID [1,2,840,10045,1,1]- :IntVal prime- :End Sequence- :Start Sequence- :OctetString a- :OctetString b- :BitString seed- :End Sequence- :OctetString generator- :IntVal order- :IntVal cofactor- :End Sequence- :End Sequence- :BitString pub- :End Sequence- :xs2 ->- Right (PubKeyEC $ PubKeyEC_Prime- { pubkeyEC_pub = bitArrayToPoint pub- , pubkeyEC_a = os2ip a- , pubkeyEC_b = os2ip b- , pubkeyEC_prime = prime- , pubkeyEC_generator = SerializedPoint generator- , pubkeyEC_order = order- , pubkeyEC_cofactor = cofactor- , pubkeyEC_seed = os2ip $ bitArrayGetData seed- }, xs2)+ : IntVal 1+ : Start Sequence+ : OID [1, 2, 840, 10045, 1, 1]+ : IntVal prime+ : End Sequence+ : Start Sequence+ : OctetString a+ : OctetString b+ : BitString seed+ : End Sequence+ : OctetString generator+ : IntVal order+ : IntVal cofactor+ : End Sequence+ : End Sequence+ : BitString pub+ : End Sequence+ : xs2 ->+ Right+ ( PubKeyEC $+ PubKeyEC_Prime+ { pubkeyEC_pub = bitArrayToPoint pub+ , pubkeyEC_a = os2ip a+ , pubkeyEC_b = os2ip b+ , pubkeyEC_prime = prime+ , pubkeyEC_generator = SerializedPoint generator+ , pubkeyEC_order = order+ , pubkeyEC_cofactor = cofactor+ , pubkeyEC_seed = os2ip $ bitArrayGetData seed+ }+ , xs2+ ) _ -> Left $ "fromASN1: X509.PubKey: unknown EC format: " ++ show xs- | pkalg == getObjectID PubKeyALG_X25519 =+ | pkalg == getObjectID PubKeyALG_X25519 = case xs of- End Sequence:BitString bits:End Sequence:xs2 -> decodeCF "X25519" PubKeyX25519 bits xs2 X25519.publicKey+ End Sequence : BitString bits : End Sequence : xs2 -> decodeCF "X25519" PubKeyX25519 bits xs2 X25519.publicKey _ -> Left ("fromASN1: X509.PubKey: unknown X25519 format: " ++ show xs)- | pkalg == getObjectID PubKeyALG_X448 =+ | pkalg == getObjectID PubKeyALG_X448 = case xs of- End Sequence:BitString bits:End Sequence:xs2 -> decodeCF "X448" PubKeyX448 bits xs2 X448.publicKey+ End Sequence : BitString bits : End Sequence : xs2 -> decodeCF "X448" PubKeyX448 bits xs2 X448.publicKey _ -> Left ("fromASN1: X509.PubKey: unknown X448 format: " ++ show xs)- | pkalg == getObjectID PubKeyALG_Ed25519 =+ | pkalg == getObjectID PubKeyALG_Ed25519 = case xs of- End Sequence:BitString bits:End Sequence:xs2 -> decodeCF "Ed25519" PubKeyEd25519 bits xs2 Ed25519.publicKey+ End Sequence : BitString bits : End Sequence : xs2 -> decodeCF "Ed25519" PubKeyEd25519 bits xs2 Ed25519.publicKey _ -> Left ("fromASN1: X509.PubKey: unknown Ed25519 format: " ++ show xs)- | pkalg == getObjectID PubKeyALG_Ed448 =+ | pkalg == getObjectID PubKeyALG_Ed448 = case xs of- End Sequence:BitString bits:End Sequence:xs2 -> decodeCF "Ed448" PubKeyEd448 bits xs2 Ed448.publicKey+ End Sequence : BitString bits : End Sequence : xs2 -> decodeCF "Ed448" PubKeyEd448 bits xs2 Ed448.publicKey _ -> Left ("fromASN1: X509.PubKey: unknown Ed448 format: " ++ show xs) | otherwise = Left $ "fromASN1: unknown public key OID: " ++ show pkalg- where decodeASN1Err format bits xs2 f =- case decodeASN1' BER (bitArrayGetData bits) of- Left err -> Left ("fromASN1: X509.PubKey " ++ format ++ " bitarray cannot be parsed: " ++ show err)- Right s -> case f s of- Left err -> Left err- Right (r, xsinner) -> Right (r, xsinner ++ xs2)- toPubKeyRSA = either Left (\(rsaKey, r) -> Right (PubKeyRSA rsaKey, r))-- bitArrayToPoint = SerializedPoint . bitArrayGetData+ where+ decodeASN1Err format bits xs2 f =+ case decodeASN1' BER (bitArrayGetData bits) of+ Left err ->+ Left+ ("fromASN1: X509.PubKey " ++ format ++ " bitarray cannot be parsed: " ++ show err)+ Right s -> case f s of+ Left err -> Left err+ Right (r, xsinner) -> Right (r, xsinner ++ xs2)+ toPubKeyRSA = either Left (\(rsaKey, r) -> Right (PubKeyRSA rsaKey, r)) - removeNull (Null:r) = r- removeNull l = l+ bitArrayToPoint = SerializedPoint . bitArrayGetData - decodeCF format c bits xs2 f = case f (bitArrayGetData bits) of- CryptoPassed pk -> Right (c pk, xs2)- CryptoFailed err -> Left ("fromASN1: X509.PubKey " ++ format ++ " bitarray contains an invalid public key: " ++ show err)+ removeNull (Null : r) = r+ removeNull l = l + decodeCF format c bits xs2 f = case f (bitArrayGetData bits) of+ CryptoPassed pk -> Right (c pk, xs2)+ CryptoFailed err ->+ Left+ ( "fromASN1: X509.PubKey "+ ++ format+ ++ " bitarray contains an invalid public key: "+ ++ show err+ ) fromASN1 l = Left ("fromASN1: X509.PubKey: unknown format:" ++ show l) toASN1 a = \xs -> encodePK a ++ xs -- | Convert a Public key to the Public Key Algorithm type pubkeyToAlg :: PubKey -> PubKeyALG-pubkeyToAlg (PubKeyRSA _) = PubKeyALG_RSA-pubkeyToAlg (PubKeyDSA _) = PubKeyALG_DSA-pubkeyToAlg (PubKeyDH _) = PubKeyALG_DH-pubkeyToAlg (PubKeyEC _) = PubKeyALG_EC-pubkeyToAlg (PubKeyX25519 _) = PubKeyALG_X25519-pubkeyToAlg (PubKeyX448 _) = PubKeyALG_X448-pubkeyToAlg (PubKeyEd25519 _) = PubKeyALG_Ed25519-pubkeyToAlg (PubKeyEd448 _) = PubKeyALG_Ed448+pubkeyToAlg (PubKeyRSA _) = PubKeyALG_RSA+pubkeyToAlg (PubKeyDSA _) = PubKeyALG_DSA+pubkeyToAlg (PubKeyDH _) = PubKeyALG_DH+pubkeyToAlg (PubKeyEC _) = PubKeyALG_EC+pubkeyToAlg (PubKeyX25519 _) = PubKeyALG_X25519+pubkeyToAlg (PubKeyX448 _) = PubKeyALG_X448+pubkeyToAlg (PubKeyEd25519 _) = PubKeyALG_Ed25519+pubkeyToAlg (PubKeyEd448 _) = PubKeyALG_Ed448 pubkeyToAlg (PubKeyUnknown oid _) = PubKeyALG_Unknown oid encodePK :: PubKey -> [ASN1]@@ -197,68 +228,79 @@ where pkalg = OID $ getObjectID $ pubkeyToAlg key encodeInner (PubKeyRSA pubkey) =- asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray bits 0]- where bits = encodeASN1' DER $ rsaPubToASN1 pubkey []+ asn1Container Sequence [pkalg, Null] ++ [BitString $ toBitArray bits 0]+ where+ bits = encodeASN1' DER $ rsaPubToASN1 pubkey [] encodeInner (PubKeyDSA pubkey) = asn1Container Sequence ([pkalg] ++ dsaseq) ++ [BitString $ toBitArray bits 0] where- dsaseq = asn1Container Sequence [IntVal (DSA.params_p params)- ,IntVal (DSA.params_q params)- ,IntVal (DSA.params_g params)]+ dsaseq =+ asn1Container+ Sequence+ [ IntVal (DSA.params_p params)+ , IntVal (DSA.params_q params)+ , IntVal (DSA.params_g params)+ ] params = DSA.public_params pubkey- bits = encodeASN1' DER [IntVal $ DSA.public_y pubkey]+ bits = encodeASN1' DER [IntVal $ DSA.public_y pubkey] encodeInner (PubKeyEC (PubKeyEC_Named curveName (SerializedPoint bits))) =- asn1Container Sequence [pkalg,OID eOid] ++ [BitString $ toBitArray bits 0]+ asn1Container Sequence [pkalg, OID eOid] ++ [BitString $ toBitArray bits 0] where eOid = case lookupOID curvesOIDTable curveName of- Just oid -> oid- _ -> error ("undefined curve OID: " ++ show curveName)- encodeInner (PubKeyEC (PubKeyEC_Prime {})) =+ Just oid -> oid+ _ -> error ("undefined curve OID: " ++ show curveName)+ encodeInner (PubKeyEC (PubKeyEC_Prime{})) = error "encodeInner: unimplemented public key EC_Prime"- encodeInner (PubKeyX25519 pubkey) =+ encodeInner (PubKeyX25519 pubkey) = asn1Container Sequence [pkalg] ++ [BitString $ toBitArray (convert pubkey) 0]- encodeInner (PubKeyX448 pubkey) =+ encodeInner (PubKeyX448 pubkey) = asn1Container Sequence [pkalg] ++ [BitString $ toBitArray (convert pubkey) 0]- encodeInner (PubKeyEd25519 pubkey) =+ encodeInner (PubKeyEd25519 pubkey) = asn1Container Sequence [pkalg] ++ [BitString $ toBitArray (convert pubkey) 0]- encodeInner (PubKeyEd448 pubkey) =+ encodeInner (PubKeyEd448 pubkey) = asn1Container Sequence [pkalg] ++ [BitString $ toBitArray (convert pubkey) 0] encodeInner (PubKeyDH _) = error "encodeInner: unimplemented public key DH" encodeInner (PubKeyUnknown _ l) =- asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray l 0]+ asn1Container Sequence [pkalg, Null] ++ [BitString $ toBitArray l 0] rsaPubToASN1 :: RSA.PublicKey -> [ASN1] -> [ASN1] rsaPubToASN1 pubkey xs =- Start Sequence : IntVal (RSA.public_n pubkey) : IntVal (RSA.public_e pubkey) : End Sequence : xs+ Start Sequence+ : IntVal (RSA.public_n pubkey)+ : IntVal (RSA.public_e pubkey)+ : End Sequence+ : xs rsaPubFromASN1 :: [ASN1] -> Either String (RSA.PublicKey, [ASN1])-rsaPubFromASN1 (Start Sequence:IntVal smodulus:IntVal pubexp:End Sequence:xs) =+rsaPubFromASN1 (Start Sequence : IntVal smodulus : IntVal pubexp : End Sequence : xs) = Right (pub, xs) where- pub = RSA.PublicKey { RSA.public_size = numBytes modulus- , RSA.public_n = modulus- , RSA.public_e = pubexp- }+ pub =+ RSA.PublicKey+ { RSA.public_size = numBytes modulus+ , RSA.public_n = modulus+ , RSA.public_e = pubexp+ } -- some bad implementation will not serialize ASN.1 integer properly, leading -- to negative modulus. if that's the case, we correct it. modulus = toPositive smodulus--rsaPubFromASN1 ( Start Sequence- : IntVal ver- : Start Sequence- : OID oid- : Null- : End Sequence- : OctetString bs- : xs- )- | ver /= 0 = Left "rsaPubFromASN1: Invalid version, expecting 0"- | oid /= [1,2,840,113549,1,1,1] =- Left "rsaPubFromASN1: invalid OID"- | otherwise =- let inner = either strError rsaPubFromASN1 $ decodeASN1' BER bs- strError = Left . ("fromASN1: RSA.PublicKey: " ++) . show- in either Left (\(k, _) -> Right (k, xs)) inner+rsaPubFromASN1+ ( Start Sequence+ : IntVal ver+ : Start Sequence+ : OID oid+ : Null+ : End Sequence+ : OctetString bs+ : xs+ )+ | ver /= 0 = Left "rsaPubFromASN1: Invalid version, expecting 0"+ | oid /= [1, 2, 840, 113549, 1, 1, 1] =+ Left "rsaPubFromASN1: invalid OID"+ | otherwise =+ let inner = either strError rsaPubFromASN1 $ decodeASN1' BER bs+ strError = Left . ("fromASN1: RSA.PublicKey: " ++) . show+ in either Left (\(k, _) -> Right (k, xs)) inner rsaPubFromASN1 _ = Left "fromASN1: RSA.PublicKey: unexpected format" @@ -266,14 +308,19 @@ -- to negative modulus. toPositive :: Integer -> Integer toPositive int- | int < 0 = uintOfBytes $ bytesOfInt int+ | int < 0 = uintOfBytes $ bytesOfInt int | otherwise = int where uintOfBytes = foldl (\acc n -> (acc `shiftL` 8) + fromIntegral n) 0 bytesOfInt :: Integer -> [Word8] bytesOfInt n = if testBit (head nints) 7 then nints else 0xff : nints- where nints = reverse $ plusOne $ reverse $ map complement $ bytesOfUInt (abs n)- plusOne [] = [1]- plusOne (x:xs) = if x == 0xff then 0 : plusOne xs else (x+1) : xs+ where+ nints = reverse $ plusOne $ reverse $ map complement $ bytesOfUInt (abs n)+ plusOne [] = [1]+ plusOne (x : xs) = if x == 0xff then 0 : plusOne xs else (x + 1) : xs bytesOfUInt x = reverse (list x)- where list i = if i <= 0xff then [fromIntegral i] else (fromIntegral i .&. 0xff) : list (i `shiftR` 8)+ where+ list i =+ if i <= 0xff+ then [fromIntegral i]+ else (fromIntegral i .&. 0xff) : list (i `shiftR` 8)
Data/X509/Signed.hs view
@@ -21,59 +21,69 @@ -- -- Signed represent the pure data type for compliant cases, and SignedExact -- the real world situation of having to deal with compliant and non-compliant cases.----module Data.X509.Signed- (+module Data.X509.Signed ( -- * Types- Signed(..)- , SignedExact+ Signed (..),+ SignedExact,+ -- * SignedExact to Signed- , getSigned- , getSignedData+ getSigned,+ getSignedData,+ -- * Marshalling function- , encodeSignedObject- , decodeSignedObject+ encodeSignedObject,+ decodeSignedObject,+ -- * Object to Signed and SignedExact- , objectToSignedExact- , objectToSignedExactF- , objectToSigned- , signedToExact- ) where+ objectToSignedExact,+ objectToSignedExactF,+ objectToSigned,+ signedToExact,+) where import Control.Arrow (first)+import Data.ASN1.BinaryEncoding+import qualified Data.ASN1.BinaryEncoding.Raw as Raw (toByteString)+import Data.ASN1.BitArray+import Data.ASN1.Encoding+import Data.ASN1.Stream+import Data.ASN1.Types import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.X509.AlgorithmIdentifier-import Data.ASN1.Types-import Data.ASN1.Encoding-import Data.ASN1.BinaryEncoding-import Data.ASN1.Stream-import Data.ASN1.BitArray-import qualified Data.ASN1.BinaryEncoding.Raw as Raw (toByteString) -- | Represent a signed object using a traditional X509 structure. -- -- When dealing with external certificate, use the SignedExact structure -- not this one. data (Show a, Eq a, ASN1Object a) => Signed a = Signed- { signedObject :: a -- ^ Object to sign- , signedAlg :: SignatureALG -- ^ Signature Algorithm used- , signedSignature :: B.ByteString -- ^ Signature as bytes- } deriving (Show, Eq)+ { signedObject :: a+ -- ^ Object to sign+ , signedAlg :: SignatureALG+ -- ^ Signature Algorithm used+ , signedSignature :: B.ByteString+ -- ^ Signature as bytes+ }+ deriving (Show, Eq) -- | Represent the signed object plus the raw data that we need to -- keep around for non compliant case to be able to verify signature. data (Show a, Eq a, ASN1Object a) => SignedExact a = SignedExact- { getSigned :: Signed a -- ^ get the decoded Signed data- , exactObjectRaw :: B.ByteString -- ^ The raw representation of the object a- -- TODO: in later version, replace with offset in exactRaw- , encodeSignedObject :: B.ByteString -- ^ The raw representation of the whole signed structure- } deriving (Show, Eq)+ { getSigned :: Signed a+ -- ^ get the decoded Signed data+ , exactObjectRaw :: B.ByteString+ -- ^ The raw representation of the object a+ -- TODO: in later version, replace with offset in exactRaw+ , encodeSignedObject :: B.ByteString+ -- ^ The raw representation of the whole signed structure+ }+ deriving (Show, Eq) -- | Get the signed data for the signature-getSignedData :: (Show a, Eq a, ASN1Object a)- => SignedExact a- -> B.ByteString+getSignedData+ :: (Show a, Eq a, ASN1Object a)+ => SignedExact a+ -> B.ByteString getSignedData = exactObjectRaw -- | make a 'SignedExact' copy of a 'Signed' object@@ -82,18 +92,23 @@ -- encoded object to have been made on a compliant DER ASN1 implementation. -- -- It's better to use 'objectToSignedExact' instead of this.-signedToExact :: (Show a, Eq a, ASN1Object a)- => Signed a- -> SignedExact a+signedToExact+ :: (Show a, Eq a, ASN1Object a)+ => Signed a+ -> SignedExact a signedToExact signed = sExact- where (sExact, ()) = objectToSignedExact fakeSigFunction (signedObject signed)- fakeSigFunction _ = (signedSignature signed, signedAlg signed, ())+ where+ (sExact, ()) = objectToSignedExact fakeSigFunction (signedObject signed)+ fakeSigFunction _ = (signedSignature signed, signedAlg signed, ()) -- | Transform an object into a 'SignedExact' object-objectToSignedExact :: (Show a, Eq a, ASN1Object a)- => (ByteString -> (ByteString, SignatureALG, r)) -- ^ signature function- -> a -- ^ object to sign- -> (SignedExact a, r)+objectToSignedExact+ :: (Show a, Eq a, ASN1Object a)+ => (ByteString -> (ByteString, SignatureALG, r))+ -- ^ signature function+ -> a+ -- ^ object to sign+ -> (SignedExact a, r) objectToSignedExact signatureFunction object = (signedExact, val) where (val, signedExact) = objectToSignedExactF (wrap . signatureFunction) object@@ -102,70 +117,86 @@ -- | A generalization of 'objectToSignedExact' where the signature function -- runs in an arbitrary functor. This allows for example to sign using an -- algorithm needing random values.-objectToSignedExactF :: (Functor f, Show a, Eq a, ASN1Object a)- => (ByteString -> f (ByteString, SignatureALG)) -- ^ signature function- -> a -- ^ object to sign- -> f (SignedExact a)+objectToSignedExactF+ :: (Functor f, Show a, Eq a, ASN1Object a)+ => (ByteString -> f (ByteString, SignatureALG))+ -- ^ signature function+ -> a+ -- ^ object to sign+ -> f (SignedExact a) objectToSignedExactF signatureFunction object = fmap buildSignedExact (signatureFunction objRaw)- where buildSignedExact (sigBits,sigAlg) =- let signed = Signed { signedObject = object- , signedAlg = sigAlg- , signedSignature = sigBits- }- signedRaw = encodeASN1' DER signedASN1- signedASN1 = Start Sequence- : objASN1- (toASN1 sigAlg- (BitString (toBitArray sigBits 0)- : End Sequence- : []))- in SignedExact signed objRaw signedRaw- objASN1 = \xs -> Start Sequence : toASN1 object (End Sequence : xs)- objRaw = encodeASN1' DER (objASN1 [])+ where+ buildSignedExact (sigBits, sigAlg) =+ let signed =+ Signed+ { signedObject = object+ , signedAlg = sigAlg+ , signedSignature = sigBits+ }+ signedRaw = encodeASN1' DER signedASN1+ signedASN1 =+ Start Sequence+ : objASN1+ ( toASN1+ sigAlg+ ( BitString (toBitArray sigBits 0)+ : End Sequence+ : []+ )+ )+ in SignedExact signed objRaw signedRaw+ objASN1 = \xs -> Start Sequence : toASN1 object (End Sequence : xs)+ objRaw = encodeASN1' DER (objASN1 []) -- | Transform an object into a 'Signed' object. -- -- It's recommended to use the SignedExact object instead of Signed.-objectToSigned :: (Show a, Eq a, ASN1Object a)- => (ByteString- -> (ByteString, SignatureALG, r))- -> a- -> (Signed a, r)+objectToSigned+ :: (Show a, Eq a, ASN1Object a)+ => ( ByteString+ -> (ByteString, SignatureALG, r)+ )+ -> a+ -> (Signed a, r) objectToSigned signatureFunction object = first getSigned $ objectToSignedExact signatureFunction object -- | Try to parse a bytestring that use the typical X509 signed structure format-decodeSignedObject :: (Show a, Eq a, ASN1Object a)- => ByteString- -> Either String (SignedExact a)+decodeSignedObject+ :: (Show a, Eq a, ASN1Object a)+ => ByteString+ -> Either String (SignedExact a) decodeSignedObject b = either (Left . show) parseSigned $ decodeASN1Repr' BER b- where -- the following implementation is very inefficient.- -- uses reverse and containing, move to a better solution eventually- parseSigned l = onContainer (fst $ getConstructedEndRepr l) $ \l2 ->- let (objRepr,rem1) = getConstructedEndRepr l2- (sigAlgSeq,rem2) = getConstructedEndRepr rem1- (sigSeq,_) = getConstructedEndRepr rem2- obj = onContainer objRepr (either Left Right . fromASN1 . map fst)- in case (obj, map fst sigSeq) of- (Right (o,[]), [BitString signature]) ->- let rawObj = Raw.toByteString $ concatMap snd objRepr- in case fromASN1 $ map fst sigAlgSeq of- Left s -> Left ("signed object error sigalg: " ++ s)- Right (sigAlg,_) ->- let signed = Signed- { signedObject = o- , signedAlg = sigAlg- , signedSignature = bitArrayGetData signature- }- in Right $ SignedExact- { getSigned = signed- , exactObjectRaw = rawObj- , encodeSignedObject = b- }- (Right (_,remObj), _) ->- Left $ ("signed object error: remaining stream in object: " ++ show remObj)- (Left err, _) -> Left $ ("signed object error: " ++ show err)- onContainer ((Start _, _) : l) f =- case reverse l of- ((End _, _) : l2) -> f $ reverse l2- _ -> f []- onContainer _ f = f []+ where+ -- the following implementation is very inefficient.+ -- uses reverse and containing, move to a better solution eventually+ parseSigned l = onContainer (fst $ getConstructedEndRepr l) $ \l2 ->+ let (objRepr, rem1) = getConstructedEndRepr l2+ (sigAlgSeq, rem2) = getConstructedEndRepr rem1+ (sigSeq, _) = getConstructedEndRepr rem2+ obj = onContainer objRepr (either Left Right . fromASN1 . map fst)+ in case (obj, map fst sigSeq) of+ (Right (o, []), [BitString signature]) ->+ let rawObj = Raw.toByteString $ concatMap snd objRepr+ in case fromASN1 $ map fst sigAlgSeq of+ Left s -> Left ("signed object error sigalg: " ++ s)+ Right (sigAlg, _) ->+ let signed =+ Signed+ { signedObject = o+ , signedAlg = sigAlg+ , signedSignature = bitArrayGetData signature+ }+ in Right $+ SignedExact+ { getSigned = signed+ , exactObjectRaw = rawObj+ , encodeSignedObject = b+ }+ (Right (_, remObj), _) ->+ Left $ ("signed object error: remaining stream in object: " ++ show remObj)+ (Left err, _) -> Left $ ("signed object error: " ++ show err)+ onContainer ((Start _, _) : l) f =+ case reverse l of+ ((End _, _) : l2) -> f $ reverse l2+ _ -> f []+ onContainer _ f = f []
Setup.hs view
@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain
Tests/Tests.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-}+ module Main where import Test.Tasty@@ -9,28 +10,30 @@ import Control.Applicative import Control.Monad -import Data.List (nub, sort)-import Data.ASN1.Types-import Data.X509 import Crypto.Error (throwCryptoError) 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-import qualified Crypto.PubKey.RSA as RSA+import qualified Crypto.PubKey.Curve448 as X448 import qualified Crypto.PubKey.DSA as DSA+import qualified Crypto.PubKey.Ed25519 as Ed25519+import qualified Crypto.PubKey.Ed448 as Ed448+import qualified Crypto.PubKey.RSA as RSA+import Data.ASN1.Types+import Data.List (nub, sort)+import Data.X509 import Data.Hourglass instance Arbitrary RSA.PublicKey where arbitrary = do- bytes <- elements [64,128,256]- e <- elements [0x3,0x10001]- n <- choose (2^(8*(bytes-1)),2^(8*bytes))- return $ RSA.PublicKey { RSA.public_size = bytes- , RSA.public_n = n- , RSA.public_e = e- }+ bytes <- elements [64, 128, 256]+ e <- elements [0x3, 0x10001]+ n <- choose (2 ^ (8 * (bytes - 1)), 2 ^ (8 * bytes))+ return $+ RSA.PublicKey+ { RSA.public_size = bytes+ , RSA.public_n = n+ , RSA.public_e = e+ } instance Arbitrary DSA.Params where arbitrary = DSA.Params <$> arbitrary <*> arbitrary <*> arbitrary@@ -51,24 +54,27 @@ arbitrary = Ed448.toPublic <$> arbitrary instance Arbitrary PubKey where- arbitrary = oneof- [ PubKeyRSA <$> arbitrary- , PubKeyDSA <$> arbitrary- --, PubKeyECDSA ECDSA_Hash_SHA384 <$> (B.pack <$> replicateM 384 arbitrary)- , PubKeyX25519 <$> arbitrary- , PubKeyX448 <$> arbitrary- , PubKeyEd25519 <$> arbitrary- , PubKeyEd448 <$> arbitrary- ]+ arbitrary =+ oneof+ [ PubKeyRSA <$> arbitrary+ , PubKeyDSA <$> arbitrary+ , -- , PubKeyECDSA ECDSA_Hash_SHA384 <$> (B.pack <$> replicateM 384 arbitrary)+ PubKeyX25519 <$> arbitrary+ , PubKeyX448 <$> arbitrary+ , PubKeyEd25519 <$> arbitrary+ , PubKeyEd448 <$> arbitrary+ ] instance Arbitrary RSA.PrivateKey where- arbitrary = RSA.PrivateKey <$> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary+ arbitrary =+ RSA.PrivateKey+ <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary instance Arbitrary DSA.PrivateKey where arbitrary = DSA.PrivateKey <$> arbitrary <*> arbitrary@@ -86,56 +92,61 @@ arbitrary = throwCryptoError . Ed448.secretKey <$> arbitraryBS 57 57 instance Arbitrary PrivKey where- arbitrary = oneof- [ PrivKeyRSA <$> arbitrary- , PrivKeyDSA <$> arbitrary- --, PrivKeyECDSA ECDSA_Hash_SHA384 <$> (B.pack <$> replicateM 384 arbitrary)- , PrivKeyX25519 <$> arbitrary- , PrivKeyX448 <$> arbitrary- , PrivKeyEd25519 <$> arbitrary- , PrivKeyEd448 <$> arbitrary- ]+ arbitrary =+ oneof+ [ PrivKeyRSA <$> arbitrary+ , PrivKeyDSA <$> arbitrary+ , -- , PrivKeyECDSA ECDSA_Hash_SHA384 <$> (B.pack <$> replicateM 384 arbitrary)+ PrivKeyX25519 <$> arbitrary+ , PrivKeyX448 <$> arbitrary+ , PrivKeyEd25519 <$> arbitrary+ , PrivKeyEd448 <$> arbitrary+ ] instance Arbitrary HashALG where- arbitrary = elements [HashMD2,HashMD5,HashSHA1,HashSHA224,HashSHA256,HashSHA384,HashSHA512]+ arbitrary =+ elements+ [HashMD2, HashMD5, HashSHA1, HashSHA224, HashSHA256, HashSHA384, HashSHA512] instance Arbitrary PubKeyALG where- arbitrary = elements [PubKeyALG_RSA,PubKeyALG_DSA,PubKeyALG_EC,PubKeyALG_DH]+ arbitrary = elements [PubKeyALG_RSA, PubKeyALG_DSA, PubKeyALG_EC, PubKeyALG_DH] instance Arbitrary SignatureALG where -- unfortunately as the encoding of this is a single OID as opposed to two OID,- -- the testing need to limit itself to Signature ALG that has been defined in the OID database. + -- the testing need to limit itself to Signature ALG that has been defined in the OID database. -- arbitrary = SignatureALG <$> arbitrary <*> arbitrary- arbitrary = elements- [ SignatureALG HashSHA1 PubKeyALG_RSA- , SignatureALG HashMD5 PubKeyALG_RSA- , SignatureALG HashMD2 PubKeyALG_RSA- , SignatureALG HashSHA256 PubKeyALG_RSA- , SignatureALG HashSHA384 PubKeyALG_RSA- , SignatureALG HashSHA512 PubKeyALG_RSA- , SignatureALG HashSHA224 PubKeyALG_RSA- , SignatureALG HashSHA1 PubKeyALG_DSA- , SignatureALG HashSHA224 PubKeyALG_DSA- , SignatureALG HashSHA256 PubKeyALG_DSA- , SignatureALG HashSHA224 PubKeyALG_EC- , SignatureALG HashSHA256 PubKeyALG_EC- , SignatureALG HashSHA384 PubKeyALG_EC- , SignatureALG HashSHA512 PubKeyALG_EC- , SignatureALG_IntrinsicHash PubKeyALG_Ed25519- , SignatureALG_IntrinsicHash PubKeyALG_Ed448- ]+ arbitrary =+ elements+ [ SignatureALG HashSHA1 PubKeyALG_RSA+ , SignatureALG HashMD5 PubKeyALG_RSA+ , SignatureALG HashMD2 PubKeyALG_RSA+ , SignatureALG HashSHA256 PubKeyALG_RSA+ , SignatureALG HashSHA384 PubKeyALG_RSA+ , SignatureALG HashSHA512 PubKeyALG_RSA+ , SignatureALG HashSHA224 PubKeyALG_RSA+ , SignatureALG HashSHA1 PubKeyALG_DSA+ , SignatureALG HashSHA224 PubKeyALG_DSA+ , SignatureALG HashSHA256 PubKeyALG_DSA+ , SignatureALG HashSHA224 PubKeyALG_EC+ , SignatureALG HashSHA256 PubKeyALG_EC+ , SignatureALG HashSHA384 PubKeyALG_EC+ , SignatureALG HashSHA512 PubKeyALG_EC+ , SignatureALG_IntrinsicHash PubKeyALG_Ed25519+ , SignatureALG_IntrinsicHash PubKeyALG_Ed448+ ] -arbitraryBS r1 r2 = choose (r1,r2) >>= \l -> (B.pack <$> replicateM l arbitrary)+arbitraryBS r1 r2 = choose (r1, r2) >>= \l -> (B.pack <$> replicateM l arbitrary) instance Arbitrary ASN1StringEncoding where- arbitrary = elements [IA5,UTF8]+ arbitrary = elements [IA5, UTF8] instance Arbitrary ASN1CharacterString where arbitrary = ASN1CharacterString <$> arbitrary <*> arbitraryBS 2 36 instance Arbitrary DistinguishedName where- arbitrary = DistinguishedName <$> (choose (1,5) >>= \l -> replicateM l arbitraryDE)- where arbitraryDE = (,) <$> arbitrary <*> arbitrary+ arbitrary = DistinguishedName <$> (choose (1, 5) >>= \l -> replicateM l arbitraryDE)+ where+ arbitraryDE = (,) <$> arbitrary <*> arbitrary instance Arbitrary DateTime where arbitrary = timeConvert <$> (arbitrary :: Gen Elapsed)@@ -143,13 +154,17 @@ arbitrary = Elapsed . Seconds <$> (choose (1, 100000000)) instance Arbitrary Extensions where- arbitrary = Extensions <$> oneof- [ pure Nothing- , Just <$> (listOf1 $ oneof- [ extensionEncode <$> arbitrary <*> (arbitrary :: Gen ExtKeyUsage)- ]- )- ]+ arbitrary =+ Extensions+ <$> oneof+ [ pure Nothing+ , Just+ <$> ( listOf1 $+ oneof+ [ extensionEncode <$> arbitrary <*> (arbitrary :: Gen ExtKeyUsage)+ ]+ )+ ] instance Arbitrary ExtKeyUsageFlag where arbitrary = elements $ enumFrom KeyUsage_digitalSignature@@ -157,67 +172,109 @@ arbitrary = ExtKeyUsage . sort . nub <$> listOf1 arbitrary instance Arbitrary ExtKeyUsagePurpose where- arbitrary = elements [ KeyUsagePurpose_ServerAuth- , KeyUsagePurpose_ClientAuth- , KeyUsagePurpose_CodeSigning- , KeyUsagePurpose_EmailProtection- , KeyUsagePurpose_TimeStamping- , KeyUsagePurpose_OCSPSigning ]+ arbitrary =+ elements+ [ KeyUsagePurpose_ServerAuth+ , KeyUsagePurpose_ClientAuth+ , KeyUsagePurpose_CodeSigning+ , KeyUsagePurpose_EmailProtection+ , KeyUsagePurpose_TimeStamping+ , KeyUsagePurpose_OCSPSigning+ ] instance Arbitrary ExtExtendedKeyUsage where arbitrary = ExtExtendedKeyUsage . nub <$> listOf1 arbitrary instance Arbitrary Certificate where- arbitrary = Certificate <$> pure 2- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary+ arbitrary =+ Certificate+ <$> pure 2+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary instance Arbitrary RevokedCertificate where- arbitrary = RevokedCertificate <$> arbitrary- <*> arbitrary- <*> arbitrary+ arbitrary =+ RevokedCertificate+ <$> arbitrary+ <*> arbitrary+ <*> arbitrary instance Arbitrary CRL where- arbitrary = CRL <$> pure 1- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary+ arbitrary =+ CRL+ <$> pure 1+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary -property_unmarshall_marshall_id :: (Show o, Arbitrary o, ASN1Object o, Eq o) => o -> Bool+property_unmarshall_marshall_id+ :: (Show o, Arbitrary o, ASN1Object o, Eq o) => o -> Bool property_unmarshall_marshall_id o = case got of Right (gotObject, []) | gotObject == o -> True- | otherwise -> error ("object is different: " ++ show gotObject ++ " expecting " ++ show o)- Right (gotObject, l) -> error ("state remaining: " ++ show l ++ " marshalled: " ++ show oMarshalled ++ " parsed: " ++ show gotObject)- Left e -> error ("parsing failed: " ++ show e ++ " object: " ++ show o ++ " marshalled as: " ++ show oMarshalled)- where got = fromASN1 oMarshalled- oMarshalled = toASN1 o []+ | otherwise ->+ error ("object is different: " ++ show gotObject ++ " expecting " ++ show o)+ Right (gotObject, l) ->+ error+ ( "state remaining: "+ ++ show l+ ++ " marshalled: "+ ++ show oMarshalled+ ++ " parsed: "+ ++ show gotObject+ )+ Left e ->+ error+ ( "parsing failed: "+ ++ show e+ ++ " object: "+ ++ show o+ ++ " marshalled as: "+ ++ show oMarshalled+ )+ where+ got = fromASN1 oMarshalled+ oMarshalled = toASN1 o [] property_extension_id :: (Show e, Eq e, Extension e) => e -> Bool property_extension_id e = case extDecode (extEncode e) of- Left err -> error err- Right v | v == e -> True- | otherwise -> error ("expected " ++ show e ++ " got: " ++ show v)+ Left err -> error err+ Right v+ | v == e -> True+ | otherwise -> error ("expected " ++ show e ++ " got: " ++ show v) -main = defaultMain $ testGroup "X509"- [ testGroup "marshall"- [ testProperty "pubkey" (property_unmarshall_marshall_id :: PubKey -> Bool)- , testProperty "privkey" (property_unmarshall_marshall_id :: PrivKey -> Bool)- , testProperty "signature alg" (property_unmarshall_marshall_id :: SignatureALG -> Bool)- , testGroup "extension"- [ testProperty "key-usage" (property_extension_id :: ExtKeyUsage -> Bool)- , testProperty "extended-key-usage" (property_extension_id :: ExtExtendedKeyUsage -> Bool)+main =+ defaultMain $+ testGroup+ "X509"+ [ testGroup+ "marshall"+ [ testProperty "pubkey" (property_unmarshall_marshall_id :: PubKey -> Bool)+ , testProperty "privkey" (property_unmarshall_marshall_id :: PrivKey -> Bool)+ , testProperty+ "signature alg"+ (property_unmarshall_marshall_id :: SignatureALG -> Bool)+ , testGroup+ "extension"+ [ testProperty "key-usage" (property_extension_id :: ExtKeyUsage -> Bool)+ , testProperty+ "extended-key-usage"+ (property_extension_id :: ExtExtendedKeyUsage -> Bool)+ ]+ , testProperty+ "extensions"+ (property_unmarshall_marshall_id :: Extensions -> Bool)+ , testProperty+ "certificate"+ (property_unmarshall_marshall_id :: Certificate -> Bool)+ , testProperty "crl" (property_unmarshall_marshall_id :: CRL -> Bool)+ ] ]- , testProperty "extensions" (property_unmarshall_marshall_id :: Extensions -> Bool)- , testProperty "certificate" (property_unmarshall_marshall_id :: Certificate -> Bool)- , testProperty "crl" (property_unmarshall_marshall_id :: CRL -> Bool)- ]- ]
crypton-x509.cabal view
@@ -1,64 +1,71 @@-Name: crypton-x509-version: 1.7.7-Description: X509 reader and writer. please see README-License: BSD3-License-file: LICENSE-Copyright: Vincent Hanquez <vincent@snarc.org>-Author: Vincent Hanquez <vincent@snarc.org>-Maintainer: Kazu Yamamoto <kazu@iij.ad.jp>-Synopsis: X509 reader and writer-Build-Type: Simple-Category: Data-stability: experimental-Homepage: https://github.com/kazu-yamamoto/crypton-certificate-Cabal-Version: >= 1.10+cabal-version: >=1.10+name: crypton-x509+version: 1.8.0+license: BSD3+license-file: LICENSE+copyright: Vincent Hanquez <vincent@snarc.org>+maintainer: Kazu Yamamoto <kazu@iij.ad.jp>+author: Vincent Hanquez <vincent@snarc.org>+stability: experimental+homepage: https://github.com/kazu-yamamoto/crypton-certificate+synopsis: X509 reader and writer+description: X509 reader and writer. please see README+category: Data+build-type: Simple+extra-source-files: ChangeLog.md -Library- Default-Language: Haskell2010- Build-Depends: base >= 4.7 && < 5- , bytestring- , memory- , transformers >= 0.4- , containers- , hourglass- , pem >= 0.1- , asn1-types >= 0.3.1 && < 0.4- , asn1-encoding >= 0.9 && < 0.10- , asn1-parse >= 0.9.3 && < 0.10- , crypton >= 0.24- Exposed-modules: Data.X509- Data.X509.EC- Other-modules: Data.X509.Internal- Data.X509.CertificateChain- Data.X509.AlgorithmIdentifier- Data.X509.DistinguishedName- Data.X509.Cert- Data.X509.PublicKey- Data.X509.PrivateKey- Data.X509.Ext- Data.X509.ExtensionRaw- Data.X509.CRL- Data.X509.OID- Data.X509.Signed- ghc-options: -Wall+source-repository head+ type: git+ location: https://github.com/kazu-yamamoto/crypton-certificate+ subdir: x509 -Test-Suite test-x509- Default-Language: Haskell2010- type: exitcode-stdio-1.0- hs-source-dirs: Tests- Main-is: Tests.hs- Build-Depends: base >= 3 && < 5- , bytestring- , mtl- , tasty- , tasty-quickcheck- , hourglass- , asn1-types- , crypton-x509- , crypton- ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures+library+ exposed-modules:+ Data.X509+ Data.X509.EC -source-repository head- type: git- location: https://github.com/kazu-yamamoto/crypton-certificate- subdir: x509+ other-modules:+ Data.X509.Internal+ Data.X509.CertificateChain+ Data.X509.AlgorithmIdentifier+ Data.X509.DistinguishedName+ Data.X509.Cert+ Data.X509.PublicKey+ Data.X509.PrivateKey+ Data.X509.Ext+ Data.X509.ExtensionRaw+ Data.X509.CRL+ Data.X509.OID+ Data.X509.Signed++ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=4.7 && <5,+ bytestring,+ containers,+ crypton >=0.24,+ crypton-asn1-encoding >=0.10.0 && <0.11,+ crypton-asn1-parse >=0.10.0 && <0.11,+ crypton-asn1-types >=0.4.1 && <0.5,+ crypton-pem >=0.2.4 && <0.4,+ memory,+ time-hourglass,+ transformers >=0.4++test-suite test-x509+ type: exitcode-stdio-1.0+ main-is: Tests.hs+ hs-source-dirs: Tests+ default-language: Haskell2010+ ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures+ build-depends:+ base >=3 && <5,+ bytestring,+ crypton,+ crypton-x509,+ crypton-asn1-types,+ mtl,+ tasty,+ tasty-quickcheck,+ time-hourglass