packages feed

openpgp-crypto-api 0.4 → 0.6

raw patch · 15 files changed

+645/−129 lines, 15 filesdep +quickcheck-instancesdep +taggeddep +transformersdep ~binarydep ~crypto-apidep ~cryptocipherbinary-added

Dependencies added: quickcheck-instances, tagged, transformers

Dependency ranges changed: binary, crypto-api, cryptocipher, openpgp

Files

Data/OpenPGP/CryptoAPI.hs view
@@ -1,13 +1,19 @@-module Data.OpenPGP.CryptoAPI (fingerprint, sign, verify) where+module Data.OpenPGP.CryptoAPI (fingerprint, sign, verify, encrypt, decryptAsymmetric, decryptSymmetric, decryptSecretKey) where -import Numeric-import Data.Word import Data.Char import Data.Bits import Data.List (find)-import Data.Binary+import Data.Maybe (mapMaybe, catMaybes, listToMaybe)+import Control.Arrow+import Control.Applicative+import Control.Monad+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.State (StateT(..), runStateT)+import Data.Binary (encode, decode, get, Word16) import Crypto.Classes hiding (hash,sign,verify,encode)-import Crypto.Random (CryptoRandomGen)+import Data.Tagged (untag, asTaggedTypeOf, Tagged(..))+import Crypto.Modes (cfb, unCfb, IV, zeroIV)+import Crypto.Random (CryptoRandomGen, GenError(GenErrorOther), genBytes) import Crypto.Hash.MD5 (MD5) import Crypto.Hash.SHA1 (SHA1) import Crypto.Hash.RIPEMD160 (RIPEMD160)@@ -15,25 +21,41 @@ import Crypto.Hash.SHA384 (SHA384) import Crypto.Hash.SHA512 (SHA512) import Crypto.Hash.SHA224 (SHA224)-import qualified Crypto.Classes as Serialize (encode)+import Crypto.Cipher.AES (AES128,AES192,AES256)+import qualified Data.Serialize as Serialize import qualified Crypto.Cipher.RSA as RSA import qualified Crypto.Cipher.DSA as DSA import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LZ-import qualified Data.ByteString.Lazy.UTF8 as LZ (fromString)  import qualified Data.OpenPGP as OpenPGP+import Data.OpenPGP.CryptoAPI.Util+import Data.OpenPGP.CryptoAPI.Blowfish128 --- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket--- <http://tools.ietf.org/html/rfc4880#section-12.2>-fingerprint :: OpenPGP.Packet -> String-fingerprint p-	| OpenPGP.version p == 4 = snd $ hash OpenPGP.SHA1 material-	| OpenPGP.version p `elem` [2, 3] = snd $ hash OpenPGP.MD5 material-	| otherwise = error "Unsupported Packet version or type in fingerprint"-	where-	material = LZ.concat $ OpenPGP.fingerprint_material p+-- | An encryption routine+type Encrypt g = (LZ.ByteString -> g -> (LZ.ByteString, g)) +-- | A decryption routine, Bool=True to do resynchronization+type Decrypt = (Bool -> LZ.ByteString -> (LZ.ByteString, LZ.ByteString))++-- Start differently-formatted section+-- | This should be in Crypto.Classes and is based on buildKeyIO+buildKeyGen :: (BlockCipher k, CryptoRandomGen g) => g -> Either GenError (k, g)+buildKeyGen = runStateT (go (0::Int))+  where+  go 1000 = lift $ Left $ GenErrorOther+                  "Tried 1000 times to generate a key from the system entropy.\+                  \  No keys were returned! Perhaps the system entropy is broken\+                  \ or perhaps the BlockCipher instance being used has a non-flat\+                  \ keyspace."+  go i = do+	let bs = keyLength+	kd <- StateT $ genBytes ((7 + untag bs) `div` 8)+	case buildKey kd of+		Nothing -> go (i+1)+		Just k  -> return $ k `asTaggedTypeOf` bs+-- End differently-formatted section+ find_key :: OpenPGP.Message -> String -> Maybe OpenPGP.Packet find_key = OpenPGP.find_key fingerprint @@ -54,13 +76,6 @@ 	pad s = replicate (len - length s) '0' ++ s 	len = (outputLength `for` d) `div` 8 -hexString :: [Word8] -> String-hexString = foldr (pad `oo` showHex) ""-	where-	oo = (.) . (.)-	pad s | odd $ length s = '0':s-	      | otherwise = s- -- http://tools.ietf.org/html/rfc3447#page-43 -- http://tools.ietf.org/html/rfc4880#section-5.2.2 emsa_pkcs1_v1_5_hash_padding :: OpenPGP.HashAlgorithm -> BS.ByteString@@ -74,22 +89,80 @@ emsa_pkcs1_v1_5_hash_padding _ = 	error "Unsupported HashAlgorithm in emsa_pkcs1_v1_5_hash_padding." -toStrictBS :: LZ.ByteString -> BS.ByteString-toStrictBS = BS.concat . LZ.toChunks+blockBytes :: (BlockCipher k, Num n) => k -> n+blockBytes k = fromIntegral $ blockSizeBytes `for` k -toLazyBS :: BS.ByteString -> LZ.ByteString-toLazyBS = LZ.fromChunks . (:[])+pgpCFBPrefix :: (BlockCipher k, CryptoRandomGen g) => k -> g -> (LZ.ByteString, g)+pgpCFBPrefix k g =+	(toLazyBS $ str `BS.append` BS.reverse (BS.take 2 $ BS.reverse str), g')+	where+	Right (str,g') = genBytes (blockSizeBytes `for` k) g -fromJustMPI :: Maybe OpenPGP.MPI -> Integer-fromJustMPI (Just (OpenPGP.MPI x)) = x-fromJustMPI _ = error "Not a Just MPI, Data.OpenPGP.CryptoAPI"+pgpCFB :: (BlockCipher k, CryptoRandomGen g) => k -> (LZ.ByteString -> LZ.ByteString -> LZ.ByteString) -> Encrypt g+pgpCFB k sufGen bs g =+	(simpleCFB k zeroIV (LZ.concat [p, bs, sufGen p bs]), g')+	where+	(p,g') = pgpCFBPrefix k g +simpleCFB :: (BlockCipher k) => k -> IV k -> LZ.ByteString -> LZ.ByteString+simpleCFB k iv = padThenUnpad k (fst . cfb k iv)++pgpUnCFB :: (BlockCipher k) => k -> Decrypt+pgpUnCFB k False s = LZ.splitAt (2 + blockBytes k) $ simpleUnCFB k zeroIV s+pgpUnCFB k True s = (simpleUnCFB k zeroIV prefix, simpleUnCFB k iv content)+	where+	Just iv = sDecode $ toStrictBS $ LZ.drop 2 prefix+	(prefix, content) = LZ.splitAt (2 + blockBytes k) s++simpleUnCFB :: (BlockCipher k) => k -> IV k -> LZ.ByteString -> LZ.ByteString+simpleUnCFB k iv = padThenUnpad k (fst . unCfb k iv)++padThenUnpad :: (BlockCipher k) => k -> (LZ.ByteString -> LZ.ByteString) -> LZ.ByteString -> LZ.ByteString+padThenUnpad k f s = dropPadEnd (f padded)+	where+	dropPadEnd s = LZ.take (LZ.length s - padAmount) s+	padded = s `LZ.append` LZ.replicate padAmount 0+	padAmount = blockBytes k - (LZ.length s `mod` blockBytes k)++addBitLen :: LZ.ByteString -> LZ.ByteString+addBitLen bytes = encode (bitLen bytes :: Word16) `LZ.append` bytes+	where+	bitLen bytes = (fromIntegral (LZ.length bytes) - 1) * 8 + sigBit bytes+	sigBit bytes = fst $ until ((==0) . snd)+		(first (+1) . second (`shiftR` 1)) (0,LZ.index bytes 0)++-- Drops 2 because the value is an MPI+rsaDecrypt :: RSA.PrivateKey -> BS.ByteString -> Maybe BS.ByteString+rsaDecrypt pk = hush . RSA.decrypt pk . BS.drop 2++rsaEncrypt :: (CryptoRandomGen g) => RSA.PublicKey -> BS.ByteString -> StateT g (Either GenError) BS.ByteString+rsaEncrypt pk bs = StateT (\g ->+		case RSA.encrypt g pk bs of+			(Left (RSA.RandomGenFailure e)) -> Left e+			(Left e) -> Left (GenErrorOther $ show e)+			(Right v) -> Right v+	)+ integerBytesize :: Integer -> Int-integerBytesize i = length (LZ.unpack $ encode (OpenPGP.MPI i)) - 2+integerBytesize i = fromIntegral $ LZ.length (encode (OpenPGP.MPI i)) - 2  keyParam :: Char -> OpenPGP.Packet -> Integer keyParam c k = fromJustMPI $ lookup c (OpenPGP.key k) +keyAlgorithmIs :: OpenPGP.KeyAlgorithm -> OpenPGP.Packet -> Bool+keyAlgorithmIs algo p = OpenPGP.key_algorithm p == algo++secretKeys :: OpenPGP.Message -> ([(String, RSA.PrivateKey)], [(String, DSA.PrivateKey)])+secretKeys (OpenPGP.Message keys) =+	(+		map (fingerprint &&& privateRSAkey) rsa,+		map (fingerprint &&& privateDSAkey) dsa+	)+	where+	dsa = secrets OpenPGP.DSA+	rsa = secrets OpenPGP.RSA+	secrets algo = filter (swing all [isSecretKey, keyAlgorithmIs algo]) keys+ privateRSAkey :: OpenPGP.Packet -> RSA.PrivateKey privateRSAkey k = 	-- Invert p and q because u is pinv not qinv@@ -117,80 +190,77 @@ dsaKey k = DSA.PublicKey 	(keyParam 'p' k, keyParam 'g' k, keyParam 'q' k) (keyParam 'y' k) +-- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket+-- <http://tools.ietf.org/html/rfc4880#section-12.2>+fingerprint :: OpenPGP.Packet -> String+fingerprint p+	| OpenPGP.version p == 4 = snd $ hash OpenPGP.SHA1 material+	| OpenPGP.version p `elem` [2, 3] = snd $ hash OpenPGP.MD5 material+	| otherwise = error "Unsupported Packet version or type in fingerprint"+	where+	material = LZ.concat $ OpenPGP.fingerprint_material p+ -- | Verify a message signature-verify :: OpenPGP.Message    -- ^ Keys that may have made the signature-          -> OpenPGP.Message -- ^ LiteralData message to verify-          -> Int             -- ^ Index of signature to verify (0th, 1st, etc)-          -> Bool-verify keys message sigidx =+verify ::+	OpenPGP.Message          -- ^ Keys that may have made the signature+	-> OpenPGP.SignatureOver -- ^ Signatures to verify+	-> OpenPGP.SignatureOver -- ^ Will only contain signatures that passed+verify keys over =+	over {OpenPGP.signatures_over = mapMaybe (uncurry $ verifyOne keys) sigs}+	where+	sigs = map (\s -> (s, toStrictBS $ encode over `LZ.append` OpenPGP.trailer s))+		(OpenPGP.signatures_over over)++verifyOne :: OpenPGP.Message -> OpenPGP.Packet -> BS.ByteString -> Maybe OpenPGP.Packet+verifyOne keys sig over = fmap (const sig) $ maybeKey >>= 	case OpenPGP.key_algorithm sig of 		OpenPGP.DSA -> dsaVerify 		alg | alg `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> rsaVerify-		    | otherwise -> error ("Unsupported key algorithm " ++ show alg)+		    | otherwise -> const Nothing 	where-	dsaVerify = let k' = dsaKey k in-		case DSA.verify dsaSig (dsaTruncate k' . bhash) k' signature_over of-			Left _ -> False-			Right v -> v-	rsaVerify =-		case RSA.verify bhash padding (rsaKey k) signature_over rsaSig of-			Left _ -> False-			Right v -> v-	rsaSig = toStrictBS $ LZ.drop 2 $ encode (head $ OpenPGP.signature sig)+	dsaVerify k = let k' = dsaKey k in+		hush $ DSA.verify dsaSig (dsaTruncate k' . bhash) k' over+	rsaVerify k = hush $ RSA.verify bhash padding (rsaKey k) over rsaSig+	[rsaSig] = map (toStrictBS . LZ.drop 2 . encode) (OpenPGP.signature sig) 	dsaSig = let [OpenPGP.MPI r, OpenPGP.MPI s] = OpenPGP.signature sig in 		(r, s) 	dsaTruncate (DSA.PublicKey (_,_,q) _) = BS.take (integerBytesize q) 	bhash = fst . hash hash_algo . toLazyBS 	padding = emsa_pkcs1_v1_5_hash_padding hash_algo 	hash_algo = OpenPGP.hash_algorithm sig-	signature_over = toStrictBS $ dta `LZ.append` OpenPGP.trailer sig-	Just k = OpenPGP.signature_issuer sig >>= find_key keys-	sig = sigs !! sigidx-	(sigs, (OpenPGP.LiteralDataPacket {OpenPGP.content = dta}):_) =-		OpenPGP.signatures_and_data message+	maybeKey = OpenPGP.signature_issuer sig >>= find_key keys --- | Sign data or key/userID pair.+-- | Make a signature+--+-- In order to set more options on a signature, pass in a signature packet. sign :: (CryptoRandomGen g) =>-        OpenPGP.Message    -- ^ SecretKeys, one of which will be used-        -> OpenPGP.Message -- ^ Message containing data or key to sign, and optional signature packet-        -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature-        -> String  -- ^ KeyID of key to choose or @[]@ for first-        -> Integer -- ^ Timestamp for signature (unless sig supplied)-        -> g       -- ^ Random number generator-        -> OpenPGP.Packet-sign keys message hsh keyid timestamp g =-	-- WARNING: this style of update is unsafe on most fields-	-- it is safe on signature and hash_head, though-	sig {-		OpenPGP.signature = map OpenPGP.MPI final,-		OpenPGP.hash_head = 0 -- TODO-	}+	OpenPGP.Message          -- ^ SecretKeys, one of which will be used+	-> OpenPGP.SignatureOver -- ^ Data to sign, and optional signature packet+	-> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature+	-> String                -- ^ KeyID of key to choose+	-> Integer               -- ^ Timestamp for signature (unless sig supplied)+	-> g                     -- ^ Random number generator+	-> (OpenPGP.SignatureOver, g)+sign keys over hsh keyid timestamp g = (over {OpenPGP.signatures_over = [sig]}, g') 	where-	final   = case OpenPGP.key_algorithm sig of-		OpenPGP.DSA -> [dsaR, dsaS]-		kalgo | kalgo `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> [toNum rsaFinal]+	(final, g') = case OpenPGP.key_algorithm sig of+		OpenPGP.DSA -> ([dsaR, dsaS], dsaG)+		kalgo | kalgo `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> ([toNum rsaFinal], g) 		      | otherwise -> 			error ("Unsupported key algorithm " ++ show kalgo ++ "in sign")-	Right ((dsaR,dsaS),_) = let k' = privateDSAkey k in+	Right ((dsaR,dsaS),dsaG) = let k' = privateDSAkey k in 		DSA.sign g (dsaTruncate k' . bhash) k' dta 	Right rsaFinal = RSA.sign bhash padding (privateRSAkey k) dta 	dsaTruncate (DSA.PrivateKey (_,_,q) _) = BS.take (integerBytesize q)-	dta     = toStrictBS $ case signOver of {-		OpenPGP.LiteralDataPacket {OpenPGP.content = c} -> c;-		_ -> LZ.concat $ OpenPGP.fingerprint_material signOver ++ [-			LZ.singleton 0xB4,-			encode (fromIntegral (length firstUserID) :: Word32),-			LZ.fromString firstUserID-		]-	} `LZ.append` OpenPGP.trailer sig-	sig     = findSigOrDefault (find OpenPGP.isSignaturePacket m)+	dta     = toStrictBS $ encode over `LZ.append` OpenPGP.trailer sig+	sig     = findSigOrDefault (listToMaybe $ OpenPGP.signatures_over over) 	padding = emsa_pkcs1_v1_5_hash_padding hsh 	bhash   = fst . hash hsh . toLazyBS 	toNum   = BS.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0+	Just k  = find_key keys keyid  	-- Either a SignaturePacket was found, or we need to make one-	findSigOrDefault (Just s) =-		OpenPGP.signaturePacket+	findSigOrDefault (Just s) = OpenPGP.signaturePacket 		(OpenPGP.version s) 		(OpenPGP.signature_type s) 		(OpenPGP.key_algorithm k) -- force to algo of key@@ -198,7 +268,7 @@ 		(OpenPGP.hashed_subpackets s) 		(OpenPGP.unhashed_subpackets s) 		(OpenPGP.hash_head s)-		(OpenPGP.signature s)+		(map OpenPGP.MPI final) 	findSigOrDefault Nothing  = OpenPGP.signaturePacket 		4 		defaultStype@@ -207,32 +277,277 @@ 		([ 			-- Do we really need to pass in timestamp just for the default? 			OpenPGP.SignatureCreationTimePacket $ fromIntegral timestamp,-			OpenPGP.IssuerPacket keyid'-		] ++ (case signOver of-			OpenPGP.LiteralDataPacket {} -> []-			_ -> [] -- TODO: OpenPGP.KeyFlagsPacket [0x01, 0x02]+			OpenPGP.IssuerPacket $ fingerprint k+		] ++ (case over of+			OpenPGP.KeySignature  {} -> [OpenPGP.KeyFlagsPacket {+					OpenPGP.certify_keys = True,+					OpenPGP.sign_data = True,+					OpenPGP.encrypt_communication = False,+					OpenPGP.encrypt_storage = False,+					OpenPGP.split_key = False,+					OpenPGP.authentication = False,+					OpenPGP.group_key = False+				}]+			_ -> [] 		)) 		[]-		undefined-		undefined+		0 -- TODO+		(map OpenPGP.MPI final) -	keyid'  = reverse $ take 16 $ reverse $ fingerprint k-	Just k  = find_key keys keyid+	defaultStype = case over of+		OpenPGP.DataSignature ld _+			| OpenPGP.format ld == 'b'     -> 0x00+			| otherwise                    -> 0x01+		OpenPGP.KeySignature {}           -> 0x1F+		OpenPGP.SubkeySignature {}        -> 0x18+		OpenPGP.CertificationSignature {} -> 0x13 -	Just (OpenPGP.UserIDPacket firstUserID) = find isUserID m+encrypt :: (CryptoRandomGen g) =>+	[BS.ByteString]               -- ^ Passphrases, all of which will be used+	-> OpenPGP.Message            -- ^ PublicKeys, all of which will be used+	-> OpenPGP.SymmetricAlgorithm -- ^ Cipher to use+	-> OpenPGP.Message            -- ^ The 'OpenPGP.Message' to encrypt+	-> g                          -- ^ Random number generator+	-> Either GenError (OpenPGP.Message, g)+encrypt pass (OpenPGP.Message keys) algo msg = runStateT $ do+	(sk, encP) <- sessionFor algo msg+	OpenPGP.Message . (++[encP]) <$> liftA2 (++)+		(mapM (encryptSessionKeyAsymmetric sk) (filter isKey keys))+		(mapM (encryptSessionKeySymmetric (LZ.take (LZ.length sk - 2) sk) algo) pass) -	defaultStype = case signOver of-		OpenPGP.LiteralDataPacket {OpenPGP.format = f} ->-			if f == 'b' then 0x00 else 0x01-		_ -> 0x13+encryptSessionKeyAsymmetric :: (CryptoRandomGen g) => LZ.ByteString -> OpenPGP.Packet -> StateT g (Either GenError) OpenPGP.Packet+encryptSessionKeyAsymmetric sk pk = OpenPGP.AsymmetricSessionKeyPacket 3+	(fingerprint pk)+	(OpenPGP.key_algorithm pk)+	. addBitLen <$> encd (OpenPGP.key_algorithm pk)+	where+	encd OpenPGP.RSA = toLazyBS <$> rsaEncrypt (rsaKey pk) (toStrictBS sk)+	encd _ = lift $ Left $ GenErrorOther $ "Unsupported PublicKey: " ++ show pk -	Just signOver = find isSignable m-	OpenPGP.Message m = message+encryptSessionKeySymmetric :: (CryptoRandomGen g) => LZ.ByteString -> OpenPGP.SymmetricAlgorithm -> BS.ByteString -> StateT g (Either GenError) OpenPGP.Packet+encryptSessionKeySymmetric sk salgo pass = do+	s2k <- s2k+	return $ OpenPGP.SymmetricSessionKeyPacket 4 salgo s2k+		(string2sencrypt salgo s2k (toLazyBS pass) sk)+	where+	halgo = s2kHashAlgorithmFor salgo+	s2k = OpenPGP.IteratedSaltedS2K halgo . decode . toLazyBS <$>+		(StateT $ genBytes 8) <*> pure 65536 -	isSignable (OpenPGP.LiteralDataPacket {}) = True-	isSignable (OpenPGP.PublicKeyPacket {})   = True-	isSignable (OpenPGP.SecretKeyPacket {})   = True-	isSignable _                              = False+s2kHashAlgorithmFor :: OpenPGP.SymmetricAlgorithm -> OpenPGP.HashAlgorithm+s2kHashAlgorithmFor OpenPGP.AES128 = s2kHashAlgorithm `for` (undefined :: AES128)+s2kHashAlgorithmFor OpenPGP.AES192 = s2kHashAlgorithm `for` (undefined :: AES192)+s2kHashAlgorithmFor OpenPGP.AES256 = s2kHashAlgorithm `for` (undefined :: AES256)+s2kHashAlgorithmFor OpenPGP.Blowfish = s2kHashAlgorithm `for` (undefined :: Blowfish128)+s2kHashAlgorithmFor algo = error $ "Unsupported SymmetricAlgorithm " ++ show algo ++ " in Data.OpenPGP.CryptoAPI.s2kHashAlgorithmFor" -	isUserID (OpenPGP.UserIDPacket {})        = True-	isUserID _                                = False+s2kHashAlgorithm :: (BlockCipher k) => Tagged k OpenPGP.HashAlgorithm+s2kHashAlgorithm = v+	where+	v = Tagged $ case () of+		_ | ksize <= 160 -> OpenPGP.SHA1+		  | ksize <= 256 -> OpenPGP.SHA256+		  | otherwise    -> OpenPGP.SHA512+	ksize = keyLength `tagOfTag` v++tagOfTag :: Tagged a c -> Tagged a b -> c+tagOfTag a b = a `for` (undefined `asTaggedTypeOf` b)++sessionFor :: (CryptoRandomGen g) => OpenPGP.SymmetricAlgorithm -> OpenPGP.Message -> StateT g (Either GenError) (LZ.ByteString, OpenPGP.Packet)+sessionFor algo@OpenPGP.AES128 msg = do+	sk <- StateT buildKeyGen+	encP <- newSession (sk :: AES128) msg+	return (sessionKeyEncode sk algo, encP)+sessionFor algo@OpenPGP.AES192 msg = do+	sk <- StateT buildKeyGen+	encP <- newSession (sk :: AES192) msg+	return (sessionKeyEncode sk algo, encP)+sessionFor algo@OpenPGP.AES256 msg = do+	sk <- StateT buildKeyGen+	encP <- newSession (sk :: AES256) msg+	return (sessionKeyEncode sk algo, encP)+sessionFor algo@OpenPGP.Blowfish msg = do+	sk <- StateT buildKeyGen+	encP <- newSession (sk :: Blowfish128) msg+	return (sessionKeyEncode sk algo, encP)+sessionFor algo _ = lift $ Left $ GenErrorOther $ "Unsupported cipher: " ++ show algo++sessionKeyEncode :: (BlockCipher k) => k -> OpenPGP.SymmetricAlgorithm -> LZ.ByteString+sessionKeyEncode sk algo =+	LZ.concat [encode algo, toLazyBS bs, encode $ checksum bs]+	where+	bs = Serialize.encode sk++newSession :: (BlockCipher k, CryptoRandomGen g, Monad m) => k -> OpenPGP.Message -> StateT g m OpenPGP.Packet+newSession sk msg = do+	encd <- StateT $ return . pgpCFB sk (encode `oo` mkMDC) (encode msg)+	return $ OpenPGP.EncryptedDataPacket 1 encd++mkMDC :: LZ.ByteString -> LZ.ByteString -> OpenPGP.Packet+mkMDC prefix msg = OpenPGP.ModificationDetectionCodePacket $ toLazyBS $ fst $+	hash OpenPGP.SHA1 $ LZ.concat [prefix, msg, LZ.pack [0xD3, 0x14]]++checksum :: BS.ByteString -> Word16+checksum key = fromIntegral $+	BS.foldl' (\x y -> x + fromIntegral y) (0::Integer) key `mod` 65536++decryptSecretKey ::+	BS.ByteString           -- ^ Passphrase+	-> OpenPGP.Packet       -- ^ Encrypted SecretKeyPacket+	-> Maybe OpenPGP.Packet -- ^ Decrypted SecretKeyPacket+decryptSecretKey pass k@(OpenPGP.SecretKeyPacket {+		OpenPGP.version = 4, OpenPGP.key_algorithm = kalgo,+		OpenPGP.s2k = s2k, OpenPGP.symmetric_algorithm = salgo,+		OpenPGP.key = existing, OpenPGP.encrypted_data = encd+	}) | chkF material == toStrictBS chk =+		fmap (\m -> k {+			OpenPGP.s2k_useage = 0,+			OpenPGP.symmetric_algorithm = OpenPGP.Unencrypted,+			OpenPGP.encrypted_data = LZ.empty,+			OpenPGP.key = m+		}) parseMaterial+	   | otherwise = Nothing+	where+	parseMaterial = maybeGet+		(foldM (\m f -> do {mpi <- get; return $ (f,mpi):m}) existing+		(OpenPGP.secret_key_fields kalgo)) material+	(material, chk) = LZ.splitAt (LZ.length decd - chkSize) decd+	(chkSize, chkF)+		| OpenPGP.s2k_useage k == 254 = (20, fst . hash OpenPGP.SHA1)+		| otherwise = (2, Serialize.encode . checksum . toStrictBS)+	decd = string2sdecrypt salgo s2k (toLazyBS pass) (EncipheredWithIV encd)+decryptSecretKey _ _ = Nothing++-- | Decrypt an OpenPGP message using secret key+decryptAsymmetric ::+	OpenPGP.Message    -- ^ SecretKeys, one of which will be used+	-> OpenPGP.Message -- ^ A 'OpenPGP.Message' containing AsymmetricSessionKey and EncryptedData+	-> Maybe OpenPGP.Message+decryptAsymmetric keys msg@(OpenPGP.Message pkts) = do+	(_, d) <- getAsymmetricSessionKey keys msg+	pkt <- find isEncryptedData pkts+	decryptPacket d pkt++-- | Decrypt an OpenPGP message using passphrase+decryptSymmetric ::+	[BS.ByteString]    -- ^ Passphrases, one of which will be used+	-> OpenPGP.Message -- ^ A 'OpenPGP.Message' containing SymetricSessionKey and EncryptedData+	-> Maybe OpenPGP.Message+decryptSymmetric pass msg@(OpenPGP.Message pkts) = do+	let ds = map snd $ getSymmetricSessionKey pass msg+	pkt <- find isEncryptedData pkts+	listToMaybe $ mapMaybe (`decryptPacket` pkt) ds++-- | Decrypt a single packet, given the decryptor+decryptPacket :: Decrypt -> OpenPGP.Packet -> Maybe OpenPGP.Message+decryptPacket d (OpenPGP.EncryptedDataPacket {+		OpenPGP.version = 1,+		OpenPGP.encrypted_data = encd+	}) | Just (mkMDC prefix msg) == maybeDecode mdc = maybeDecode msg+	   | otherwise = Nothing+	where+	(msg,mdc) = LZ.splitAt (LZ.length content - 22) content+	(prefix, content) = d False encd+decryptPacket d (OpenPGP.EncryptedDataPacket {+		OpenPGP.version = 0,+		OpenPGP.encrypted_data = encd+	}) = maybeDecode (snd $ d True encd)+decryptPacket _ _ = error "Can only decrypt EncryptedDataPacket in Data.OpenPGP.CryptoAPI.decryptPacket"++getSymmetricSessionKey ::+	[BS.ByteString]    -- ^ Passphrases, one of which will be used+	-> OpenPGP.Message -- ^ An OpenPGP Message containing SymmetricSessionKey+	-> [(OpenPGP.SymmetricAlgorithm, Decrypt)]+getSymmetricSessionKey pass (OpenPGP.Message ps) =+	concatMap (\OpenPGP.SymmetricSessionKeyPacket {+			OpenPGP.s2k = s2k, OpenPGP.symmetric_algorithm = algo,+			OpenPGP.encrypted_data = encd+		} ->+		if LZ.null encd then+			map ((,) algo . string2decrypt algo s2k) pass'+		else+			mapMaybe (\p -> decodeSess $ string2sdecrypt algo s2k p (EncipheredZeroIV encd)) pass'+	) sessionKeys+	where+	decodeSess s = let (a, k) = LZ.splitAt 1 s in+		(,) (decode a) <$> decodeSymKey (decode a) (toStrictBS k)+	sessionKeys = filter isSymmetricSessionKey ps+	pass' = map toLazyBS pass++-- | Decrypt an asymmetrically encrypted symmetric session key+getAsymmetricSessionKey ::+	OpenPGP.Message    -- ^ SecretKeys, one of which will be used+	-> OpenPGP.Message -- ^ An OpenPGP Message containing AssymetricSessionKey+	-> Maybe (OpenPGP.SymmetricAlgorithm, Decrypt)+getAsymmetricSessionKey keys (OpenPGP.Message ps) =+	listToMaybe $ mapMaybe decodeSessionKey $ catMaybes $+	concatMap (\(sk,ks) ->+		map ($ toStrictBS $ OpenPGP.encrypted_data sk) ks+	) toTry+	where+	toTry = map (id &&& lookupKey) sessionKeys++	lookupKey (OpenPGP.AsymmetricSessionKeyPacket {+		OpenPGP.key_algorithm = OpenPGP.RSA,+		OpenPGP.key_id = key_id+	}) | all (=='0') key_id = map (rsaDecrypt . snd) rsa+	   | otherwise = map (rsaDecrypt . snd) $+		filter (keyIdMatch key_id . fst) rsa+	lookupKey _ = []++	sessionKeys = filter isAsymmetricSessionKey ps+	(rsa, _) = secretKeys keys++decodeSessionKey :: BS.ByteString -> Maybe (OpenPGP.SymmetricAlgorithm, Decrypt)+decodeSessionKey sk+	| checksum key == (decode (toLazyBS chk) :: Word16) = do+		algo <- maybeDecode (toLazyBS algoByte)+		decrypt <- decodeSymKey algo key+		return (algo, decrypt)+	| otherwise = Nothing+	where+	(key, chk) = BS.splitAt (BS.length rest - 2) rest+	(algoByte, rest) = BS.splitAt 1 sk++decodeSymKey :: OpenPGP.SymmetricAlgorithm -> BS.ByteString -> Maybe Decrypt+decodeSymKey OpenPGP.AES128 k = pgpUnCFB <$> (`asTypeOf` (undefined :: AES128)) <$> sDecode k+decodeSymKey OpenPGP.AES192 k = pgpUnCFB <$> (`asTypeOf` (undefined :: AES192)) <$> sDecode k+decodeSymKey OpenPGP.AES256 k = pgpUnCFB <$> (`asTypeOf` (undefined :: AES256)) <$> sDecode k+decodeSymKey OpenPGP.Blowfish k = pgpUnCFB <$> (`asTypeOf` (undefined :: Blowfish128)) <$> sDecode k+decodeSymKey _ _ = Nothing++string2sencrypt :: OpenPGP.SymmetricAlgorithm -> OpenPGP.S2K -> LZ.ByteString -> LZ.ByteString -> LZ.ByteString+string2sencrypt OpenPGP.AES128 s2k s = simpleCFB (string2key s2k s :: AES128) zeroIV+string2sencrypt OpenPGP.AES192 s2k s = simpleCFB (string2key s2k s :: AES192) zeroIV+string2sencrypt OpenPGP.AES256 s2k s = simpleCFB (string2key s2k s :: AES256) zeroIV+string2sencrypt OpenPGP.Blowfish s2k s = simpleCFB (string2key s2k s :: Blowfish128) zeroIV+string2sencrypt algo _ _ = error $ "Unsupported symmetric algorithm : " ++ show algo ++ " in Data.OpenPGP.CryptoAPI.string2sencrypt"++string2decrypt :: OpenPGP.SymmetricAlgorithm -> OpenPGP.S2K -> LZ.ByteString -> Decrypt+string2decrypt OpenPGP.AES128 s2k s = pgpUnCFB (string2key s2k s :: AES128)+string2decrypt OpenPGP.AES192 s2k s = pgpUnCFB (string2key s2k s :: AES192)+string2decrypt OpenPGP.AES256 s2k s = pgpUnCFB (string2key s2k s :: AES256)+string2decrypt OpenPGP.Blowfish s2k s = pgpUnCFB (string2key s2k s :: Blowfish128)+string2decrypt algo _ _ = error $ "Unsupported symmetric algorithm : " ++ show algo ++ " in Data.OpenPGP.CryptoAPI.string2decrypt"++string2sdecrypt :: OpenPGP.SymmetricAlgorithm -> OpenPGP.S2K -> LZ.ByteString -> Enciphered -> LZ.ByteString+string2sdecrypt OpenPGP.AES128 s2k s = withIV $ simpleUnCFB (string2key s2k s :: AES128)+string2sdecrypt OpenPGP.AES192 s2k s = withIV $ simpleUnCFB (string2key s2k s :: AES192)+string2sdecrypt OpenPGP.AES256 s2k s = withIV $ simpleUnCFB (string2key s2k s :: AES256)+string2sdecrypt OpenPGP.Blowfish s2k s = withIV $ simpleUnCFB (string2key s2k s :: Blowfish128)+string2sdecrypt algo _ _ = error $ "Unsupported symmetric algorithm : " ++ show algo ++ " in Data.OpenPGP.CryptoAPI.string2sdecrypt"++data Enciphered = EncipheredWithIV !LZ.ByteString | EncipheredZeroIV !LZ.ByteString++withIV :: (BlockCipher k) => (IV k -> LZ.ByteString -> LZ.ByteString) -> Enciphered -> LZ.ByteString+withIV f (EncipheredWithIV s) = f iv $ LZ.drop (fromIntegral $ BS.length $ Serialize.encode iv) s+	where+	iv = let Right x = Serialize.decode (toStrictBS s) in x+withIV f (EncipheredZeroIV s) = f zeroIV s++string2key :: (BlockCipher k) => OpenPGP.S2K -> LZ.ByteString -> k+string2key s2k s = k+	where+	Just k = buildKey $ toStrictBS $+		LZ.take ksize $ OpenPGP.string2key (fst `oo` hash) s2k s+	ksize = fromIntegral (keyLength `for` k) `div` 8
+ Data/OpenPGP/CryptoAPI/Blowfish128.hs view
@@ -0,0 +1,20 @@+module Data.OpenPGP.CryptoAPI.Blowfish128 (Blowfish128) where++import Crypto.Classes (BlockCipher(..))+import Crypto.Types (BitLength)+import Crypto.Cipher.Blowfish (Blowfish)+import Data.Tagged (retag, Tagged(..))+import qualified Data.Serialize as Serialize++newtype Blowfish128 = Blowfish128 Blowfish++instance Serialize.Serialize Blowfish128 where+	put (Blowfish128 b) = Serialize.put b+	get = fmap Blowfish128 Serialize.get++instance BlockCipher Blowfish128 where+	blockSize = retag (blockSize :: Tagged Blowfish BitLength)+	encryptBlock (Blowfish128 k) = encryptBlock k+	decryptBlock (Blowfish128 k) = decryptBlock k+	buildKey = fmap Blowfish128 . buildKey+	keyLength = Tagged 128
+ Data/OpenPGP/CryptoAPI/Util.hs view
@@ -0,0 +1,80 @@+module Data.OpenPGP.CryptoAPI.Util where++import Numeric+import Control.Applicative+import Data.Binary+import Data.Binary.Get (runGetOrFail)+import qualified Data.Serialize as Serialize+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LZ+import qualified Data.OpenPGP as OpenPGP++swing :: (((a -> b) -> b) -> c -> d) -> c -> a -> d+swing f c a = f ($ a) c++hush :: Either a b -> Maybe b+hush (Left _) = Nothing+hush (Right x) = Just x++toStrictBS :: LZ.ByteString -> BS.ByteString+toStrictBS = BS.concat . LZ.toChunks++toLazyBS :: BS.ByteString -> LZ.ByteString+toLazyBS = LZ.fromChunks . (:[])++oo :: (b -> c) -> (a -> a1 -> b) -> a -> a1 -> c+oo = (.) . (.)++hexString :: [Word8] -> String+hexString = foldr (pad `oo` showHex) ""+	where+	pad s | odd $ length s = '0':s+	      | otherwise = s++maybeDecode :: (Binary a) => LZ.ByteString -> Maybe a+maybeDecode = maybeGet get++maybeGet :: (Binary a) => Get a -> LZ.ByteString -> Maybe a+maybeGet g bs = (\(_,_,x) -> x) <$> hush (runGetOrFail g bs)++sDecode :: (Serialize.Serialize a) => BS.ByteString -> Maybe a+sDecode = hush . Serialize.decode++keyIdMatch :: String -> String -> Bool+keyIdMatch x y = all (uncurry (==)) $ uncurry (flip zip) $+	unzip $ zip (reverse x) (reverse y)++fromJustMPI :: Maybe OpenPGP.MPI -> Integer+fromJustMPI (Just (OpenPGP.MPI x)) = x+fromJustMPI _ = error "Not a Just MPI, Data.OpenPGP.CryptoAPI"++isSecretKey :: OpenPGP.Packet -> Bool+isSecretKey (OpenPGP.SecretKeyPacket {}) = True+isSecretKey                            _ = False++isAsymmetricSessionKey :: OpenPGP.Packet -> Bool+isAsymmetricSessionKey (OpenPGP.AsymmetricSessionKeyPacket {}) = True+isAsymmetricSessionKey                                       _ = False++isSymmetricSessionKey :: OpenPGP.Packet -> Bool+isSymmetricSessionKey (OpenPGP.SymmetricSessionKeyPacket {}) = True+isSymmetricSessionKey                                      _ = False++isEncryptedData :: OpenPGP.Packet -> Bool+isEncryptedData (OpenPGP.EncryptedDataPacket {}) = True+isEncryptedData                                _ = False++isUserID :: OpenPGP.Packet -> Bool+isUserID (OpenPGP.UserIDPacket {})        = True+isUserID _                                = False++isSignable :: OpenPGP.Packet -> Bool+isSignable (OpenPGP.LiteralDataPacket {}) = True+isSignable (OpenPGP.PublicKeyPacket {})   = True+isSignable (OpenPGP.SecretKeyPacket {})   = True+isSignable _                              = False++isKey :: OpenPGP.Packet -> Bool+isKey (OpenPGP.SecretKeyPacket {}) = True+isKey (OpenPGP.PublicKeyPacket {}) = True+isKey                            _ = False
README view
@@ -1,6 +1,7 @@ This is a wrapper around <http://hackage.haskell.org/package/crypto-api> and related libraries that currently does fingerprint generation, signature-generation, and signature verification (for RSA and DSA keys).+generation, signature verification, and both asymmetric and symmetric+encryption and decryption.  It is indended to be used with <http://hackage.haskell.org/package/openpgp>
openpgp-crypto-api.cabal view
@@ -1,5 +1,5 @@ name:            openpgp-crypto-api-version:         0.4+version:         0.6 cabal-version:   >= 1.8 license:         OtherLicense license-file:    COPYING@@ -11,12 +11,13 @@ tested-with:     GHC == 7.0.3 synopsis:        Implement cryptography for OpenPGP using crypto-api compatible libraries homepage:        http://github.com/singpolyma/OpenPGP-CryptoAPI-bug-reports:     http://github.com/singpolyma/OpenPGP-Haskell/issues+bug-reports:     http://github.com/singpolyma/OpenPGP-CryptoAPI/issues build-type:      Simple description:         This is a wrapper around <http://hackage.haskell.org/package/crypto-api>         and related libraries that currently does fingerprint generation, signature-        generation, and signature verification (for RSA and DSA keys).+        generation, signature verification, and both asymmetric and symmetric+        encryption and decryption.         .         It is indended to be used with <http://hackage.haskell.org/package/openpgp>         .@@ -31,25 +32,39 @@         tests/data/000016-006.public_key,         tests/data/000027-006.public_key,         tests/data/000035-006.public_key,-        tests/data/uncompressed-ops-dsa.gpg-        tests/data/uncompressed-ops-dsa-sha384.txt.gpg+        tests/data/compressedsig-bzip2.gpg,+        tests/data/compressedsig.gpg,+        tests/data/compressedsig-zlib.gpg,+        tests/data/encryptedSecretKey.gpg,+        tests/data/hello.gpg,+        tests/data/helloKey.gpg,+        tests/data/pubring.gpg,+        tests/data/secring.gpg,+        tests/data/symmetric-aes.gpg,+        tests/data/symmetric-blowfish.gpg,+        tests/data/symmetric-no-mdc.gpg,+        tests/data/symmetric-with-session-key.gpg,+        tests/data/uncompressed-ops-dsa.gpg,+        tests/data/uncompressed-ops-dsa-sha384.txt.gpg,         tests/data/uncompressed-ops-rsa.gpg-        tests/data/compressedsig.gpg-        tests/data/compressedsig-zlib.gpg-        tests/data/compressedsig-bzip2.gpg  library         exposed-modules:                 Data.OpenPGP.CryptoAPI +        other-modules:+                Data.OpenPGP.CryptoAPI.Util+                Data.OpenPGP.CryptoAPI.Blowfish128+         build-depends:                 base == 4.*,+                transformers,                 bytestring,-                utf8-string,-                binary,-                openpgp,-                crypto-api,-                cryptocipher >= 0.3.7,+                binary >= 0.6.4.0,+                openpgp >= 0.6,+                crypto-api >= 0.9,+                tagged,+                cryptocipher >= 0.3.6,                 cryptohash,                 cereal @@ -59,15 +74,19 @@          build-depends:                 base == 4.*,+                transformers,                 bytestring,+                binary >= 0.6.4.0,                 utf8-string,-                binary,-                openpgp,+                openpgp >= 0.6,                 crypto-api >= 0.9,-                cryptocipher >= 0.3.7,+                tagged,+                cryptocipher >= 0.3.6,                 cryptohash,+                cereal,                 HUnit,                 QuickCheck >= 2.4.1.1,+                quickcheck-instances,                 test-framework,                 test-framework-hunit,                 test-framework-quickcheck2
+ tests/data/encryptedSecretKey.gpg view

