From 1ddca48c27cece9352e85ce6188f697eb9124750 Mon Sep 17 00:00:00 2001 From: Clint Adams Date: Thu, 26 Apr 2012 19:34:16 -0400 Subject: Introduce some lazy bytestrings internally. --- Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs | 16 ++++++++++------ Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs | 5 +++-- Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs | 10 +++++----- Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs | 2 +- Codec/Encryption/OpenPGP/ASCIIArmor/Utils.hs | 7 +++++++ tests/suite.hs | 18 ++++++++++-------- 6 files changed, 36 insertions(+), 22 deletions(-) diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs index b0033a8..b89fbfa 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs @@ -18,6 +18,7 @@ import Data.Attoparsec.Combinator (manyTill) import Data.Bits (shiftL) import Data.ByteString (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.Base64 as Base64 import Data.Digest.CRC24 (crc24) @@ -48,7 +49,7 @@ clearsigned = do blankishLine "blank line" cleartext <- dashEscapedCleartext sig <- armor - return $ ClearSigned headers cleartext sig + return $ ClearSigned headers (BL.fromChunks [cleartext]) sig armor :: Parser Armor armor = do @@ -57,7 +58,7 @@ armor = do blankishLine "blank line" payload <- base64Data "base64 data" endLine atype "end line" - return $ Armor atype headers payload + return $ Armor atype headers (BL.fromChunks [payload]) beginLine :: Parser ArmorType beginLine = do @@ -77,8 +78,8 @@ beginLine = do firstnum <- num word8 (fromIntegral . fromEnum $ '/') secondnum <- num - return $ ArmorSplitMessage (B.pack firstnum) (B.pack secondnum) - partsindef = ArmorSplitMessageIndefinite . B.pack <$> num + return $ ArmorSplitMessage (BL.pack firstnum) (BL.pack secondnum) + partsindef = ArmorSplitMessageIndefinite . BL.pack <$> num num = many1 (satisfy isDigit_w8) "number" lineEnding :: Parser ByteString @@ -109,10 +110,13 @@ 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` x `B.append` BC8.singleton '/' `B.append` y -aType (ArmorSplitMessageIndefinite x) = BC8.pack "MESSAGE, PART " `B.append` 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 +l2s = B.concat . BL.toChunks + base64Data :: Parser ByteString base64Data = do ls <- many1 base64Line diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs index 00d9dd3..06d7f1a 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs @@ -10,6 +10,7 @@ module Codec.Encryption.OpenPGP.ASCIIArmor.Encode ( import Codec.Encryption.OpenPGP.ASCIIArmor.Types import Data.ByteString (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.Base64 as Base64 import Data.Digest.CRC24 (crc24) @@ -21,8 +22,8 @@ encode :: [Armor] -> ByteString encode = B.concat . map armor armor :: Armor -> ByteString -armor (Armor atype ahs bs) = beginLine atype `B.append` armorHeaders ahs `B.append` blankLine `B.append` armorData bs `B.append` armorChecksum 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 ctxt `B.append` armor csig +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 blankLine :: ByteString blankLine = BC8.singleton '\n' diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs index 8719c7c..313c3bc 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs @@ -9,16 +9,16 @@ module Codec.Encryption.OpenPGP.ASCIIArmor.Multipart ( import Codec.Encryption.OpenPGP.ASCIIArmor.Types -import Data.ByteString (ByteString) -import qualified Data.ByteString as B +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy as BL multipartMerge :: [Armor] -> Armor -multipartMerge as = go as (Armor ArmorMessage [] B.empty) +multipartMerge as = go as (Armor ArmorMessage [] BL.empty) where go :: [Armor] -> Armor -> Armor go [] state = state go ((Armor at hs bs):as) state = go as (go' at hs bs state) go' :: ArmorType -> [(String,String)] -> ByteString -> Armor -> Armor - go' (ArmorSplitMessage _ _) hs bs (Armor _ ohs obs) = Armor ArmorMessage (ohs ++ hs) (obs `B.append` bs) - go' (ArmorSplitMessageIndefinite _) hs bs (Armor _ ohs obs) = Armor ArmorMessage (ohs ++ hs) (obs `B.append` bs) + go' (ArmorSplitMessage _ _) hs bs (Armor _ ohs obs) = Armor ArmorMessage (ohs ++ hs) (obs `BL.append` bs) + go' (ArmorSplitMessageIndefinite _) hs bs (Armor _ ohs obs) = Armor ArmorMessage (ohs ++ hs) (obs `BL.append` bs) go' _ _ _ state = state diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs index 88a03ce..fa83d23 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs @@ -8,7 +8,7 @@ module Codec.Encryption.OpenPGP.ASCIIArmor.Types ( , ArmorType(..) ) where -import Data.ByteString (ByteString) +import Data.ByteString.Lazy (ByteString) data Armor = Armor ArmorType [(String, String)] ByteString | ClearSigned [(String, String)] ByteString Armor diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Utils.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Utils.hs index 014c8aa..dddecab 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Utils.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Utils.hs @@ -5,13 +5,20 @@ module Codec.Encryption.OpenPGP.ASCIIArmor.Utils ( crlfUnlines + , crlfUnlinesLazy ) where import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC8 +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Char8 as BLC8 import Data.List (intersperse) crlfUnlines :: [ByteString] -> ByteString crlfUnlines [] = B.empty crlfUnlines ss = B.concat $ intersperse (BC8.pack "\r\n") ss + +crlfUnlinesLazy :: [BL.ByteString] -> BL.ByteString +crlfUnlinesLazy [] = BL.empty +crlfUnlinesLazy ss = BL.concat $ intersperse (BLC8.pack "\r\n") ss diff --git a/tests/suite.hs b/tests/suite.hs index 838a5f3..ffe8b50 100644 --- a/tests/suite.hs +++ b/tests/suite.hs @@ -9,7 +9,9 @@ import Codec.Encryption.OpenPGP.ASCIIArmor.Utils import Data.ByteString (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 Data.Digest.CRC24 (crc24) import Data.Word (Word32) @@ -19,7 +21,7 @@ testCRC24 bs crc = assertEqual "crc24" crc (crc24 bs) testArmorDecode :: FilePath -> [FilePath] -> Assertion testArmorDecode fp targets = do bs <- B.readFile $ "tests/data/" ++ fp - tbss <- mapM (\target -> B.readFile $ "tests/data/" ++ target) targets + tbss <- mapM (\target -> BL.readFile $ "tests/data/" ++ target) targets case decode bs of Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp Right as -> assertEqual ("for " ++ fp) tbss (map getPayload as) @@ -29,7 +31,7 @@ testArmorDecode fp targets = do testArmorMultipartDecode :: FilePath -> FilePath -> Assertion testArmorMultipartDecode fp target = do bs <- B.readFile $ "tests/data/" ++ fp - tbs <- B.readFile $ "tests/data/" ++ target + tbs <- BL.readFile $ "tests/data/" ++ target case decode bs of Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp Right as -> assertEqual ("for " ++ fp) tbs (getPayload (multipartMerge as)) @@ -39,18 +41,18 @@ testArmorMultipartDecode fp target = do testClearsignedDecodeBody :: FilePath -> FilePath -> Assertion testClearsignedDecodeBody fp target = do bs <- B.readFile $ "tests/data/" ++ fp - tbs <- B.readFile $ "tests/data/" ++ target + tbs <- BL.readFile $ "tests/data/" ++ target case decode bs of Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp Right [a] -> assertEqual ("for " ++ fp) (convertEndings tbs) (getBody a) where getBody (ClearSigned _ txt _) = txt - convertEndings = crlfUnlines . BC8.lines + convertEndings = crlfUnlinesLazy . BLC8.lines testClearsignedDecodeSig :: FilePath -> FilePath -> Assertion testClearsignedDecodeSig fp target = do bs <- B.readFile $ "tests/data/" ++ fp - tbs <- B.readFile $ "tests/data/" ++ target + tbs <- BL.readFile $ "tests/data/" ++ target case decode bs of Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp Right [a] -> assertEqual ("for " ++ fp) tbs (getSig a) @@ -59,14 +61,14 @@ testClearsignedDecodeSig fp target = do testArmorEncode :: [FilePath] -> FilePath -> Assertion testArmorEncode fps target = do - bss <- mapM (\fp -> B.readFile $ "tests/data/" ++ fp) fps + 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)) testClearsignedEncode :: FilePath -> FilePath -> FilePath -> Assertion testClearsignedEncode ftxt fsig ftarget = do - txt <- B.readFile $ "tests/data/" ++ ftxt - sig <- B.readFile $ "tests/data/" ++ fsig + 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)]) -- cgit v1.2.3