From 8c34729c62ba64c810fbfa73719ae7f7110c0fbe Mon Sep 17 00:00:00 2001 From: Clint Adams Date: Thu, 26 Apr 2012 20:28:40 -0400 Subject: More laziness. --- Codec/Encryption/OpenPGP/ASCIIArmor.hs | 10 +++-- Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs | 23 +++++++---- Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs | 55 +++++++++++++++------------ Data/Digest/CRC24.hs | 13 +++++-- tests/suite.hs | 39 ++++++++++++------- 5 files changed, 87 insertions(+), 53 deletions(-) diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor.hs b/Codec/Encryption/OpenPGP/ASCIIArmor.hs index 6d0c172..fcb7337 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor.hs @@ -4,12 +4,14 @@ -- (See the LICENSE file). module Codec.Encryption.OpenPGP.ASCIIArmor ( - encode - , decode + decode + , decodeLazy + , encode + , encodeLazy , parseArmor , multipartMerge ) where -import Codec.Encryption.OpenPGP.ASCIIArmor.Encode (encode) -import Codec.Encryption.OpenPGP.ASCIIArmor.Decode (decode, parseArmor) +import Codec.Encryption.OpenPGP.ASCIIArmor.Decode (decode, decodeLazy, parseArmor) +import Codec.Encryption.OpenPGP.ASCIIArmor.Encode (encode, encodeLazy) import Codec.Encryption.OpenPGP.ASCIIArmor.Multipart (multipartMerge) diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs index b89fbfa..bfaef39 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs @@ -7,12 +7,15 @@ module Codec.Encryption.OpenPGP.ASCIIArmor.Decode ( parseArmor , decode + , decodeLazy ) where import Codec.Encryption.OpenPGP.ASCIIArmor.Types import Codec.Encryption.OpenPGP.ASCIIArmor.Utils import Control.Applicative (many, (<|>), (<$>), Alternative, (<*), (<*>), (*>), optional) -import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, (), parse, IResult(..)) +import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, ()) +import qualified Data.Attoparsec.ByteString as AS +import qualified Data.Attoparsec.ByteString.Lazy as AL import Data.Attoparsec.ByteString.Char8 (isDigit_w8, anyChar) import Data.Attoparsec.Combinator (manyTill) import Data.Bits (shiftL) @@ -29,11 +32,17 @@ import Data.String (IsString, fromString) import Data.Word (Word32) decode :: IsString e => ByteString -> Either e [Armor] -decode bs = go (parse parseArmors bs) +decode bs = go (AS.parse parseArmors bs) where - go (Fail t c e) = Left (fromString e) - go (Partial cont) = go (cont B.empty) - go (Done _ r) = Right r + go (AS.Fail t c e) = Left (fromString e) + go (AS.Partial cont) = go (cont B.empty) + go (AS.Done _ r) = Right r + +decodeLazy :: IsString e => BL.ByteString -> Either e [Armor] +decodeLazy bs = go (AL.parse parseArmors bs) + where + go (AL.Fail t c e) = Left (fromString e) + go (AL.Done _ r) = Right r parseArmors :: Parser [Armor] parseArmors = many parseArmor @@ -110,8 +119,8 @@ aType :: ArmorType -> ByteString aType (ArmorMessage) = BC8.pack "MESSAGE" aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" -aType (ArmorSplitMessage x y) = BC8.pack "MESSAGE, PART " `B.append` (l2s x) `B.append` BC8.singleton '/' `B.append` (l2s y) -aType (ArmorSplitMessageIndefinite x) = BC8.pack "MESSAGE, PART " `B.append` (l2s x) +aType (ArmorSplitMessage x y) = BC8.pack "MESSAGE, PART " `B.append` l2s x `B.append` BC8.singleton '/' `B.append` l2s y +aType (ArmorSplitMessageIndefinite x) = BC8.pack "MESSAGE, PART " `B.append` l2s x aType (ArmorSignature) = BC8.pack "SIGNATURE" l2s :: BL.ByteString -> ByteString diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs index 06d7f1a..cb7eb3d 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs @@ -5,66 +5,71 @@ module Codec.Encryption.OpenPGP.ASCIIArmor.Encode ( encode + , encodeLazy ) where import Codec.Encryption.OpenPGP.ASCIIArmor.Types -import Data.ByteString (ByteString) +import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Char8 as BC8 +import qualified Data.ByteString.Lazy.Char8 as BLC8 import qualified Data.ByteString.Base64 as Base64 -import Data.Digest.CRC24 (crc24) +import Data.Digest.CRC24 (crc24Lazy) import Data.Serialize (put) -import Data.Serialize.Put (runPut, putWord32be) +import Data.Serialize.Put (runPutLazy, putWord32be) import Data.String (IsString, fromString) -encode :: [Armor] -> ByteString -encode = B.concat . map armor +encode :: [Armor] -> B.ByteString +encode = B.concat . BL.toChunks . encodeLazy + +encodeLazy :: [Armor] -> ByteString +encodeLazy = BL.concat . map armor armor :: Armor -> ByteString -armor (Armor atype ahs bs) = beginLine atype `B.append` armorHeaders ahs `B.append` blankLine `B.append` armorData (B.concat . BL.toChunks $ bs) `B.append` armorChecksum (B.concat . BL.toChunks $ bs) `B.append` endLine atype -armor (ClearSigned chs ctxt csig) = BC8.pack "-----BEGIN PGP SIGNED MESSAGE-----\n" `B.append` armorHeaders chs `B.append` blankLine `B.append` dashEscape (B.concat . BL.toChunks $ ctxt) `B.append` armor csig +armor (Armor atype ahs bs) = beginLine atype `BL.append` armorHeaders ahs `BL.append` blankLine `BL.append` armorData bs `BL.append` armorChecksum bs `BL.append` endLine atype +armor (ClearSigned chs ctxt csig) = BLC8.pack "-----BEGIN PGP SIGNED MESSAGE-----\n" `BL.append` armorHeaders chs `BL.append` blankLine `BL.append` dashEscape ctxt `BL.append` armor csig blankLine :: ByteString -blankLine = BC8.singleton '\n' +blankLine = BLC8.singleton '\n' beginLine :: ArmorType -> ByteString -beginLine atype = BC8.pack "-----BEGIN PGP " `B.append` aType atype `B.append` BC8.pack "-----\n" +beginLine atype = BLC8.pack "-----BEGIN PGP " `BL.append` aType atype `BL.append` BLC8.pack "-----\n" endLine :: ArmorType -> ByteString -endLine atype = BC8.pack "-----END PGP " `B.append` aType atype `B.append` BC8.pack "-----\n" +endLine atype = BLC8.pack "-----END PGP " `BL.append` aType atype `BL.append` BLC8.pack "-----\n" aType :: ArmorType -> ByteString -aType (ArmorMessage) = BC8.pack "MESSAGE" -aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" -aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" -aType (ArmorSplitMessage x y) = BC8.pack $ "MESSAGE, PART " ++ show x ++ "/" ++ show y -aType (ArmorSplitMessageIndefinite x) = BC8.pack $ "MESSAGE, PART " ++ show x -aType (ArmorSignature) = BC8.pack "SIGNATURE" +aType (ArmorMessage) = BLC8.pack "MESSAGE" +aType (ArmorPublicKeyBlock) = BLC8.pack "PUBLIC KEY BLOCK" +aType (ArmorPrivateKeyBlock) = BLC8.pack "PRIVATE KEY BLOCK" +aType (ArmorSplitMessage x y) = BLC8.pack $ "MESSAGE, PART " ++ show x ++ "/" ++ show y +aType (ArmorSplitMessageIndefinite x) = BLC8.pack $ "MESSAGE, PART " ++ show x +aType (ArmorSignature) = BLC8.pack "SIGNATURE" armorHeaders :: [(String, String)] -> ByteString -armorHeaders ahs = BC8.unlines . map armorHeader $ ahs +armorHeaders ahs = BLC8.unlines . map armorHeader $ ahs where armorHeader :: (String, String) -> ByteString - armorHeader (k, v) = BC8.pack k `B.append` BC8.pack ": " `B.append` BC8.pack v + armorHeader (k, v) = BLC8.pack k `BL.append` BLC8.pack ": " `BL.append` BLC8.pack v armorData :: ByteString -> ByteString -armorData = BC8.unlines . wordWrap 64 . Base64.encode +armorData = BLC8.unlines . wordWrap 64 . BL.fromChunks . return . Base64.encode . B.concat . BL.toChunks wordWrap :: Int -> ByteString -> [ByteString] wordWrap lw bs - | B.null bs = [] + | BL.null bs = [] | lw < 1 || lw > 76 = wordWrap 76 bs - | otherwise = B.take lw bs : wordWrap lw (B.drop lw bs) + | otherwise = BL.take (fromIntegral lw) bs : wordWrap lw (BL.drop (fromIntegral lw) bs) armorChecksum :: ByteString -> ByteString -armorChecksum = BC8.cons '=' . armorData . B.tail . runPut . putWord32be . crc24 +armorChecksum = BLC8.cons '=' . armorData . BL.tail . runPutLazy . putWord32be . crc24Lazy dashEscape :: ByteString -> ByteString -dashEscape = BC8.unlines . map escapeLine . BC8.lines +dashEscape = BLC8.unlines . map escapeLine . BLC8.lines where escapeLine :: ByteString -> ByteString escapeLine l - | BC8.singleton '-' `B.isPrefixOf` l = BC8.pack "- " `B.append` l - | BC8.pack "From " `B.isPrefixOf` l = BC8.pack "- " `B.append` l + | BLC8.singleton '-' `BL.isPrefixOf` l = BLC8.pack "- " `BL.append` l + | BLC8.pack "From " `BL.isPrefixOf` l = BLC8.pack "- " `BL.append` l | otherwise = l diff --git a/Data/Digest/CRC24.hs b/Data/Digest/CRC24.hs index 4637834..4586177 100644 --- a/Data/Digest/CRC24.hs +++ b/Data/Digest/CRC24.hs @@ -4,12 +4,14 @@ -- (See the LICENSE file). module Data.Digest.CRC24 ( - crc24 + crc24 + , crc24Lazy ) where import Data.Bits (shiftL, (.&.), xor) -import Data.ByteString (ByteString) +import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL import Data.Word (Word8, Word32) crc24_init :: Word32 @@ -21,5 +23,8 @@ crc24_poly = 0x1864CFB crc24_update :: Word32 -> Word8 -> Word32 crc24_update c b = (last . take 9 $ iterate (\x -> if (shiftL x 1) .&. 0x1000000 == 0x1000000 then shiftL x 1 `xor` crc24_poly else shiftL x 1) (c `xor` shiftL (fromIntegral b) 16)) .&. 0xFFFFFF -crc24 :: ByteString -> Word32 -crc24 bs = B.foldl crc24_update crc24_init bs +crc24 :: B.ByteString -> Word32 +crc24 bs = crc24Lazy . BL.fromChunks $ [bs] + +crc24Lazy :: ByteString -> Word32 +crc24Lazy bs = BL.foldl crc24_update crc24_init bs diff --git a/tests/suite.hs b/tests/suite.hs index ffe8b50..ffcbc17 100644 --- a/tests/suite.hs +++ b/tests/suite.hs @@ -3,7 +3,7 @@ import Test.Framework.Providers.HUnit import Test.HUnit -import Codec.Encryption.OpenPGP.ASCIIArmor (encode, decode, multipartMerge) +import Codec.Encryption.OpenPGP.ASCIIArmor (decode, decodeLazy, encode, encodeLazy, multipartMerge) import Codec.Encryption.OpenPGP.ASCIIArmor.Types import Codec.Encryption.OpenPGP.ASCIIArmor.Utils @@ -20,9 +20,9 @@ testCRC24 bs crc = assertEqual "crc24" crc (crc24 bs) testArmorDecode :: FilePath -> [FilePath] -> Assertion testArmorDecode fp targets = do - bs <- B.readFile $ "tests/data/" ++ fp + bs <- BL.readFile $ "tests/data/" ++ fp tbss <- mapM (\target -> BL.readFile $ "tests/data/" ++ target) targets - case decode bs of + case decodeLazy bs of Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp Right as -> assertEqual ("for " ++ fp) tbss (map getPayload as) where @@ -30,9 +30,9 @@ testArmorDecode fp targets = do testArmorMultipartDecode :: FilePath -> FilePath -> Assertion testArmorMultipartDecode fp target = do - bs <- B.readFile $ "tests/data/" ++ fp + bs <- BL.readFile $ "tests/data/" ++ fp tbs <- BL.readFile $ "tests/data/" ++ target - case decode bs of + case decodeLazy bs of Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp Right as -> assertEqual ("for " ++ fp) tbs (getPayload (multipartMerge as)) where @@ -40,9 +40,9 @@ testArmorMultipartDecode fp target = do testClearsignedDecodeBody :: FilePath -> FilePath -> Assertion testClearsignedDecodeBody fp target = do - bs <- B.readFile $ "tests/data/" ++ fp + bs <- BL.readFile $ "tests/data/" ++ fp tbs <- BL.readFile $ "tests/data/" ++ target - case decode bs of + case decodeLazy bs of Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp Right [a] -> assertEqual ("for " ++ fp) (convertEndings tbs) (getBody a) where @@ -51,9 +51,9 @@ testClearsignedDecodeBody fp target = do testClearsignedDecodeSig :: FilePath -> FilePath -> Assertion testClearsignedDecodeSig fp target = do - bs <- B.readFile $ "tests/data/" ++ fp + bs <- BL.readFile $ "tests/data/" ++ fp tbs <- BL.readFile $ "tests/data/" ++ target - case decode bs of + case decodeLazy bs of Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp Right [a] -> assertEqual ("for " ++ fp) tbs (getSig a) where @@ -62,15 +62,26 @@ testClearsignedDecodeSig fp target = do testArmorEncode :: [FilePath] -> FilePath -> Assertion testArmorEncode fps target = do bss <- mapM (\fp -> BL.readFile $ "tests/data/" ++ fp) fps - tbs <- B.readFile $ "tests/data/" ++ target - assertEqual ("literaldata") tbs (encode (map (\bs -> Armor ArmorMessage [("Version","OpenPrivacy 0.99")] bs) bss)) + tbs <- BL.readFile $ "tests/data/" ++ target + assertEqual ("literaldata") tbs (encodeLazy (map (\bs -> Armor ArmorMessage [("Version","OpenPrivacy 0.99")] bs) bss)) testClearsignedEncode :: FilePath -> FilePath -> FilePath -> Assertion testClearsignedEncode ftxt fsig ftarget = do txt <- BL.readFile $ "tests/data/" ++ ftxt sig <- BL.readFile $ "tests/data/" ++ fsig - target <- B.readFile $ "tests/data/" ++ ftarget - assertEqual ("clearsigned encode") target (encode [ClearSigned [("Hash","SHA1")] txt (Armor ArmorSignature [("Version","OpenPrivacy 0.99")] sig)]) + target <- BL.readFile $ "tests/data/" ++ ftarget + assertEqual ("clearsigned encode") target (encodeLazy [ClearSigned [("Hash","SHA1")] txt (Armor ArmorSignature [("Version","OpenPrivacy 0.99")] sig)]) + +testStrictDecode :: FilePath -> Assertion +testStrictDecode fp = do + bs <- BL.readFile $ "tests/data/" ++ fp + assertEqual ("strict decode") (decodeLazy bs :: Either String [Armor]) (decode (B.concat . BL.toChunks $ bs) :: Either String [Armor]) + +testStrictEncode :: FilePath -> Assertion +testStrictEncode fp = do + bs <- BL.readFile $ "tests/data/" ++ fp + let fakearmors = [Armor ArmorMessage [("Version","OpenPrivacy 0.99")] bs, ClearSigned [("Hash","SHA1")] bs (Armor ArmorSignature [("Version","OpenPrivacy 0.99")] bs)] + assertEqual ("strict encode") (encodeLazy fakearmors) (BL.fromChunks [(encode fakearmors)]) tests = [ testGroup "CRC24" [ @@ -89,6 +100,8 @@ tests = [ , testCase "Encode sample armor" (testArmorEncode ["msg1.gpg"] "msg1.asc") , testCase "Encode multiple sample armors" (testArmorEncode ["msg1.gpg","msg1.gpg","msg1.gpg"] "msg1c.asc") , testCase "Encode clear-signed sig" (testClearsignedEncode "msg3" "msg3.sig" "msg3.asc") + , testCase "Decode from strict ByteString" (testStrictDecode "msg1.asc") + , testCase "Encode to strict ByteString" (testStrictEncode "msg1.gpg") ] ] -- cgit v1.2.3