3 files changed, 121 insertions, 69 deletions

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index be50d1a..d950570 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -3,7 +3,47 @@
 -- The recommended way to import this module is:
 --
 -- > import qualified Data.OpenPGP as OpenPGP
-module Data.OpenPGP (Message(..), Packet(..), SignatureSubpacket(..), HashAlgorithm(..), KeyAlgorithm(..), CompressionAlgorithm(..), MPI(..), fingerprint_material, signatures_and_data, signature_issuer, calculate_signature_trailer, decode_s2k_count, encode_s2k_count) where
+module Data.OpenPGP (
+        Packet(OnePassSignaturePacket, PublicKeyPacket, SecretKeyPacket, CompressedDataPacket, LiteralDataPacket, UserIDPacket, UnsupportedPacket),
+        compression_algorithm,
+        content,
+        encrypted_data,
+        filename,
+        format,
+        hash_algorithm,
+        hashed_subpackets,
+        hash_head,
+        key,
+        key_algorithm,
+        key_id,
+        message,
+        nested,
+        private_hash,
+        s2k_count,
+        s2k_hash_algorithm,
+        s2k_salt,
+        s2k_type,
+        s2k_useage,
+        signature,
+        signature_type,
+        symmetric_type,
+        timestamp,
+        trailer,
+        unhashed_subpackets,
+        version,
+        isSignaturePacket,
+        signaturePacket,
+        Message(..),
+        SignatureSubpacket(..),
+        HashAlgorithm(..),
+        KeyAlgorithm(..),
+        CompressionAlgorithm(..),
+        MPI(..),
+        fingerprint_material,
+        signatures_and_data,
+        signature_issuer,
+        decode_s2k_count, encode_s2k_count
+) where
 
 import Control.Monad
 import Data.Bits
@@ -181,22 +221,16 @@ calculate_signature_trailer p =
 
 put_packet :: (Num a) => Packet -> (LZ.ByteString, a)
 put_packet (SignaturePacket { version = 4,
-                              signature_type = signature_type,
-                              key_algorithm = key_algorithm,
-                              hash_algorithm = hash_algorithm,
-                              hashed_subpackets = hashed_subpackets,
                               unhashed_subpackets = unhashed_subpackets,
                               hash_head = hash_head,
-                              signature = signature }) =
-        (LZ.concat [ LZ.singleton 4, encode signature_type,
-                    encode key_algorithm, encode hash_algorithm,
-                    encode (fromIntegral $ LZ.length hashed :: Word16),
-                    hashed,
+                              signature = signature,
+                              trailer = trailer }) =
+        (LZ.concat [ trailer_top,
                     encode (fromIntegral $ LZ.length unhashed :: Word16),
                     unhashed,
                     encode hash_head, encode signature ], 2)
         where