binary file changed (absent → 1291 bytes)

+ tests/data/hello.gpg view

binary file changed (absent → 238 bytes)

+ tests/data/helloKey.gpg view

binary file changed (absent → 1598 bytes)

+ tests/data/pubring.gpg view

binary file changed (absent → 7368 bytes)

+ tests/data/secring.gpg view

binary file changed (absent → 10573 bytes)

+ tests/data/symmetric-aes.gpg view
@@ -0,0 +1,1 @@+Œ
	»†FÝyDã`Ò>ì~i•XaMé©MÂÛ7*W£ÛK1®IºÉ&¢·UÞ]-axósön´ìí֎‘ì©ó§jUÄûǕ%ÀøÔ©eÚ
+ tests/data/symmetric-blowfish.gpg view
@@ -0,0 +1,1 @@+Œ
B|LÉ©<îâ`Ò2ÆïG5ðÌzšì÷g¶çóý¬î%dõíú`Š~JXêMÂÄľm˦Ž4Ü
+ tests/data/symmetric-no-mdc.gpg view
@@ -0,0 +1,2 @@+Œ
[¨¡JH×BÉ`É#¥{Õ%íû‘|ž©6™buâC»	gÝ++HÞÄè
+ tests/data/symmetric-with-session-key.gpg view

