diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,36 @@ +# ChangeLog for crypton-x509 + +## 1.10.0 + +* Support ML-DSA (RFC 9881) + [#35](https://github.com/kazu-yamamoto/crypton-certificate/pull/35) +* An ML-DSA private key keeps the form it was written in + [#35](https://github.com/kazu-yamamoto/crypton-certificate/pull/35) + +## 1.9.2 + +* Stop printing EC private keys + [#34](https://github.com/kazu-yamamoto/crypton-certificate/pull/34) + +## 1.9.1 + +* Implementing the X509 name constrains extension. + [#30](https://github.com/kazu-yamamoto/crypton-certificate/pull/30) + +## 1.9.0 + +* Using "ram" instead of "memory" + [#29](https://github.com/kazu-yamamoto/crypton-certificate/pull/29) + +## 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) diff --git a/Data/X509.hs b/Data/X509.hs --- a/Data/X509.hs +++ b/Data/X509.hs @@ -8,75 +8,80 @@ -- 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 (..), + PrivKeyMLDSA, + MLDSAKeyForm (..), + privkeyMLDSAFromSeed, + privkeyMLDSAFromKey, + privkeyMLDSA_key, + privkeyMLDSA_seed, + privkeyMLDSA_form, + 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 +89,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 +112,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 diff --git a/Data/X509/AlgorithmIdentifier.hs b/Data/X509/AlgorithmIdentifier.hs --- a/Data/X509/AlgorithmIdentifier.hs +++ b/Data/X509/AlgorithmIdentifier.hs @@ -4,93 +4,125 @@ -- Maintainer : Vincent Hanquez -- 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 + | -- | ML-DSA-44 signature algorithm (RFC 9881) + PubKeyALG_MLDSA44 + | -- | ML-DSA-65 signature algorithm (RFC 9881) + PubKeyALG_MLDSA65 + | -- | ML-DSA-87 signature algorithm (RFC 9881) + PubKeyALG_MLDSA87 + | -- | 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_MLDSA44 = [2, 16, 840, 1, 101, 3, 4, 3, 17] + getObjectID PubKeyALG_MLDSA65 = [2, 16, 840, 1, 101, 3, 4, 3, 18] + getObjectID PubKeyALG_MLDSA87 = [2, 16, 840, 1, 101, 3, 4, 3, 19] + 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) + , + ( [2, 16, 840, 1, 101, 3, 4, 3, 17] + , SignatureALG_IntrinsicHash PubKeyALG_MLDSA44 + ) + , + ( [2, 16, 840, 1, 101, 3, 4, 3, 18] + , SignatureALG_IntrinsicHash PubKeyALG_MLDSA65 + ) + , + ( [2, 16, 840, 1, 101, 3, 4, 3, 19] + , SignatureALG_IntrinsicHash PubKeyALG_MLDSA87 + ) + ] 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 +130,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" + Left "fromASN1: X509.SignatureALG: EdDSA and ML-DSA require 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 diff --git a/Data/X509/CRL.hs b/Data/X509/CRL.hs --- a/Data/X509/CRL.hs +++ b/Data/X509/CRL.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE FlexibleContexts #-} + -- | -- Module : Data.X509.CRL -- License : BSD-style @@ -8,89 +10,90 @@ -- Read and Write X509 Certificate Revocation List (CRL). -- -- follows RFC5280 / RFC6818. --- -{-# LANGUAGE FlexibleContexts #-} - -module Data.X509.CRL - ( CRL(..) - , RevokedCertificate(..) - ) where - -import Control.Applicative +module Data.X509.CRL ( + CRL (..), + RevokedCertificate (..), +) where -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 +102,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' diff --git a/Data/X509/Cert.hs b/Data/X509/Cert.hs --- a/Data/X509/Cert.hs +++ b/Data/X509/Cert.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE FlexibleContexts #-} + -- | -- Module : Data.X509.Cert -- License : BSD-style @@ -6,118 +8,138 @@ -- 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.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 diff --git a/Data/X509/CertificateChain.hs b/Data/X509/CertificateChain.hs --- a/Data/X509/CertificateChain.hs +++ b/Data/X509/CertificateChain.hs @@ -4,37 +4,39 @@ -- Maintainer : Vincent Hanquez -- 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 diff --git a/Data/X509/DistinguishedName.hs b/Data/X509/DistinguishedName.hs --- a/Data/X509/DistinguishedName.hs +++ b/Data/X509/DistinguishedName.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- | -- Module : Data.X509.DistinguishedName -- License : BSD-style @@ -6,18 +8,15 @@ -- 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) import Data.Semigroup #else @@ -27,24 +26,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 +57,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 +65,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 +92,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 diff --git a/Data/X509/EC.hs b/Data/X509/EC.hs --- a/Data/X509/EC.hs +++ b/Data/X509/EC.hs @@ -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 diff --git a/Data/X509/Ext.hs b/Data/X509/Ext.hs --- a/Data/X509/Ext.hs +++ b/Data/X509/Ext.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} + -- | -- Module : Data.X509.Ext -- License : BSD-style @@ -6,58 +9,59 @@ -- 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 (..), + ExtNameConstraints (..), + GeneralSubtree (..), + AltName (..), + DistributionPoint (..), + ReasonFlag (..), + -- * Accessor turning extension into a specific one - , extensionGet - , extensionGetE - , extensionDecode - , extensionEncode - ) where + extensionGet, + extensionGetE, + extensionDecode, + extensionEncode, + recognizedOIDs, +) 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.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 +80,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 +91,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 +117,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 @@ -206,26 +223,25 @@ -- Not all name types are available, missing: -- otherName -- x400Address --- directoryName -- ediPartyName -- registeredID --- -data AltName = - AltNameRFC822 String +data AltName + = AltNameRFC822 String | AltNameDNS String + | AltNameDN DistinguishedName | 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 +249,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,92 +275,254 @@ | 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 + +getAddr :: ParseASN1 AltName +getAddr = do + m <- onNextContainerMaybe (Container Context 0) getComposedAddr + case m of + Nothing -> getSimpleAddr + Just r -> return r 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) + 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 4 b) -> case decodeASN1' DER b of + Left e1 -> throwParseError $ show e1 + Right as -> case runParseASN1 getObject as of + Right dn -> return $ AltNameDN dn + Left e2 -> throwParseError e2 + (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] +encodeAltName :: AltName -> [ASN1] +encodeAltName (AltNameRFC822 n) = [Other Context 1 $ BC.pack n] +encodeAltName (AltNameDNS n) = [Other Context 2 $ BC.pack n] +encodeAltName (AltNameDN dn) = [Other Context 4 $ encodeASN1' DER $ toASN1 dn []] +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" extEncodeBs (ExtNetscapeComment b) = b extDecodeBs = Right . ExtNetscapeComment + +-------------------------------------------------------------------------------- +-- RFC5280 +-- +-- NameConstraints ::= SEQUENCE { +-- permittedSubtrees [0] GeneralSubtrees OPTIONAL, +-- excludedSubtrees [1] GeneralSubtrees OPTIONAL +-- } +-- +-- GeneralSubtrees ::= SEQUENCE SIZE (1..MAX) OF GeneralSubtree +-- +-- GeneralSubtree ::= SEQUENCE { +-- base GeneralName, +-- minimum [0] BaseDistance DEFAULT 0, +-- maximum [1] BaseDistance OPTIONAL +-- } +-------------------------------------------------------------------------------- + +data GeneralSubtree = GeneralSubtree AltName Integer (Maybe Integer) + deriving (Show, Eq) + +data ExtNameConstraints = ExtNameConstraints [GeneralSubtree] [GeneralSubtree] + deriving (Show, Eq) + +instance Extension ExtNameConstraints where + extOID _ = [2, 5, 29, 30] + extHasNestedASN1 _ = True + extEncode = encodeNameConstraints + extDecode = decodeNameConstraints + +-------------------------------------------------------------------------------- +-- Encoding +-------------------------------------------------------------------------------- + +encodeNameConstraints :: ExtNameConstraints -> [ASN1] +encodeNameConstraints (ExtNameConstraints permitted excluded) = + [Start Sequence] + ++ put 0 permitted + ++ put 1 excluded + ++ [End Sequence] + where + put _ [] = [] + put n xs = + [Start (Container Context n), Start Sequence] + ++ concatMap encodeGeneralSubtree xs + ++ [End Sequence, End (Container Context n)] + +encodeGeneralSubtree :: GeneralSubtree -> [ASN1] +encodeGeneralSubtree (GeneralSubtree base minimum' maximum') = + [Start Sequence] + ++ encodeAltName base + ++ ( if minimum' /= 0 + then [Other Context 0 (encodeASN1' DER [IntVal minimum'])] + else [] + ) + ++ maybe + [] + ( \m -> + [Other Context 1 (encodeASN1' DER [IntVal m])] + ) + maximum' + ++ [End Sequence] + +-------------------------------------------------------------------------------- +-- Decoding +-------------------------------------------------------------------------------- + +decodeNameConstraints :: [ASN1] -> Either String ExtNameConstraints +decodeNameConstraints + (Start Sequence : xs) = + go xs [] [] + where + go (End Sequence : _) permitted excluded = + Right $ ExtNameConstraints permitted excluded + go (Start (Container Context 0) : rest) _ excluded = do + (subs, rest') <- decodeSubtrees rest + go rest' subs excluded + go (Start (Container Context 1) : rest) permitted _ = do + (subs, rest') <- decodeSubtrees rest + go rest' permitted subs + go _ _ _ = Left "Invalid NameConstraints" + decodeSubtrees :: [ASN1] -> Either String ([GeneralSubtree], [ASN1]) + decodeSubtrees ys = loop ys [] + where + loop (End (Container Context _) : rest) acc = + Right (reverse acc, rest) + loop zs acc = do + (s, zs') <- decodeGeneralSubtree zs + loop zs' (s : acc) +decodeNameConstraints _ = + Left "NameConstraints: expected SEQUENCE" + +decodeGeneralSubtree + :: [ASN1] + -> Either String (GeneralSubtree, [ASN1]) +decodeGeneralSubtree (Start Sequence : xs) = do + (base, rest1) <- runParseASN1State getAddr xs + + let (minimum', rest2) = + case rest1 of + (Other Context 0 bs : rs) -> + case decodeASN1' DER bs of + Right [IntVal n] -> (n, rs) + _ -> (0, rest1) + _ -> (0, rest1) + + let (maximum', rest3) = + case rest2 of + (Other Context 1 bs : rs) -> + case decodeASN1' DER bs of + Right [IntVal n] -> (Just n, rs) + _ -> (Nothing, rest2) + _ -> (Nothing, rest2) + + case rest3 of + (End Sequence : rs) -> + Right (GeneralSubtree base minimum' maximum', rs) + _ -> + Left "GeneralSubtree: missing end sequence" +decodeGeneralSubtree _ = + Left "GeneralSubtree: invalid ASN1" + +recognizedOIDs :: [OID] +recognizedOIDs = + [ [2, 5, 29, 19] -- ExtBasicConstraints + , [2, 5, 29, 15] -- ExtKeyUsage + , [2, 5, 29, 37] -- ExtExtendedKeyUsage + , [2, 5, 29, 14] -- ExtSubjectKeyId + , [2, 5, 29, 17] -- ExtSubjectAltName + , [2, 5, 29, 35] -- ExtAuthorityKeyId + , [2, 5, 29, 31] -- ExtCrlDistributionPoints + , [2, 5, 29, 30] -- ExtNameConstraints + , [2, 16, 840, 1, 113730, 1, 13] -- ExtNetscapeComment + ] diff --git a/Data/X509/ExtensionRaw.hs b/Data/X509/ExtensionRaw.hs --- a/Data/X509/ExtensionRaw.hs +++ b/Data/X509/ExtensionRaw.hs @@ -6,33 +6,40 @@ -- 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 +47,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]) diff --git a/Data/X509/Internal.hs b/Data/X509/Internal.hs --- a/Data/X509/Internal.hs +++ b/Data/X509/Internal.hs @@ -4,19 +4,19 @@ -- Maintainer : Vincent Hanquez -- 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 diff --git a/Data/X509/OID.hs b/Data/X509/OID.hs --- a/Data/X509/OID.hs +++ b/Data/X509/OID.hs @@ -4,20 +4,18 @@ -- Maintainer : Vincent Hanquez -- 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 +25,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]) ] diff --git a/Data/X509/PrivateKey.hs b/Data/X509/PrivateKey.hs --- a/Data/X509/PrivateKey.hs +++ b/Data/X509/PrivateKey.hs @@ -6,113 +6,324 @@ -- Portability : unknown -- -- Private key handling in X.509 infrastructure --- -module Data.X509.PrivateKey - ( PrivKey(..) - , PrivKeyEC(..) - , privkeyToAlg - ) where +module Data.X509.PrivateKey ( + PrivKey (..), + PrivKeyEC (..), + PrivKeyMLDSA, + MLDSAKeyForm (..), + privkeyMLDSAFromSeed, + privkeyMLDSAFromKey, + privkeyMLDSA_key, + privkeyMLDSA_seed, + privkeyMLDSA_form, + privkeyToAlg, +) where -import Control.Applicative ((<$>), pure) import Data.Maybe (fromMaybe) -import Data.Word (Word) +import Data.Proxy (Proxy (..)) -import Data.ByteArray (ByteArrayAccess, convert) +import Data.ByteArray (ByteArrayAccess, ScrubbedBytes, 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.Debug (DebugShow (..), debugShowBytes) +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.MLDSA as MLDSA +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 (Eq) +-- | The curve is shown; @privkeyEC_priv@ is not. Use +-- 'Crypto.Debug.debugShow' to see it. +instance Show PrivKeyEC where + showsPrec = showsPrivKeyEC (showString "") + +instance DebugShow PrivKeyEC where + debugShow k = showsPrivKeyEC (shows $ privkeyEC_priv k) 0 k "" + +-- | What the two instances above share, so that a field added to +-- 'PrivKeyEC' cannot reach one of them and not the other. The first +-- argument renders @privkeyEC_priv@; everything else is what @deriving +-- Show@ used to write. +showsPrivKeyEC :: ShowS -> Int -> PrivKeyEC -> ShowS +showsPrivKeyEC priv d (PrivKeyEC_Prime _ a b p g o c s) = + showParen (d > 10) $ + showString "PrivKeyEC_Prime {privkeyEC_priv = " + . priv + . showString ", privkeyEC_a = " + . shows a + . showString ", privkeyEC_b = " + . shows b + . showString ", privkeyEC_prime = " + . shows p + . showString ", privkeyEC_generator = " + . shows g + . showString ", privkeyEC_order = " + . shows o + . showString ", privkeyEC_cofactor = " + . shows c + . showString ", privkeyEC_seed = " + . shows s + . showChar '}' +showsPrivKeyEC priv d (PrivKeyEC_Named n _) = + showParen (d > 10) $ + showString "PrivKeyEC_Named {privkeyEC_name = " + . shows n + . showString ", privkeyEC_priv = " + . priv + . showChar '}' + +-- | Which of the three forms of RFC 9881 Section 6 a private key was read +-- as, and is written back out as. +data MLDSAKeyForm + = -- | The seed alone, @seed@, which Section 6 recommends. + MLDSAKeySeed + | -- | The expanded key alone, @expandedKey@. + MLDSAKeyExpanded + | -- | Both together, @both@. + MLDSAKeyBoth + deriving (Show, Eq) + +-- | An ML-DSA private key. +-- +-- RFC 9881 Section 6 writes one as the seed it was derived from, as the +-- expanded key, or as both, and which of the three it was is part of the +-- key here. A key read from a file is therefore written back out as the +-- same thing it came in as, rather than as whichever form this module +-- happens to prefer. +-- +-- The expanded key is there whatever the form: a seed is expanded as it is +-- read, so 'privkeyMLDSA_key' always answers. The seed is not, since a +-- key written as @expandedKey@ does not carry one; 'privkeyMLDSA_seed' is +-- a 'Maybe' for that reason, and a key whose seed was never on the wire +-- cannot be given one back -- @crypton@'s +-- @Crypto.PubKey.MLDSA.generateKeyPairAndSeed@ is where a seed that is to +-- be kept has to be caught. +-- +-- The constructors are not exported: a seed and an expanded key that do +-- not belong together would be a key that signs with one and claims the +-- other, so the only ways in are 'privkeyMLDSAFromSeed', which expands the +-- seed itself, and 'privkeyMLDSAFromKey', which has no seed to disagree +-- with. +-- +-- Two keys are equal when they hold the same thing /in the same form/: the +-- same key as a seed and as an expanded key are two different files, and +-- the encoding round trip says so. +data PrivKeyMLDSA p + = PrivKeyMLDSA_Seed ScrubbedBytes (MLDSA.SigningKey p) + | PrivKeyMLDSA_Expanded (MLDSA.SigningKey p) + | PrivKeyMLDSA_Both ScrubbedBytes (MLDSA.SigningKey p) + deriving (Eq) + +-- | What the two instances below share, so that a form added to +-- 'PrivKeyMLDSA' cannot reach one of them and not the other. The +-- arguments render the seed and the key. +showsPrivKeyMLDSA + :: (ScrubbedBytes -> String) + -> (MLDSA.SigningKey p -> String) + -> PrivKeyMLDSA p + -> String +showsPrivKeyMLDSA seed key k = case k of + PrivKeyMLDSA_Seed s sk -> con "PrivKeyMLDSA_Seed" [seed s, key sk] + PrivKeyMLDSA_Expanded sk -> con "PrivKeyMLDSA_Expanded" [key sk] + PrivKeyMLDSA_Both s sk -> con "PrivKeyMLDSA_Both" [seed s, key sk] + where + con name as = unwords (name : map (\a -> "(" ++ a ++ ")") as) + +-- | The form is shown; neither the seed nor the key is. Use +-- 'Crypto.Debug.debugShow' to see them. +instance Show (PrivKeyMLDSA p) where + show = showsPrivKeyMLDSA (const "") show + +instance DebugShow (PrivKeyMLDSA p) where + debugShow = showsPrivKeyMLDSA (debugShowBytes "seed") debugShow + +-- | Build a key from its seed, to be written back out in the given form. +-- +-- The expanded key is derived here, so it cannot fail to be the one the +-- seed belongs to. Passing 'MLDSAKeyExpanded' throws the seed away, which +-- is the way to turn a seed into a key that will be written without one. +privkeyMLDSAFromSeed + :: (MLDSA.MLDSA p, ByteArrayAccess ba) + => proxy p -> MLDSAKeyForm -> ba -> CryptoFailable (PrivKeyMLDSA p) +privkeyMLDSAFromSeed p form bs = case MLDSA.keyPairFromSeed p bs of + CryptoFailed e -> CryptoFailed e + CryptoPassed (_, sk) -> + CryptoPassed $ case form of + MLDSAKeySeed -> PrivKeyMLDSA_Seed seed sk + MLDSAKeyExpanded -> PrivKeyMLDSA_Expanded sk + MLDSAKeyBoth -> PrivKeyMLDSA_Both seed sk + where + seed = convert bs :: ScrubbedBytes + +-- | Build a key from the expanded key alone, which is what a key that was +-- generated without keeping its seed has to be. +privkeyMLDSAFromKey :: MLDSA.SigningKey p -> PrivKeyMLDSA p +privkeyMLDSAFromKey = PrivKeyMLDSA_Expanded + +-- | The expanded key, whatever form the key is in. +privkeyMLDSA_key :: PrivKeyMLDSA p -> MLDSA.SigningKey p +privkeyMLDSA_key (PrivKeyMLDSA_Seed _ sk) = sk +privkeyMLDSA_key (PrivKeyMLDSA_Expanded sk) = sk +privkeyMLDSA_key (PrivKeyMLDSA_Both _ sk) = sk + +-- | The seed, for a key that has one. +privkeyMLDSA_seed :: PrivKeyMLDSA p -> Maybe ScrubbedBytes +privkeyMLDSA_seed (PrivKeyMLDSA_Seed s _) = Just s +privkeyMLDSA_seed (PrivKeyMLDSA_Expanded _) = Nothing +privkeyMLDSA_seed (PrivKeyMLDSA_Both s _) = Just s + +-- | The form the key will be written out in. +privkeyMLDSA_form :: PrivKeyMLDSA p -> MLDSAKeyForm +privkeyMLDSA_form (PrivKeyMLDSA_Seed _ _) = MLDSAKeySeed +privkeyMLDSA_form (PrivKeyMLDSA_Expanded _) = MLDSAKeyExpanded +privkeyMLDSA_form (PrivKeyMLDSA_Both _ _) = MLDSAKeyBoth + -- | 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 + | -- | ML-DSA-44 private key + PrivKeyMLDSA44 (PrivKeyMLDSA MLDSA.MLDSA44) + | -- | ML-DSA-65 private key + PrivKeyMLDSA65 (PrivKeyMLDSA MLDSA.MLDSA65) + | -- | ML-DSA-87 private key + PrivKeyMLDSA87 (PrivKeyMLDSA MLDSA.MLDSA87) + deriving (Show, Eq) +-- | Rendering a private key with the key material in it, for the times when +-- that is what is meant. Each arm is @crypton@'s own 'debugShow' for that +-- key type, except the EC one, which is this module's. +instance DebugShow PrivKey where + debugShow k = case k of + PrivKeyRSA p -> con "PrivKeyRSA" $ debugShow p + PrivKeyDSA p -> con "PrivKeyDSA" $ debugShow p + PrivKeyEC p -> con "PrivKeyEC" $ debugShow p + PrivKeyX25519 p -> con "PrivKeyX25519" $ debugShow p + PrivKeyX448 p -> con "PrivKeyX448" $ debugShow p + PrivKeyEd25519 p -> con "PrivKeyEd25519" $ debugShow p + PrivKeyEd448 p -> con "PrivKeyEd448" $ debugShow p + PrivKeyMLDSA44 p -> con "PrivKeyMLDSA44" $ debugShow p + PrivKeyMLDSA65 p -> con "PrivKeyMLDSA65" $ debugShow p + PrivKeyMLDSA87 p -> con "PrivKeyMLDSA87" $ debugShow p + where + con name body = name ++ " (" ++ body ++ ")" + instance ASN1Object PrivKey where fromASN1 = privkeyFromASN1 toASN1 = privkeyToASN1 privkeyFromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1]) privkeyFromASN1 asn1 = - (mapFst PrivKeyRSA <$> rsaFromASN1 asn1) - (mapFst PrivKeyDSA <$> dsaFromASN1 asn1) - (mapFst PrivKeyEC <$> ecdsaFromASN1 asn1) - 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 +348,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 +401,189 @@ 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 -> case getMLDSA oid of + Just (name, parse) -> + case decodeASN1' BER bs of + Right inner -> (\k -> (k, zs)) <$> parse inner + Left e -> Left (name ++ ".SigningKey.fromASN1: " ++ 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 + getMLDSA [2, 16, 840, 1, 101, 3, 4, 3, 17] = + Just + ( "ML-DSA-44" + , mldsaFromASN1 (Proxy :: Proxy MLDSA.MLDSA44) PrivKeyMLDSA44 "ML-DSA-44" + ) + getMLDSA [2, 16, 840, 1, 101, 3, 4, 3, 18] = + Just + ( "ML-DSA-65" + , mldsaFromASN1 (Proxy :: Proxy MLDSA.MLDSA65) PrivKeyMLDSA65 "ML-DSA-65" + ) + getMLDSA [2, 16, 840, 1, 101, 3, 4, 3, 19] = + Just + ( "ML-DSA-87" + , mldsaFromASN1 (Proxy :: Proxy MLDSA.MLDSA87) PrivKeyMLDSA87 "ML-DSA-87" + ) + getMLDSA _ = Nothing + isValidVersion version = version >= 0 && version <= 1 newcurveFromASN1 _ = Left "newcurveFromASN1: unexpected format" +-- | The private key of RFC 9881 Section 6: a CHOICE of the seed, tagged +-- [0], the expanded key, or both. A seed is expanded into the key; with +-- both, the expanded key must be what the seed expands to. Which of the +-- three it was is kept, so that 'mldsaToASN1' writes back what was read. +mldsaFromASN1 + :: MLDSA.MLDSA p + => proxy p + -> (PrivKeyMLDSA p -> PrivKey) + -> String + -> [ASN1] + -> Either String PrivKey +mldsaFromASN1 p con name inner = case inner of + [Other Context 0 seed] -> con <$> fromSeed MLDSAKeySeed seed + [OctetString expanded] -> con . privkeyMLDSAFromKey <$> fromExpanded expanded + [Start Sequence, OctetString seed, OctetString expanded, End Sequence] -> do + k <- fromSeed MLDSAKeyBoth seed + sk <- fromExpanded expanded + if privkeyMLDSA_key k == sk + then Right (con k) + else err "seed and expandedKey do not match" + _ -> err "unexpected inner format" + where + err s = Left (name ++ ".SigningKey.fromASN1: " ++ s) + fromSeed form seed = case privkeyMLDSAFromSeed p form seed of + CryptoPassed k -> Right k + CryptoFailed e -> err ("invalid seed: " ++ show e) + fromExpanded expanded = case MLDSA.signingKey expanded of + CryptoPassed sk -> Right sk + CryptoFailed e -> err ("invalid expandedKey: " ++ show e) + 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 +privkeyToASN1 (PrivKeyMLDSA44 k) = mldsaToASN1 (getObjectID PubKeyALG_MLDSA44) k +privkeyToASN1 (PrivKeyMLDSA65 k) = mldsaToASN1 (getObjectID PubKeyALG_MLDSA65) k +privkeyToASN1 (PrivKeyMLDSA87 k) = mldsaToASN1 (getObjectID PubKeyALG_MLDSA87) 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,22 +593,55 @@ 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 + ] +-- | The inverse of 'mldsaFromASN1': the form the key is in is the form it +-- is written in, so reading a key and writing it again gives back the +-- bytes it came from. +mldsaToASN1 :: OID -> PrivKeyMLDSA p -> ASN1S +mldsaToASN1 oid k = + (++) + [ Start Sequence + , IntVal 0 + , Start Sequence + , OID oid + , End Sequence + , OctetString (encodeASN1' DER inner) + , End Sequence + ] + where + inner = case k of + PrivKeyMLDSA_Seed s _ -> [Other Context 0 (convert s)] + PrivKeyMLDSA_Expanded sk -> [OctetString (convert sk)] + PrivKeyMLDSA_Both s sk -> + [ Start Sequence + , OctetString (convert s) + , OctetString (convert sk) + , End Sequence + ] + mapLeft :: (a0 -> a1) -> Either a0 b -> Either a1 b mapLeft f (Left x) = Left (f x) mapLeft _ (Right x) = Right x -- | Convert a Private key to the Public Key Algorithm type privkeyToAlg :: PrivKey -> PubKeyALG -privkeyToAlg (PrivKeyRSA _) = PubKeyALG_RSA -privkeyToAlg (PrivKeyDSA _) = PubKeyALG_DSA -privkeyToAlg (PrivKeyEC _) = PubKeyALG_EC -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 +privkeyToAlg (PrivKeyMLDSA44 _) = PubKeyALG_MLDSA44 +privkeyToAlg (PrivKeyMLDSA65 _) = PubKeyALG_MLDSA65 +privkeyToAlg (PrivKeyMLDSA87 _) = PubKeyALG_MLDSA87 diff --git a/Data/X509/PublicKey.hs b/Data/X509/PublicKey.hs --- a/Data/X509/PublicKey.hs +++ b/Data/X509/PublicKey.hs @@ -6,78 +6,92 @@ -- 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.MLDSA as MLDSA +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 + | -- | ML-DSA-44 public key + PubKeyMLDSA44 (MLDSA.VerificationKey MLDSA.MLDSA44) + | -- | ML-DSA-65 public key + PubKeyMLDSA65 (MLDSA.VerificationKey MLDSA.MLDSA65) + | -- | ML-DSA-87 public key + PubKeyMLDSA87 (MLDSA.VerificationKey MLDSA.MLDSA87) + | -- | unrecognized format + PubKeyUnknown OID B.ByteString + deriving (Show, Eq) -- Public key are in the format: -- @@ -87,109 +101,150 @@ -- 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) + -- RFC 9881 Section 4: the parameters are absent and the BIT STRING + -- is the raw public key. + | pkalg == getObjectID PubKeyALG_MLDSA44 = + case xs of + End Sequence : BitString bits : End Sequence : xs2 -> decodeCF "ML-DSA-44" PubKeyMLDSA44 bits xs2 MLDSA.verificationKey + _ -> Left ("fromASN1: X509.PubKey: unknown ML-DSA-44 format: " ++ show xs) + | pkalg == getObjectID PubKeyALG_MLDSA65 = + case xs of + End Sequence : BitString bits : End Sequence : xs2 -> decodeCF "ML-DSA-65" PubKeyMLDSA65 bits xs2 MLDSA.verificationKey + _ -> Left ("fromASN1: X509.PubKey: unknown ML-DSA-65 format: " ++ show xs) + | pkalg == getObjectID PubKeyALG_MLDSA87 = + case xs of + End Sequence : BitString bits : End Sequence : xs2 -> decodeCF "ML-DSA-87" PubKeyMLDSA87 bits xs2 MLDSA.verificationKey + _ -> Left ("fromASN1: X509.PubKey: unknown ML-DSA-87 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 (PubKeyMLDSA44 _) = PubKeyALG_MLDSA44 +pubkeyToAlg (PubKeyMLDSA65 _) = PubKeyALG_MLDSA65 +pubkeyToAlg (PubKeyMLDSA87 _) = PubKeyALG_MLDSA87 pubkeyToAlg (PubKeyUnknown oid _) = PubKeyALG_Unknown oid encodePK :: PubKey -> [ASN1] @@ -197,68 +252,85 @@ 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 (PubKeyMLDSA44 pubkey) = + asn1Container Sequence [pkalg] ++ [BitString $ toBitArray (convert pubkey) 0] + encodeInner (PubKeyMLDSA65 pubkey) = + asn1Container Sequence [pkalg] ++ [BitString $ toBitArray (convert pubkey) 0] + encodeInner (PubKeyMLDSA87 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 +338,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) diff --git a/Data/X509/Signed.hs b/Data/X509/Signed.hs --- a/Data/X509/Signed.hs +++ b/Data/X509/Signed.hs @@ -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 [] diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,3 @@ import Distribution.Simple + main = defaultMain diff --git a/Tests/MLDSAKeys.hs b/Tests/MLDSAKeys.hs new file mode 100644 --- /dev/null +++ b/Tests/MLDSAKeys.hs @@ -0,0 +1,365 @@ +-- | ML-DSA private keys in PKCS#8, as OpenSSL 3.6.4 writes them. +-- +-- Not generated here: the point of these is that another implementation +-- made them. A round trip through this library's own encoder and decoder +-- says only that the two halves agree; these say that what comes out is +-- what the rest of the world reads. +-- +-- openssl genpkey -algorithm ML-DSA-44 | openssl pkey -outform DER +-- +-- OpenSSL writes the @both@ form of RFC 9881 section 6: the seed and the +-- expanded key in a SEQUENCE. +module MLDSAKeys ( + opensslMLDSA44, + opensslMLDSA65, + opensslMLDSA87, +) where + +import qualified Data.ByteString as BS + +import Data.ByteArray.Encoding (Base (Base16), convertFromBase) + +hex :: String -> BS.ByteString +hex s = case convertFromBase Base16 (BS.pack (map (fromIntegral . fromEnum) s)) of + Left e -> error e + Right b -> b + +-- | 2626 bytes of DER. +opensslMLDSA44 :: BS.ByteString +opensslMLDSA44 = hex $ concat + [ "30820a3e020100300b060960864801650304031104820a2a30820a260420151dff249cb3" + , "4b87169de5d99e2b19666f2a9efbecab731295509007c22ddcc604820a003053ed09fbcf" + , "1d28675cc66c20e7bb04cb7e077b11f285aec9ce9ae530526ab0299ad6d0887cff9a40ff" + , "d31ea92f2b7ef42338fe02d3159b236d1252012e65a60936c589b63435a8f2f65b5b6f16" + , "058f72851d5e63f064187083aafbec42927db7b13528591a2336c476736e0c0a0c6dacb7" + , "6c70949268a84b9530bb2bb2689608a72c48982044c01014a721d224644b820914876cd9" + , "40090386418440221ba26ccc42818816608230420ba684d9b40921236959182d084852d8" + , "380c04367102254e82b21021c78c4b442e123071822621184720c8226298120adb207118" + , "248ae40084e2b4315ac220e0404089900023119201c628123351db10848bc88808382c0c" + , "498c81360441380cc32012180460c2c844d0384144102909448ad2382592442a1929721a" + , "2388d1328d51a68c21460e1811510ca3459a9608d0c824a4c87003b9840a284462b84d08" + , "99501c803020b890c1b0654a20012403441146665430868b48910a448d4ca80801994d9a" + , "847161288664248999427009c825609441a4948042200401046c2202311ca184a0002dc4" + , "c24c51088898a6699aa2298b106d44448e1129721b000a93b229da1249cc164022182d91" + , "26442014004c4866002461c1b0059a140c02238a1b410e0a3806cb9251524840cc80290b" + , "04224218686440828c964852445209906162a27181066a5ab48c20984d893805cbc84881" + , "8090d4a2915006651326649aa608e2c8059128041a27729c228853b86541382e89b23001" + , "828d1b820022115159a41024436498a0508a06648c020093c6411b060e932021d0004021" + , "21801c364609292198c2659c3449d8126a0811452246218c864ca0260c9c023199880c22" + , "2149e39809d2342501a570d4a83150c0601c929082a60d02c629d0400a44068404b9611a" + , "866003396d0a186463c0680820204b260a114992a30049099089044752a3186610298d8a" + , "446682320850b2904ac289d9122d44462212246193a62804a28854a80c00b74c51044403" + , "801012458e50162cd3285002c4051c388ca04412903070a1c861cc349080c42c43324224" + , "45269c96696288688c268299b26c4c823000b2809c24051ab889530685028401d3c0491a" + , "80680003861b252c523669d3c62019042453222983866d9102826496910a4321da462493" + , "404ad23689233031a1104a01328108396880288d608271440404d81865d2a0818c44095c" + , "a08d43188401c971101205c8c0045b1085dc2050cac410a320319a35cb74122d502593d4" + , "edf07f9236080bd29e26691f48721d4724b5a1b13a14aae5f8a1d1e0504419ac39dea10a" + , "5ad354bba5a81c391739a3505d5e92d3b35ad7a74c64b0c46229a61be43cfb9e14aa97ab" + , "99295cf2212be68590e7e53659f2cb6a5718a0859acd609fd94845ddee0927c75547d1d4" + , "ab9864f60266df48f9afae8ee8275f98c8273f6be0249e6f0c069da46d215596cbc1c5d2" + , "ce17c67287e7696e45a6d9fea29ef1a7206855d87841a929837277f7aa0ef8118e52659e" + , "a033c42ef06cbc913fb02ceeea3a1bc9d5c09e89d8dc49d85044a01e8803fe3a540b02f3" + , "ec78fcf2611c103a8f9b5bd9db91b9a69a12b96402cc6866b16fd22923ce78e8c75754a3" + , "6c04aa80b21f0a90c28ee2e6e567be4a278427619965e289dde9643fe4b483fa70367efb" + , "9d52a517a2b1798dab0a4e89198cc3fd30afcd85ee423523f06cb23c7959c0d120256561" + , "88c4a818e7fec6e7195cf3a5ad016f93d8a62cd6b557cc6400ed2e81b43613f0da80934d" + , "d9be78bfdacd6fe50819498a076806a326fb3825dfff67a8dbf2da4cd81b88965d8b170e" + , "87e56a796c028e6511ca9a3db4eefadc1a0d57d75e1d75ebefeffe9ac4d0ec5a60cad8ae" + , "27e6f39afda951b2de41e4042845584e753654a619f1c9df5c7996ddde570ff42522538a" + , "5e323936f2b3bced1eadffc5bcef84d16b729a8a9442ac7c3844b66dbc75deb4904bc207" + , "948f162bbfbea6f8b7788f90cd66b61120b8c29b317cead830d018d6990b9bcfa6c907bd" + , "8ea63176fa89bf0c4af60f28b4604bff034a36f70be8ed8d004ef520f292cc8e9202c0fb" + , "28df92c04296547f3ab012068fd24cce21307201ade6b7b7071937471be57ef02173e7c0" + , "fddcc302c210f3ba2defd3631b174a590371e81dc4a0c8a7c79ce59840d4fb1b2620ac11" + , "c831b43da3525db213adbe3b35295aef04bed771db85cee59ce7a8ede9bf1782ed0b074f" + , "c3db5bcc5b6d101e250df37913d3b76babc9ff7852fe9f47427d04ee0c19ed869297428c" + , "84e0549e6fdbf16733fa32097dfd97ff5165c9dd34e6db794de6d9680e995fef0c22a3cc" + , "28cf4fdb3b080269d7f1aa65516042186ad420a75841d7c762f0e4754113aa518d185d6a" + , "934704b285d78fec4d34246c338e062687cc0f1f9311e948428ee7885492fd0c08da6471" + , "d3a2afd3e7388989ceb0e91f905d1e0f6e2f67c2be69dbb6df0f421ca8403f69946e88fe" + , "b695b0b1b6cd93a25a8316527505dbad480a59bce5b68d261851311ad410efd9ccb10ee5" + , "0f8448d1493242050e016912f80789c15ea5bbf382600203360deec68ac3ccdd861c54b2" + , "8555a398ef400792e6410f37aa74a502ecee6130da2f8b2a97005f76386978c1300e4e50" + , "49a722a0af7de32b010a73a6514a614dc80901fa868ab749ed109ee5d10a3807e2b3b4d8" + , "a5bbaa4b6d3f88104798135ecf77ddb314f7bfdc0a1eb461bc3a1890dea5e62ce4a1cdb0" + , "411b585178bb6fedd29a56b1cabdc93d09e008199a6558742bf8d66899ea6f10aab34bb2" + , "f6b08dddbba4169f6f61a7c5368addb74b6c4b8dbc9882abddbdcc403b749f5edd4a3b70" + , "561a44b34c3f85ef84c845751e983025e50d984eaf38a0d470d73436a537ce1f07666751" + , "8fcd15547d98e79f27c6241da5fdba9946a3916e2037f76ce82535a17a1618a8894e63a5" + , "1fb2258a2e5e7794ad9e839cc03c3a2113204b514ac55e4e9e330b2295c65504eb16714d" + , "af385fa09b3dc92a2594c75fada27a17cc09f6d5581b08a03136d1ddc4cd2bfe1f7c384a" + , "9b01f26698bc0e3914448a6ce6f50ee09f618b6ee4b29694919cf1c1304c35c9fc429964" + , "31f1c5e1965383bdd9d6e85a1df1f6a73065a1cc4dc00ae7e69bff0683d844c5bfdcdc08" + , "05dcd36ffbcdd7bb94fe4194c715197401c97771cccf078d591cea169b25cb60e7148678" + , "e4efb857bb101a78abb396a73fb8556fba6b265f7dc4c793cf58048a005be22917e61bf8" + , "edb95cf1005c3a9b6c797f49f25dc13c869399091bcaa0e699cb8258e4b2c843da6a1048" + , "48e4471eb1e8f08c7482c7531b30174cb433cac5050399fa607bc6244400cf0744caee56" + , "31ac9a5ecf67abf77c6bfd438fb76f3d18d859b7e209c88e1e5fdeb77bfe999547a207c9" + , "05e8889fa622043f2b8da2e052e5a160bb006bf40f69761820435c59585d49101607b046" + , "291f407f795e7d71f5a43eafc36b319a03162a155a40799a61225efe3990aefa4779283d" + , "ae2b66daa98b28ce95d0a0afcab2e42301f46eec233439e80391941904881e716c4f2c79" + , "23711d2927e181193a6de8d4329ad358817ddb2463148c3ab985c19808aed1909cce" + ] + +-- | 4098 bytes of DER. +opensslMLDSA65 :: BS.ByteString +opensslMLDSA65 = hex $ concat + [ "30820ffe020100300b060960864801650304031204820fea30820fe6042062c8740c6f5b" + , "e0c726ecb2e8c6f1b22faf29ee7a562de1a95a6ace4993812c8e04820fc01a31edba22f1" + , "50ee1738e8bf87429343d274b5bd69e60feda1dae7b881afd0354992fd2ba1a609acf0b4" + , "4a0413a86ac8dca104cc460d7cd80db0f38c76ad816f8c692ec5b5c821aa21ded5f1e7b1" + , "7a8ad3534d2850d1d3f08562ab2b8b00a18f8e796ecc8f9f6d44d19099aa49410fb23e37" + , "981740d02d957bdd8dd19aa9463e52208184643106838414406247510502717570630322" + , "333340348846565153734381027643367848711037342000305418167076011152763614" + , "360036114818757772181646230261447105735122373755001016732454770100313157" + , "017817783853214666474073350114481534144318477611815667075522034524034561" + , "405058475248684860680411802753833017174355888413426888852426871532668712" + , "111433846561762118875606253783552072354337335766843377042210322266862033" + , "318347136247651233866617100468638340638002367511352001360712375002063667" + , "513007528247530118344227327731070538433300147277812580606457801432336627" + , "354041166152518730060160020748471117175588272420573372562508520727654411" + , "207507452018363433575624541814133431773421663310458463112367254078641742" + , "601601041567835052631717551465400580807676334023431865516435865273080275" + , "105305862184715168400303265533644671604143424001288640550704174028060502" + , "655158646531448117777064104154583325006466524860733405334611440438553060" + , "561536627177465858121558620423860053888746373827387753536775632241028626" + , "833887013814141312321545831375434468161657485845108015474443283753833717" + , "753678738561138255737381602451863450022408252128406317347455344310081565" + , "526811015763376527042614842148148805104082500020533740381561618131672237" + , "806557607168670118153081638474686850760447381012211060418005871108243667" + , "672823514026365327021815127654068432345354144202635848086606318504201076" + , "347262054208141460281457238134715587066020113468581226120277165763646706" + , "335268040647817457330735125026055883341578536181455620235405883043100185" + , "836410080502321606151075828705654646467866335740352251484250636375724436" + , "700476701341487842804788605677123552714662132871600465871663678172122308" + , "117801578082508863160152568880765846330011510607645371033231548620270651" + , "217822156271604815603740340311422686316862400374766762631221508365438245" + , "322565585663385524478706630016782647387350068870323363054176624783638712" + , "504004872703415740422242376674302301424417033455127724488012872205680268" + , "074052636611562483800502260316637482200001108624572715700743752306022188" + , "440684881514010455750377217655046186824282620128031056600471876815022773" + , "465323471601830471086315511081723030757186532733414771668757146585873778" + , "643523825637838431777263531448504444788253215812408468467773328233352487" + , "470808848157886003582420058711663641226827647106518037834311220647336226" + , "172235777106242832861510073285581843682263331052140236102155032852815016" + , "601700412573263188186253846627461715416718320841166781368781674771073677" + , "453304358813321407060576436306848150507710618286640354123320525147476718" + , "177333846174371781255824717212823625567200001848525323737344106125680584" + , "181846483106031726074672420026727441500182257456024485874381257168246807" + , "585557261283143712318526341803073887550140836151518677231230288877371567" + , "642718063771662662581227147768585853432257306476775841358601510038120126" + , "407387663325055740436215754707688310d0d58aa8cc178e2462327d7adbbc0a8bd863" + , "62d4c35db9d95f18842c38d2f408451e1f4f971623d954df6e0fa9a4595de7984746f11c" + , "8b09de3bd6d2cc60788f319552e0e0364b1d5a3cce106c495bf349bcdb51000dec34590b" + , "f11bcc1dcda4f2bf50efe394d62f846822fa3a96126974be047e456c7bb0a1124b448332" + , "fcbd5865a1ef81be8838075bc129eca0c7dedc9a2736da6391124d1da59014391b35c625" + , "74c66b96235ec17ad7ff4f7974d20d10a2ad9d7613c91e7785ef955f8d289baed537046b" + , "90a18fd35058f6efbdf996625824f0f2b6da5449a64ec8c17155a152c5736f5185be3bf2" + , "ece2ebb06947a0f39a12bd704b097b04291ae4af4ebdbe087a6a17cb1520c869f62ab927" + , "99a6d2d798ef01978f6d00eeee529b28992d54aa47a64c99feca55ffcd52eb7c84a7fc19" + , "3899a23b8a639d5f682e0bbf16cb12f609506866565fec091ee97001335a4252065447ec" + , "81e734d2f911d0ac496fe94b40b7beb5b52d6f5949f5ade53b3aaa8d9ee35e7c7b6a5f80" + , "f010b69e1f1d781c0f7dd730106b2dc17c9f9cfb64003acfca0013968d98d865f5a1d253" + , "fbf78d7fc30f7bde65212f4aabfc3e976178ed6f94d12b084b3aa2031e4aeeabc2fb691e" + , "9dbe40c2d7a32a92d86dab00c39c8bbf94b93f20c68ff711250ce43ad169c228133b0958" + , "97c62cbe2706dad8cf23f2ed1ddca4200d6ce9fcb7c48ae6dd080316cfbe87d36a3a9a80" + , "04caa374b0f08e9e0faadf53cd0130c0116aefa222ab2d2a7c8c7d5ab3e17e8a7d0a98dc" + , "818331657ffb452e65e110b63ba008a6c1250a1198e11855078c1c76c3777dbd3da08160" + , "78977b9873b9537da023466a3ccd47520bc3254224b583932259bfcf6df1cf9cae1bbde9" + , "814c4bc05da3385d18af20e91dacebc9827cfb5c342205e49dbd3110af4c5ad0c9b3c435" + , "945e9152929bb094444101dfc95c9847bec5721b0a629b2f1ef646c6eba796d4409fa889" + , "240e127e9b530070dc78e504160aa8a7e01483c48d54925ae36ee91f6c1647c0c292522b" + , "931ecc6544c1e1ef933205cc4665d7c43a5e537df9de1ce34b9eb985ab9abe607228a748" + , "0f96f7f2c233feb9d3039980cf8c9aec54f92ec8211a9a2d7ad42eaa9c0da5e7d032e63d" + , "d1c85cbc732c90f07e1411086c95f401a68da033db92a1144c09ada62e6022443b0ee70b" + , "8ca04c4fe663c304449fcf4236b9cac8461d5ae3e3ccc409afc5f0aa4d02abe980995545" + , "1198f88d143488f62d5ec2f5301f706a19efebda7878a6e1afa7daafcac0d45fb8451ea5" + , "6c681937f0ccec0c1b3a437e12bdcbcb62a17ad1d99f499b8b9c1bb35e85dfb88bdccd91" + , "f71e1bfba790a5200c166aedc29b7fed78b1e4a0691229f2e8add8377e369005867b1e5d" + , "c43050fe546c65751e79ad032323e039e1ac67acc081c1b157771edfad6e275f105460f3" + , "7da53ac4ea4941490527233925b7f860eebeaf89ef096a4a00979c61e6dc8bbcee482ad6" + , "822041e8625a69fd6616981240cc2a01ca33bd67a674e273994632a43f141b89a89a24e4" + , "fa94780b9b3fab34669f6f6acd264b4a0cb8f0f3f7260a784c79efcb9107d6d784ac4a67" + , "a86f50da3c7cec7783914727dd0d06343d84f9760dd8c3de98eb3b6240277985b14e5baf" + , "3ce83fb02d7bdd97fbd7aae97a6fd159c0c910f7004de43605dcec069c9e9dd9678b7bc6" + , "2614217df4ba635ed1636149ac6c207bdb149a551d5b73037cb238f677a113316a857cea" + , "6763fe1386e59568dd82970e7f006c0b312e49c31047e2af7b52c9964f94fd207fe7773a" + , "68978dec08cf2cd350b9d1728c663725499e4f98504d8620762d175ac7a061552a65b088" + , "fcf048b64d94f3e63bb1fb5daae5b8e6b4475fed3a7440406affcbbe1ad9100b50ec1fce" + , "b5863a77ec8be20c17afa9fec9827d0cf108f945317c9b6aa295fd59ad9127d7455dd18d" + , "5cae5bf6f821020255e7687f445e205ae71ecdb2511264284f04b6d5f3d30e26a608cfb0" + , "a60623e1a66d3686344ce160092bf808c95ea6a9bef196a903a4d1482c354945fe88820e" + , "f13501c270c02864a63134051184449ed9201d49184ff824c5185f82c49bda8cb1a2b051" + , "163016814fd1bb5fdb2d936bc4f5c21e5ee3e8584179e43be5cde2f2b47c457be9980559" + , "5bc3e9d8e4c9ce8e748e8cfa9f4ecacd228ddd7690084d0d893ab014bc72e70dad8264f5" + , "8eb498caa0e3025f43fc71c02dd32afed753b5d8a46dd9c8b3978e8e4163423cfb0dbfec" + , "a06b3666ab5743afc0d540604755bf716a1de0c6d32c7e28eda63e69053b9e54a4569ce5" + , "58ed1049f3058efec60877a53b9f56ca3a217a95a3bf918f5d1a58fe2a890ff8f72f1d32" + , "df30470cc667e504149b04207c13a16428e3f47b6ea1c6f889bd2363be544f91a326724b" + , "fde2dd3984475c86a8dd5c7b45b5f76e9162959300790167bca61666085216404e140f4d" + , "0c2787a85c6d2dfc018ab44e0ea0dc00a89eba64bf71a4e57a2266a96d7a39baebcb682b" + , "c0361ff336ab7d0b440f5f9d320dd5f705e9316c3be45a3ff96f5ea87dc5ce397f3ae7c5" + , "38188b253ac6df51906637a6ff5c26066f541eea6d63bdd7821451e1c4769216f5e45511" + , "d99b949610d222135a8d3dfea12f0d704cdd4012882340db36c1e2085ed065b49fc998c6" + , "bd4955282cc8c450fe8f5dac5fa4b0dd882a378b399b3097b8afab0ab1d2fe2433fda7f5" + , "542707b50e49744832b3693b44377b8fbc9362367841e85e1ef9d2789617b302f935fc58" + , "53fc5a6783bd307c2097f612b173d0b3b24fdf2b332ab9827ada091b8cb4243b23490438" + , "84abf44ab780599d682484a898c89612dfa6e6e128626b23e32fc1c3bbe717cec0141bc7" + , "379a3ebf1eb072f70e4aabbdc0a7635760cd74eb850c42bc2b9298794963b833c48ca544" + , "683e512c5a734e713e10274b0ce5adbe15fad996643fa6c075db2fdac2cb4438027c6b5d" + , "7eb4f2980c1513d92267f90a6ed8e287f6bde9e745712d2ac6de843f56223bb2f5bd35bc" + , "c9fd83a782d437e0d6094af64255de70cc2240c7bbc57cb4c5ebff8bf288df4b28822306" + , "02a1cb7a984e5f6923f8c5db79cea441f8a28a559be3c74d5352f00f5ab5ea6c369f94bf" + , "432b66e7982c078980edef59d757d133033253b1b55066dac7954d2ca53fc42744eeb541" + , "bcd971a1ebf832e2925177024222c3eeaa9226efe93e229d1561ff7ed471fc71fb435028" + , "458438e20d671d26bf3fd1052a255a63b249d855c98f44cf1a01f72acb3e1dde713facf3" + , "8195d7950e0584f98c0145d5e60d275d299a8607af142d12cfc7f1c1e19b5ce917a3062e" + , "18f15890ef19f923edcf18a6af4e4b1514fe064b10153793acbc23c3ece6fe2e1095e202" + , "1d92d82cca5b24d517bf9cd848af9813909604dfd4128b349dde403458e55a34ec4b41c8" + , "97ea9a909515774e0aa757cb863296bc1c017a693bf7e104aabe3458a08f7b897a5b128d" + , "463b03d52acd6fccafe603aeef466e3d88887533b76a0a33d3cad5ca1ad7" + ] + +-- | 4962 bytes of DER. +opensslMLDSA87 :: BS.ByteString +opensslMLDSA87 = hex $ concat + [ "3082135e020100300b06096086480165030403130482134a30821346042086aea35731b2" + , "7bde938f1eac39d757b84e88fddde9f585703952cca3a8f29b53048213204624fcb8e48e" + , "f22d91bf330fb8378a5d2d89a7c7800d90c8f289209faef4e924f685483fb0f845abe9bc" + , "130b4e070ca994d1fb925d736ba629eee21d10e126c02eb255fffa131ba3145c485db180" + , "69c4bf25d5379c789593e78594b4931e02b497f5d16cfcd44ddf8970fc2271115ced6968" + , "6c8fe8bf8eda96d66aaf309f650f54c885c396490000620929060bc465123632c892450a" + , "094e8c1446d1a09113345214c488c3c401db20400b1712dc3844610888a0308502c64461" + , "98619b068919184ce1805089c26c544671e2482840260160480c904001cc94305b269041" + , "a4214428308922264c266d81284d0c366c62c211cb8630d238514188095b3689921626e2" + , "388d10308a9c0010632242caa87003a4719022481cc18861c6480b028192960c8b100152" + , "406adb846c19054624296603b2600ca76511056658c270d080851c98040a25691925290b" + , "c7010ba051941264d446818aa4500b022e014231cc14229a382a50144111097140426022" + , "072183b2688c1624c0c865db84216314125c16214022440b124a24829110a20903184e11" + , "958184a825d19081d802028c18285286499ba024d9c24d8228469ab000e2924409c4818c" + , "406c50348c9cb848494464403409cc301120c24863980540144a828684db3232d1b83184" + , "420161c0658900450b208d08c18400c26d11b56053a42843c8091410261b9311c402600b" + , "91880c24264a462501818cd9028184286ad4288c6204412146845c126413c00420246940" + , "10610bb020009508d8107241c40d0c280d932485c032414432718a08405ab445da246c21" + , "2562cc80208332660b1408004652c30061a30231c19451133305c0a20409166cc4408c12" + , "4788014701999681c8c46d0ca26c4b368ac19829dab48cd3b68c011284c1a27090086cc2" + , "34640c174e63120aa22266d18061c4262908474e0bc548d3a26d82184494a8049a804d50" + , "36052016325cc0450b288d4a86695a2000db084e9c22819b380061a8881c1084c4462660" + , "c028922252a33872e22672c91042d300264b124ad8927119320e1916325404624c0400c3" + , "844d648045c0800d030668a4988098887011474d232066db2404a48421832664a2085042" + , "805101250a5ab405c2a2001b2346a44609a00404a0846594462264c26499a08d92120e80" + , "107000b800a2184593086a53187204087093060ae1a0881010429826468086410b364804" + , "b020030266d3a42cd93842129781da9480180785648840e1c22ccab60c6038800cc93089" + , "188901c9650105825b4681a33861990290ca027159c0045c240009870c42302c8332425b" + , "2845a4189103c83000142c0812491126520a224804c924c11688dac201113046da84684c" + , "c40ca2086908b510c8b640d32462c2a888a02665d8a42c09450a1b1464d28620c8386259" + , "c67110041221352823174900b350121841a3484ca0947054006dd43801e39600112542a1" + , "a66500c8850aa280d99468424686a30028a4c62d24496508130d61280aa0222d4a068610" + , "348a8b16118aa8241a14609008000a4365a14849182630d9b2201a19800b34245bc46003" + , "148201315092420421c1811bc205cb06911a3000013370cc0205e1a888030100c1081201" + , "c92121170413472c8cc0655b162423434689362c542666980205ca868584946d9c288aa0" + , "1664dc2442e3402c61c205892080a1008601937011106608014dcc186c99868de4406a41" + , "080209b9711a46311a2081e3c88924a04d1112100a3101d90630830432e28244d8488643" + , "144e19116641169109248a13c6900b2841cc146cdab229099268d48405d31251e0008ed1" + , "38601321519a4670d9464a18148218000e18170e200728cb384402356a89a08141246c0c" + , "1886024881d3a289429220a0188614446560c870c01010dc300ec2a00c0a1231d8384d19" + , "4670e1920090322910822de1c008d11804a1102da3028981b231231484a1026ca3842d14" + , "c7080cb68c11050d6124241b190582102e2440221bb1914c948010969193c45142188e23" + , "431153c4614c42641ca61093b260042344cc249160a664881260ccb4712015419a80114c" + , "160550902020b05041a02c1417208400464c264119470513860ce09460e20608a012418c" + , "4260249030c318255b224619b86980240260101223b4315828495144529312264a8444da" + , "b408e4b28cc0c8104bb861e4c2093b72853beba635de72bc5dffee98638ac0059b01dfa7" + , "74f4a518039a355770b5c4e4cc09dcf898d3be26f98fa8e5b00baf0608055b66e90fd213" + , "87a1e2a59d648650b128672779707d37ffae34d9f861a20f797bef2f191688653e789fdb" + , "4f8ca396678f1ddd97befb8073e30577ee1ae6c879ec67185fe2511a47497613c3697263" + , "8ead3a46de50376a11a19166adec634986d8a4331a7fdeb98734b6c1f9850619afa0d513" + , "3409e2ce3b96a63db20b0e32aeb8f61e9ee7668a40f0bc1929b5a1890e347c91716cc3e1" + , "9e6ab093215634b293d333c21df77e1fb7df0dc5588dcaccc4de79282e60d10c9a04fa16" + , "3bee28c2275f0eb8d0ee30f4ed06541f57bef39b0808d14ae28c3585b4e538e87aec5ea8" + , "b6c1fc19160ec3b4ddfc4f018d408bb5e34a5c691aa2b261e2bec96c66854611ff11f94d" + , "a992c0db558d2d9851a758ea551a6285c8384b6a5790ff07cf4beabb644048b73b8a63ca" + , "fa50885da407307d676bdfc01840e1513e47aac4306430f5ca946f3f7fa140bb6726138a" + , "b29fcb3fbf551c6e97c4d63234d0e8a972cc1cd375422f71d8d3b8dc2eaeed51645196e4" + , "b8c15a469b77b40aabaa3f0b6b6832f4c415fee3f83b9e02e2649879092bc980cdf39f28" + , "b67b161f0dc49958fd4d32c2484c3a2732ceed9f2073bbd4247027118ead972ae6a74a58" + , "a25af79ef715bd285f37602fd1a83605c37c0a39f5bf1b618e571eb96aa65c9162521fb6" + , "79ef1f45bae2e6647c8ae17a3b3e1050004fb92f9f6cf0f178d65d462e59ff839c139262" + , "1245da9faabbebe93025bf6522679cc84915a5315639f5d1ead92632975be7f29db03b90" + , "892de9001dcfa7b8fbb7e35cbb3393b76ba88514f60600b9a6a8d0564643ddca1d6f72ad" + , "c15389debf65bbb72add4fbe2c440ec6f8479d5b1d721feb0f698de826f1bb64ec2fb85a" + , "61a9db8c6713cbfdedffa4fce1f403511af4765afb56f88a1664fbe5a37a736d9929ade5" + , "8b192bf96433950f32385d94a4ea501005057dec3511b30996299c61d354712068eea89c" + , "2ed098b94c7c353b4546ed9fb0637537155cc9abdf345246e20c7e300e13dad32c8d9f2e" + , "1aba7ae20c8b90ab84e863a835cbf1a00288f6642a3ac050c91eb0987674dfdca68241b6" + , "e5caf55937d838b5daeeaca88161a48c3951438d33d34814c9f71b0f5f9d657dd0702101" + , "b1a5a8f708d0b8a3f19a17baa0d63e695e29c6ce78a2b443e023610b81aca48a8fae237b" + , "0f82b98e69d89943d560c9731e4b395e4e75714ac915b56cb39cfbe9cf5e1d7ab1531883" + , "21fead83dafddc45b9fa81f0f088bca3fe32684e290d8461e9514797c238262b1dbe42f0" + , "827a1336273264fcd7ee59147c7e01e896b03b960b96f67cc3ac63f6dc05df6824069e19" + , "d9518878a7d8b3f1356c452c5d93ffb0f443ed9180b6a7489c119631388f95eca3ce5ab6" + , "8ffb56ee5cc8b879ac65ba27cd9819ffaa042f23e9ea3d4a1d00b64e73e14645a682c499" + , "661760b0571f17c94680c30aab8cf3151405cd852621a23354591d4f0aad3d3a481fd634" + , "b8521c25c3893f1cb7d34524878273bfce2fd45d134e1a78ece266bcfcfc7b043f49c1c3" + , "916b2ff2848e93921b2b961d93a60fee7b4b34006a1fc5aac978bfb462a27fed57bcdead" + , "a5864c8ca3e7e45a6cb1ca1af96ff56fe822dccde098ead28ff581a6ec34119dc44b8449" + , "08ce63260a2fbcd887cc8557fde512c8048f4481452011f13709bf1919961a7a94d99f3c" + , "e9c8c8311a12a2f6aae242a80af2971fa541999e33e110945a6f46a1e44f551256c8eefa" + , "fbded8e69f0796b47a14e10e3d5ce65e9b06ef01fe7fa337b8ffcdc9159995bb1f7940bf" + , "f9b7f06185c904f8bdd629f00db2fc12e5c53cc8cadff9913d755920fa61d3616fbacb90" + , "d035a637dd5eaa1497efacb87eb2bc7e9fecf449773e925f51635f2a07d6945a8f270ab9" + , "b1ebdba6228c8c53dfd1446eaaf2cc5a8887f40d91a97d6d9b0e27846185128c762b3981" + , "a09619c3201b2dd3eafbfdb9a1863a13bfe97116b32dc8784474a1f5395694a0553a72ae" + , "038afe497755b627632bd90ce3b3b0a15c5249fad5422a93e6cabc26989d6d586e8f935f" + , "ccf40115b3fcbcda1c0bcb4d1da8eb5d9df47c940b410cb03c10aac83d11a6fe3066f092" + , "6b3133e214b978f96902f591a159f3668d1c233122da7c3da21ffa9e8cffc556aa63cc7e" + , "d7202d228fa149acf595261cd3d6f457bdfdb116a1b139ada16e265d417cca161ea4bfae" + , "c4f2b1e4d2a1a9557a56f4cb36aba114e4d6279e45028fb25f96bc86546a3d351fb99433" + , "8e9d108d9a5138badd1eb647a74b231871d8b5a994fa56eeb2e09ac04fd89c8f56c157a5" + , "f9942c75087887098a5c0e959cf72e11bd9008d8eb57ccc4f9513200da7dbb6b3615efe5" + , "90e619e1ff90c8781e9bf19d2b7b4e04884827d0bd94b297f4a8638575102dd236eca161" + , "d9771cebd1cc529d85186c84ec86b0376a3ad7745b58af6bacca35b10fed57a349d2fb22" + , "7b114ca86716a98de8a2aac6b5f678ecd7127e6a09babb182d8fcaff2394d3f65e98a43b" + , "4d2f58bd29864f0cb0fbae6b6f1b68077f40cfb553c42d873157215e90437f4a648b2c66" + , "ae049290f717197fb3f00acb82d659281009a0cf9682faa66fdcd2ad7219fb883a236fe9" + , "3b7768e8df11ca70d094a9faa2c3a87e0293ec1a2feefdda5ea68a53ddced5f12aaa3820" + , "6fe739d4ef29555dcc720bddcb0e09a757aca320442add161faf36d306682fc89f3aba84" + , "b07c0a644602bf236f3fbe558e084b90108e3f16171c5bfab6f2e3d2017ef7b476bb3a0d" + , "ce25e8398ac291259000dc320418d313d5ecba47a1173dfc66aa40a322076ad79c494f48" + , "b5b2777545fd37cbdf6a295b0bd55982385e38dd4411cc560acc819a4a7e344befe841a0" + , "964e84e15a517127fba2325e67223b42a308ef43e0a503cf850663a3986abea5b3ed9235" + , "231ce6988f83c24fb0156a881f5380fb7aefbd6e8fcbb0cd192a80342ec8b5b1748d38fd" + , "d62d2275594ac48a7dc4c1069a3663f33e10ec711e5d92506cf1e45f3fe21ace45ed80d5" + , "c3221141a7308b3ea68263665c54d0cee1d36a49bb35595d0720e78b9b8f4e7f94f99947" + , "219f8d222e0bcc9198bda51b569d70dd26e278b8c3606694c8e06539b6fdd1bef69ea854" + , "647041ec4035f77bf13748f90ac6ca018f50af5511fd60f43d40ff0314310be5cfcba12b" + , "c1fe793e66a5954ef7a7a5e1d5699042e96a3f61d026b35b376dd3f494325bcc3dad2571" + , "5e40d5b9417a2d9c77b247200901a4b489aad5ab83d89f74da9e88e443d557536fb6c452" + , "af978e477a87f0bcc8cfc0535a6023d7f92826e5ee1f75e6c81bff20d277555e03d7991b" + , "3b3924023c33b5f80693bbbc33803a7a26206c654b05f6a39974dfe49b579b44a5f6706b" + , "4841098b9bcaa215865faf270ff186e1208c4614d1217978f07574d85d2a506ae7f77763" + , "b9e7419d00c8cee5688f14dd154ec9e7e3975f2119d0e9e64b071a6b80e8cf2c1b233317" + , "d3a64e8caf73cea3b47f2e1102871d40851230e8f09e908fe86495f69fae0a5301b5b289" + , "8167960fba4c1de5657ede5c958f3adcec887c9f21dfb25ff58edc283a28fb7f2e84fc2a" + , "1ca28a4602baf26a71d2eaa5b7c2d5f4573d3329f4ed754893700f6e2379b97bb119de85" + , "f3bc0367f0a23d31c4b7fc01c93574ffad9ea310d40b747fa12cda69e8da8a57ab09a703" + , "33e76c02abeb43f92c9b118bf234fb33b2dc82f909fbb07250db23dde3dbc14a799b5fbf" + , "4d5d2c361c8c21871c958117c1bc76d283c80156ab418848b8c189fc93ece61472e34109" + , "231c2d888f785510f9b9310c49664bb206a548c8b54fb29bf75fc642ab200c1f6fc07ead" + , "999fa61bc18ad5daba0e299658dde9865b51e54ff4cfe6cf26b5165884053c0ca7c6ff0d" + , "0774f623ec012f9ec999e2a9b4e24bc854fa89100e07399e24a22c99945e8f1c1de485e5" + , "43ee1e4f5f095f91d877d1f456c633f5ab5003ffbcea595827d88263ed67c6dc5f5a1aa4" + , "0b5150c8f6cb4e336cf7ec2a69937fb9d5e1d56e901d608dc6d29c23e27959813fd678fa" + , "957806dd510c3f69f8aca976178fe08a3e073272337bd1046885320c811d1e2d6d41d170" + , "0a4cf6773c2cd62d0d5199ed928277a54eca08a42e9037be611d6e7344570db3cb0d82a0" + , "d166e1162ea3d1b2d32ad10d90f542b8fa2dd9667c7ba465b7b66cda42d34acf612f7049" + , "d6c720bb613fcffa6c749275c4326dca1a3c95c98ef3ebd79c2625e9b437e52a737a9c05" + , "c5402a7ebcb81c71b7f9dff761ff3637a353969ce041397afe201cb5d4e519773b4fb9ab" + , "5389cd6c43f57f7ddd0ce00e9150d31594b4d4584ed4c4f41d0990ec224bb825ff14046f" + , "6d854347067607eb6740d578694c4542798bcff502517265b8173b0cd8200ae502321695" + , "9cc405d2bab2ecd22dfa6a967edb6e84377ee2558177148a28bb7d07c85466ea4ddea4e1" + , "49c0900217737ef402ca9580325c48e73a1a9c2cd62a6dea57489f0cb8399cd3e4a600a8" + , "210b80de90e38c6c58d9e67b22788939bf01881afa9d325853a1ec6b783d5ce3bab56ac8" + , "c967b451ece8e2f611faa073ce978344662d001714b493e7bd23937f5ebba2b3bc873931" + , "e2f8d27fd01071f0b7cd32980f3438423c86ce2bd56d45665029ee7f3097" + ] diff --git a/Tests/Tests.hs b/Tests/Tests.hs --- a/Tests/Tests.hs +++ b/Tests/Tests.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-} + module Main where import Test.Tasty @@ -6,31 +7,41 @@ import qualified Data.ByteString as B -import Control.Applicative import Control.Monad -import Data.List (nub, sort) -import Data.ASN1.Types -import Data.X509 +import Crypto.Debug (DebugShow (..)) 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.ECC.Types as ECC +import qualified Crypto.PubKey.Ed25519 as Ed25519 +import qualified Crypto.PubKey.Ed448 as Ed448 +import qualified Crypto.PubKey.MLDSA as MLDSA +import qualified Crypto.PubKey.RSA as RSA +import Data.ASN1.BinaryEncoding (DER (..)) +import Data.ASN1.Encoding (decodeASN1', encodeASN1') +import Data.ASN1.Types +import Data.ByteArray (convert) +import Data.List (isInfixOf, nub, sort) +import Data.Proxy (Proxy (..)) +import Data.X509 +import MLDSAKeys + 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 +62,30 @@ 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 + , PubKeyMLDSA44 . MLDSA.toPublic <$> arbitraryMLDSA (Proxy :: Proxy MLDSA.MLDSA44) + , PubKeyMLDSA65 . MLDSA.toPublic <$> arbitraryMLDSA (Proxy :: Proxy MLDSA.MLDSA65) + , PubKeyMLDSA87 . MLDSA.toPublic <$> arbitraryMLDSA (Proxy :: Proxy MLDSA.MLDSA87) + ] 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 +103,77 @@ 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 + , PrivKeyMLDSA44 <$> arbitraryPrivMLDSA (Proxy :: Proxy MLDSA.MLDSA44) + , PrivKeyMLDSA65 <$> arbitraryPrivMLDSA (Proxy :: Proxy MLDSA.MLDSA65) + , PrivKeyMLDSA87 <$> arbitraryPrivMLDSA (Proxy :: Proxy MLDSA.MLDSA87) + ] +arbitraryMLDSA :: MLDSA.MLDSA p => proxy p -> Gen (MLDSA.SigningKey p) +arbitraryMLDSA p = snd . throwCryptoError . MLDSA.keyPairFromSeed p <$> arbitraryBS 32 32 + +-- | All three forms are generated, so that the marshalling round trip +-- covers each of them and not just whichever one this module would pick. +arbitraryPrivMLDSA :: MLDSA.MLDSA p => proxy p -> Gen (PrivKeyMLDSA p) +arbitraryPrivMLDSA p = do + form <- elements [MLDSAKeySeed, MLDSAKeyExpanded, MLDSAKeyBoth] + throwCryptoError . privkeyMLDSAFromSeed p form <$> arbitraryBS 32 32 + 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 + , SignatureALG_IntrinsicHash PubKeyALG_MLDSA44 + , SignatureALG_IntrinsicHash PubKeyALG_MLDSA65 + , SignatureALG_IntrinsicHash PubKeyALG_MLDSA87 + ] -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 +181,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 +199,308 @@ 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 [] +-- | A scalar long enough that finding it in the rendered key cannot be an +-- accident of the curve parameters beside it. +newtype ECSecret = ECSecret Integer + deriving (Show) + +instance Arbitrary ECSecret where + arbitrary = ECSecret <$> choose (10 ^ (40 :: Int), 10 ^ (41 :: Int)) + +-- | 'show' of an EC private key holds the curve and not the scalar, and +-- 'debugShow' holds both. The wrapper is checked too, since it is +-- @Credential@ and @ServerParams@ that a program actually prints. +property_ec_show_redacts :: ECSecret -> Bool +property_ec_show_redacts (ECSecret d) = all ok [named, prime] + where + named = PrivKeyEC_Named ECC.SEC_p256r1 d + prime = PrivKeyEC_Prime d 1 2 3 (SerializedPoint B.empty) 4 1 5 + digits = show d + ok k = + not (digits `isInfixOf` show k) + && not (digits `isInfixOf` show (PrivKeyEC k)) + && "" `isInfixOf` show k + && digits `isInfixOf` debugShow k + && digits `isInfixOf` debugShow (PrivKeyEC k) + +-- | RFC 9881 Section 6: an ML-DSA-44 private key in PKCS#8 is the seed, +-- tagged [0], the expanded key, or both. All three give one signing key, +-- and each is written back out as what it was read as. +newtype MLDSASeed = MLDSASeed B.ByteString deriving (Show) + +instance Arbitrary MLDSASeed where + arbitrary = MLDSASeed <$> arbitraryBS 32 32 + +mldsaPKCS8ASN1 :: [ASN1] -> [ASN1] +mldsaPKCS8ASN1 inner = + [ Start Sequence + , IntVal 0 + , Start Sequence + , OID [2, 16, 840, 1, 101, 3, 4, 3, 17] + , End Sequence + , OctetString (encodeASN1' DER inner) + , End Sequence + ] + +mldsaPKCS8 :: [ASN1] -> Either String (PrivKey, [ASN1]) +mldsaPKCS8 = fromASN1 . mldsaPKCS8ASN1 + +mldsaExpanded :: B.ByteString -> B.ByteString +mldsaExpanded seed = + convert $ + snd $ + throwCryptoError $ + MLDSA.keyPairFromSeed (Proxy :: Proxy MLDSA.MLDSA44) seed + +-- | The three encodings of one seed, with the form each of them is. +mldsaForms :: B.ByteString -> [(MLDSAKeyForm, [ASN1])] +mldsaForms seed = + [ (MLDSAKeySeed, [Other Context 0 seed]) + , (MLDSAKeyExpanded, [OctetString expanded]) + , + ( MLDSAKeyBoth + , [Start Sequence, OctetString seed, OctetString expanded, End Sequence] + ) + ] + where + expanded = mldsaExpanded seed + +-- | Each form parses, and all three carry the one signing key the seed +-- expands to. The forms themselves stay apart: the parsed keys are three +-- different values, because they are three different files. +property_mldsa_forms :: MLDSASeed -> Bool +property_mldsa_forms (MLDSASeed seed) = + map (fmap fst . mldsaPKCS8 . snd) (mldsaForms seed) == map (Right . expected) forms + && length (nub (map expected forms)) == 3 + where + forms = map fst (mldsaForms seed) + expected form = + PrivKeyMLDSA44 $ + throwCryptoError $ + privkeyMLDSAFromSeed (Proxy :: Proxy MLDSA.MLDSA44) form seed + +-- | Reading a key and writing it again gives back the bytes it came from, +-- for each of the three forms. This is what keeping the form is for: a +-- key store that rewrites a file must not turn a seed into an expanded key +-- behind the owner's back. +property_mldsa_form_round_trip :: MLDSASeed -> Bool +property_mldsa_form_round_trip (MLDSASeed seed) = all ok (mldsaForms seed) + where + ok (form, inner) = case mldsaPKCS8 inner of + Right (k, []) -> + toASN1 k [] == mldsaPKCS8ASN1 inner + && formOf k == Just form + _ -> False + formOf (PrivKeyMLDSA44 k) = Just (privkeyMLDSA_form k) + formOf _ = Nothing + +-- | The seed caught at generation, written out and read back. +-- +-- This is the whole point of the two halves: @crypton@'s +-- 'MLDSA.generateKeyPairAndSeed' is the only way to keep the seed a key was +-- made from, and the seed form of RFC 9881 Section 6 is where it goes. +-- Nothing else here generates a key, so without this the two never meet. +-- +-- The key the seed expands to is the one that was generated, the file reads +-- back as what was written, and the file is shorter than the expanded key +-- alone -- which is what writing the seed is for. +property_mldsa_generated_seed :: Property +property_mldsa_generated_seed = ioProperty $ do + (_, sk, seed) <- MLDSA.generateKeyPairAndSeed p + let k = throwCryptoError $ privkeyMLDSAFromSeed p MLDSAKeySeed seed + privkey = PrivKeyMLDSA44 k + encoded = toASN1 privkey [] + return $ + privkeyMLDSA_key k == sk + && fromASN1 encoded == Right (privkey, []) + && B.length (encodeASN1' DER encoded) < B.length (convert sk :: B.ByteString) + where + p = Proxy :: Proxy MLDSA.MLDSA44 + +-- | What another implementation writes, this one reads and writes back. +-- +-- Everything else here encodes with this library and decodes with it again, +-- which says the two halves agree and nothing about the bytes. These keys +-- were made by OpenSSL 3.6.4, so they say what no round trip can: that a +-- PKCS#8 from the rest of the world parses, and that what goes back out is +-- byte for byte what came in. +-- +-- OpenSSL writes the @both@ form, which is also the case that has something +-- to check -- the expanded key must be what the seed expands to, or the +-- parse is refused. +property_mldsa_openssl :: Bool +property_mldsa_openssl = all ok keys + where + keys = + [ (opensslMLDSA44, "ML-DSA-44") + , (opensslMLDSA65, "ML-DSA-65") + , (opensslMLDSA87, "ML-DSA-87") + ] + ok (der, _) = case decodeASN1' DER der of + Left _ -> False + Right asn1 -> case fromASN1 asn1 :: Either String (PrivKey, [ASN1]) of + Right (k, []) -> + formOf k == Just MLDSAKeyBoth + && encodeASN1' DER (toASN1 k []) == der + _ -> False + formOf (PrivKeyMLDSA44 k) = Just (privkeyMLDSA_form k) + formOf (PrivKeyMLDSA65 k) = Just (privkeyMLDSA_form k) + formOf (PrivKeyMLDSA87 k) = Just (privkeyMLDSA_form k) + formOf _ = Nothing + +-- | 'show' of an ML-DSA private key holds neither the seed nor the key, +-- and 'debugShow' holds both. +property_mldsa_show_redacts :: MLDSASeed -> Bool +property_mldsa_show_redacts (MLDSASeed seed) = all ok (map fst (mldsaForms seed)) + where + hex = concatMap byte . B.unpack + byte w = [digit (w `div` 16), digit (w `mod` 16)] + digit n = "0123456789abcdef" !! fromIntegral n + ok form = + let k = + throwCryptoError $ + privkeyMLDSAFromSeed (Proxy :: Proxy MLDSA.MLDSA44) form seed + wrapped = PrivKeyMLDSA44 k + shown = show k ++ show wrapped + debugged = debugShow k ++ debugShow wrapped + expanded = hex (mldsaExpanded seed) + in not (hex seed `isInfixOf` shown) + && not (expanded `isInfixOf` shown) + && expanded `isInfixOf` debugged + && (form == MLDSAKeyExpanded || hex seed `isInfixOf` debugged) + +property_mldsa_mismatch :: MLDSASeed -> MLDSASeed -> Property +property_mldsa_mismatch (MLDSASeed seed1) (MLDSASeed seed2) = + seed1 /= seed2 ==> + either (const True) (const False) $ + mldsaPKCS8 + [ Start Sequence + , OctetString seed1 + , OctetString (mldsaExpanded seed2) + , End Sequence + ] + 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) + ] + , testGroup + "show" + [testProperty "ec privkey is redacted" property_ec_show_redacts] + , testGroup + "ML-DSA private key" + [ testProperty "seed, expandedKey and both" property_mldsa_forms + , testProperty + "each form is written back as itself" + property_mldsa_form_round_trip + , testProperty + "a generated seed survives the round trip" + property_mldsa_generated_seed + , testProperty + "a key OpenSSL wrote reads and writes back unchanged" + (property_mldsa_openssl) + , testProperty "both refused if they disagree" property_mldsa_mismatch + , testProperty "is redacted" property_mldsa_show_redacts + ] ] - , testProperty "extensions" (property_unmarshall_marshall_id :: Extensions -> Bool) - , testProperty "certificate" (property_unmarshall_marshall_id :: Certificate -> Bool) - , testProperty "crl" (property_unmarshall_marshall_id :: CRL -> Bool) - ] - ] diff --git a/crypton-x509.cabal b/crypton-x509.cabal --- a/crypton-x509.cabal +++ b/crypton-x509.cabal @@ -1,64 +1,74 @@ -Name: crypton-x509 -version: 1.7.7 -Description: X509 reader and writer. please see README -License: BSD3 -License-file: LICENSE -Copyright: Vincent Hanquez -Author: Vincent Hanquez -Maintainer: Kazu Yamamoto -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.10.0 +license: BSD3 +license-file: LICENSE +copyright: Vincent Hanquez +maintainer: Kazu Yamamoto +author: Vincent Hanquez +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 >=2.1.8 && <2.3, + 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, + ram, + time-hourglass, + transformers >=0.4 + +test-suite test-x509 + type: exitcode-stdio-1.0 + main-is: Tests.hs + other-modules: MLDSAKeys + 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-encoding, + crypton-asn1-types, + mtl, + ram, + tasty, + tasty-quickcheck, + time-hourglass