Add multipartMerge

6 files changed, 55 insertions, 2 deletions

diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor.hs b/Codec/Encryption/OpenPGP/ASCIIArmor.hs
index 26d58dd..6d0c172 100644
--- a/Codec/Encryption/OpenPGP/ASCIIArmor.hs
+++ b/Codec/Encryption/OpenPGP/ASCIIArmor.hs
@@ -7,7 +7,9 @@ module Codec.Encryption.OpenPGP.ASCIIArmor (
    encode
  , decode
  , parseArmor
+ , multipartMerge
 ) where
 
 import Codec.Encryption.OpenPGP.ASCIIArmor.Encode (encode)
 import Codec.Encryption.OpenPGP.ASCIIArmor.Decode (decode, parseArmor)
+import Codec.Encryption.OpenPGP.ASCIIArmor.Multipart (multipartMerge)
diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs
new file mode 100644
index 0000000..8719c7c
--- /dev/null
+++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs
@@ -0,0 +1,24 @@
+-- ASCIIArmor/Multipart.hs: OpenPGP (RFC4880) ASCII armor implementation
+-- Copyright Ⓒ 2012  Clint Adams
+-- This software is released under the terms of the ISC license.
+-- (See the LICENSE file).
+
+module Codec.Encryption.OpenPGP.ASCIIArmor.Multipart (
+   multipartMerge
+) where
+
+import Codec.Encryption.OpenPGP.ASCIIArmor.Types
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+
+multipartMerge :: [Armor] -> Armor
+multipartMerge as = go as (Armor ArmorMessage [] B.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' _ _ _ state = state
diff --git a/openpgp-asciiarmor.cabal b/openpgp-asciiarmor.cabal
index e161d6f..9b141c2 100644
--- a/openpgp-asciiarmor.cabal
+++ b/openpgp-asciiarmor.cabal
@@ -15,7 +15,9 @@ Extra-source-files: tests/suite.hs
   , tests/data/msg1a.asc
   , tests/data/msg1b.asc
   , tests/data/msg1c.asc
+  , tests/data/msg2.asc
   , tests/data/msg1.gpg
+  , tests/data/msg2.pgp
 
 Cabal-version:       >= 1.10
 
@@ -26,6 +28,7 @@ Library
                      , Codec.Encryption.OpenPGP.ASCIIArmor.Encode
                      , Codec.Encryption.OpenPGP.ASCIIArmor.Types
   Other-Modules: Data.Digest.CRC24
+               , Codec.Encryption.OpenPGP.ASCIIArmor.Multipart
   Build-depends: attoparsec
                , base                  > 4       && < 5
                , base64-bytestring
diff --git a/tests/data/msg2.asc b/tests/data/msg2.asc
new file mode 100644
index 0000000..7e5a287
--- /dev/null
+++ b/tests/data/msg2.asc
@@ -0,0 +1,13 @@
+-----BEGIN PGP MESSAGE, PART 01/02-----
+Version: ClosedPrivacy 0.99
+
+pgAAAHnw/J+O5ibiYizWTVDTrl/FUe926aD7lhNS+qjFNASGRmSSvWqWyubVcW0Z
+YnVtKfpv03Y+zIUQv+TATmWcwpkzhQ9QeTk70ZBFFmNXsuM12dTQGkY8IDRsmUT9
+=H7u4
+-----END PGP MESSAGE, PART 01/02-----
+
+-----BEGIN PGP MESSAGE, PART 02/02-----
+
+m+f4GTQ2FwJzO0GeazzBV4ywKLqSnCQVFBNKhDnw
+=hLwC
+-----END PGP MESSAGE, PART 02/02-----
diff --git a/tests/data/msg2.pgp b/tests/data/msg2.pgp
new file mode 100644
index 0000000..46c4db7
--- /dev/null
+++ b/tests/data/msg2.pgp
diff --git a/tests/suite.hs b/tests/suite.hs
index a843664..6fdd816 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)
+import Codec.Encryption.OpenPGP.ASCIIArmor (encode, decode, multipartMerge)
 import Codec.Encryption.OpenPGP.ASCIIArmor.Types
 
 import Data.ByteString (ByteString)
@@ -21,7 +21,17 @@ testArmorDecode fp targets = do
     tbss <- mapM (\target -> B.readFile $ "tests/data/" ++ target) targets
     case decode bs of
         Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp
-        Right as -> do assertEqual ("for " ++ fp) tbss (map getPayload as)
+        Right as -> assertEqual ("for " ++ fp) tbss (map getPayload as)
+    where
+        getPayload (Armor _ _ pl) = pl
+
+testArmorMultipartDecode :: FilePath -> FilePath -> Assertion
+testArmorMultipartDecode fp target = do
+    bs <- B.readFile $ "tests/data/" ++ fp
+    tbs <- B.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))
     where
         getPayload (Armor _ _ pl) = pl
 
@@ -41,6 +51,7 @@ tests = [
       testCase "Decode sample armor" (testArmorDecode "msg1.asc" ["msg1.gpg"])
     , testCase "Decode sample armor with cruft" (testArmorDecode "msg1a.asc" ["msg1.gpg"])
     , testCase "Decode multiple sample armors" (testArmorDecode "msg1b.asc" ["msg1.gpg","msg1.gpg","msg1.gpg"])
+    , testCase "Decode multi-part armor" (testArmorMultipartDecode "msg2.asc" "msg2.pgp")
     , testCase "Encode sample armor" (testArmorEncode ["msg1.gpg"] "msg1.asc")
     , testCase "Encode multiple sample armors" (testArmorEncode ["msg1.gpg","msg1.gpg","msg1.gpg"] "msg1c.asc")
     ]