diff --git a/Data/X509/AlgorithmIdentifier.hs b/Data/X509/AlgorithmIdentifier.hs --- a/Data/X509/AlgorithmIdentifier.hs +++ b/Data/X509/AlgorithmIdentifier.hs @@ -67,7 +67,7 @@ sigOID :: SignatureALG -> OID sigOID (SignatureALG_Unknown oid) = oid -sigOID sig = maybe [] fst $ find ((==) sig . snd) sig_table +sigOID sig = maybe (error ("unknown OID for " ++ show sig)) fst $ find ((==) sig . snd) sig_table instance ASN1Object SignatureALG where fromASN1 (Start Sequence:OID oid:Null:End Sequence:xs) = diff --git a/Data/X509/Cert.hs b/Data/X509/Cert.hs --- a/Data/X509/Cert.hs +++ b/Data/X509/Cert.hs @@ -94,7 +94,7 @@ <*> getObject <*> getObject <*> getObject - + encodeCertificateHeader :: Certificate -> [ASN1] encodeCertificateHeader cert = eVer ++ eSerial ++ eAlgId ++ eIssuer ++ eValidity ++ eSubject ++ epkinfo ++ eexts diff --git a/Data/X509/Ext.hs b/Data/X509/Ext.hs --- a/Data/X509/Ext.hs +++ b/Data/X509/Ext.hs @@ -23,6 +23,7 @@ -- * Accessor turning extension into a specific one , extensionGet , extensionDecode + , extensionEncode ) where import qualified Data.ByteString as B @@ -86,6 +87,10 @@ | extOID dummy == oid = Just (extDecode asn1) | otherwise = Nothing +-- | Encode an Extension to extensionRaw +extensionEncode :: Extension a => Bool -> a -> ExtensionRaw +extensionEncode critical ext = ExtensionRaw (extOID ext) critical (extEncode ext) + -- | Basic Constraints data ExtBasicConstraints = ExtBasicConstraints Bool (Maybe Integer) deriving (Show,Eq) @@ -186,8 +191,8 @@ instance Extension ExtCrlDistributionPoints where extOID _ = [2,5,29,31] - extEncode = undefined - extDecode = undefined + extEncode = error "extEncode ExtCrlDistributionPoints unimplemented" + extDecode = error "extDecode ExtCrlDistributionPoints unimplemented" --extEncode (ExtCrlDistributionPoints ) parseGeneralNames :: ParseASN1 [AltName] @@ -219,4 +224,4 @@ flagsToBits :: Enum a => [a] -> BitArray flagsToBits flags = foldl bitArraySetBit bitArrayEmpty $ map (fromIntegral . fromEnum) flags - where bitArrayEmpty = BitArray 2 (B.pack [0,0]) + where bitArrayEmpty = toBitArray (B.pack [0,0]) 7 diff --git a/Data/X509/ExtensionRaw.hs b/Data/X509/ExtensionRaw.hs --- a/Data/X509/ExtensionRaw.hs +++ b/Data/X509/ExtensionRaw.hs @@ -30,8 +30,12 @@ deriving (Show,Eq) instance ASN1Object Extensions where - toASN1 exts = \xs -> encodeExts exts ++ xs - fromASN1 = runParseASN1State parseExtensions + toASN1 (Extensions Nothing) = \xs -> xs + toASN1 (Extensions (Just exts)) = \xs -> + asn1Container (Container Context 3) (asn1Container Sequence (concatMap encodeExt exts)) ++ xs + fromASN1 s = runParseASN1State (Extensions <$> parseExtensions) s + where parseExtensions = onNextContainerMaybe (Container Context 3) $ + onNextContainer Sequence (getMany getObject) instance ASN1Object ExtensionRaw where toASN1 extraw = \xs -> encodeExt extraw ++ xs @@ -48,34 +52,6 @@ Right r -> Right (ExtensionRaw oid critical r, remainingStream) fromASN1 l = Left ("fromASN1: X509.ExtensionRaw: unknown format:" ++ show l) - - -parseExtensions :: ParseASN1 Extensions -parseExtensions = Extensions <$> ( - onNextContainerMaybe (Container Context 3) $ - onNextContainer Sequence (getMany getObject) - ) -{- - where getSequences = do - n <- hasNext - if n - then getNextContainer Sequence >>= \sq -> liftM (sq :) getSequences - else return [] - extractExtension [OID oid,Boolean b,OctetString obj] = - case decodeASN1' BER obj of - Left _ -> Nothing - Right r -> Just (oid, b, r) - extractExtension [OID oid,OctetString obj] = - case decodeASN1' BER obj of - Left _ -> Nothing - Right r -> Just (oid, False, r) - extractExtension _ = - Nothing --} - -encodeExts :: Extensions -> [ASN1] -encodeExts (Extensions Nothing) = [] -encodeExts (Extensions (Just l)) = asn1Container (Container Context 3) $ concatMap encodeExt l encodeExt :: ExtensionRaw -> [ASN1] encodeExt (ExtensionRaw oid critical asn1) = diff --git a/Data/X509/PublicKey.hs b/Data/X509/PublicKey.hs --- a/Data/X509/PublicKey.hs +++ b/Data/X509/PublicKey.hs @@ -60,7 +60,7 @@ , DSA.params_g = g } , DSA.public_y = dsapub } - in Right (PubKeyDSA pubkey, xs2) + in Right (PubKeyDSA pubkey, []) _ -> Left "fromASN1: X509.PubKey: unknown DSA format" ) _ -> Left "fromASN1: X509.PubKey: unknown DSA format" @@ -68,15 +68,15 @@ case xs of OID [1,3,132,0,34]:End Sequence:BitString bits:End Sequence:xs2 -> Right (PubKeyECDSA ECC.SEC_p384r1 (bitArrayGetData bits), xs2) _ -> Left "fromASN1: X509.PubKey: unknown ECDSA format" - | otherwise = undefined - where decodeASN1Err format bits xs2 f = + | otherwise = error ("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)) - + toPubKeyRSA = either Left (\(rsaKey, r) -> Right (PubKeyRSA rsaKey, r)) + fromASN1 l = Left ("fromASN1: X509.PubKey: unknown format:" ++ show l) toASN1 a = \xs -> encodePK a ++ xs @@ -109,6 +109,6 @@ eOid = case curveName of ECC.SEC_p384r1 -> [1,3,132,0,34] _ -> error ("undefined curve OID: " ++ show curveName) - encodeInner (PubKeyDH _) = undefined + encodeInner (PubKeyDH _) = error "encodeInner: unimplemented public key DH" encodeInner (PubKeyUnknown _ l) = asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray l 0] diff --git a/Data/X509/Signed.hs b/Data/X509/Signed.hs --- a/Data/X509/Signed.hs +++ b/Data/X509/Signed.hs @@ -130,9 +130,9 @@ let (objRepr,rem1) = getConstructedEndRepr l2 (sigAlgSeq,rem2) = getConstructedEndRepr rem1 (sigSeq,_) = getConstructedEndRepr rem2 - obj = onContainer objRepr (either Left (Right . fst) . fromASN1 . map fst) + obj = onContainer objRepr (either Left Right . fromASN1 . map fst) in case (obj, map fst sigSeq) of - (Right o, [BitString signature]) -> + (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) @@ -147,8 +147,9 @@ , exactObjectRaw = rawObj , encodeSignedObject = b } + (Right (_,remObj), _) -> + Left $ ("signed object error: remaining stream in object: " ++ show remObj) (Left err, _) -> Left $ ("signed object error: " ++ show err) - _ -> Left $ "signed object structure error" onContainer ((Start _, _) : l) f = case reverse l of ((End _, _) : l2) -> f $ reverse l2 diff --git a/Tests/Tests.hs b/Tests/Tests.hs --- a/Tests/Tests.hs +++ b/Tests/Tests.hs @@ -11,6 +11,7 @@ import Control.Applicative import Control.Monad +import Data.List (nub) import Data.ASN1.Types import Data.X509 import qualified Crypto.Types.PubKey.RSA as RSA @@ -81,8 +82,19 @@ arbitrary = posixSecondsToUTCTime . fromIntegral <$> (arbitrary :: Gen Int) instance Arbitrary Extensions where - arbitrary = pure (Extensions Nothing) + arbitrary = Extensions <$> oneof + [ pure Nothing + , Just <$> (listOf1 $ oneof + [ extensionEncode <$> arbitrary <*> (arbitrary :: Gen ExtKeyUsage) + ] + ) + ] +instance Arbitrary ExtKeyUsageFlag where + arbitrary = elements $ enumFrom KeyUsage_digitalSignature +instance Arbitrary ExtKeyUsage where + arbitrary = ExtKeyUsage . nub <$> listOf1 arbitrary + instance Arbitrary Certificate where arbitrary = Certificate <$> pure 2 <*> arbitrary @@ -107,17 +119,22 @@ <*> arbitrary <*> arbitrary -assertEq a b - | a == b = True - | otherwise = error (show b ++ " got: " ++ show a) - property_unmarshall_marshall_id :: (Show o, Arbitrary o, ASN1Object o, Eq o) => o -> Bool -property_unmarshall_marshall_id o = (fromASN1 (toASN1 o []) `assertEq` Right (o, [])) +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 [] main = defaultMain [ testGroup "asn1 objects unmarshall.marshall=id" [ testProperty "pubkey" (property_unmarshall_marshall_id :: PubKey -> Bool) , testProperty "signature alg" (property_unmarshall_marshall_id :: SignatureALG -> 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) ] diff --git a/x509.cabal b/x509.cabal --- a/x509.cabal +++ b/x509.cabal @@ -1,5 +1,5 @@ Name: x509 -Version: 1.4.5 +Version: 1.4.6 Description: X509 reader and writer License: BSD3 License-file: LICENSE