diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,17 @@ # Revision history for cryptostore +## 0.2.1.0 - 2019-10-13 + +* Added CMS fuctions `contentInfoToDER` and `berToContentInfo` in order to + generate and parse raw ASN.1. + +* Implementation of AES key wrap had some optimizations. + +* SHAKE hash algorithms now allow arbitrary output lengths. Lengths that are + very small decrease security. A protection is added so that attempts to use + lengths which are too small fail, although the criteria are conservative. + Generating and parsing content has no restriction. + ## 0.2.0.0 - 2019-03-24 * Added functions `toNamedCredential` and `fromNamedCredential` to handle diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2018, Olivier Chéron +Copyright (c) 2018-2019, Olivier Chéron All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -193,10 +193,12 @@ * and S/MIME external format (only PEM is supported, i.e. the textual encoding of [RFC 7468](https://tools.ietf.org/html/rfc7468)) +### Enveloped data + The following examples generate a CMS structure enveloping some data to a password recipient, then decrypt the data to recover the content. -### Generating enveloped data +#### Generating enveloped data ```haskell > :set -XOverloadedStrings @@ -224,7 +226,7 @@ > writeCMSFile "/path/to/enveloped.pem" [envelopedCI] ``` -### Opening the enveloped data +#### Opening the enveloped data ```haskell > :set -XOverloadedStrings @@ -236,6 +238,60 @@ > envelopedData <- fromAttached envelopedEncapData > openEnvelopedData (withRecipientPassword "mypassword") envelopedData Right (DataCI "Hi, what will you need from the cryptostore?") +``` + +### Signed data + +The following examples generate a CMS structure signing data with an RSA key +and certificate, then verify the signature and recover the content. + +#### Signing data + +```haskell +> :set -XOverloadedStrings +> :m Crypto.Store.CMS Data.X509 Crypto.Store.X509 Crypto.Store.PKCS8 + +-- Input content info +> let info = DataCI "Some trustworthy content" + +-- Read signer certificate and private key +> (key : _) <- readKeyFile "/path/to/privkey.pem" -- assuming single key +> let Right priv = recover "mypassword" key +> chain <- readSignedObject "/path/to/cert.pem" :: IO [SignedCertificate] +> let cert = CertificateChain chain + +-- Signature will use RSASSA-PSS and SHA-256 +> let sha256 = DigestAlgorithm SHA256 +> let params = PSSParams sha256 (MGF1 sha256) 16 + +-- Generate the signed structure with a single signer. Signed content is +-- kept attached in the structure. +> let signer = certSigner (RSAPSS params) priv cert (Just []) [] +> Right signedData <- signData [signer] info +> let signedCI = toAttachedCI signedData +> writeCMSFile "/path/to/signed.pem" [signedCI] +``` + +#### Verifying signed data + +```haskell +-- Read certificate authorities to be trusted for validation +> :m Crypto.Store.X509 Data.X509.CertificateStore +> store <- makeCertificateStore <$> readSignedObject "/path/to/cacert.pem" + +-- Assume we will not verify the signer FQHN. Instead the certificate could be +-- related to an identity from which we received the signed data. +> :m Data.Default.Class Data.X509 Data.X509.Validation +> let validateNoFQHN = validate HashSHA256 def def { checkFQHN = False } +> let noServiceID = (undefined, undefined) + +-- Read the signed data and validate it to recover the content +> :m Crypto.Store.CMS Data.Default.Class +> [SignedDataCI signedEncapData] <- readCMSFile "/path/to/signed.pem" +> signedData <- fromAttached signedEncapData +> let doValidation chain = null <$> validateNoFQHN store def noServiceID chain +> verifySignedData (withSignerCertificate doValidation) signedData +Right (DataCI "Some trustworthy content") ``` ## Algorithms and security diff --git a/cryptostore.cabal b/cryptostore.cabal --- a/cryptostore.cabal +++ b/cryptostore.cabal @@ -1,5 +1,5 @@ name: cryptostore -version: 0.2.0.0 +version: 0.2.1.0 synopsis: Serialization of cryptographic data types description: Haskell implementation of PKCS \#8, PKCS \#12 and CMS (Cryptographic Message Syntax). @@ -56,7 +56,7 @@ , bytestring , basement , memory - , cryptonite >= 0.25 + , cryptonite >= 0.26 , pem >= 0.1 && < 0.3 , asn1-types >= 0.3.1 && < 0.4 , asn1-encoding >= 0.9 && < 0.10 diff --git a/src/Crypto/Store/ASN1/Parse.hs b/src/Crypto/Store/ASN1/Parse.hs --- a/src/Crypto/Store/ASN1/Parse.hs +++ b/src/Crypto/Store/ASN1/Parse.hs @@ -18,6 +18,7 @@ -- -- * The 'fail' function returns a parse error so that pattern matching makes -- monadic parsing code easier to write. +{-# LANGUAGE CPP #-} module Crypto.Store.ASN1.Parse ( ParseASN1 -- * run @@ -43,7 +44,9 @@ import Control.Applicative import Control.Arrow (first) import Control.Monad (MonadPlus(..), liftM2) +#if !(MIN_VERSION_base(4,13,0)) import Control.Monad.Fail as Fail +#endif data State e = State [(ASN1, e)] !e @@ -70,7 +73,9 @@ case runP m1 s of Left err -> Left err Right (a, s2) -> runP (m2 a) s2 +#if !(MIN_VERSION_base(4,13,0)) fail = Fail.fail +#endif instance MonadFail (ParseASN1 e) where fail = throwParseError instance MonadPlus (ParseASN1 e) where diff --git a/src/Crypto/Store/CMS.hs b/src/Crypto/Store/CMS.hs --- a/src/Crypto/Store/CMS.hs +++ b/src/Crypto/Store/CMS.hs @@ -194,10 +194,12 @@ -- | Return the inner content info but only if the digest is valid. digestVerify :: DigestedData EncapsulatedContent -> Either StoreError ContentInfo -digestVerify DigestedData{..} = - if ddDigest == hash ddEncapsulatedContent - then decapsulate ddContentType ddEncapsulatedContent - else Left DigestMismatch +digestVerify DigestedData{..} + | not acceptable = Left (InvalidParameter "Digest too weak") + | ddDigest == hash ddEncapsulatedContent = + decapsulate ddContentType ddEncapsulatedContent + | otherwise = Left DigestMismatch + where acceptable = securityAcceptable (DigestAlgorithm ddDigestAlgorithm) -- EncryptedData @@ -340,6 +342,8 @@ mdMatch = case adDigestAlgorithm of Nothing -> False Just dig -> mdAttr == Just (digest dig msg) + mdAccept = maybe True securityAcceptable adDigestAlgorithm + macAccept = securityAcceptable adMACAlgorithm attrMatch = ctAttr == Just ct && mdMatch mdAttr = getMessageDigestAttr adAuthAttrs ctAttr = getContentTypeAttr adAuthAttrs @@ -348,6 +352,8 @@ unwrap k | isJust adDigestAlgorithm && noAttr = Left (InvalidInput "Missing auth attributes") | not noAttr && not attrMatch = Left (InvalidInput "Invalid auth attributes") + | not mdAccept = Left (InvalidParameter "Digest too weak") + | not macAccept = Left (InvalidParameter "MAC too weak") | adMAC /= mac adMACAlgorithm k input = Left BadContentMAC | otherwise = decapsulate adContentType adEncapsulatedContent diff --git a/src/Crypto/Store/CMS/Algorithms.hs b/src/Crypto/Store/CMS/Algorithms.hs --- a/src/Crypto/Store/CMS/Algorithms.hs +++ b/src/Crypto/Store/CMS/Algorithms.hs @@ -24,6 +24,8 @@ , MessageAuthenticationCode , MACAlgorithm(..) , mac + , HasStrength + , securityAcceptable , HasKeySize(..) , getMaximumKeySize , validateKeySize @@ -174,6 +176,23 @@ deriving instance Show (DigestProxy hashAlg) deriving instance Eq (DigestProxy hashAlg) +instance HasStrength (DigestProxy hashAlg) where + getSecurityBits MD2 = 64 + getSecurityBits MD4 = 64 + getSecurityBits MD5 = 64 + getSecurityBits SHA1 = 80 + getSecurityBits SHA224 = 112 + getSecurityBits SHA256 = 128 + getSecurityBits SHA384 = 192 + getSecurityBits SHA512 = 256 + getSecurityBits SHAKE128_256 = 128 + getSecurityBits SHAKE256_512 = 256 + getSecurityBits (SHAKE128 a) = shakeSecurityBits 128 a + getSecurityBits (SHAKE256 a) = shakeSecurityBits 256 a + +shakeSecurityBits :: KnownNat n => Int -> proxy n -> Int +shakeSecurityBits m a = min m (fromInteger (natVal a) `div` 2) + -- | CMS digest algorithm. data DigestAlgorithm = forall hashAlg . Hash.HashAlgorithm hashAlg @@ -197,6 +216,9 @@ DigestAlgorithm (SHAKE256 a) == DigestAlgorithm (SHAKE256 b) = natVal a == natVal b _ == _ = False +instance HasStrength DigestAlgorithm where + getSecurityBits (DigestAlgorithm a) = getSecurityBits a + data DigestType = Type_MD2 | Type_MD4 @@ -277,8 +299,10 @@ parseParameter Type_SHA512 = parseDigestParam (DigestAlgorithm SHA512) parseParameter Type_SHAKE128_256 = parseDigestParam (DigestAlgorithm SHAKE128_256) parseParameter Type_SHAKE256_512 = parseDigestParam (DigestAlgorithm SHAKE256_512) - parseParameter Type_SHAKE128_Len = parseBitLen 256 (DigestAlgorithm $ SHAKE128 p256) - parseParameter Type_SHAKE256_Len = parseBitLen 512 (DigestAlgorithm $ SHAKE256 p512) + parseParameter Type_SHAKE128_Len = parseBitLen $ + \(SomeNat p) -> DigestAlgorithm (SHAKE128 p) + parseParameter Type_SHAKE256_Len = parseBitLen $ + \(SomeNat p) -> DigestAlgorithm (SHAKE256 p) -- | Compute the digest of a message. digest :: ByteArrayAccess message => DigestAlgorithm -> message -> ByteString @@ -294,22 +318,35 @@ parseDigestParam :: Monoid e => DigestAlgorithm -> ParseASN1 e DigestAlgorithm parseDigestParam p = getNextMaybe nullOrNothing >> return p -parseBitLen :: Monoid e => Integer -> a -> ParseASN1 e a -parseBitLen expected res = do +parseBitLen :: Monoid e => (SomeNat -> a) -> ParseASN1 e a +parseBitLen build = do IntVal n <- getNext - if n == expected - then return res - else throwParseError ("Invalid bit length: " ++ show n) - -- FIXME: should allow any input size but cryptonite requires - -- divisibility by 8. For now we restrict to 256/512 bits only. - -p256 :: Proxy 256 -p256 = Proxy + case someNatVal n of + Nothing -> throwParseError ("Invalid bit length: " ++ show n) + Just sn -> return (build sn) p512 :: Proxy 512 p512 = Proxy +-- Security strength + +-- | Algorithms with known security strength. +class HasStrength params where + -- | Get security strength in bits. + -- + -- This returns the strength for which the algorithm was designed. + -- Algorithms with weaknesses have an effective strength lower than the + -- returned value. + getSecurityBits :: params -> Int + +-- | Whether the algorithm has acceptable security. The goal is to eliminate +-- variable-length algorithms, like SHAKE with 1-byte output, that would make +-- strength lower than the weakest fixed-length algorithm. +securityAcceptable :: HasStrength params => params -> Bool +securityAcceptable = (>= 64) . getSecurityBits + + -- Cipher-like things -- | Algorithms that are based on a secret key. This includes ciphers but also @@ -357,6 +394,9 @@ instance Eq MACAlgorithm where HMAC a1 == HMAC a2 = DigestAlgorithm a1 == DigestAlgorithm a2 +instance HasStrength MACAlgorithm where + getSecurityBits (HMAC a) = getSecurityBits (DigestAlgorithm a) + instance Enumerable MACAlgorithm where values = [ HMAC MD5 , HMAC SHA1 @@ -1005,12 +1045,14 @@ authDecrypt :: AuthEncParams -> Either StoreError ba authDecrypt p@AuthEncParams{..} + | not acceptable = Left (InvalidParameter "authEnc MAC too weak") | found == expected = contentDecrypt encKey encAlgorithm bs | otherwise = badMac where (encKey, macKey) = authKeys key p macMsg = paramsRaw `B.append` bs `B.append` B.convert aad found = mac macAlgorithm macKey macMsg + acceptable = securityAcceptable macAlgorithm getAEAD :: (BlockCipher cipher, ByteArray key, ByteArrayAccess iv) => proxy cipher -> key -> AEADMode -> iv -> Either StoreError (AEAD cipher) @@ -1398,6 +1440,11 @@ } deriving (Show,Eq) +instance HasStrength OAEPParams where + getSecurityBits OAEPParams{..} = + min (getSecurityBits oaepHashAlgorithm) + (getSecurityBits oaepMaskGenAlgorithm) + withOAEPParams :: forall seed output a . (ByteArrayAccess seed, ByteArray output) => OAEPParams -> (forall hash . Hash.HashAlgorithm hash => RSAOAEP.OAEPParams hash seed output -> a) @@ -1497,9 +1544,11 @@ -> m (Either StoreError ByteString) transportDecrypt RSAES (X509.PrivKeyRSA priv) bs = mapLeft RSAError <$> RSA.decryptSafer priv bs -transportDecrypt (RSAESOAEP p) (X509.PrivKeyRSA priv) bs = - withOAEPParams p $ \params -> - mapLeft RSAError <$> RSAOAEP.decryptSafer params priv bs +transportDecrypt (RSAESOAEP p) (X509.PrivKeyRSA priv) bs + | securityAcceptable p = + withOAEPParams p $ \params -> + mapLeft RSAError <$> RSAOAEP.decryptSafer params priv bs + | otherwise = return $ Left (InvalidParameter "OAEP parameters too weak") transportDecrypt _ _ _ = return $ Left UnexpectedPrivateKeyType @@ -1772,6 +1821,9 @@ newtype MaskGenerationFunc = MGF1 DigestAlgorithm deriving (Show,Eq) +instance HasStrength MaskGenerationFunc where + getSecurityBits (MGF1 d) = getSecurityBits d + instance AlgorithmId MaskGenerationFunc where type AlgorithmType MaskGenerationFunc = MaskGenerationType algorithmName _ = "mask generation function" @@ -1801,6 +1853,11 @@ } deriving (Show,Eq) +instance HasStrength PSSParams where + getSecurityBits PSSParams{..} = + min (getSecurityBits pssHashAlgorithm) + (getSecurityBits pssMaskGenAlgorithm) + withPSSParams :: forall seed output a . (ByteArrayAccess seed, ByteArray output) => PSSParams -> (forall hash . Hash.HashAlgorithm hash => RSAPSS.PSSParams hash seed output -> a) @@ -1987,8 +2044,10 @@ signatureVerify (RSA alg) (X509.PubKeyRSA pub) msg sig = withHashAlgorithmASN1 alg False $ \hashAlg -> RSA.verify (Just hashAlg) pub msg sig -signatureVerify (RSAPSS p) (X509.PubKeyRSA pub) msg sig = - withPSSParams p $ \params -> RSAPSS.verify params pub msg sig +signatureVerify (RSAPSS p) (X509.PubKeyRSA pub) msg sig + | securityAcceptable p = + withPSSParams p $ \params -> RSAPSS.verify params pub msg sig + | otherwise = False signatureVerify (DSA alg) (X509.PubKeyDSA pub) msg sig = fromMaybe False $ do s <- dsaToSignature sig case alg of diff --git a/src/Crypto/Store/CMS/PEM.hs b/src/Crypto/Store/CMS/PEM.hs --- a/src/Crypto/Store/CMS/PEM.hs +++ b/src/Crypto/Store/CMS/PEM.hs @@ -9,19 +9,20 @@ module Crypto.Store.CMS.PEM ( readCMSFile , readCMSFileFromMemory + , berToContentInfo , pemToContentInfo , writeCMSFile , writeCMSFileToMemory + , contentInfoToDER , contentInfoToPEM ) where -import Data.ASN1.BinaryEncoding -import Data.ASN1.Encoding import qualified Data.ByteString as B import Data.Maybe (catMaybes) import Crypto.Store.CMS.Info import Crypto.Store.CMS.Util +import Crypto.Store.Error import Crypto.Store.PEM @@ -38,6 +39,10 @@ accumulate :: [PEM] -> [ContentInfo] accumulate = catMaybes . foldr (flip pemToContentInfo) [] +-- | Read a content info from a bytearray in BER format. +berToContentInfo :: B.ByteString -> Either StoreError ContentInfo +berToContentInfo = decodeASN1Object + -- | Read a content info from a 'PEM' element and add it to the accumulator -- list. pemToContentInfo :: [Maybe ContentInfo] -> PEM -> [Maybe ContentInfo] @@ -47,12 +52,9 @@ where names = [ "CMS", "PKCS7" ] decode bs = - case decodeASN1Repr' BER bs of + case berToContentInfo bs of Left _ -> Nothing : acc - Right asn1 -> - case fromASN1Repr asn1 of - Right (info, []) -> Just info : acc - _ -> Nothing : acc + Right info -> Just info : acc -- Writing to PEM format @@ -65,7 +67,11 @@ writeCMSFileToMemory :: [ContentInfo] -> B.ByteString writeCMSFileToMemory = pemsWriteBS . map contentInfoToPEM +-- | Generate a bytearray in DER format for a content info. +contentInfoToDER :: ContentInfo -> B.ByteString +contentInfoToDER = encodeASN1Object + -- | Generate PEM for a content info. contentInfoToPEM :: ContentInfo -> PEM contentInfoToPEM info = PEM { pemName = "CMS", pemHeader = [], pemContent = bs} - where bs = encodeASN1Object info + where bs = contentInfoToDER info diff --git a/src/Crypto/Store/CMS/Signed.hs b/src/Crypto/Store/CMS/Signed.hs --- a/src/Crypto/Store/CMS/Signed.hs +++ b/src/Crypto/Store/CMS/Signed.hs @@ -209,6 +209,7 @@ withPublicKey pub ct msg SignerInfo{..} _ _ = pure $ fromMaybe False $ do guard (noAttr || attrMatch) + guard mdAccept alg <- signatureCheckHash siDigestAlgorithm siSignatureAlg return (signatureVerify alg pub input siSignature) where @@ -216,6 +217,7 @@ mdMatch = mdAttr == Just (digest siDigestAlgorithm msg) attrMatch = ctAttr == Just ct && mdMatch mdAttr = getMessageDigestAttr siSignedAttrs + mdAccept = securityAcceptable siDigestAlgorithm ctAttr = getContentTypeAttr siSignedAttrs input = if noAttr then msg else encodeAuthAttrs siSignedAttrs diff --git a/src/Crypto/Store/CMS/Type.hs b/src/Crypto/Store/CMS/Type.hs --- a/src/Crypto/Store/CMS/Type.hs +++ b/src/Crypto/Store/CMS/Type.hs @@ -51,11 +51,11 @@ instance OIDNameable ContentType where fromObjectID oid = unOIDNW <$> fromObjectID oid --- | Denotes the state of encapsulated content in a CMS data structure. This +-- | Denote the state of encapsulated content in a CMS data structure. This -- type is isomorphic to 'Maybe'. data Encap a - = Detached -- content is stored externally to the structure - | Attached a -- content is stored inside the CMS struture + = Detached -- ^ Content is stored externally to the structure + | Attached a -- ^ Content is stored inside the CMS struture deriving (Show,Eq) instance Functor Encap where diff --git a/src/Crypto/Store/CMS/Util.hs b/src/Crypto/Store/CMS/Util.hs --- a/src/Crypto/Store/CMS/Util.hs +++ b/src/Crypto/Store/CMS/Util.hs @@ -30,7 +30,7 @@ , ProduceASN1Object(..) , encodeASN1Object , ParseASN1Object(..) - , fromASN1Repr + , decodeASN1Object -- * Algorithm Identifiers , AlgorithmId(..) , algorithmASN1S @@ -41,9 +41,10 @@ , orElse ) where +import Data.ASN1.BinaryEncoding import Data.ASN1.BinaryEncoding.Raw +import Data.ASN1.Encoding import Data.ASN1.OID -import Data.ASN1.Stream import Data.ASN1.Types import Data.ByteString (ByteString) import Data.List (find) @@ -53,6 +54,7 @@ import Crypto.Store.ASN1.Generate import Crypto.Store.ASN1.Parse +import Crypto.Store.Error -- | Try to parse a 'Null' ASN.1 value. nullOrNothing :: ASN1 -> Maybe () @@ -152,10 +154,16 @@ Right se -> return se Left err -> throwParseError ("SignedExact: " ++ err) --- | Create an object from the ASN.1 stream. -fromASN1Repr :: ParseASN1Object [ASN1Event] obj - => [ASN1Repr] -> Either String (obj, [ASN1Repr]) -fromASN1Repr = runParseASN1State_ parse +-- | Create an ASN.1 object from a bytearray in BER format. +decodeASN1Object :: ParseASN1Object [ASN1Event] obj => ByteString -> Either StoreError obj +decodeASN1Object bs = + case decodeASN1Repr' BER bs of + Left e -> Left (DecodingError e) + Right asn1 -> + case runParseASN1State_ parse asn1 of + Right (obj, []) -> Right obj + Right _ -> Left (ParseFailure "Incomplete parse") + Left e -> Left (ParseFailure e) -- | An ASN.1 object associated with the raw data it was parsed from. data ASN1ObjectExact a = ASN1ObjectExact diff --git a/src/Crypto/Store/KeyWrap/AES.hs b/src/Crypto/Store/KeyWrap/AES.hs --- a/src/Crypto/Store/KeyWrap/AES.hs +++ b/src/Crypto/Store/KeyWrap/AES.hs @@ -9,6 +9,7 @@ -- Key Wrap () -- -- Should be used with a cipher from module "Crypto.Cipher.AES". +{-# LANGUAGE BangPatterns #-} module Crypto.Store.KeyWrap.AES ( wrap , unwrap @@ -50,11 +51,12 @@ => aes -> ba -> Chunked ba -> Chunked ba wrapc cipher iiv list = uncurry (:) $ foldl' pass (iiv, list) [0 .. 5] where - n = fromIntegral (length list) - pass (a, l) j = mapAccumL f a $ zip [n * j + 1 ..] l - f a (i, r) = - let (msb, lsb) = aes cipher (a, r) - in (xorWith msb i, lsb) + !n = fromIntegral (length list) + pass (a, l) j = go a (n * j + 1) l + go a !_ [] = (a, []) + go a !i (r : rs) = + let (a', t) = aes cipher (a, r) + in (t :) <$> go (xorWith a' i) (succ i) rs unwrapc :: (BlockCipher aes, ByteArray ba) => aes -> Chunked ba -> Either StoreError (ba, Chunked ba) @@ -62,9 +64,12 @@ unwrapc cipher (iv:list) = Right (iiv, reverse out) where (iiv, out) = foldl' pass (iv, reverse list) (reverse [0 .. 5]) - n = fromIntegral (length list) - pass (a, l) j = mapAccumL f a $ zip (reverse [n * j + 1 .. n * j + n]) l - f a (i, r) = aesrev cipher (xorWith a i, r) + !n = fromIntegral (length list) + pass (a, l) j = go a (n * j + n) l + go a !_ [] = (a, []) + go a !i (r : rs) = + let (a', t) = aesrev cipher (xorWith a i, r) + in (t :) <$> go a' (pred i) rs -- | Wrap a key with the specified AES cipher. wrap :: (BlockCipher aes, ByteArray ba) => aes -> ba -> Either StoreError ba @@ -125,11 +130,11 @@ | otherwise = fmap unchunks <$> (unwrapc cipher =<< chunks bs) xorWith :: (ByteArrayAccess bin, ByteArray bout) => bin -> Word64 -> bout -xorWith bs i = B.copyAndFreeze bs $ \dst -> loop dst len i - where len = B.length bs - loop _ 0 _ = return () - loop _ _ 0 = return () -- return early (constant-time not needed) - loop p n j = do +xorWith bs !i = B.copyAndFreeze bs $ \dst -> loop dst len i + where !len = B.length bs + loop _ 0 !_ = return () + loop _ _ 0 = return () -- return early (constant-time not needed) + loop p n j = do b <- peekByteOff p (n - 1) let mask = fromIntegral j :: Word8 pokeByteOff p (n - 1) (xor b mask) diff --git a/src/Crypto/Store/PKCS12.hs b/src/Crypto/Store/PKCS12.hs --- a/src/Crypto/Store/PKCS12.hs +++ b/src/Crypto/Store/PKCS12.hs @@ -66,8 +66,6 @@ import Control.Monad import Data.ASN1.Types -import Data.ASN1.BinaryEncoding -import Data.ASN1.Encoding import qualified Data.ByteArray as B import qualified Data.ByteString as BS import Data.List (partition) @@ -110,6 +108,8 @@ case digAlg of DigestAlgorithm d -> let fn key macAlg bs + | not (securityAcceptable macAlg) = + Left (InvalidParameter "Integrity MAC too weak") | macValue == mac macAlg key bs = decode bs | otherwise = Left BadContentMAC in pkcs12mac Left fn d macParams content pwdUTF8 @@ -738,14 +738,7 @@ where attrs = bagAttributes bag decode :: ParseASN1Object [ASN1Event] obj => BS.ByteString -> Either StoreError obj -decode bs = - case decodeASN1Repr' BER bs of - Left e -> Left (DecodingError e) - Right asn1 -> - case fromASN1Repr asn1 of - Right (obj, []) -> Right obj - Right _ -> Left (ParseFailure "Incomplete parse") - Left e -> Left (ParseFailure e) +decode = decodeASN1Object parseOctetStringObject :: (Monoid e, ParseASN1Object [ASN1Event] obj) => String -> ParseASN1 e obj diff --git a/tests/CMS/Instances.hs b/tests/CMS/Instances.hs --- a/tests/CMS/Instances.hs +++ b/tests/CMS/Instances.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Orphan instances. module CMS.Instances @@ -12,9 +11,10 @@ import Data.ASN1.Types import qualified Data.ByteArray as B import Data.ByteString (ByteString) -import Data.Proxy import Data.X509 +import GHC.TypeLits + import Test.Tasty.QuickCheck import Crypto.Cipher.Types @@ -112,7 +112,7 @@ return (alg, key, attrs) failIfError :: Either StoreError a -> Gen a - failIfError = either (fail . show) return + failIfError = either (error . show) return instance Arbitrary Attribute where arbitrary = do @@ -123,11 +123,9 @@ arbitraryAttributes :: Gen [Attribute] arbitraryAttributes = resize 3 arbitrary -p256 :: Proxy 256 -p256 = Proxy - -p512 :: Proxy 512 -p512 = Proxy +arbitraryNat :: Gen SomeNat +arbitraryNat = unwrap <$> arbitrary + where unwrap (Positive i) = let Just n = someNatVal (127 + i) in n instance Arbitrary DigestAlgorithm where arbitrary = oneof @@ -141,8 +139,8 @@ , pure $ DigestAlgorithm SHA512 , pure $ DigestAlgorithm SHAKE128_256 , pure $ DigestAlgorithm SHAKE256_512 - , pure $ DigestAlgorithm (SHAKE128 p256) - , pure $ DigestAlgorithm (SHAKE256 p512) + , (\(SomeNat p) -> DigestAlgorithm (SHAKE128 p)) <$> arbitraryNat + , (\(SomeNat p) -> DigestAlgorithm (SHAKE256 p)) <$> arbitraryNat ] arbitraryIntegrityDigest :: Gen DigestAlgorithm diff --git a/tests/PKCS12/Instances.hs b/tests/PKCS12/Instances.hs --- a/tests/PKCS12/Instances.hs +++ b/tests/PKCS12/Instances.hs @@ -42,7 +42,7 @@ arbitraryEncrypted sc = do alg <- arbitrary case encrypted alg pwd sc of - Left e -> fail (show e) + Left e -> error ("failed generating PKCS12: " ++ show e) Right aSafe -> return aSafe instance Arbitrary SafeContents where diff --git a/tests/PKCS8/Instances.hs b/tests/PKCS8/Instances.hs --- a/tests/PKCS8/Instances.hs +++ b/tests/PKCS8/Instances.hs @@ -41,10 +41,12 @@ instance Arbitrary (FormattedKey PrivKey) where arbitrary = do key <- arbitrary - fmt <- case key of - PrivKeyX25519 _ -> return PKCS8Format - PrivKeyX448 _ -> return PKCS8Format - PrivKeyEd25519 _ -> return PKCS8Format - PrivKeyEd448 _ -> return PKCS8Format - _ -> arbitrary + fmt <- if pkcs8only key then return PKCS8Format else arbitrary return (FormattedKey fmt key) + +pkcs8only :: PrivKey -> Bool +pkcs8only (PrivKeyX25519 _) = True +pkcs8only (PrivKeyX448 _) = True +pkcs8only (PrivKeyEd25519 _) = True +pkcs8only (PrivKeyEd448 _) = True +pkcs8only _ = False diff --git a/tests/X509/Instances.hs b/tests/X509/Instances.hs --- a/tests/X509/Instances.hs +++ b/tests/X509/Instances.hs @@ -333,6 +333,6 @@ >>= arbitrarySignedExact shuffleCertificateChain :: CertificateChain -> Gen CertificateChain -shuffleCertificateChain (CertificateChain []) = fail "empty certificate chain" +shuffleCertificateChain (CertificateChain []) = error "empty certificate chain" shuffleCertificateChain (CertificateChain (leaf : auths)) = CertificateChain . (leaf :) <$> shuffle auths