cryptostore 0.2.0.0 → 0.2.1.0
raw patch · 17 files changed
+236/−84 lines, 17 filesdep ~cryptonitePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: cryptonite
API changes (from Hackage documentation)
+ Crypto.Store.CMS: berToContentInfo :: ByteString -> Either StoreError ContentInfo
+ Crypto.Store.CMS: contentInfoToDER :: ContentInfo -> ByteString
Files
- ChangeLog.md +12/−0
- LICENSE +1/−1
- README.md +58/−2
- cryptostore.cabal +2/−2
- src/Crypto/Store/ASN1/Parse.hs +5/−0
- src/Crypto/Store/CMS.hs +10/−4
- src/Crypto/Store/CMS/Algorithms.hs +76/−17
- src/Crypto/Store/CMS/PEM.hs +14/−8
- src/Crypto/Store/CMS/Signed.hs +2/−0
- src/Crypto/Store/CMS/Type.hs +3/−3
- src/Crypto/Store/CMS/Util.hs +14/−6
- src/Crypto/Store/KeyWrap/AES.hs +18/−13
- src/Crypto/Store/PKCS12.hs +3/−10
- tests/CMS/Instances.hs +8/−10
- tests/PKCS12/Instances.hs +1/−1
- tests/PKCS8/Instances.hs +8/−6
- tests/X509/Instances.hs +1/−1
ChangeLog.md view
@@ -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
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2018, Olivier Chéron+Copyright (c) 2018-2019, Olivier Chéron All rights reserved.
README.md view
@@ -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
cryptostore.cabal view
@@ -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
src/Crypto/Store/ASN1/Parse.hs view
@@ -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
src/Crypto/Store/CMS.hs view
@@ -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
src/Crypto/Store/CMS/Algorithms.hs view
@@ -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
src/Crypto/Store/CMS/PEM.hs view
@@ -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
src/Crypto/Store/CMS/Signed.hs view
@@ -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
src/Crypto/Store/CMS/Type.hs view
@@ -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
src/Crypto/Store/CMS/Util.hs view
@@ -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
src/Crypto/Store/KeyWrap/AES.hs view
@@ -9,6 +9,7 @@ -- Key Wrap (<https://tools.ietf.org/html/rfc5649 RFC 5649>) -- -- 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)
src/Crypto/Store/PKCS12.hs view
@@ -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
tests/CMS/Instances.hs view
@@ -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
tests/PKCS12/Instances.hs view
@@ -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
tests/PKCS8/Instances.hs view
@@ -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
tests/X509/Instances.hs view
@@ -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