-        hashed   = LZ.concat $ map encode hashed_subpackets
+        trailer_top = LZ.reverse $ LZ.drop 6 $ LZ.reverse trailer
         unhashed = LZ.concat $ map encode unhashed_subpackets
 put_packet (OnePassSignaturePacket { version = version,
                                      signature_type = signature_type,
@@ -522,10 +556,8 @@ signatures_and_data :: Message -> ([Packet], [Packet])
 signatures_and_data (Message ((CompressedDataPacket {message = m}):_)) =
         signatures_and_data m
 signatures_and_data (Message lst) =
-        (filter isSig lst, filter isDta lst)
+        (filter isSignaturePacket lst, filter isDta lst)
         where
-        isSig (SignaturePacket {}) = True
-        isSig _ = False
         isDta (LiteralDataPacket {}) = True
         isDta _ = False
 
@@ -631,3 +663,22 @@ encode_s2k_count iterations
         encode_s2k_count' count c
                 | count < 32 = (count, c)
                 | otherwise = encode_s2k_count' (count `shiftR` 1) (c+1)
+
+-- SignaturePacket smart constructor
+signaturePacket :: Word8 -> Word8 -> KeyAlgorithm -> HashAlgorithm -> [SignatureSubpacket] -> [SignatureSubpacket] -> Word16 -> MPI -> Packet
+signaturePacket version signature_type key_algorithm hash_algorithm hashed_subpackets unhashed_subpackets hash_head signature =
+        let p = SignaturePacket {
+                version = version,
+                signature_type = signature_type,
+                key_algorithm = key_algorithm,
+                hash_algorithm = hash_algorithm,
+                hashed_subpackets = hashed_subpackets,
+                unhashed_subpackets = unhashed_subpackets,
+                hash_head = hash_head,
+                signature = signature,
+                trailer = undefined
+        } in p { trailer = calculate_signature_trailer p }
+
+isSignaturePacket :: Packet -> Bool
+isSignaturePacket (SignaturePacket {})  = True
+isSignaturePacket _                     = False
diff --git a/Data/OpenPGP/Crypto.hs b/Data/OpenPGP/Crypto.hs
index b34c395..173fe08 100644
--- a/Data/OpenPGP/Crypto.hs
+++ b/Data/OpenPGP/Crypto.hs
@@ -106,6 +106,8 @@ sign :: OpenPGP.Message    -- ^ SecretKeys, one of which will be used
         -> Integer -- ^ Timestamp for signature (unless sig supplied)
         -> OpenPGP.Packet
 sign keys message hsh keyid timestamp =
+        -- WARNING: this style of update is unsafe on most fields
+        -- it is safe on signature and hash_head, though
         sig {
                 OpenPGP.signature = OpenPGP.MPI $ toNum final,
                 OpenPGP.hash_head = toNum $ take 2 final
@@ -124,32 +126,34 @@ sign keys message hsh keyid timestamp =
                         LZ.fromString firstUserID
                 ]
         } `LZ.append` OpenPGP.trailer sig
-        -- Always force key and hash algorithm
-        sig     = let s = (findSigOrDefault (find isSignature m)) {
-                OpenPGP.key_algorithm = OpenPGP.RSA,
-                OpenPGP.hash_algorithm = hsh
-        } in s { OpenPGP.trailer = OpenPGP.calculate_signature_trailer s }
+        sig     = (findSigOrDefault (find OpenPGP.isSignaturePacket m))
 
         -- Either a SignaturePacket was found, or we need to make one
-        findSigOrDefault (Just s) = s
-        findSigOrDefault Nothing  = OpenPGP.SignaturePacket {
-                OpenPGP.version = 4,
-                OpenPGP.key_algorithm = undefined,
-                OpenPGP.hash_algorithm = undefined,
-                OpenPGP.signature_type = defaultStype,
-                OpenPGP.hashed_subpackets = [
+        findSigOrDefault (Just s) = OpenPGP.signaturePacket
+                (OpenPGP.version s)
+                (OpenPGP.signature_type s)
+                OpenPGP.RSA -- force key and hash algorithm
+                hsh
+                (OpenPGP.hashed_subpackets s)
+                (OpenPGP.unhashed_subpackets s)
+                (OpenPGP.hash_head s)
+                (OpenPGP.signature s)
+        findSigOrDefault Nothing  = OpenPGP.signaturePacket
+                4
+                defaultStype
+                OpenPGP.RSA
+                hsh
+                ([
                         -- Do we really need to pass in timestamp just for the default?
                         OpenPGP.SignatureCreationTimePacket $ fromIntegral timestamp,
                         OpenPGP.IssuerPacket keyid'
                 ] ++ (case signOver of
                         OpenPGP.LiteralDataPacket {} -> []
                         _ -> [] -- TODO: OpenPGP.KeyFlagsPacket [0x01, 0x02]
-                ),
-                OpenPGP.unhashed_subpackets = [],
-                OpenPGP.signature = undefined,
-                OpenPGP.trailer = undefined,
-                OpenPGP.hash_head = undefined
-        }
+                ))
+                []
+                undefined
+                undefined
 
         keyid'  = reverse $ take 16 $ reverse $ fingerprint k
         Just k  = find_key keys keyid
@@ -169,8 +173,5 @@ sign keys message hsh keyid timestamp =
         isSignable (OpenPGP.SecretKeyPacket {})   = True
         isSignable _                              = False
 
-        isSignature (OpenPGP.SignaturePacket {})  = True
-        isSignature _                             = False
-
         isUserID (OpenPGP.UserIDPacket {})        = True
         isUserID _                                = False
diff --git a/tests/suite.hs b/tests/suite.hs
index 9480c0b..17ab3cb 100644
--- a/tests/suite.hs
+++ b/tests/suite.hs
@@ -63,90 +63,90 @@ tests secring =
                 testGroup "Serialization" [
                         testCase "000001-006.public_key" (testSerialization "000001-006.public_key"),
                         testCase "000002-013.user_id" (testSerialization "000002-013.user_id"),
-                        -- Issue #11 -- testCase "000003-002.sig" (testSerialization "000003-002.sig"),
+                        testCase "000003-002.sig" (testSerialization "000003-002.sig"),
                         testCase "000004-012.ring_trust" (testSerialization "000004-012.ring_trust"),
-                        -- Issue #11 -- testCase "000005-002.sig" (testSerialization "000005-002.sig"),
+                        testCase "000005-002.sig" (testSerialization "000005-002.sig"),
                         testCase "000006-012.ring_trust" (testSerialization "000006-012.ring_trust"),
-                        -- Issue #11 -- testCase "000007-002.sig" (testSerialization "000007-002.sig"),
+                        testCase "000007-002.sig" (testSerialization "000007-002.sig"),
                         testCase "000008-012.ring_trust" (testSerialization "000008-012.ring_trust"),
-                        -- Issue #11 -- testCase "000009-002.sig" (testSerialization "000009-002.sig"),
+                        testCase "000009-002.sig" (testSerialization "000009-002.sig"),
                         testCase "000010-012.ring_trust" (testSerialization "000010-012.ring_trust"),
-                        -- Issue #11 -- testCase "000011-002.sig" (testSerialization "000011-002.sig"),
+                        testCase "000011-002.sig" (testSerialization "000011-002.sig"),
                         testCase "000012-012.ring_trust" (testSerialization "000012-012.ring_trust"),
                         testCase "000013-014.public_subkey" (testSerialization "000013-014.public_subkey"),
-                        -- Issue #11 -- testCase "000014-002.sig" (testSerialization "000014-002.sig"),
+                        testCase "000014-002.sig" (testSerialization "000014-002.sig"),
                         testCase "000015-012.ring_trust" (testSerialization "000015-012.ring_trust"),
                         testCase "000016-006.public_key" (testSerialization "000016-006.public_key"),
-                        -- Issue #11 -- testCase "000017-002.sig" (testSerialization "000017-002.sig"),
+                        testCase "000017-002.sig" (testSerialization "000017-002.sig"),
                         testCase "000018-012.ring_trust" (testSerialization "000018-012.ring_trust"),
                         testCase "000019-013.user_id" (testSerialization "000019-013.user_id"),
-                        -- Issue #11 -- testCase "000020-002.sig" (testSerialization "000020-002.sig"),
+                        testCase "000020-002.sig" (testSerialization "000020-002.sig"),
                         testCase "000021-012.ring_trust" (testSerialization "000021-012.ring_trust"),
-                        -- Issue #11 -- testCase "000022-002.sig" (testSerialization "000022-002.sig"),
+                        testCase "000022-002.sig" (testSerialization "000022-002.sig"),
                         testCase "000023-012.ring_trust" (testSerialization "000023-012.ring_trust"),
                         testCase "000024-014.public_subkey" (testSerialization "000024-014.public_subkey"),
-                        -- Issue #11 -- testCase "000025-002.sig" (testSerialization "000025-002.sig"),
+                        testCase "000025-002.sig" (testSerialization "000025-002.sig"),
                         testCase "000026-012.ring_trust" (testSerialization "000026-012.ring_trust"),
                         testCase "000027-006.public_key" (testSerialization "000027-006.public_key"),
-                        -- Issue #11 -- testCase "000028-002.sig" (testSerialization "000028-002.sig"),
+                        testCase "000028-002.sig" (testSerialization "000028-002.sig"),
                         testCase "000029-012.ring_trust" (testSerialization "000029-012.ring_trust"),
                         testCase "000030-013.user_id" (testSerialization "000030-013.user_id"),
-                        -- Issue #11 -- testCase "000031-002.sig" (testSerialization "000031-002.sig"),
+                        testCase "000031-002.sig" (testSerialization "000031-002.sig"),
                         testCase "000032-012.ring_trust" (testSerialization "000032-012.ring_trust"),
-                        -- Issue #11 -- testCase "000033-002.sig" (testSerialization "000033-002.sig"),
+                        testCase "000033-002.sig" (testSerialization "000033-002.sig"),
                         testCase "000034-012.ring_trust" (testSerialization "000034-012.ring_trust"),
                         testCase "000035-006.public_key" (testSerialization "000035-006.public_key"),
                         testCase "000036-013.user_id" (testSerialization "000036-013.user_id"),
-                        -- Issue #11 -- testCase "000037-002.sig" (testSerialization "000037-002.sig"),
+                        testCase "000037-002.sig" (testSerialization "000037-002.sig"),
                         testCase "000038-012.ring_trust" (testSerialization "000038-012.ring_trust"),
-                        -- Issue #11 -- testCase "000039-002.sig" (testSerialization "000039-002.sig"),
+                        testCase "000039-002.sig" (testSerialization "000039-002.sig"),
                         testCase "000040-012.ring_trust" (testSerialization "000040-012.ring_trust"),
                         testCase "000041-017.attribute" (testSerialization "000041-017.attribute"),
-                        -- Issue #11 -- testCase "000042-002.sig" (testSerialization "000042-002.sig"),
+                        testCase "000042-002.sig" (testSerialization "000042-002.sig"),
                         testCase "000043-012.ring_trust" (testSerialization "000043-012.ring_trust"),
                         testCase "000044-014.public_subkey" (testSerialization "000044-014.public_subkey"),
-                        -- Issue #11 -- testCase "000045-002.sig" (testSerialization "000045-002.sig"),
+                        testCase "000045-002.sig" (testSerialization "000045-002.sig"),
                         testCase "000046-012.ring_trust" (testSerialization "000046-012.ring_trust"),
                         testCase "000047-005.secret_key" (testSerialization "000047-005.secret_key"),
                         testCase "000048-013.user_id" (testSerialization "000048-013.user_id"),
-                        -- Issue #11 -- testCase "000049-002.sig" (testSerialization "000049-002.sig"),
+                        testCase "000049-002.sig" (testSerialization "000049-002.sig"),
                         testCase "000050-012.ring_trust" (testSerialization "000050-012.ring_trust"),
                         testCase "000051-007.secret_subkey" (testSerialization "000051-007.secret_subkey"),
-                        -- Issue #11 -- testCase "000052-002.sig" (testSerialization "000052-002.sig"),
+                        testCase "000052-002.sig" (testSerialization "000052-002.sig"),
                         testCase "000053-012.ring_trust" (testSerialization "000053-012.ring_trust"),
                         testCase "000054-005.secret_key" (testSerialization "000054-005.secret_key"),
-                        -- Issue #11 -- testCase "000055-002.sig" (testSerialization "000055-002.sig"),
+                        testCase "000055-002.sig" (testSerialization "000055-002.sig"),
                         testCase "000056-012.ring_trust" (testSerialization "000056-012.ring_trust"),
                         testCase "000057-013.user_id" (testSerialization "000057-013.user_id"),
-                        -- Issue #11 -- testCase "000058-002.sig" (testSerialization "000058-002.sig"),
+                        testCase "000058-002.sig" (testSerialization "000058-002.sig"),
                         testCase "000059-012.ring_trust" (testSerialization "000059-012.ring_trust"),
                         testCase "000060-007.secret_subkey" (testSerialization "000060-007.secret_subkey"),
-                        -- Issue #11 -- testCase "000061-002.sig" (testSerialization "000061-002.sig"),
+                        testCase "000061-002.sig" (testSerialization "000061-002.sig"),
                         testCase "000062-012.ring_trust" (testSerialization "000062-012.ring_trust"),
                         testCase "000063-005.secret_key" (testSerialization "000063-005.secret_key"),
-                        -- Issue #11 -- testCase "000064-002.sig" (testSerialization "000064-002.sig"),
+                        testCase "000064-002.sig" (testSerialization "000064-002.sig"),
                         testCase "000065-012.ring_trust" (testSerialization "000065-012.ring_trust"),
                         testCase "000066-013.user_id" (testSerialization "000066-013.user_id"),
-                        -- Issue #11 -- testCase "000067-002.sig" (testSerialization "000067-002.sig"),
+                        testCase "000067-002.sig" (testSerialization "000067-002.sig"),
                         testCase "000068-012.ring_trust" (testSerialization "000068-012.ring_trust"),
                         testCase "000069-005.secret_key" (testSerialization "000069-005.secret_key"),
                         testCase "000070-013.user_id" (testSerialization "000070-013.user_id"),
-                        -- Issue #11 -- testCase "000071-002.sig" (testSerialization "000071-002.sig"),
+                        testCase "000071-002.sig" (testSerialization "000071-002.sig"),
                         testCase "000072-012.ring_trust" (testSerialization "000072-012.ring_trust"),
                         testCase "000073-017.attribute" (testSerialization "000073-017.attribute"),
-                        -- Issue #11 -- testCase "000074-002.sig" (testSerialization "000074-002.sig"),
+                        testCase "000074-002.sig" (testSerialization "000074-002.sig"),
                         testCase "000075-012.ring_trust" (testSerialization "000075-012.ring_trust"),
                         testCase "000076-007.secret_subkey" (testSerialization "000076-007.secret_subkey"),
-                        -- Issue #11 -- testCase "000077-002.sig" (testSerialization "000077-002.sig"),
+                        testCase "000077-002.sig" (testSerialization "000077-002.sig"),
                         testCase "000078-012.ring_trust" (testSerialization "000078-012.ring_trust"),
-                        -- Issue #11 -- testCase "pubring.gpg" (testSerialization "pubring.gpg"),
                         -- Issue #11 -- testCase "secring.gpg" (testSerialization "secring.gpg"),
-                        -- Issue #11 -- testCase "compressedsig.gpg" (testSerialization "compressedsig.gpg"),
-                        -- Issue #11 -- testCase "compressedsig-zlib.gpg" (testSerialization "compressedsig-zlib.gpg"),
-                        -- Issue #11 -- testCase "compressedsig-bzip2.gpg" (testSerialization "compressedsig-bzip2.gpg"),
-                        testCase "onepass_sig" (testSerialization "onepass_sig")
-                        -- Issue #11 -- testCase "uncompressed-ops-dsa.gpg" (testSerialization "uncompressed-ops-dsa.gpg"),
-                        -- Issue #11 -- testCase "uncompressed-ops-rsa.gpg" (testSerialization "uncompressed-ops-rsa.gpg"),
+                        testCase "pubring.gpg" (testSerialization "pubring.gpg"),
+                        testCase "compressedsig.gpg" (testSerialization "compressedsig.gpg"),
+                        testCase "compressedsig-zlib.gpg" (testSerialization "compressedsig-zlib.gpg"),
+                        testCase "compressedsig-bzip2.gpg" (testSerialization "compressedsig-bzip2.gpg"),
+                        testCase "onepass_sig" (testSerialization "onepass_sig"),
+                        testCase "uncompressed-ops-dsa.gpg" (testSerialization "uncompressed-ops-dsa.gpg"),
+                        testCase "uncompressed-ops-rsa.gpg" (testSerialization "uncompressed-ops-rsa.gpg")
                 ],
                 testGroup "Fingerprint" [
                         testCase "000001-006.public_key" (testFingerprint "000001-006.public_key" "421F28FEAAD222F856C8FFD5D4D54EA16F87040E"),