More laziness.

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")
     ]
  ]