binary file changed (absent → 641 bytes)

tests/suite.hs view
@@ -2,18 +2,31 @@ import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Test.QuickCheck+import Test.QuickCheck.Instances () import Test.HUnit hiding (Test) +import Data.Maybe+import Data.Monoid+import Data.List (find) import Crypto.Random import Data.Binary import qualified Data.OpenPGP as OpenPGP import qualified Data.OpenPGP.CryptoAPI as OpenPGP import qualified Data.ByteString.Lazy as LZ-import qualified Data.ByteString.Lazy.UTF8 as LZ (fromString)+import qualified Data.ByteString.Lazy.UTF8 as LZ (fromString, toString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.UTF8 as BS (fromString)  instance Arbitrary OpenPGP.HashAlgorithm where 	arbitrary = elements [OpenPGP.MD5, OpenPGP.SHA1, OpenPGP.RIPEMD160, OpenPGP.SHA256, OpenPGP.SHA384, OpenPGP.SHA512, OpenPGP.SHA224] +instance Arbitrary OpenPGP.SymmetricAlgorithm where+	arbitrary = elements [OpenPGP.AES128, OpenPGP.AES192, OpenPGP.AES256, OpenPGP.Blowfish]++isLiteral :: OpenPGP.Packet -> Bool+isLiteral (OpenPGP.LiteralDataPacket {}) = True+isLiteral                              _ = False+ testFingerprint :: FilePath -> String -> Assertion testFingerprint fp kf = do 	bs <- LZ.readFile $ "tests/data/" ++ fp@@ -24,9 +37,41 @@ testVerifyMessage keyring message = do 	keys <- fmap decode $ LZ.readFile $ "tests/data/" ++ keyring 	m <- fmap decode $ LZ.readFile $ "tests/data/" ++ message-	let verification = OpenPGP.verify keys m 0-	assertEqual (keyring ++ " for " ++ message) True verification+	let OpenPGP.DataSignature _ ss =+		OpenPGP.verify keys (head $ OpenPGP.signatures m)+	assertEqual (keyring ++ " for " ++ message) 1 (length ss) +testVerifyKey :: FilePath -> Int -> Assertion+testVerifyKey keyring count = do+	keys <- fmap decode $ LZ.readFile $ "tests/data/" ++ keyring+	let out = OpenPGP.verify keys (OpenPGP.signatures keys !! 1)+	assertEqual keyring count (length $ OpenPGP.signatures_over out)++testDecryptHello :: Assertion+testDecryptHello = do+	keys <- fmap decode $ LZ.readFile "tests/data/helloKey.gpg"+	m <- fmap decode $ LZ.readFile "tests/data/hello.gpg"+	let Just (OpenPGP.Message [OpenPGP.CompressedDataPacket {+			OpenPGP.message = OpenPGP.Message msg+		}]) = OpenPGP.decryptAsymmetric keys m+	let content = fmap (LZ.toString . OpenPGP.content) (find isLiteral msg)+	assertEqual "Decrypt hello" (Just "hello\n") content++testDecryptSymmetric :: String -> String -> FilePath -> Assertion+testDecryptSymmetric pass cnt file = do+	m <- fmap decode $ LZ.readFile $ "tests/data/" ++ file+	let Just (OpenPGP.Message [OpenPGP.CompressedDataPacket {+			OpenPGP.message = OpenPGP.Message msg+		}]) = OpenPGP.decryptSymmetric [BS.fromString pass] m+	let content = fmap (LZ.toString . OpenPGP.content) (find isLiteral msg)+	assertEqual "Decrypt symmetric" (Just cnt) content++testDecryptSecretKey :: String -> FilePath -> Assertion+testDecryptSecretKey pass file = do+	m <- fmap decode $ LZ.readFile $ "tests/data/" ++ file+	let d = OpenPGP.decryptSecretKey (BS.fromString pass) m+	assertEqual "Decrypt secret key" True (isJust d)+ prop_sign_and_verify :: (CryptoRandomGen g) => OpenPGP.Message -> g -> OpenPGP.HashAlgorithm -> String -> String -> Gen Bool prop_sign_and_verify secring g halgo filename msg = do 	keyid <- elements ["FEF8AFA0F661C3EE","7F69FA376B020509"]@@ -36,12 +81,29 @@ 			OpenPGP.timestamp = 12341234, 			OpenPGP.content = LZ.fromString msg 		}-	let sig = OpenPGP.sign secring (OpenPGP.Message [m])+	let (sig,_) = OpenPGP.sign secring (OpenPGP.DataSignature m []) 			halgo keyid 12341234 g-	return $ OpenPGP.verify secring (OpenPGP.Message [sig,m]) 0+	let OpenPGP.DataSignature _ ss = OpenPGP.verify secring sig+	return (length ss == 1) -tests :: (CryptoRandomGen g) => OpenPGP.Message -> g -> [Test]-tests secring rng =+prop_encrypt_and_decrypt :: (CryptoRandomGen g) => OpenPGP.Message -> g -> BS.ByteString -> OpenPGP.SymmetricAlgorithm -> String -> String -> Bool+prop_encrypt_and_decrypt secring g pass algo filename msg =+	case (OpenPGP.encrypt [] secring algo m g, OpenPGP.encrypt [pass] mempty algo m g) of+		(Left _, _) -> False+		(_, Left _) -> False+		(Right (encA, _), Right (encB, _)) ->+			(OpenPGP.decryptAsymmetric secring encA == Just m) &&+			(OpenPGP.decryptSymmetric [pass] encB == Just m)+	where+	m = OpenPGP.Message [OpenPGP.LiteralDataPacket {+			OpenPGP.format = 'u',+			OpenPGP.filename = filename,+			OpenPGP.timestamp = 12341234,+			OpenPGP.content = LZ.fromString msg+		}]++tests :: (CryptoRandomGen g) => OpenPGP.Message -> OpenPGP.Message -> g -> [Test]+tests secring oneKey rng = 	[ 		testGroup "Fingerprint" [ 			testCase "000001-006.public_key" (testFingerprint "000001-006.public_key" "421F28FEAAD222F856C8FFD5D4D54EA16F87040E"),@@ -57,8 +119,22 @@ 			testCase "compressedsig-zlib" (testVerifyMessage "pubring.gpg" "compressedsig-zlib.gpg"), 			testCase "compressedsig-bzip2" (testVerifyMessage "pubring.gpg" "compressedsig-bzip2.gpg") 		],+		testGroup "Key verification" [+			testCase "helloKey" (testVerifyKey "helloKey.gpg" 1)+		], 		testGroup "Signing" [-			testProperty "Crypto signatures verify" (prop_sign_and_verify secring rng)+			testProperty "Signatures verify" (prop_sign_and_verify secring rng)+		],+		testGroup "Decryption" [+			testCase "decrypt hello" testDecryptHello,+			testCase "decrypt AES" (testDecryptSymmetric "hello" "PGP\n" "symmetric-aes.gpg"),+			testCase "decrypt session key" (testDecryptSymmetric "hello" "PGP\n" "symmetric-with-session-key.gpg"),+			testCase "decrypt Blowfish" (testDecryptSymmetric "hello" "PGP\n" "symmetric-blowfish.gpg"),+			testCase "decrypt no MDC" (testDecryptSymmetric "hello" "PGP\n" "symmetric-no-mdc.gpg"),+			testCase "decrypt secret key" (testDecryptSecretKey "hello" "encryptedSecretKey.gpg")+		],+		testGroup "Encryption" [+			testProperty "Encrypted messages decrypt" (prop_encrypt_and_decrypt oneKey rng) 		] 	] @@ -66,4 +142,5 @@ main = do 	rng <- newGenIO :: IO SystemRandom 	secring <- fmap decode $ LZ.readFile "tests/data/secring.gpg"-	defaultMain (tests secring rng)+	oneKey <- fmap decode $ LZ.readFile "tests/data/helloKey.gpg"+	defaultMain (tests secring oneKey rng)