Make SignaturePacket opaque, emit trailer

Instead of the Put instance emitting the actual packet header, it emits
the start of the trailer data (which is the same bytes as the packet
header).

SignaturePacket is opaque and there is a smart constructor,
signaturePacket, that takes all the data *except* the trailer and
auto-generates the trailer, making sure the trailer is always valid, so
that the above becomes possible.

WARNING: SignaturePacket is not *fully* opaque.  You *may* still update
fields directly using record syntax (on an already constructed packet).
This may be useful, but if any of the values that make up the trailer
are changed this will MAKE THE PACKET INVALID.  This trade-off is deemed
acceptable for now, but may change in the future.  Any fields that do not
affect the trailer (unhashed subpackets, etc) may be safely updated in
this way.  Other fields MUST be updated by constructing a new
SignaturePacket with the smart constructor.

This usage is exemplefied by Data.OpenPGP.Crypto

The major upside of this is that it is now possible to re-emit
unmodified (or even modified, if only fields not in the trailer are
modified) SignaturePackets without invalidating the signature.

Closes #11

2 files changed, 87 insertions, 35 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