packages feed

openpgp-crypto-api 0.6.2 → 0.6.3

raw patch · 3 files changed

+58/−57 lines, 3 filesdep ~crypto-api

Dependency ranges changed: crypto-api

Files

Data/OpenPGP/CryptoAPI.hs view
@@ -10,7 +10,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State (StateT(..), runStateT) import Data.Binary (encode, decode, get, Word16)-import Crypto.Classes hiding (cfb,unCfb,hash,sign,verify,encode)+import Crypto.Classes hiding (cfb,unCfb,sign,verify,encode) import Data.Tagged (untag, asTaggedTypeOf, Tagged(..)) import Crypto.Modes (cfb, unCfb, zeroIV) import Crypto.Types (IV)@@ -39,41 +39,23 @@ -- | 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 -hash :: OpenPGP.HashAlgorithm -> LZ.ByteString -> (BS.ByteString, String)-hash OpenPGP.MD5 = hash_ (undefined :: MD5)-hash OpenPGP.SHA1 = hash_ (undefined :: SHA1)-hash OpenPGP.RIPEMD160 = hash_ (undefined :: RIPEMD160)-hash OpenPGP.SHA256 = hash_ (undefined :: SHA256)-hash OpenPGP.SHA384 = hash_ (undefined :: SHA384)-hash OpenPGP.SHA512 = hash_ (undefined :: SHA512)-hash OpenPGP.SHA224 = hash_ (undefined :: SHA224)-hash _ = error "Unsupported HashAlgorithm in hash"+pgpHash :: OpenPGP.HashAlgorithm -> LZ.ByteString -> (BS.ByteString, String)+pgpHash OpenPGP.MD5 = formatHash . (hash :: LZ.ByteString -> MD5)+pgpHash OpenPGP.SHA1 = formatHash . (hash :: LZ.ByteString -> SHA1)+pgpHash OpenPGP.RIPEMD160 = formatHash . (hash :: LZ.ByteString -> RIPEMD160)+pgpHash OpenPGP.SHA256 = formatHash . (hash :: LZ.ByteString -> SHA256)+pgpHash OpenPGP.SHA384 = formatHash . (hash :: LZ.ByteString -> SHA384)+pgpHash OpenPGP.SHA512 = formatHash . (hash :: LZ.ByteString -> SHA512)+pgpHash OpenPGP.SHA224 = formatHash . (hash :: LZ.ByteString -> SHA224)+pgpHash _ = error "Unsupported HashAlgorithm in pgpHash" -hash_ :: (Hash c d) => d -> LZ.ByteString -> (BS.ByteString, String)-hash_ d bs = (hbs, map toUpper $ pad $ hexString $ BS.unpack hbs)+formatHash :: (Hash c d) => d -> (BS.ByteString, String)+formatHash d = (hbs, map toUpper $ pad $ hexString $ BS.unpack hbs) 	where-	hbs = Serialize.encode $ hashFunc d bs+	hbs = Serialize.encode d 	pad s = replicate (len - length s) '0' ++ s 	len = (outputLength `for` d) `div` 8 @@ -195,8 +177,8 @@ -- <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+	| OpenPGP.version p == 4 = snd $ pgpHash OpenPGP.SHA1 material+	| OpenPGP.version p `elem` [2, 3] = snd $ pgpHash OpenPGP.MD5 material 	| otherwise = error "Unsupported Packet version or type in fingerprint" 	where 	material = LZ.concat $ OpenPGP.fingerprint_material p@@ -213,12 +195,12 @@ 		(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+verifyOne keys sig over = fmap (const sig) $ maybeKey >>= verification >>= guard+	where+	verification = case OpenPGP.key_algorithm sig of 		OpenPGP.DSA -> dsaVerify 		alg | alg `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> rsaVerify 		    | otherwise -> const Nothing-	where 	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@@ -226,7 +208,7 @@ 	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+	bhash = fst . pgpHash hash_algo . toLazyBS 	padding = emsa_pkcs1_v1_5_hash_padding hash_algo 	hash_algo = OpenPGP.hash_algorithm sig 	maybeKey = OpenPGP.signature_issuer sig >>= find_key keys@@ -256,7 +238,7 @@ 	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+	bhash   = fst . pgpHash hsh . toLazyBS 	toNum   = BS.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0 	Just k  = find_key keys keyid @@ -336,10 +318,14 @@ 		(StateT $ genBytes 8) <*> pure 65536  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 OpenPGP.AES128 =+	untag (s2kHashAlgorithm :: Tagged AES128 OpenPGP.HashAlgorithm)+s2kHashAlgorithmFor OpenPGP.AES192 =+	untag (s2kHashAlgorithm :: Tagged AES192 OpenPGP.HashAlgorithm)+s2kHashAlgorithmFor OpenPGP.AES256 =+	untag (s2kHashAlgorithm :: Tagged AES256 OpenPGP.HashAlgorithm)+s2kHashAlgorithmFor OpenPGP.Blowfish =+	untag (s2kHashAlgorithm :: Tagged Blowfish128 OpenPGP.HashAlgorithm) s2kHashAlgorithmFor algo = error $ "Unsupported SymmetricAlgorithm " ++ show algo ++ " in Data.OpenPGP.CryptoAPI.s2kHashAlgorithmFor"  s2kHashAlgorithm :: (BlockCipher k) => Tagged k OpenPGP.HashAlgorithm@@ -349,10 +335,7 @@ 		_ | 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)+	ksize = untag $ const <$> keyLength <*> v  sessionFor :: (CryptoRandomGen g) => OpenPGP.SymmetricAlgorithm -> OpenPGP.Message -> StateT g (Either GenError) (LZ.ByteString, OpenPGP.Packet) sessionFor algo@OpenPGP.AES128 msg = do@@ -386,7 +369,7 @@  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]]+	pgpHash OpenPGP.SHA1 $ LZ.concat [prefix, msg, LZ.pack [0xD3, 0x14]]  checksum :: BS.ByteString -> Word16 checksum key = fromIntegral $@@ -414,7 +397,7 @@ 		(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)+		| OpenPGP.s2k_useage k == 254 = (20, fst . pgpHash OpenPGP.SHA1) 		| otherwise = (2, Serialize.encode . checksum . toStrictBS) 	decd = string2sdecrypt salgo s2k (toLazyBS pass) (EncipheredWithIV encd) decryptSecretKey _ _ = Nothing@@ -511,10 +494,10 @@ 	(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 OpenPGP.AES128 k = (pgpUnCFB :: AES128 -> Decrypt) <$> sDecode k+decodeSymKey OpenPGP.AES192 k = (pgpUnCFB :: AES192 -> Decrypt) <$> sDecode k+decodeSymKey OpenPGP.AES256 k = (pgpUnCFB :: AES256 -> Decrypt) <$> sDecode k+decodeSymKey OpenPGP.Blowfish k = (pgpUnCFB :: Blowfish128 -> Decrypt) <$> sDecode k decodeSymKey _ _ = Nothing  string2sencrypt :: OpenPGP.SymmetricAlgorithm -> OpenPGP.S2K -> LZ.ByteString -> LZ.ByteString -> LZ.ByteString@@ -550,5 +533,5 @@ string2key s2k s = k 	where 	Just k = buildKey $ toStrictBS $-		LZ.take ksize $ OpenPGP.string2key (fst `oo` hash) s2k s+		LZ.take ksize $ OpenPGP.string2key (fst `oo` pgpHash) s2k s 	ksize = fromIntegral (keyLength `for` k) `div` 8
openpgp-crypto-api.cabal view
@@ -1,5 +1,5 @@ name:            openpgp-crypto-api-version:         0.6.2+version:         0.6.3 cabal-version:   >= 1.8 license:         OtherLicense license-file:    COPYING@@ -62,7 +62,7 @@                 bytestring,                 binary >= 0.6.4.0,                 openpgp >= 0.6,-                crypto-api >= 0.11,+                crypto-api >= 0.12.2.2,                 tagged,                 cryptocipher >= 0.3.6 && <= 0.3.7,                 cryptohash <= 0.9.1,@@ -79,7 +79,7 @@                 binary >= 0.6.4.0,                 utf8-string,                 openpgp >= 0.6,-                crypto-api >= 0.11,+                crypto-api >= 0.12.2.2,                 tagged,                 cryptocipher >= 0.3.6 && <= 0.3.7,                 cryptohash <= 0.9.1,
tests/suite.hs view
@@ -10,6 +10,7 @@ import Data.List (find) import Crypto.Random import Data.Binary+import Data.Bits (xor) import qualified Data.OpenPGP as OpenPGP import qualified Data.OpenPGP.CryptoAPI as OpenPGP import qualified Data.ByteString.Lazy as LZ@@ -27,6 +28,11 @@ isLiteral (OpenPGP.LiteralDataPacket {}) = True isLiteral                              _ = False +modifyLiteralPacket :: OpenPGP.Packet -> OpenPGP.Packet+modifyLiteralPacket d@(OpenPGP.LiteralDataPacket { OpenPGP.content = cnt }) =+	d { OpenPGP.content = LZ.cons 0x00 $ LZ.map (xor 0xFF) cnt }+modifyLiteralPacket nonliteral = nonliteral+ testFingerprint :: FilePath -> String -> Assertion testFingerprint fp kf = do 	bs <- LZ.readFile $ "tests/data/" ++ fp@@ -41,6 +47,15 @@ 		OpenPGP.verify keys (head $ OpenPGP.signatures m) 	assertEqual (keyring ++ " for " ++ message) 1 (length ss) +testVerifyModifiedMessage :: FilePath -> FilePath -> Assertion+testVerifyModifiedMessage keyring message = do+	keys <- fmap decode $ LZ.readFile $ "tests/data/" ++ keyring+	OpenPGP.Message m <- fmap decode $ LZ.readFile $ "tests/data/" ++ message+	let corrupt_message = OpenPGP.Message (map modifyLiteralPacket m)+	let OpenPGP.DataSignature _ ss =+		OpenPGP.verify keys (head $ OpenPGP.signatures corrupt_message)+	assertEqual (keyring ++ " for " ++ message) 0 (length ss)+ testVerifyKey :: FilePath -> Int -> Assertion testVerifyKey keyring count = do 	keys <- fmap decode $ LZ.readFile $ "tests/data/" ++ keyring@@ -117,7 +132,10 @@ 			testCase "uncompressed-ops-rsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-rsa.gpg"), 			testCase "compressedsig" (testVerifyMessage "pubring.gpg" "compressedsig.gpg"), 			testCase "compressedsig-zlib" (testVerifyMessage "pubring.gpg" "compressedsig-zlib.gpg"),-			testCase "compressedsig-bzip2" (testVerifyMessage "pubring.gpg" "compressedsig-bzip2.gpg")+			testCase "compressedsig-bzip2" (testVerifyMessage "pubring.gpg" "compressedsig-bzip2.gpg"),+			testCase "corrupted-ops-dsa" (testVerifyModifiedMessage "pubring.gpg" "uncompressed-ops-dsa.gpg"),+			testCase "corrupted-ops-dsa-sha384" (testVerifyModifiedMessage "pubring.gpg" "uncompressed-ops-dsa-sha384.txt.gpg"),+			testCase "corrupted-ops-rsa" (testVerifyModifiedMessage "pubring.gpg" "uncompressed-ops-rsa.gpg") 		], 		testGroup "Key verification" [ 			testCase "helloKey" (testVerifyKey "helloKey.gpg" 1)