From aa8529550515d2a1a59adff2fc5dbd4235b92f18 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 8 Aug 2011 21:47:10 -0500
Subject: Move into Data hierarchy

---
 Data/BaseConvert.hs    |  30 +++
 Data/OpenPGP.hs        | 573 +++++++++++++++++++++++++++++++++++++++++++++++++
 Data/OpenPGP/Crypto.hs |  82 +++++++
 3 files changed, 685 insertions(+)
 create mode 100644 Data/BaseConvert.hs
 create mode 100644 Data/OpenPGP.hs
 create mode 100644 Data/OpenPGP/Crypto.hs

(limited to 'Data')

diff --git a/Data/BaseConvert.hs b/Data/BaseConvert.hs
new file mode 100644
index 0000000..655f593
--- /dev/null
+++ b/Data/BaseConvert.hs
@@ -0,0 +1,30 @@
+module Data.BaseConvert (toString, toNum, toAlphaDigit, fromAlphaDigit) where
+
+import Data.Sequence
+import Data.Foldable (toList)
+import Data.List
+import Data.Char
+
+digit_alphabet :: [Char]
+digit_alphabet = ['0'..'9'] ++ ['A'..]
+
+toBase :: (Integral a) => a -> a -> [a]
+toBase _ 0 = [0]
+toBase b v = toList $
+	unfoldl (\n -> if n == 0 then Nothing else Just (n `divMod` b)) v
+
+toAlphaDigit :: (Integral a) => a -> Char
+toAlphaDigit = (digit_alphabet !!) . fromIntegral
+
+toString :: (Integral a) => a -> a -> String
+toString b v = map toAlphaDigit (toBase b v)
+
+fromAlphaDigit :: (Num a) => Char -> a
+fromAlphaDigit v = fromIntegral n
+	where Just n = elemIndex (toUpper v) digit_alphabet
+
+fromBase :: (Num a) => a -> [a] -> a
+fromBase b = foldl (\n k -> n * b + k) 0
+
+toNum :: (Num a) => a -> String -> a
+toNum b v = fromBase b (map fromAlphaDigit v)
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
new file mode 100644
index 0000000..1c76202
--- /dev/null
+++ b/Data/OpenPGP.hs
@@ -0,0 +1,573 @@
+module Data.OpenPGP (Message(..), Packet(..), SignatureSubpacket(..), HashAlgorithm(..), KeyAlgorithm(..), CompressionAlgorithm(..), MPI(..), fingerprint_material, signatures_and_data, signature_issuer) where
+
+import Control.Monad
+import Data.Bits
+import Data.Word
+import Data.Map (Map, (!))
+import qualified Data.Map as Map
+import qualified Data.ByteString.Lazy as LZ
+import qualified Data.ByteString.Lazy.UTF8 as LZ (toString, fromString)
+
+import Data.Binary
+import Data.Binary.Get
+import Data.Binary.Put
+import qualified Codec.Compression.Zlib.Raw as Zip
+import qualified Codec.Compression.Zlib as Zlib
+import qualified Codec.Compression.BZip as BZip2
+
+import qualified Data.BaseConvert as BaseConvert
+
+data Packet =
+	SignaturePacket {
+		version::Word8,
+		signature_type::Word8,
+		key_algorithm::KeyAlgorithm,
+		hash_algorithm::HashAlgorithm,
+		hashed_subpackets::[SignatureSubpacket],
+		unhashed_subpackets::[SignatureSubpacket],
+		hash_head::Word16,
+		signature::MPI,
+		trailer::LZ.ByteString
+	} |
+	OnePassSignaturePacket {
+		version::Word8,
+		signature_type::Word8,
+		hash_algorithm::HashAlgorithm,
+		key_algorithm::KeyAlgorithm,
+		key_id::String,
+		nested::Word8
+	} |
+	PublicKeyPacket {
+		version::Word8,
+		timestamp::Word32,
+		key_algorithm::KeyAlgorithm,
+		key::Map Char MPI
+	} |
+	SecretKeyPacket {
+		version::Word8,
+		timestamp::Word32,
+		key_algorithm::KeyAlgorithm,
+		key::Map Char MPI,
+		s2k_useage::Word8,
+		symmetric_type::Word8,
+		s2k_type::Word8,
+		s2k_hash_algorithm::HashAlgorithm,
+		s2k_salt::Word64,
+		s2k_count::Word8,
+		encrypted_data::LZ.ByteString,
+		private_hash::LZ.ByteString
+	} |
+	CompressedDataPacket {
+		compression_algorithm::CompressionAlgorithm,
+		message::Message
+	} |
+	LiteralDataPacket {
+		format::Char,
+		filename::String,
+		timestamp::Word32,
+		content::LZ.ByteString
+	} |
+	UserIDPacket String
+	deriving (Show, Read, Eq)
+
+instance Binary Packet where
+	put p = do
+		-- First two bits are 1 for new packet format
+		put ((tag .|. 0xC0) :: Word8)
+		-- Use 5-octet lengths
+		put (255 :: Word8)
+		put ((fromIntegral $ LZ.length body) :: Word32)
+		putLazyByteString body
+		where (body, tag) = put_packet p
+	get = do
+		tag <- get :: Get Word8
+		let (t, l) =
+			if (tag .&. 64) /= 0 then
+				(tag .&. 63, parse_new_length)
+			else
+				((tag `shiftR` 2) .&. 15, parse_old_length tag)
+		len <- l
+		-- This forces the whole packet to be consumed
+		packet <- getLazyByteString (fromIntegral len)
+		return $ runGet (parse_packet t) packet
+
+-- http://tools.ietf.org/html/rfc4880#section-4.2.2
+parse_new_length :: Get Word32
+parse_new_length = do
+	len <- fmap fromIntegral (get :: Get Word8)
+	case len of
+		-- One octet length
+		_ | len < 192 -> return len
+		-- Two octet length
+		_ | len > 191 && len < 224 -> do
+			second <- fmap fromIntegral (get :: Get Word8)
+			return $ ((len - 192) `shiftL` 8) + second + 192
+		-- Five octet length
+		255 -> get :: Get Word32
+		-- TODO: Partial body lengths. 1 << (len & 0x1F)
+		_ -> fail "Unsupported new packet length."
+
+-- http://tools.ietf.org/html/rfc4880#section-4.2.1
+parse_old_length :: Word8 -> Get Word32
+parse_old_length tag =
+	case (tag .&. 3) of
+		-- One octet length
+		0 -> fmap fromIntegral (get :: Get Word8)
+		-- Two octet length
+		1 -> fmap fromIntegral (get :: Get Word16)
+		-- Four octet length
+		2 -> get
+		-- Indeterminate length
+		3 -> fmap fromIntegral remaining
+		-- Error
+		_ -> fail "Unsupported old packet length."
+
+-- http://tools.ietf.org/html/rfc4880#section-5.5.2
+public_key_fields :: KeyAlgorithm -> [Char]
+public_key_fields RSA     = ['n', 'e']
+public_key_fields RSA_E   = public_key_fields RSA
+public_key_fields RSA_S   = public_key_fields RSA
+public_key_fields ELGAMAL = ['p', 'g', 'y']
+public_key_fields DSA     = ['p', 'q', 'g', 'y']
+public_key_fields _       = undefined -- Nothing in the spec. Maybe empty
+
+-- http://tools.ietf.org/html/rfc4880#section-5.5.3
+secret_key_fields :: KeyAlgorithm -> [Char]
+secret_key_fields RSA     = ['d', 'p', 'q', 'u']
+secret_key_fields RSA_E   = secret_key_fields RSA
+secret_key_fields RSA_S   = secret_key_fields RSA
+secret_key_fields ELGAMAL = ['x']
+secret_key_fields DSA     = ['x']
+secret_key_fields _       = undefined -- Nothing in the spec. Maybe empty
+
+-- Need this seperate for trailer calculation
+signature_packet_start :: Packet -> LZ.ByteString
+signature_packet_start (SignaturePacket {
+	version = 4,
+	signature_type = signature_type,
+	key_algorithm = key_algorithm,
+	hash_algorithm = hash_algorithm,
+	hashed_subpackets = hashed_subpackets
+}) =
+	LZ.concat $ [
+		encode (0x04 :: Word8),
+		encode signature_type,
+		encode key_algorithm,
+		encode hash_algorithm,
+		encode ((fromIntegral $ LZ.length hashed_subs) :: Word16),
+		hashed_subs
+	]
+	where hashed_subs = LZ.concat $ map encode hashed_subpackets
+signature_packet_start _ =
+	error "Trying to get start of signature packet for non signature packet."
+
+-- The trailer is just the top of the body plus some crap
+calculate_signature_trailer :: Packet -> LZ.ByteString
+calculate_signature_trailer p =
+	LZ.concat [
+		signature_packet_start p,
+		encode (0x04 :: Word8),
+		encode (0xff :: Word8),
+		encode ((fromIntegral (LZ.length $ signature_packet_start p)) :: Word32)
+	]
+
+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,
+	            encode (fromIntegral $ LZ.length unhashed :: Word16),
+	            unhashed,
+	            encode hash_head, encode signature ], 2)
+	where hashed   = LZ.concat $ map encode hashed_subpackets
+	      unhashed = LZ.concat $ map encode unhashed_subpackets
+put_packet (OnePassSignaturePacket { version = version,
+                                     signature_type = signature_type,
+                                     hash_algorithm = hash_algorithm,
+                                     key_algorithm = key_algorithm,
+                                     key_id = key_id,
+                                     nested = nested }) =
+	(LZ.concat [ encode version, encode signature_type,
+	             encode hash_algorithm, encode key_algorithm,
+	             encode (BaseConvert.toNum 16 key_id :: Word64),
+	             encode nested ], 4)
+put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
+                              key_algorithm = algorithm, key = key,
+                              s2k_useage = s2k_useage,
+                              symmetric_type = symmetric_type,
+                              s2k_type = s2k_type,
+                              s2k_hash_algorithm = s2k_hash_algo,
+                              s2k_salt = s2k_salt,
+                              encrypted_data = encrypted_data }) =
+	(LZ.concat $ [p, encode s2k_useage] ++
+	(if s2k_useage `elem` [255, 254] then
+		-- TODO: if s2k_type == 3 reverse ugly bit manipulation
+		[encode symmetric_type, encode s2k_type, encode s2k_hash_algo] ++
+		if s2k_type `elem` [1, 3] then [encode s2k_salt] else []
+	else []) ++
+	(if s2k_useage > 0 then
+		[encrypted_data]
+	else s) ++
+	(if s2k_useage == 254 then
+		[LZ.replicate 20 0] -- TODO SHA1 Checksum
+	else
+		[encode $ (fromIntegral $
+			LZ.foldl (\c i -> (c + (fromIntegral i)) `mod` 65536)
+			(0::Integer) (LZ.concat s) :: Word16)]), 5)
+	where
+	p = fst (put_packet $
+		PublicKeyPacket version timestamp algorithm key
+		:: (LZ.ByteString, Integer)) -- Supress warning
+	s = map (encode . (key !)) (secret_key_fields algorithm)
+put_packet (PublicKeyPacket { version = 4, timestamp = timestamp,
+                              key_algorithm = algorithm, key = key }) =
+	(LZ.concat $ [LZ.singleton 4, encode timestamp, encode algorithm] ++
+	            map (encode . (key !)) (public_key_fields algorithm), 6)
+put_packet (CompressedDataPacket { compression_algorithm = algorithm,
+                                   message = message }) =
+	(LZ.append (encode algorithm) $ compress $ encode message, 8)
+	where compress = case algorithm of
+		Uncompressed -> id
+		ZIP -> Zip.compress
+		ZLIB -> Zlib.compress
+		BZip2 -> BZip2.compress
+put_packet (LiteralDataPacket { format = format, filename = filename,
+                                timestamp = timestamp, content = content
+                              }) =
+	(LZ.concat [encode format, encode filename_l, lz_filename,
+	            encode timestamp, content], 11)
+	where
+	filename_l  = (fromIntegral $ LZ.length lz_filename) :: Word8
+	lz_filename = LZ.fromString filename
+put_packet (UserIDPacket txt) = (LZ.fromString txt, 13)
+put_packet _ = error "Unsupported Packet version or type in put_packet."
+
+parse_packet :: Word8 -> Get Packet
+-- SignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2
+parse_packet  2 = do
+	version <- get
+	case version of
+		3 -> undefined -- TODO: V3 sigs
+		4 -> do
+			signature_type <- get
+			key_algorithm <- get
+			hash_algorithm <- get
+			hashed_size <- fmap fromIntegral (get :: Get Word16)
+			hashed_data <- getLazyByteString hashed_size
+			let hashed = runGet get_signature_subpackets hashed_data
+			unhashed_size <- fmap fromIntegral (get :: Get Word16)
+			unhashed_data <- getLazyByteString unhashed_size
+			let unhashed = runGet get_signature_subpackets unhashed_data
+			hash_head <- get
+			signature <- get
+			return (SignaturePacket {
+				version = version,
+				signature_type = signature_type,
+				key_algorithm = key_algorithm,
+				hash_algorithm = hash_algorithm,
+				hashed_subpackets = hashed,
+				unhashed_subpackets = unhashed,
+				hash_head = hash_head,
+				signature = signature,
+				trailer = LZ.concat [encode version, encode signature_type, encode key_algorithm, encode hash_algorithm, encode (fromIntegral hashed_size :: Word16), hashed_data, LZ.pack [4, 0xff], encode ((6 + (fromIntegral hashed_size)) :: Word32)]
+			})
+		x -> fail $ "Unknown SignaturePacket version " ++ (show x) ++ "."
+-- OnePassSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.4
+parse_packet  4 = do
+	version <- get
+	signature_type <- get
+	hash_algo <- get
+	key_algo <- get
+	key_id <- get :: Get Word64
+	nested <- get
+	return (OnePassSignaturePacket {
+		version = version,
+		signature_type = signature_type,
+		hash_algorithm = hash_algo,
+		key_algorithm = key_algo,
+		key_id = (BaseConvert.toString 16 key_id),
+		nested = nested
+	})
+-- SecretKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.3
+parse_packet  5 = do
+	-- Parse PublicKey part
+	(PublicKeyPacket {
+		version = version,
+		timestamp = timestamp,
+		key_algorithm = algorithm,
+		key = key
+	}) <- parse_packet 6
+	s2k_useage <- get :: Get Word8
+	let k = SecretKeyPacket version timestamp algorithm key s2k_useage
+	k' <- case s2k_useage of
+		_ | s2k_useage `elem` [255, 254] -> do
+			symmetric_type <- get
+			s2k_type <- get
+			s2k_hash_algorithm <- get
+			s2k_salt <- if s2k_type `elem` [1, 3] then get
+				else return undefined
+			s2k_count <- if s2k_type == 3 then do
+				c <- fmap fromIntegral (get :: Get Word8)
+				return $ fromIntegral $
+					(16 + (c .&. 15)) `shiftL` ((c `shiftR` 4) + 6)
+				else return undefined
+			return (k symmetric_type s2k_type s2k_hash_algorithm
+				s2k_salt s2k_count)
+		_ | s2k_useage > 0 ->
+			-- s2k_useage is symmetric_type in this case
+			return (k s2k_useage undefined undefined undefined undefined)
+		_ ->
+			return (k undefined undefined undefined undefined undefined)
+	if s2k_useage > 0 then do
+		encrypted <- getRemainingLazyByteString
+		return (k' encrypted undefined)
+	else do
+		key <- foldM (\m f -> do
+			mpi <- get :: Get MPI
+			return $ Map.insert f mpi m) key (secret_key_fields algorithm)
+		private_hash <- getRemainingLazyByteString
+		return ((k' undefined private_hash) {key = key})
+-- PublicKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.2
+parse_packet  6 = do
+	version <- get :: Get Word8
+	case version of
+		4 -> do
+			timestamp <- get
+			algorithm <- get
+			key <- mapM (\f -> do
+				mpi <- get :: Get MPI
+				return (f, mpi)) (public_key_fields algorithm)
+			return (PublicKeyPacket {
+				version = 4,
+				timestamp = timestamp,
+				key_algorithm = algorithm,
+				key = Map.fromList key
+			})
+		x -> fail $ "Unsupported PublicKeyPacket version " ++ (show x) ++ "."
+-- CompressedDataPacket, http://tools.ietf.org/html/rfc4880#section-5.6
+parse_packet  8 = do
+	algorithm <- get
+	message <- getRemainingLazyByteString
+	let decompress = case algorithm of
+		Uncompressed -> id
+		ZIP -> Zip.decompress
+		ZLIB -> Zlib.decompress
+		BZip2 -> BZip2.decompress
+	return (CompressedDataPacket {
+		compression_algorithm = algorithm,
+		message = runGet (get :: Get Message) (decompress message)
+	})
+-- LiteralDataPacket, http://tools.ietf.org/html/rfc4880#section-5.9
+parse_packet 11 = do
+	format <- get
+	filenameLength <- get :: Get Word8
+	filename <- getLazyByteString (fromIntegral filenameLength)
+	timestamp <- get
+	content <- getRemainingLazyByteString
+	return (LiteralDataPacket {
+		format = format,
+		filename = LZ.toString filename,
+		timestamp = timestamp,
+		content = content
+	})
+-- UserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.11
+parse_packet 13 =
+	fmap UserIDPacket (fmap LZ.toString getRemainingLazyByteString)
+-- Fail nicely for unimplemented packets
+parse_packet x = fail $ "Unimplemented OpenPGP packet tag " ++ (show x) ++ "."
+
+-- Helper method for fingerprints and such
+fingerprint_material :: Packet -> [LZ.ByteString]
+fingerprint_material (PublicKeyPacket {version = 4,
+                      timestamp = timestamp,
+                      key_algorithm = algorithm,
+                      key = key}) =
+	[
+		LZ.singleton 0x99,
+		encode (6 + fromIntegral (LZ.length material) :: Word16),
+		LZ.singleton 4, encode timestamp, encode algorithm,
+		material
+	]
+	where material = LZ.concat $
+		map (\f -> encode (key ! f)) (public_key_fields algorithm)
+fingerprint_material p | (version p) `elem` [2, 3] = [n, e]
+	where n = LZ.drop 2 (encode (key p ! 'n'))
+	      e = LZ.drop 2 (encode (key p ! 'e'))
+fingerprint_material _ =
+	error "Unsupported Packet version or type in fingerprint_material."
+
+data HashAlgorithm = MD5 | SHA1 | RIPEMD160 | SHA256 | SHA384 | SHA512 | SHA224
+	deriving (Show, Read, Eq)
+instance Binary HashAlgorithm where
+	put MD5       = put (01 :: Word8)
+	put SHA1      = put (02 :: Word8)
+	put RIPEMD160 = put (03 :: Word8)
+	put SHA256    = put (08 :: Word8)
+	put SHA384    = put (09 :: Word8)
+	put SHA512    = put (10 :: Word8)
+	put SHA224    = put (11 :: Word8)
+	get = do
+		tag <- get :: Get Word8
+		case tag of
+			01 -> return MD5
+			02 -> return SHA1
+			03 -> return RIPEMD160
+			08 -> return SHA256
+			09 -> return SHA384
+			10 -> return SHA512
+			11 -> return SHA224
+			x  -> fail $ "Unknown HashAlgorithm " ++ (show x) ++ "."
+
+data KeyAlgorithm = RSA | RSA_E | RSA_S | ELGAMAL | DSA | ECC | ECDSA | DH
+	deriving (Show, Read, Eq)
+instance Binary KeyAlgorithm where
+	put RSA     = put (01 :: Word8)
+	put RSA_E   = put (02 :: Word8)
+	put RSA_S   = put (03 :: Word8)
+	put ELGAMAL = put (16 :: Word8)
+	put DSA     = put (17 :: Word8)
+	put ECC     = put (18 :: Word8)
+	put ECDSA   = put (19 :: Word8)
+	put DH      = put (21 :: Word8)
+	get = do
+		tag <- get :: Get Word8
+		case tag of
+			01 -> return RSA
+			02 -> return RSA_E
+			03 -> return RSA_S
+			16 -> return ELGAMAL
+			17 -> return DSA
+			18 -> return ECC
+			19 -> return ECDSA
+			21 -> return DH
+			x  -> fail $ "Unknown KeyAlgorithm " ++ (show x) ++ "."
+
+data CompressionAlgorithm = Uncompressed | ZIP | ZLIB | BZip2
+	deriving (Show, Read, Eq)
+instance Binary CompressionAlgorithm where
+	put Uncompressed = put (0 :: Word8)
+	put ZIP          = put (1 :: Word8)
+	put ZLIB         = put (2 :: Word8)
+	put BZip2        = put (3 :: Word8)
+	get = do
+		tag <- get :: Get Word8
+		case tag of
+			0 -> return Uncompressed
+			1 -> return ZIP
+			2 -> return ZLIB
+			3 -> return BZip2
+			x  -> fail $ "Unknown CompressionAlgorithm " ++ (show x) ++ "."
+
+-- A message is encoded as a list that takes the entire file
+newtype Message = Message [Packet] deriving (Show, Read, Eq)
+instance Binary Message where
+	put (Message []) = return ()
+	put (Message (x:xs)) = do
+		put x
+		put (Message xs)
+	get = do
+		done <- isEmpty
+		if done then do
+			return (Message [])
+		else do
+			next_packet <- get :: Get Packet
+			(Message tail) <- get :: Get Message
+			return (Message (next_packet:tail))
+
+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)
+	where isSig (SignaturePacket {}) = True
+	      isSig _ = False
+	      isDta (LiteralDataPacket {}) = True
+	      isDta _ = False
+
+newtype MPI = MPI Integer deriving (Show, Read, Eq, Ord)
+instance Binary MPI where
+	put (MPI i) = do
+		put (((fromIntegral . LZ.length $ bytes) - 1) * 8
+			+ floor (logBase (2::Double) $ fromIntegral (bytes `LZ.index` 0))
+			+ 1 :: Word16)
+		putLazyByteString bytes
+		where bytes = LZ.unfoldr (\x -> if x == 0 then Nothing
+			else Just (fromIntegral x, x `shiftR` 8)) i
+	get = do
+		length <- fmap fromIntegral (get :: Get Word16)
+		bytes <- getLazyByteString ((length + 7) `div` 8)
+		return (MPI (LZ.foldr (\b a ->
+			a `shiftL` 8 .|. fromIntegral b) 0 bytes))
+
+data SignatureSubpacket =
+	SignatureCreationTimePacket Word32 |
+	IssuerPacket String
+	deriving (Show, Read, Eq)
+
+instance Binary SignatureSubpacket where
+	put p = do
+		-- Use 5-octet-length + 1 for tag as the first packet body octet
+		put (255 :: Word8)
+		put ((fromIntegral $ LZ.length body) + 1 :: Word32)
+		put tag
+		putLazyByteString body
+		where (body, tag) = put_signature_subpacket p
+	get = do
+		len <- fmap fromIntegral (get :: Get Word8)
+		len <- case len of
+			_ | len > 190 && len < 255 -> do -- Two octet length
+				second <- fmap fromIntegral (get :: Get Word8)
+				return $ ((len - 192) `shiftR` 8) + second + 192
+			255 -> -- Five octet length
+				fmap fromIntegral (get :: Get Word32)
+			_ -> -- One octet length, no furthur processing
+				return len
+		tag <- get :: Get Word8
+		-- This forces the whole packet to be consumed
+		packet <- getLazyByteString len
+		return $ runGet (parse_signature_subpacket tag) packet
+
+signature_issuer :: Packet -> Maybe String
+signature_issuer (SignaturePacket {hashed_subpackets = hashed,
+                                   unhashed_subpackets = unhashed}) =
+	if (length issuers) > 0 then Just issuer else Nothing
+	where IssuerPacket issuer = issuers !! 0
+	      issuers = (filter isIssuer hashed) ++ (filter isIssuer unhashed)
+	      isIssuer (IssuerPacket {}) = True
+	      isIssuer _ = False
+signature_issuer _ = Nothing
+
+put_signature_subpacket :: SignatureSubpacket -> (LZ.ByteString, Word8)
+put_signature_subpacket (SignatureCreationTimePacket time) =
+	(encode time, 2)
+put_signature_subpacket (IssuerPacket keyid) =
+	(encode ((BaseConvert.toNum 16 keyid) :: Word64), 16)
+
+get_signature_subpackets :: Get [SignatureSubpacket]
+get_signature_subpackets = do
+	done <- isEmpty
+	if done then do
+		return []
+	else do
+		next_packet <- get :: Get SignatureSubpacket
+		tail <- get_signature_subpackets
+		return (next_packet:tail)
+
+parse_signature_subpacket :: Word8 -> Get SignatureSubpacket
+-- SignatureCreationTimePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.4
+parse_signature_subpacket  2 = fmap SignatureCreationTimePacket get
+-- IssuerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.5
+parse_signature_subpacket 16 = do
+	keyid <- get :: Get Word64
+	return $ IssuerPacket (BaseConvert.toString 16 keyid)
+-- Fail nicely for unimplemented packets
+parse_signature_subpacket x =
+	fail $ "Unimplemented OpenPGP signature subpacket tag " ++ (show x) ++ "."
diff --git a/Data/OpenPGP/Crypto.hs b/Data/OpenPGP/Crypto.hs
new file mode 100644
index 0000000..e2151fc
--- /dev/null
+++ b/Data/OpenPGP/Crypto.hs
@@ -0,0 +1,82 @@
+module Data.OpenPGP.Crypto (verify, fingerprint) where
+
+import Data.Word
+import Data.Map ((!))
+import qualified Data.ByteString.Lazy as LZ
+
+import Data.Binary
+import qualified Codec.Encryption.RSA as RSA
+import qualified Data.Digest.MD5 as MD5
+import qualified Data.Digest.SHA1 as SHA1
+import qualified Data.Digest.SHA256 as SHA256
+import qualified Data.Digest.SHA384 as SHA384
+import qualified Data.Digest.SHA512 as SHA512
+
+import qualified Data.OpenPGP as OpenPGP
+import qualified Data.BaseConvert as BaseConvert
+
+-- http://tools.ietf.org/html/rfc4880#section-12.2
+fingerprint :: OpenPGP.Packet -> String
+fingerprint p | OpenPGP.version p == 4 =
+	BaseConvert.toString 16 $ SHA1.toInteger $ SHA1.hash $
+		LZ.unpack (LZ.concat (OpenPGP.fingerprint_material p))
+fingerprint p | OpenPGP.version p `elem` [2, 3] =
+	concatMap (BaseConvert.toString 16) $
+		MD5.hash $ LZ.unpack (LZ.concat (OpenPGP.fingerprint_material p))
+fingerprint _ = error "Unsupported Packet version or type in fingerprint."
+
+find_key :: OpenPGP.Message -> String -> Maybe OpenPGP.Packet
+find_key (OpenPGP.Message (x@(OpenPGP.PublicKeyPacket {}):xs)) keyid =
+	find_key_ x xs keyid
+find_key (OpenPGP.Message (x@(OpenPGP.SecretKeyPacket {}):xs)) keyid =
+	find_key_ x xs keyid
+find_key _ _ = Nothing
+
+find_key_ :: OpenPGP.Packet -> [OpenPGP.Packet] -> String -> Maybe OpenPGP.Packet
+find_key_ x xs keyid =
+	if thisid == keyid then Just x else find_key (OpenPGP.Message xs) keyid
+	where thisid = reverse $
+		take (length keyid) (reverse (fingerprint x))
+
+keyfield_as_octets :: OpenPGP.Packet -> Char -> [Word8]
+keyfield_as_octets k f =
+	LZ.unpack $ LZ.drop 2 (encode (k' ! f))
+	where k' = OpenPGP.key k
+
+-- http://tools.ietf.org/html/rfc3447#page-43
+emsa_pkcs1_v1_5_hash_padding :: OpenPGP.HashAlgorithm -> [Word8]
+emsa_pkcs1_v1_5_hash_padding OpenPGP.MD5 = [0x30, 0x20, 0x30, 0x0c, 0x06, 0x08, 0x2a, 0x86, 0x48, 0x86, 0xf7, 0x0d, 0x02, 0x05, 0x05, 0x00, 0x04, 0x10]
+emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA1 = [0x30, 0x21, 0x30, 0x09, 0x06, 0x05, 0x2b, 0x0e, 0x03, 0x02, 0x1a, 0x05, 0x00, 0x04, 0x14]
+emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA256 = [0x30, 0x31, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x01, 0x05, 0x00, 0x04, 0x20]
+emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA384 = [0x30, 0x41, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x02, 0x05, 0x00, 0x04, 0x30]
+emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA512 = [0x30, 0x51, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x03, 0x05, 0x00, 0x04, 0x40]
+emsa_pkcs1_v1_5_hash_padding _ =
+	error "Unsupported HashAlgorithm in emsa_pkcs1_v1_5_hash_padding."
+
+hash :: OpenPGP.HashAlgorithm -> [Word8] -> [Word8]
+hash OpenPGP.MD5 = MD5.hash
+hash OpenPGP.SHA1 = reverse . drop 2 . LZ.unpack . encode . OpenPGP.MPI . SHA1.toInteger . SHA1.hash
+hash OpenPGP.SHA256 = SHA256.hash
+hash OpenPGP.SHA384 = SHA384.hash
+hash OpenPGP.SHA512 = SHA512.hash
+hash _ = error "Unsupported HashAlgorithm in hash."
+
+emsa_pkcs1_v1_5_encode :: [Word8] -> Int -> OpenPGP.HashAlgorithm -> [Word8]
+emsa_pkcs1_v1_5_encode m emLen algo =
+	[0, 1] ++ replicate (emLen - length t - 3) 0xff ++ [0] ++ t
+	where t = emsa_pkcs1_v1_5_hash_padding algo ++ hash algo m
+
+verify :: OpenPGP.Message -> OpenPGP.Message -> Int -> Bool
+verify keys packet sigidx =
+	encoded == RSA.encrypt (n, e) raw_sig
+	where
+	raw_sig = LZ.unpack $ LZ.drop 2 $ encode (OpenPGP.signature sig)
+	encoded = emsa_pkcs1_v1_5_encode signature_over
+		(length n) (OpenPGP.hash_algorithm sig)
+	signature_over = LZ.unpack $ dta `LZ.append` OpenPGP.trailer sig
+	(n, e) = (keyfield_as_octets k 'n', keyfield_as_octets k 'e')
+	Just k = find_key keys issuer
+	Just issuer = OpenPGP.signature_issuer sig
+	sig = sigs !! sigidx
+	(sigs, (OpenPGP.LiteralDataPacket {OpenPGP.content = dta}):_) =
+		OpenPGP.signatures_and_data packet
-- 
cgit v1.2.3


From f3ae8c4ff4494cc97dbd42be5a2a4775e4844c35 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 8 Aug 2011 23:31:03 -0500
Subject: Haskel98 parsing compat

---
 Data/OpenPGP.hs | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 1c76202..c285127 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -326,10 +326,10 @@ parse_packet  5 = do
 			return (k s2k_useage undefined undefined undefined undefined)
 		_ ->
 			return (k undefined undefined undefined undefined undefined)
-	if s2k_useage > 0 then do
-		encrypted <- getRemainingLazyByteString
+	if s2k_useage > 0 then do {
+		encrypted <- getRemainingLazyByteString;
 		return (k' encrypted undefined)
-	else do
+	} else do
 		key <- foldM (\m f -> do
 			mpi <- get :: Get MPI
 			return $ Map.insert f mpi m) key (secret_key_fields algorithm)
@@ -475,9 +475,9 @@ instance Binary Message where
 		put (Message xs)
 	get = do
 		done <- isEmpty
-		if done then do
-			return (Message [])
-		else do
+		if done then do {
+			return (Message []);
+		} else do
 			next_packet <- get :: Get Packet
 			(Message tail) <- get :: Get Message
 			return (Message (next_packet:tail))
@@ -554,9 +554,9 @@ put_signature_subpacket (IssuerPacket keyid) =
 get_signature_subpackets :: Get [SignatureSubpacket]
 get_signature_subpackets = do
 	done <- isEmpty
-	if done then do
-		return []
-	else do
+	if done then do {
+		return [];
+	} else do
 		next_packet <- get :: Get SignatureSubpacket
 		tail <- get_signature_subpackets
 		return (next_packet:tail)
-- 
cgit v1.2.3


From 1f8f4b5405430fec064e1c30f7c374a73523267f Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 8 Aug 2011 23:31:14 -0500
Subject: haddock

---
 Data/OpenPGP.hs        |  9 ++++++++-
 Data/OpenPGP/Crypto.hs | 19 +++++++++++++++----
 2 files changed, 23 insertions(+), 5 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index c285127..0ce9991 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -1,3 +1,8 @@
+-- | Main implementation of the OpenPGP message format <http://tools.ietf.org/html/rfc4880>
+--
+-- 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) where
 
 import Control.Monad
@@ -384,7 +389,7 @@ parse_packet 13 =
 -- Fail nicely for unimplemented packets
 parse_packet x = fail $ "Unimplemented OpenPGP packet tag " ++ (show x) ++ "."
 
--- Helper method for fingerprints and such
+-- | Helper method for fingerprints and such
 fingerprint_material :: Packet -> [LZ.ByteString]
 fingerprint_material (PublicKeyPacket {version = 4,
                       timestamp = timestamp,
@@ -482,6 +487,7 @@ instance Binary Message where
 			(Message tail) <- get :: Get Message
 			return (Message (next_packet:tail))
 
+-- | Extract all signature and data packets from a 'Message'
 signatures_and_data :: Message -> ([Packet], [Packet])
 signatures_and_data (Message ((CompressedDataPacket {message = m}):_)) =
 	signatures_and_data m
@@ -535,6 +541,7 @@ instance Binary SignatureSubpacket where
 		packet <- getLazyByteString len
 		return $ runGet (parse_signature_subpacket tag) packet
 
+-- | Find the keyid that issued a SignaturePacket
 signature_issuer :: Packet -> Maybe String
 signature_issuer (SignaturePacket {hashed_subpackets = hashed,
                                    unhashed_subpackets = unhashed}) =
diff --git a/Data/OpenPGP/Crypto.hs b/Data/OpenPGP/Crypto.hs
index e2151fc..fee1d55 100644
--- a/Data/OpenPGP/Crypto.hs
+++ b/Data/OpenPGP/Crypto.hs
@@ -1,3 +1,9 @@
+-- | This is a wrapper around <http://hackage.haskell.org/package/Crypto>
+-- that currently does fingerprint generation and signature verification.
+--
+-- The recommended way to import this module is:
+--
+-- > import qualified Data.OpenPGP.Crypto as OpenPGP
 module Data.OpenPGP.Crypto (verify, fingerprint) where
 
 import Data.Word
@@ -15,7 +21,8 @@ import qualified Data.Digest.SHA512 as SHA512
 import qualified Data.OpenPGP as OpenPGP
 import qualified Data.BaseConvert as BaseConvert
 
--- http://tools.ietf.org/html/rfc4880#section-12.2
+-- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket
+-- <http://tools.ietf.org/html/rfc4880#section-12.2>
 fingerprint :: OpenPGP.Packet -> String
 fingerprint p | OpenPGP.version p == 4 =
 	BaseConvert.toString 16 $ SHA1.toInteger $ SHA1.hash $
@@ -66,8 +73,12 @@ emsa_pkcs1_v1_5_encode m emLen algo =
 	[0, 1] ++ replicate (emLen - length t - 3) 0xff ++ [0] ++ t
 	where t = emsa_pkcs1_v1_5_hash_padding algo ++ hash algo m
 
-verify :: OpenPGP.Message -> OpenPGP.Message -> Int -> Bool
-verify keys packet sigidx =
+-- | Verify a message signature.  Only supports RSA keys for now.
+verify :: OpenPGP.Message    -- ^ Keys that may have made the signature
+          -> OpenPGP.Message -- ^ Message containing data and signature packet
+          -> Int             -- ^ Index of signature to verify (0th, 1st, etc)
+          -> Bool
+verify keys message sigidx =
 	encoded == RSA.encrypt (n, e) raw_sig
 	where
 	raw_sig = LZ.unpack $ LZ.drop 2 $ encode (OpenPGP.signature sig)
@@ -79,4 +90,4 @@ verify keys packet sigidx =
 	Just issuer = OpenPGP.signature_issuer sig
 	sig = sigs !! sigidx
 	(sigs, (OpenPGP.LiteralDataPacket {OpenPGP.content = dta}):_) =
-		OpenPGP.signatures_and_data packet
+		OpenPGP.signatures_and_data message
-- 
cgit v1.2.3


From a4b22e4d7606699f6b10238aa245fa53be339d3e Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 8 Aug 2011 23:52:15 -0500
Subject: hlint clean

---
 Data/OpenPGP.hs | 82 ++++++++++++++++++++++++++++-----------------------------
 1 file changed, 40 insertions(+), 42 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 0ce9991..fd89cfb 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -115,7 +115,7 @@ parse_new_length = do
 -- http://tools.ietf.org/html/rfc4880#section-4.2.1
 parse_old_length :: Word8 -> Get Word32
 parse_old_length tag =
-	case (tag .&. 3) of
+	case tag .&. 3 of
 		-- One octet length
 		0 -> fmap fromIntegral (get :: Get Word8)
 		-- Two octet length
@@ -154,7 +154,7 @@ signature_packet_start (SignaturePacket {
 	hash_algorithm = hash_algorithm,
 	hashed_subpackets = hashed_subpackets
 }) =
-	LZ.concat $ [
+	LZ.concat [
 		encode (0x04 :: Word8),
 		encode signature_type,
 		encode key_algorithm,
@@ -173,7 +173,7 @@ calculate_signature_trailer p =
 		signature_packet_start p,
 		encode (0x04 :: Word8),
 		encode (0xff :: Word8),
-		encode ((fromIntegral (LZ.length $ signature_packet_start p)) :: Word32)
+		encode (fromIntegral (LZ.length $ signature_packet_start p) :: Word32)
 	]
 
 put_packet :: (Num a) => Packet -> (LZ.ByteString, a)
@@ -224,8 +224,8 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
 	(if s2k_useage == 254 then
 		[LZ.replicate 20 0] -- TODO SHA1 Checksum
 	else
-		[encode $ (fromIntegral $
-			LZ.foldl (\c i -> (c + (fromIntegral i)) `mod` 65536)
+		[encode (fromIntegral $
+			LZ.foldl (\c i -> (c + fromIntegral i) `mod` 65536)
 			(0::Integer) (LZ.concat s) :: Word16)]), 5)
 	where
 	p = fst (put_packet $
@@ -273,7 +273,7 @@ parse_packet  2 = do
 			let unhashed = runGet get_signature_subpackets unhashed_data
 			hash_head <- get
 			signature <- get
-			return (SignaturePacket {
+			return SignaturePacket {
 				version = version,
 				signature_type = signature_type,
 				key_algorithm = key_algorithm,
@@ -282,9 +282,9 @@ parse_packet  2 = do
 				unhashed_subpackets = unhashed,
 				hash_head = hash_head,
 				signature = signature,
-				trailer = LZ.concat [encode version, encode signature_type, encode key_algorithm, encode hash_algorithm, encode (fromIntegral hashed_size :: Word16), hashed_data, LZ.pack [4, 0xff], encode ((6 + (fromIntegral hashed_size)) :: Word32)]
-			})
-		x -> fail $ "Unknown SignaturePacket version " ++ (show x) ++ "."
+				trailer = LZ.concat [encode version, encode signature_type, encode key_algorithm, encode hash_algorithm, encode (fromIntegral hashed_size :: Word16), hashed_data, LZ.pack [4, 0xff], encode ((6 + fromIntegral hashed_size) :: Word32)]
+			}
+		x -> fail $ "Unknown SignaturePacket version " ++ show x ++ "."
 -- OnePassSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.4
 parse_packet  4 = do
 	version <- get
@@ -293,14 +293,14 @@ parse_packet  4 = do
 	key_algo <- get
 	key_id <- get :: Get Word64
 	nested <- get
-	return (OnePassSignaturePacket {
+	return OnePassSignaturePacket {
 		version = version,
 		signature_type = signature_type,
 		hash_algorithm = hash_algo,
 		key_algorithm = key_algo,
-		key_id = (BaseConvert.toString 16 key_id),
+		key_id = BaseConvert.toString 16 key_id,
 		nested = nested
-	})
+	}
 -- SecretKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.3
 parse_packet  5 = do
 	-- Parse PublicKey part
@@ -350,13 +350,13 @@ parse_packet  6 = do
 			key <- mapM (\f -> do
 				mpi <- get :: Get MPI
 				return (f, mpi)) (public_key_fields algorithm)
-			return (PublicKeyPacket {
+			return PublicKeyPacket {
 				version = 4,
 				timestamp = timestamp,
 				key_algorithm = algorithm,
 				key = Map.fromList key
-			})
-		x -> fail $ "Unsupported PublicKeyPacket version " ++ (show x) ++ "."
+			}
+		x -> fail $ "Unsupported PublicKeyPacket version " ++ show x ++ "."
 -- CompressedDataPacket, http://tools.ietf.org/html/rfc4880#section-5.6
 parse_packet  8 = do
 	algorithm <- get
@@ -366,10 +366,10 @@ parse_packet  8 = do
 		ZIP -> Zip.decompress
 		ZLIB -> Zlib.decompress
 		BZip2 -> BZip2.decompress
-	return (CompressedDataPacket {
+	return CompressedDataPacket {
 		compression_algorithm = algorithm,
 		message = runGet (get :: Get Message) (decompress message)
-	})
+	}
 -- LiteralDataPacket, http://tools.ietf.org/html/rfc4880#section-5.9
 parse_packet 11 = do
 	format <- get
@@ -377,17 +377,17 @@ parse_packet 11 = do
 	filename <- getLazyByteString (fromIntegral filenameLength)
 	timestamp <- get
 	content <- getRemainingLazyByteString
-	return (LiteralDataPacket {
+	return LiteralDataPacket {
 		format = format,
 		filename = LZ.toString filename,
 		timestamp = timestamp,
 		content = content
-	})
+	}
 -- UserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.11
 parse_packet 13 =
-	fmap UserIDPacket (fmap LZ.toString getRemainingLazyByteString)
+	fmap (UserIDPacket . LZ.toString) getRemainingLazyByteString
 -- Fail nicely for unimplemented packets
-parse_packet x = fail $ "Unimplemented OpenPGP packet tag " ++ (show x) ++ "."
+parse_packet x = fail $ "Unimplemented OpenPGP packet tag " ++ show x ++ "."
 
 -- | Helper method for fingerprints and such
 fingerprint_material :: Packet -> [LZ.ByteString]
@@ -403,7 +403,7 @@ fingerprint_material (PublicKeyPacket {version = 4,
 	]
 	where material = LZ.concat $
 		map (\f -> encode (key ! f)) (public_key_fields algorithm)
-fingerprint_material p | (version p) `elem` [2, 3] = [n, e]
+fingerprint_material p | version p `elem` [2, 3] = [n, e]
 	where n = LZ.drop 2 (encode (key p ! 'n'))
 	      e = LZ.drop 2 (encode (key p ! 'e'))
 fingerprint_material _ =
@@ -429,7 +429,7 @@ instance Binary HashAlgorithm where
 			09 -> return SHA384
 			10 -> return SHA512
 			11 -> return SHA224
-			x  -> fail $ "Unknown HashAlgorithm " ++ (show x) ++ "."
+			x  -> fail $ "Unknown HashAlgorithm " ++ show x ++ "."
 
 data KeyAlgorithm = RSA | RSA_E | RSA_S | ELGAMAL | DSA | ECC | ECDSA | DH
 	deriving (Show, Read, Eq)
@@ -453,7 +453,7 @@ instance Binary KeyAlgorithm where
 			18 -> return ECC
 			19 -> return ECDSA
 			21 -> return DH
-			x  -> fail $ "Unknown KeyAlgorithm " ++ (show x) ++ "."
+			x  -> fail $ "Unknown KeyAlgorithm " ++ show x ++ "."
 
 data CompressionAlgorithm = Uncompressed | ZIP | ZLIB | BZip2
 	deriving (Show, Read, Eq)
@@ -469,7 +469,7 @@ instance Binary CompressionAlgorithm where
 			1 -> return ZIP
 			2 -> return ZLIB
 			3 -> return BZip2
-			x  -> fail $ "Unknown CompressionAlgorithm " ++ (show x) ++ "."
+			x  -> fail $ "Unknown CompressionAlgorithm " ++ show x ++ "."
 
 -- A message is encoded as a list that takes the entire file
 newtype Message = Message [Packet] deriving (Show, Read, Eq)
@@ -480,12 +480,11 @@ instance Binary Message where
 		put (Message xs)
 	get = do
 		done <- isEmpty
-		if done then do {
-			return (Message []);
-		} else do
-			next_packet <- get :: Get Packet
-			(Message tail) <- get :: Get Message
-			return (Message (next_packet:tail))
+		if done then return (Message []) else do {
+			next_packet <- get :: Get Packet;
+			(Message tail) <- get :: Get Message;
+			return (Message (next_packet:tail));
+		}
 
 -- | Extract all signature and data packets from a 'Message'
 signatures_and_data :: Message -> ([Packet], [Packet])
@@ -522,7 +521,7 @@ instance Binary SignatureSubpacket where
 	put p = do
 		-- Use 5-octet-length + 1 for tag as the first packet body octet
 		put (255 :: Word8)
-		put ((fromIntegral $ LZ.length body) + 1 :: Word32)
+		put (fromIntegral (LZ.length body) + 1 :: Word32)
 		put tag
 		putLazyByteString body
 		where (body, tag) = put_signature_subpacket p
@@ -545,9 +544,9 @@ instance Binary SignatureSubpacket where
 signature_issuer :: Packet -> Maybe String
 signature_issuer (SignaturePacket {hashed_subpackets = hashed,
                                    unhashed_subpackets = unhashed}) =
-	if (length issuers) > 0 then Just issuer else Nothing
+	if length issuers > 0 then Just issuer else Nothing
 	where IssuerPacket issuer = issuers !! 0
-	      issuers = (filter isIssuer hashed) ++ (filter isIssuer unhashed)
+	      issuers = filter isIssuer hashed ++ filter isIssuer unhashed
 	      isIssuer (IssuerPacket {}) = True
 	      isIssuer _ = False
 signature_issuer _ = Nothing
@@ -556,17 +555,16 @@ put_signature_subpacket :: SignatureSubpacket -> (LZ.ByteString, Word8)
 put_signature_subpacket (SignatureCreationTimePacket time) =
 	(encode time, 2)
 put_signature_subpacket (IssuerPacket keyid) =
-	(encode ((BaseConvert.toNum 16 keyid) :: Word64), 16)
+	(encode (BaseConvert.toNum 16 keyid :: Word64), 16)
 
 get_signature_subpackets :: Get [SignatureSubpacket]
 get_signature_subpackets = do
 	done <- isEmpty
-	if done then do {
-		return [];
-	} else do
-		next_packet <- get :: Get SignatureSubpacket
-		tail <- get_signature_subpackets
-		return (next_packet:tail)
+	if done then return [] else do {
+		next_packet <- get :: Get SignatureSubpacket;
+		tail <- get_signature_subpackets;
+		return (next_packet:tail);
+	}
 
 parse_signature_subpacket :: Word8 -> Get SignatureSubpacket
 -- SignatureCreationTimePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.4
@@ -577,4 +575,4 @@ parse_signature_subpacket 16 = do
 	return $ IssuerPacket (BaseConvert.toString 16 keyid)
 -- Fail nicely for unimplemented packets
 parse_signature_subpacket x =
-	fail $ "Unimplemented OpenPGP signature subpacket tag " ++ (show x) ++ "."
+	fail $ "Unimplemented OpenPGP signature subpacket tag " ++ show x ++ "."
-- 
cgit v1.2.3


From f41a366e8d0070a0d3bc23c55987632750ec6761 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 10 Aug 2011 19:09:30 -0500
Subject: fix signature subpacket parsing

---
 Data/OpenPGP.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index fd89cfb..c66953e 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -537,7 +537,7 @@ instance Binary SignatureSubpacket where
 				return len
 		tag <- get :: Get Word8
 		-- This forces the whole packet to be consumed
-		packet <- getLazyByteString len
+		packet <- getLazyByteString (len-1)
 		return $ runGet (parse_signature_subpacket tag) packet
 
 -- | Find the keyid that issued a SignaturePacket
-- 
cgit v1.2.3


From 1d7d94256051b4129e7287540870bb0a2f0c618f Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 10 Aug 2011 19:09:47 -0500
Subject: export calculate_signature_trailer

---
 Data/OpenPGP.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index c66953e..d48dc5e 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -3,7 +3,7 @@
 -- 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) where
+module Data.OpenPGP (Message(..), Packet(..), SignatureSubpacket(..), HashAlgorithm(..), KeyAlgorithm(..), CompressionAlgorithm(..), MPI(..), fingerprint_material, signatures_and_data, signature_issuer, calculate_signature_trailer) where
 
 import Control.Monad
 import Data.Bits
-- 
cgit v1.2.3


From 18ef79440155b80414423819888f76fb3bf18469 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 10 Aug 2011 19:10:08 -0500
Subject: make fingerprint_material able to read SecretKeyPacket

---
 Data/OpenPGP.hs | 9 +++++++++
 1 file changed, 9 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index d48dc5e..aded330 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -403,6 +403,15 @@ fingerprint_material (PublicKeyPacket {version = 4,
 	]
 	where material = LZ.concat $
 		map (\f -> encode (key ! f)) (public_key_fields algorithm)
+-- Proxy to make SecretKeyPacket work
+fingerprint_material (SecretKeyPacket {version = 4,
+                      timestamp = timestamp,
+                      key_algorithm = algorithm,
+                      key = key}) =
+	fingerprint_material PublicKeyPacket {version = 4,
+                      timestamp = timestamp,
+                      key_algorithm = algorithm,
+                      key = key}
 fingerprint_material p | version p `elem` [2, 3] = [n, e]
 	where n = LZ.drop 2 (encode (key p ! 'n'))
 	      e = LZ.drop 2 (encode (key p ! 'e'))
-- 
cgit v1.2.3


From 446ba2e70da76d004f955876dba0d060dbe9e0a0 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 10 Aug 2011 19:14:14 -0500
Subject: Ability to sign a message with RSA

---
 Data/OpenPGP/Crypto.hs | 49 ++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 48 insertions(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP/Crypto.hs b/Data/OpenPGP/Crypto.hs
index fee1d55..d4d08c0 100644
--- a/Data/OpenPGP/Crypto.hs
+++ b/Data/OpenPGP/Crypto.hs
@@ -4,13 +4,15 @@
 -- The recommended way to import this module is:
 --
 -- > import qualified Data.OpenPGP.Crypto as OpenPGP
-module Data.OpenPGP.Crypto (verify, fingerprint) where
+module Data.OpenPGP.Crypto (sign, verify, fingerprint) where
 
 import Data.Word
+import Data.List (find)
 import Data.Map ((!))
 import qualified Data.ByteString.Lazy as LZ
 
 import Data.Binary
+import Codec.Utils (fromOctets)
 import qualified Codec.Encryption.RSA as RSA
 import qualified Data.Digest.MD5 as MD5
 import qualified Data.Digest.SHA1 as SHA1
@@ -91,3 +93,48 @@ verify keys message sigidx =
 	sig = sigs !! sigidx
 	(sigs, (OpenPGP.LiteralDataPacket {OpenPGP.content = dta}):_) =
 		OpenPGP.signatures_and_data message
+
+-- | Sign a message.  Only supports RSA keys for now.
+sign :: OpenPGP.Message    -- ^ SecretKeys, one of which will be used
+        -> OpenPGP.Message -- ^ Message containing LiteralData to sign
+        -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use is signature
+        -> String  -- ^ KeyID of key to choose or @[]@ for first
+        -> Integer -- ^ Timestamp to put in signature
+        -> OpenPGP.Message
+sign keys message hsh keyid timestamp =
+	OpenPGP.Message $ (sig' {
+		OpenPGP.signature = OpenPGP.MPI $ toNum $ reverse final,
+		OpenPGP.hash_head = toNum $ take 2 final
+	}):m
+	where
+	-- toNum has explicit param so that it can remain polymorphic
+	toNum l = fromOctets (256::Integer) l
+	final   = RSA.decrypt (n, d) encoded
+	encoded = emsa_pkcs1_v1_5_encode dta (length n) hsh
+	(n, d)  = (keyfield_as_octets k 'n', keyfield_as_octets k 'd')
+	dta     = LZ.unpack $ LZ.append
+		(OpenPGP.content dataP) (OpenPGP.trailer sig')
+	sig'    = sig {
+		OpenPGP.trailer = OpenPGP.calculate_signature_trailer sig
+	}
+	sig     = OpenPGP.SignaturePacket {
+		OpenPGP.version = 4,
+		OpenPGP.key_algorithm = OpenPGP.RSA,
+		OpenPGP.hash_algorithm = hsh,
+		OpenPGP.signature_type = stype,
+		OpenPGP.hashed_subpackets = [
+			OpenPGP.SignatureCreationTimePacket $ fromIntegral timestamp,
+			OpenPGP.IssuerPacket keyid'
+		],
+		OpenPGP.unhashed_subpackets = [],
+		OpenPGP.signature = undefined,
+		OpenPGP.trailer = undefined,
+		OpenPGP.hash_head = undefined
+	}
+	keyid'  = reverse $ take 16 $ reverse $ fingerprint k
+	stype   = if OpenPGP.format dataP == 'b' then 0x00 else 0x01
+	Just k  = find_key keys keyid
+	Just dataP = find isLiteralData m
+	OpenPGP.Message m = message
+	isLiteralData (OpenPGP.LiteralDataPacket {}) = True
+	isLiteralData _                              = False
-- 
cgit v1.2.3


From 531dc4a28554ceaaa495aa02374b559721aa6a9a Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 12 Aug 2011 21:02:53 -0500
Subject: Was encoding/reading MPI backwards

---
 Data/OpenPGP.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index aded330..3693d06 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -513,12 +513,12 @@ instance Binary MPI where
 			+ floor (logBase (2::Double) $ fromIntegral (bytes `LZ.index` 0))
 			+ 1 :: Word16)
 		putLazyByteString bytes
-		where bytes = LZ.unfoldr (\x -> if x == 0 then Nothing
+		where bytes = LZ.reverse $ LZ.unfoldr (\x -> if x == 0 then Nothing
 			else Just (fromIntegral x, x `shiftR` 8)) i
 	get = do
 		length <- fmap fromIntegral (get :: Get Word16)
 		bytes <- getLazyByteString ((length + 7) `div` 8)
-		return (MPI (LZ.foldr (\b a ->
+		return (MPI (LZ.foldl (\a b ->
 			a `shiftL` 8 .|. fromIntegral b) 0 bytes))
 
 data SignatureSubpacket =
-- 
cgit v1.2.3


From 1cc474786194555bec47dd5c061c1bcc5d992952 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 12 Aug 2011 21:03:43 -0500
Subject: Refactor sign to handle keys

Also, now if you pass in a message with a signature packet we'll just
use that one instead of making a default one.

Return value is now just the new/filled-in signature packet, update
example accordingly.
---
 Data/OpenPGP/Crypto.hs | 77 +++++++++++++++++++++++++++++++++++---------------
 examples/sign.hs       | 10 ++++---
 2 files changed, 61 insertions(+), 26 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP/Crypto.hs b/Data/OpenPGP/Crypto.hs
index d4d08c0..15c0d63 100644
--- a/Data/OpenPGP/Crypto.hs
+++ b/Data/OpenPGP/Crypto.hs
@@ -10,6 +10,7 @@ import Data.Word
 import Data.List (find)
 import Data.Map ((!))
 import qualified Data.ByteString.Lazy as LZ
+import qualified Data.ByteString.Lazy.UTF8 as LZ (fromString)
 
 import Data.Binary
 import Codec.Utils (fromOctets)
@@ -77,7 +78,7 @@ emsa_pkcs1_v1_5_encode m emLen algo =
 
 -- | Verify a message signature.  Only supports RSA keys for now.
 verify :: OpenPGP.Message    -- ^ Keys that may have made the signature
-          -> OpenPGP.Message -- ^ Message containing data and signature packet
+          -> OpenPGP.Message -- ^ Message containing data or key to sign, and optional signature packet
           -> Int             -- ^ Index of signature to verify (0th, 1st, etc)
           -> Bool
 verify keys message sigidx =
@@ -94,47 +95,79 @@ verify keys message sigidx =
 	(sigs, (OpenPGP.LiteralDataPacket {OpenPGP.content = dta}):_) =
 		OpenPGP.signatures_and_data message
 
--- | Sign a message.  Only supports RSA keys for now.
+-- | Sign data or key/userID pair.  Only supports RSA keys for now.
 sign :: OpenPGP.Message    -- ^ SecretKeys, one of which will be used
         -> OpenPGP.Message -- ^ Message containing LiteralData to sign
         -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use is signature
         -> String  -- ^ KeyID of key to choose or @[]@ for first
-        -> Integer -- ^ Timestamp to put in signature
-        -> OpenPGP.Message
+        -> Integer -- ^ Timestamp for signature (unless sig supplied)
+        -> OpenPGP.Packet
 sign keys message hsh keyid timestamp =
-	OpenPGP.Message $ (sig' {
-		OpenPGP.signature = OpenPGP.MPI $ toNum $ reverse final,
+	sig {
+		OpenPGP.signature = OpenPGP.MPI $ toNum final,
 		OpenPGP.hash_head = toNum $ take 2 final
-	}):m
+	}
 	where
 	-- toNum has explicit param so that it can remain polymorphic
 	toNum l = fromOctets (256::Integer) l
-	final   = RSA.decrypt (n, d) encoded
+	final   = dropWhile (==0) $ RSA.decrypt (n, d) encoded
 	encoded = emsa_pkcs1_v1_5_encode dta (length n) hsh
 	(n, d)  = (keyfield_as_octets k 'n', keyfield_as_octets k 'd')
-	dta     = LZ.unpack $ LZ.append
-		(OpenPGP.content dataP) (OpenPGP.trailer sig')
-	sig'    = sig {
-		OpenPGP.trailer = OpenPGP.calculate_signature_trailer sig
-	}
-	sig     = OpenPGP.SignaturePacket {
-		OpenPGP.version = 4,
+	dta     = LZ.unpack $ case signOver of {
+		OpenPGP.LiteralDataPacket {OpenPGP.content = c} -> c;
+		_ -> LZ.concat $ OpenPGP.fingerprint_material signOver ++ [
+			LZ.singleton 0xB4,
+			encode (fromIntegral (length firstUserID) :: Word32),
+			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,
-		OpenPGP.signature_type = stype,
+		OpenPGP.hash_algorithm = hsh
+	} in s { OpenPGP.trailer = OpenPGP.calculate_signature_trailer s }
+
+	-- 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 = [
+			-- 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
 	}
+
 	keyid'  = reverse $ take 16 $ reverse $ fingerprint k
-	stype   = if OpenPGP.format dataP == 'b' then 0x00 else 0x01
 	Just k  = find_key keys keyid
-	Just dataP = find isLiteralData m
+
+	Just (OpenPGP.UserIDPacket firstUserID) = find isUserID m
+
+	defaultStype = case signOver of
+		OpenPGP.LiteralDataPacket {OpenPGP.format = f} ->
+			if f == 'b' then 0x00 else 0x01
+		_ -> 0x13
+
+	Just signOver = find isSignable m
 	OpenPGP.Message m = message
-	isLiteralData (OpenPGP.LiteralDataPacket {}) = True
-	isLiteralData _                              = False
+
+	isSignable (OpenPGP.LiteralDataPacket {}) = True
+	isSignable (OpenPGP.PublicKeyPacket {})   = True
+	isSignable (OpenPGP.SecretKeyPacket {})   = True
+	isSignable _                              = False
+
+	isSignature (OpenPGP.SignaturePacket {})  = True
+	isSignature _                             = False
+
+	isUserID (OpenPGP.UserIDPacket {})        = True
+	isUserID _                                = False
diff --git a/examples/sign.hs b/examples/sign.hs
index 8fc9352..e8bea1a 100644
--- a/examples/sign.hs
+++ b/examples/sign.hs
@@ -14,8 +14,10 @@ main = do
 	time <- getClockTime
 	let TOD t _ = time
 	keys <- decodeFile (argv !! 0)
+	let dataPacket = OpenPGP.LiteralDataPacket 'u' "t.txt"
+			(fromIntegral t) (LZ.fromString "This is a message.")
 	let message = OpenPGP.Message [
-		OpenPGP.LiteralDataPacket 'u' "t.txt" (fromIntegral t)
-			(LZ.fromString "This is a message.") ]
-	LZ.putStr $ encode $
-		OpenPGP.sign keys message OpenPGP.SHA256 [] (fromIntegral t)
+		OpenPGP.sign keys (OpenPGP.Message [dataPacket])
+			OpenPGP.SHA256 [] (fromIntegral t),
+		dataPacket]
+	LZ.putStr $ encode message
-- 
cgit v1.2.3


From db1701628091dbfe16a9b122d2bfe26b10831aa4 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 12 Aug 2011 21:12:05 -0500
Subject: docs typos

---
 Data/OpenPGP/Crypto.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP/Crypto.hs b/Data/OpenPGP/Crypto.hs
index 15c0d63..c213651 100644
--- a/Data/OpenPGP/Crypto.hs
+++ b/Data/OpenPGP/Crypto.hs
@@ -78,7 +78,7 @@ emsa_pkcs1_v1_5_encode m emLen algo =
 
 -- | Verify a message signature.  Only supports RSA keys for now.
 verify :: OpenPGP.Message    -- ^ Keys that may have made the signature
-          -> OpenPGP.Message -- ^ Message containing data or key to sign, and optional signature packet
+          -> OpenPGP.Message -- ^ LiteralData message to verify
           -> Int             -- ^ Index of signature to verify (0th, 1st, etc)
           -> Bool
 verify keys message sigidx =
@@ -97,7 +97,7 @@ verify keys message sigidx =
 
 -- | Sign data or key/userID pair.  Only supports RSA keys for now.
 sign :: OpenPGP.Message    -- ^ SecretKeys, one of which will be used
-        -> OpenPGP.Message -- ^ Message containing LiteralData to sign
+        -> OpenPGP.Message -- ^ Message containing data or key to sign, and optional signature packet
         -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use is signature
         -> String  -- ^ KeyID of key to choose or @[]@ for first
         -> Integer -- ^ Timestamp for signature (unless sig supplied)
-- 
cgit v1.2.3


From cb5c1644b6540939e8d5aa1b8fef80b797577166 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Tue, 24 Apr 2012 09:05:28 -0500
Subject: some formatting cleanup

---
 Data/OpenPGP.hs | 54 +++++++++++++++++++++++++++++++-----------------------
 1 file changed, 31 insertions(+), 23 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 3693d06..affc940 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -83,7 +83,8 @@ instance Binary Packet where
 		put (255 :: Word8)
 		put ((fromIntegral $ LZ.length body) :: Word32)
 		putLazyByteString body
-		where (body, tag) = put_packet p
+		where
+		(body, tag) = put_packet p
 	get = do
 		tag <- get :: Get Word8
 		let (t, l) =
@@ -162,7 +163,8 @@ signature_packet_start (SignaturePacket {
 		encode ((fromIntegral $ LZ.length hashed_subs) :: Word16),
 		hashed_subs
 	]
-	where hashed_subs = LZ.concat $ map encode hashed_subpackets
+	where
+	hashed_subs = LZ.concat $ map encode hashed_subpackets
 signature_packet_start _ =
 	error "Trying to get start of signature packet for non signature packet."
 
@@ -192,8 +194,9 @@ put_packet (SignaturePacket { version = 4,
 	            encode (fromIntegral $ LZ.length unhashed :: Word16),
 	            unhashed,
 	            encode hash_head, encode signature ], 2)
-	where hashed   = LZ.concat $ map encode hashed_subpackets
-	      unhashed = LZ.concat $ map encode unhashed_subpackets
+	where
+	hashed   = LZ.concat $ map encode hashed_subpackets
+	unhashed = LZ.concat $ map encode unhashed_subpackets
 put_packet (OnePassSignaturePacket { version = version,
                                      signature_type = signature_type,
                                      hash_algorithm = hash_algorithm,
@@ -228,14 +231,13 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
 			LZ.foldl (\c i -> (c + fromIntegral i) `mod` 65536)
 			(0::Integer) (LZ.concat s) :: Word16)]), 5)
 	where
-	p = fst (put_packet $
-		PublicKeyPacket version timestamp algorithm key
+	p = fst (put_packet $ PublicKeyPacket version timestamp algorithm key
 		:: (LZ.ByteString, Integer)) -- Supress warning
 	s = map (encode . (key !)) (secret_key_fields algorithm)
 put_packet (PublicKeyPacket { version = 4, timestamp = timestamp,
                               key_algorithm = algorithm, key = key }) =
 	(LZ.concat $ [LZ.singleton 4, encode timestamp, encode algorithm] ++
-	            map (encode . (key !)) (public_key_fields algorithm), 6)
+		map (encode . (key !)) (public_key_fields algorithm), 6)
 put_packet (CompressedDataPacket { compression_algorithm = algorithm,
                                    message = message }) =
 	(LZ.append (encode algorithm) $ compress $ encode message, 8)
@@ -401,8 +403,9 @@ fingerprint_material (PublicKeyPacket {version = 4,
 		LZ.singleton 4, encode timestamp, encode algorithm,
 		material
 	]
-	where material = LZ.concat $
-		map (\f -> encode (key ! f)) (public_key_fields algorithm)
+	where
+	material =
+		LZ.concat $ map (encode . (key !)) (public_key_fields algorithm)
 -- Proxy to make SecretKeyPacket work
 fingerprint_material (SecretKeyPacket {version = 4,
                       timestamp = timestamp,
@@ -413,8 +416,9 @@ fingerprint_material (SecretKeyPacket {version = 4,
                       key_algorithm = algorithm,
                       key = key}
 fingerprint_material p | version p `elem` [2, 3] = [n, e]
-	where n = LZ.drop 2 (encode (key p ! 'n'))
-	      e = LZ.drop 2 (encode (key p ! 'e'))
+	where
+	n = LZ.drop 2 (encode (key p ! 'n'))
+	e = LZ.drop 2 (encode (key p ! 'e'))
 fingerprint_material _ =
 	error "Unsupported Packet version or type in fingerprint_material."
 
@@ -489,11 +493,10 @@ instance Binary Message where
 		put (Message xs)
 	get = do
 		done <- isEmpty
-		if done then return (Message []) else do {
-			next_packet <- get :: Get Packet;
-			(Message tail) <- get :: Get Message;
-			return (Message (next_packet:tail));
-		}
+		if done then return (Message []) else do
+			next_packet <- get
+			(Message tail) <- get
+			return (Message (next_packet:tail))
 
 -- | Extract all signature and data packets from a 'Message'
 signatures_and_data :: Message -> ([Packet], [Packet])
@@ -501,10 +504,11 @@ signatures_and_data (Message ((CompressedDataPacket {message = m}):_)) =
 	signatures_and_data m
 signatures_and_data (Message lst) =
 	(filter isSig lst, filter isDta lst)
-	where isSig (SignaturePacket {}) = True
-	      isSig _ = False
-	      isDta (LiteralDataPacket {}) = True
-	      isDta _ = False
+	where
+	isSig (SignaturePacket {}) = True
+	isSig _ = False
+	isDta (LiteralDataPacket {}) = True
+	isDta _ = False
 
 newtype MPI = MPI Integer deriving (Show, Read, Eq, Ord)
 instance Binary MPI where
@@ -513,8 +517,11 @@ instance Binary MPI where
 			+ floor (logBase (2::Double) $ fromIntegral (bytes `LZ.index` 0))
 			+ 1 :: Word16)
 		putLazyByteString bytes
-		where bytes = LZ.reverse $ LZ.unfoldr (\x -> if x == 0 then Nothing
-			else Just (fromIntegral x, x `shiftR` 8)) i
+		where
+		bytes = LZ.reverse $ LZ.unfoldr (\x ->
+				if x == 0 then Nothing else
+					Just (fromIntegral x, x `shiftR` 8)
+			) i
 	get = do
 		length <- fmap fromIntegral (get :: Get Word16)
 		bytes <- getLazyByteString ((length + 7) `div` 8)
@@ -533,7 +540,8 @@ instance Binary SignatureSubpacket where
 		put (fromIntegral (LZ.length body) + 1 :: Word32)
 		put tag
 		putLazyByteString body
-		where (body, tag) = put_signature_subpacket p
+		where
+		(body, tag) = put_signature_subpacket p
 	get = do
 		len <- fmap fromIntegral (get :: Get Word8)
 		len <- case len of
-- 
cgit v1.2.3


From 7d75d59b4c089f0a9ef2a3cccd099b3a3a847a7e Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Tue, 24 Apr 2012 13:04:07 -0500
Subject: Unknown algorithms and Enum

Closes #6
Closes #7
---
 Data/OpenPGP.hs | 144 +++++++++++++++++++++++++++++++-------------------------
 1 file changed, 81 insertions(+), 63 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index affc940..e0361a7 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -241,11 +241,13 @@ put_packet (PublicKeyPacket { version = 4, timestamp = timestamp,
 put_packet (CompressedDataPacket { compression_algorithm = algorithm,
                                    message = message }) =
 	(LZ.append (encode algorithm) $ compress $ encode message, 8)
-	where compress = case algorithm of
+	where
+	compress = case algorithm of
 		Uncompressed -> id
-		ZIP -> Zip.compress
-		ZLIB -> Zlib.compress
-		BZip2 -> BZip2.compress
+		ZIP          -> Zip.compress
+		ZLIB         -> Zlib.compress
+		BZip2        -> BZip2.compress
+		x            -> error ("No implementation for " ++ show x)
 put_packet (LiteralDataPacket { format = format, filename = filename,
                                 timestamp = timestamp, content = content
                               }) =
@@ -365,9 +367,10 @@ parse_packet  8 = do
 	message <- getRemainingLazyByteString
 	let decompress = case algorithm of
 		Uncompressed -> id
-		ZIP -> Zip.decompress
-		ZLIB -> Zlib.decompress
-		BZip2 -> BZip2.decompress
+		ZIP          -> Zip.decompress
+		ZLIB         -> Zlib.decompress
+		BZip2        -> BZip2.decompress
+		x            -> error ("No implementation for " ++ show x)
 	return CompressedDataPacket {
 		compression_algorithm = algorithm,
 		message = runGet (get :: Get Message) (decompress message)
@@ -422,67 +425,82 @@ fingerprint_material p | version p `elem` [2, 3] = [n, e]
 fingerprint_material _ =
 	error "Unsupported Packet version or type in fingerprint_material."
 
-data HashAlgorithm = MD5 | SHA1 | RIPEMD160 | SHA256 | SHA384 | SHA512 | SHA224
+enum_to_word8 :: (Enum a) => a -> Word8
+enum_to_word8 = fromIntegral . fromEnum
+
+enum_from_word8 :: (Enum a) => Word8 -> a
+enum_from_word8 = toEnum . fromIntegral
+
+data HashAlgorithm = MD5 | SHA1 | RIPEMD160 | SHA256 | SHA384 | SHA512 | SHA224 | HashAlgorithm Word8
 	deriving (Show, Read, Eq)
+
+instance Enum HashAlgorithm where
+	toEnum 01 = MD5
+	toEnum 02 = SHA1
+	toEnum 03 = RIPEMD160
+	toEnum 08 = SHA256
+	toEnum 09 = SHA384
+	toEnum 10 = SHA512
+	toEnum 11 = SHA224
+	toEnum x  = HashAlgorithm $ fromIntegral x
+	fromEnum MD5       = 01
+	fromEnum SHA1      = 02
+	fromEnum RIPEMD160 = 03
+	fromEnum SHA256    = 08
+	fromEnum SHA384    = 09
+	fromEnum SHA512    = 10
+	fromEnum SHA224    = 11
+	fromEnum (HashAlgorithm x) = fromIntegral x
+
 instance Binary HashAlgorithm where
-	put MD5       = put (01 :: Word8)
-	put SHA1      = put (02 :: Word8)
-	put RIPEMD160 = put (03 :: Word8)
-	put SHA256    = put (08 :: Word8)
-	put SHA384    = put (09 :: Word8)
-	put SHA512    = put (10 :: Word8)
-	put SHA224    = put (11 :: Word8)
-	get = do
-		tag <- get :: Get Word8
-		case tag of
-			01 -> return MD5
-			02 -> return SHA1
-			03 -> return RIPEMD160
-			08 -> return SHA256
-			09 -> return SHA384
-			10 -> return SHA512
-			11 -> return SHA224
-			x  -> fail $ "Unknown HashAlgorithm " ++ show x ++ "."
-
-data KeyAlgorithm = RSA | RSA_E | RSA_S | ELGAMAL | DSA | ECC | ECDSA | DH
+	put = put . enum_to_word8
+	get = fmap enum_from_word8 get
+
+data KeyAlgorithm = RSA | RSA_E | RSA_S | ELGAMAL | DSA | ECC | ECDSA | DH | KeyAlgorithm Word8
 	deriving (Show, Read, Eq)
+
+instance Enum KeyAlgorithm where
+	toEnum 01 = RSA
+	toEnum 02 = RSA_E
+	toEnum 03 = RSA_S
+	toEnum 16 = ELGAMAL
+	toEnum 17 = DSA
+	toEnum 18 = ECC
+	toEnum 19 = ECDSA
+	toEnum 21 = DH
+	toEnum x  = KeyAlgorithm $ fromIntegral x
+	fromEnum RSA     = 01
+	fromEnum RSA_E   = 02
+	fromEnum RSA_S   = 03
+	fromEnum ELGAMAL = 16
+	fromEnum DSA     = 17
+	fromEnum ECC     = 18
+	fromEnum ECDSA   = 19
+	fromEnum DH      = 21
+	fromEnum (KeyAlgorithm x) = fromIntegral x
+
 instance Binary KeyAlgorithm where
-	put RSA     = put (01 :: Word8)
-	put RSA_E   = put (02 :: Word8)
-	put RSA_S   = put (03 :: Word8)
-	put ELGAMAL = put (16 :: Word8)
-	put DSA     = put (17 :: Word8)
-	put ECC     = put (18 :: Word8)
-	put ECDSA   = put (19 :: Word8)
-	put DH      = put (21 :: Word8)
-	get = do
-		tag <- get :: Get Word8
-		case tag of
-			01 -> return RSA
-			02 -> return RSA_E
-			03 -> return RSA_S
-			16 -> return ELGAMAL
-			17 -> return DSA
-			18 -> return ECC
-			19 -> return ECDSA
-			21 -> return DH
-			x  -> fail $ "Unknown KeyAlgorithm " ++ show x ++ "."
-
-data CompressionAlgorithm = Uncompressed | ZIP | ZLIB | BZip2
+	put = put . enum_to_word8
+	get = fmap enum_from_word8 get
+
+data CompressionAlgorithm = Uncompressed | ZIP | ZLIB | BZip2 | CompressionAlgorithm Word8
 	deriving (Show, Read, Eq)
+
+instance Enum CompressionAlgorithm where
+	toEnum 0 = Uncompressed
+	toEnum 1 = ZIP
+	toEnum 2 = ZLIB
+	toEnum 3 = BZip2
+	toEnum x = CompressionAlgorithm $ fromIntegral x
+	fromEnum Uncompressed = 0
+	fromEnum ZIP          = 1
+	fromEnum ZLIB         = 2
+	fromEnum BZip2        = 3
+	fromEnum (CompressionAlgorithm x) = fromIntegral x
+
 instance Binary CompressionAlgorithm where
-	put Uncompressed = put (0 :: Word8)
-	put ZIP          = put (1 :: Word8)
-	put ZLIB         = put (2 :: Word8)
-	put BZip2        = put (3 :: Word8)
-	get = do
-		tag <- get :: Get Word8
-		case tag of
-			0 -> return Uncompressed
-			1 -> return ZIP
-			2 -> return ZLIB
-			3 -> return BZip2
-			x  -> fail $ "Unknown CompressionAlgorithm " ++ show x ++ "."
+	put = put . enum_to_word8
+	get = fmap enum_from_word8 get
 
 -- A message is encoded as a list that takes the entire file
 newtype Message = Message [Packet] deriving (Show, Read, Eq)
@@ -496,7 +514,7 @@ instance Binary Message where
 		if done then return (Message []) else do
 			next_packet <- get
 			(Message tail) <- get
-			return (Message (next_packet:tail))
+			return $ Message (next_packet:tail)
 
 -- | Extract all signature and data packets from a 'Message'
 signatures_and_data :: Message -> ([Packet], [Packet])
-- 
cgit v1.2.3


From 31e12ded73e1bf58ab565e99ab32884cde8e2c8e Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Tue, 24 Apr 2012 16:03:02 -0500
Subject: private_hash may be inside the encrypted blob

---
 Data/OpenPGP.hs | 21 +++++++++++----------
 1 file changed, 11 insertions(+), 10 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index e0361a7..233ff68 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -60,7 +60,7 @@ data Packet =
 		s2k_salt::Word64,
 		s2k_count::Word8,
 		encrypted_data::LZ.ByteString,
-		private_hash::LZ.ByteString
+		private_hash::Maybe LZ.ByteString -- the hash may be in the encrypted data
 	} |
 	CompressedDataPacket {
 		compression_algorithm::CompressionAlgorithm,
@@ -223,13 +223,14 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
 	else []) ++
 	(if s2k_useage > 0 then
 		[encrypted_data]
-	else s) ++
-	(if s2k_useage == 254 then
-		[LZ.replicate 20 0] -- TODO SHA1 Checksum
-	else
-		[encode (fromIntegral $
-			LZ.foldl (\c i -> (c + fromIntegral i) `mod` 65536)
-			(0::Integer) (LZ.concat s) :: Word16)]), 5)
+	else s ++
+		-- XXX: Checksum is part of encrypted_data for V4 ONLY
+		if s2k_useage == 254 then
+			[LZ.replicate 20 0] -- TODO SHA1 Checksum
+		else
+			[encode (fromIntegral $
+				LZ.foldl (\c i -> (c + fromIntegral i) `mod` 65536)
+				(0::Integer) (LZ.concat s) :: Word16)]), 5)
 	where
 	p = fst (put_packet $ PublicKeyPacket version timestamp algorithm key
 		:: (LZ.ByteString, Integer)) -- Supress warning
@@ -337,13 +338,13 @@ parse_packet  5 = do
 			return (k undefined undefined undefined undefined undefined)
 	if s2k_useage > 0 then do {
 		encrypted <- getRemainingLazyByteString;
-		return (k' encrypted undefined)
+		return (k' encrypted Nothing)
 	} else do
 		key <- foldM (\m f -> do
 			mpi <- get :: Get MPI
 			return $ Map.insert f mpi m) key (secret_key_fields algorithm)
 		private_hash <- getRemainingLazyByteString
-		return ((k' undefined private_hash) {key = key})
+		return ((k' undefined (Just private_hash)) {key = key})
 -- PublicKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.2
 parse_packet  6 = do
 	version <- get :: Get Word8
-- 
cgit v1.2.3


From d13c748885a3d637ee659b94892e1622127e67a6 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Tue, 24 Apr 2012 16:03:21 -0500
Subject: actually handle encoding s2k count

---
 Data/OpenPGP.hs | 32 +++++++++++++++++++++++---------
 1 file changed, 23 insertions(+), 9 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 233ff68..3e3eb9e 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -3,7 +3,7 @@
 -- 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) where
+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
 
 import Control.Monad
 import Data.Bits
@@ -58,7 +58,7 @@ data Packet =
 		s2k_type::Word8,
 		s2k_hash_algorithm::HashAlgorithm,
 		s2k_salt::Word64,
-		s2k_count::Word8,
+		s2k_count::Word32,
 		encrypted_data::LZ.ByteString,
 		private_hash::Maybe LZ.ByteString -- the hash may be in the encrypted data
 	} |
@@ -214,12 +214,13 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
                               s2k_type = s2k_type,
                               s2k_hash_algorithm = s2k_hash_algo,
                               s2k_salt = s2k_salt,
+                              s2k_count = s2k_count,
                               encrypted_data = encrypted_data }) =
 	(LZ.concat $ [p, encode s2k_useage] ++
 	(if s2k_useage `elem` [255, 254] then
-		-- TODO: if s2k_type == 3 reverse ugly bit manipulation
 		[encode symmetric_type, encode s2k_type, encode s2k_hash_algo] ++
-		if s2k_type `elem` [1, 3] then [encode s2k_salt] else []
+		(if s2k_type `elem` [1, 3] then [encode s2k_salt] else []) ++
+		if s2k_type == 3 then [encode $ encode_s2k_count s2k_count] else []
 	else []) ++
 	(if s2k_useage > 0 then
 		[encrypted_data]
@@ -324,11 +325,8 @@ parse_packet  5 = do
 			s2k_hash_algorithm <- get
 			s2k_salt <- if s2k_type `elem` [1, 3] then get
 				else return undefined
-			s2k_count <- if s2k_type == 3 then do
-				c <- fmap fromIntegral (get :: Get Word8)
-				return $ fromIntegral $
-					(16 + (c .&. 15)) `shiftL` ((c `shiftR` 4) + 6)
-				else return undefined
+			s2k_count <- if s2k_type == 3 then fmap decode_s2k_count get else
+				return undefined
 			return (k symmetric_type s2k_type s2k_hash_algorithm
 				s2k_salt s2k_count)
 		_ | s2k_useage > 0 ->
@@ -612,3 +610,19 @@ parse_signature_subpacket 16 = do
 -- Fail nicely for unimplemented packets
 parse_signature_subpacket x =
 	fail $ "Unimplemented OpenPGP signature subpacket tag " ++ show x ++ "."
+
+decode_s2k_count :: Word8 -> Word32
+decode_s2k_count c =  (16 + (fromIntegral c .&. 15)) `shiftL`
+	((fromIntegral c `shiftR` 4) + 6)
+
+encode_s2k_count :: Word32 -> Word8
+encode_s2k_count iterations
+	| iterations >= 65011712 = 255
+	| decode_s2k_count result < iterations = result+1
+	| otherwise = result
+	where
+	result = fromIntegral $ (fromIntegral c `shiftL` 4) .|. (count - 16)
+	(count, c) = encode_s2k_count' (iterations `shiftR` 6) 0
+	encode_s2k_count' count c
+		| count < 32 = (count, c)
+		| otherwise = encode_s2k_count' (count `shiftR` 1) (c+1)
-- 
cgit v1.2.3


From a47e1ba41aef9276d7654e602fd7445cad0e1355 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Tue, 24 Apr 2012 17:49:43 -0500
Subject: suppress warning

---
 Data/OpenPGP.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 3e3eb9e..bab48a4 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -622,7 +622,7 @@ encode_s2k_count iterations
 	| otherwise = result
 	where
 	result = fromIntegral $ (fromIntegral c `shiftL` 4) .|. (count - 16)
-	(count, c) = encode_s2k_count' (iterations `shiftR` 6) 0
+	(count, c) = encode_s2k_count' (iterations `shiftR` 6) (0::Word8)
 	encode_s2k_count' count c
 		| count < 32 = (count, c)
 		| otherwise = encode_s2k_count' (count `shiftR` 1) (c+1)
-- 
cgit v1.2.3


From 4df371631b16d753dd262171ec82c3ebaea42a10 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Tue, 24 Apr 2012 17:50:08 -0500
Subject: Represent unsupported packets and subpackets by their literal bytes

---
 Data/OpenPGP.hs | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index bab48a4..be50d1a 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -72,7 +72,8 @@ data Packet =
 		timestamp::Word32,
 		content::LZ.ByteString
 	} |
-	UserIDPacket String
+	UserIDPacket String |
+	UnsupportedPacket Word8 LZ.ByteString
 	deriving (Show, Read, Eq)
 
 instance Binary Packet where
@@ -259,6 +260,7 @@ put_packet (LiteralDataPacket { format = format, filename = filename,
 	filename_l  = (fromIntegral $ LZ.length lz_filename) :: Word8
 	lz_filename = LZ.fromString filename
 put_packet (UserIDPacket txt) = (LZ.fromString txt, 13)
+put_packet (UnsupportedPacket tag bytes) = (bytes, fromIntegral tag)
 put_packet _ = error "Unsupported Packet version or type in put_packet."
 
 parse_packet :: Word8 -> Get Packet
@@ -390,8 +392,8 @@ parse_packet 11 = do
 -- UserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.11
 parse_packet 13 =
 	fmap (UserIDPacket . LZ.toString) getRemainingLazyByteString
--- Fail nicely for unimplemented packets
-parse_packet x = fail $ "Unimplemented OpenPGP packet tag " ++ show x ++ "."
+-- Represent unsupported packets as their tag and literal bytes
+parse_packet tag = fmap (UnsupportedPacket tag) getRemainingLazyByteString
 
 -- | Helper method for fingerprints and such
 fingerprint_material :: Packet -> [LZ.ByteString]
@@ -547,7 +549,8 @@ instance Binary MPI where
 
 data SignatureSubpacket =
 	SignatureCreationTimePacket Word32 |
-	IssuerPacket String
+	IssuerPacket String |
+	UnsupportedSignatureSubpacket Word8 LZ.ByteString
 	deriving (Show, Read, Eq)
 
 instance Binary SignatureSubpacket where
@@ -590,6 +593,8 @@ put_signature_subpacket (SignatureCreationTimePacket time) =
 	(encode time, 2)
 put_signature_subpacket (IssuerPacket keyid) =
 	(encode (BaseConvert.toNum 16 keyid :: Word64), 16)
+put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
+	(bytes, tag)
 
 get_signature_subpackets :: Get [SignatureSubpacket]
 get_signature_subpackets = do
@@ -607,9 +612,9 @@ parse_signature_subpacket  2 = fmap SignatureCreationTimePacket get
 parse_signature_subpacket 16 = do
 	keyid <- get :: Get Word64
 	return $ IssuerPacket (BaseConvert.toString 16 keyid)
--- Fail nicely for unimplemented packets
-parse_signature_subpacket x =
-	fail $ "Unimplemented OpenPGP signature subpacket tag " ++ show x ++ "."
+-- Represent unsupported packets as their tag and literal bytes
+parse_signature_subpacket tag =
+	fmap (UnsupportedSignatureSubpacket tag) getRemainingLazyByteString
 
 decode_s2k_count :: Word8 -> Word32
 decode_s2k_count c =  (16 + (fromIntegral c .&. 15)) `shiftL`
-- 
cgit v1.2.3


From ecc7c859118e022b1f3d8fff5b74702d4c0bab71 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Tue, 24 Apr 2012 17:51:02 -0500
Subject: Some fixes for signature verification

---
 Data/OpenPGP/Crypto.hs | 13 ++++++++-----
 tests/suite.hs         | 15 +++++++++++++++
 2 files changed, 23 insertions(+), 5 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP/Crypto.hs b/Data/OpenPGP/Crypto.hs
index c213651..f9d1074 100644
--- a/Data/OpenPGP/Crypto.hs
+++ b/Data/OpenPGP/Crypto.hs
@@ -40,13 +40,16 @@ find_key (OpenPGP.Message (x@(OpenPGP.PublicKeyPacket {}):xs)) keyid =
 	find_key_ x xs keyid
 find_key (OpenPGP.Message (x@(OpenPGP.SecretKeyPacket {}):xs)) keyid =
 	find_key_ x xs keyid
+find_key (OpenPGP.Message (_:xs)) keyid =
+	find_key (OpenPGP.Message xs) keyid
 find_key _ _ = Nothing
 
 find_key_ :: OpenPGP.Packet -> [OpenPGP.Packet] -> String -> Maybe OpenPGP.Packet
-find_key_ x xs keyid =
-	if thisid == keyid then Just x else find_key (OpenPGP.Message xs) keyid
-	where thisid = reverse $
-		take (length keyid) (reverse (fingerprint x))
+find_key_ x xs keyid
+	| thisid == keyid = Just x
+	| otherwise = find_key (OpenPGP.Message xs) keyid
+	where
+	thisid = reverse $ take (length keyid) (reverse (fingerprint x))
 
 keyfield_as_octets :: OpenPGP.Packet -> Char -> [Word8]
 keyfield_as_octets k f =
@@ -65,7 +68,7 @@ emsa_pkcs1_v1_5_hash_padding _ =
 
 hash :: OpenPGP.HashAlgorithm -> [Word8] -> [Word8]
 hash OpenPGP.MD5 = MD5.hash
-hash OpenPGP.SHA1 = reverse . drop 2 . LZ.unpack . encode . OpenPGP.MPI . SHA1.toInteger . SHA1.hash
+hash OpenPGP.SHA1 = drop 2 . LZ.unpack . encode . OpenPGP.MPI . SHA1.toInteger . SHA1.hash
 hash OpenPGP.SHA256 = SHA256.hash
 hash OpenPGP.SHA384 = SHA384.hash
 hash OpenPGP.SHA512 = SHA512.hash
diff --git a/tests/suite.hs b/tests/suite.hs
index 59b9c03..d1b232c 100644
--- a/tests/suite.hs
+++ b/tests/suite.hs
@@ -29,6 +29,13 @@ testFingerprint fp kf = do
 	let (OpenPGP.Message [packet]) = decode bs
 	assertEqual ("for " ++ fp) kf (OpenPGP.fingerprint packet)
 
+testVerifyMessage :: FilePath -> FilePath -> Assertion
+testVerifyMessage keyring message = do
+	keys <- fmap decode $ LZ.readFile $ "tests/data/" ++ keyring
+	m <- fmap decode $ LZ.readFile $ "tests/data/" ++ message
+	let verification = OpenPGP.verify keys m 0
+	assertEqual (keyring ++ " for " ++ message) True verification
+
 prop_s2k_count :: Word8 -> Bool
 prop_s2k_count c =
 	c == OpenPGP.encode_s2k_count (OpenPGP.decode_s2k_count c)
@@ -130,6 +137,14 @@ tests =
 			testCase "000027-006.public_key" (testFingerprint "000027-006.public_key" "1EB20B2F5A5CC3BEAFD6E5CB7732CF988A63EA86"),
 			testCase "000035-006.public_key" (testFingerprint "000035-006.public_key" "CB7933459F59C70DF1C3FBEEDEDC3ECF689AF56D")
 		],
+		testGroup "Message verification group" [
+			--testCase "uncompressed-ops-dsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-dsa.gpg"),
+			--testCase "uncompressed-ops-dsa-sha384" (testVerifyMessage "pubring.gpg" "uncompressed-ops-dsa-sha384.txt.gpg"),
+			testCase "uncompressed-ops-rsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-rsa.gpg"),
+			testCase "compressedsig" (testVerifyMessage "pubring.gpg" "compressedsig.gpg"),
+			testCase "compressedsig-zlib" (testVerifyMessage "pubring.gpg" "compressedsig-zlib.gpg"),
+			testCase "compressedsig-bzip2" (testVerifyMessage "pubring.gpg" "compressedsig-bzip2.gpg")
+		],
 		testGroup "S2K count" [
 			testProperty "S2K count encode reverses decode" prop_s2k_count
 		]
-- 
cgit v1.2.3


From fb1dc48bcf701e0878730b279522ee810f548521 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Tue, 24 Apr 2012 18:12:59 -0500
Subject: typo in comment

---
 Data/OpenPGP/Crypto.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP/Crypto.hs b/Data/OpenPGP/Crypto.hs
index f9d1074..b34c395 100644
--- a/Data/OpenPGP/Crypto.hs
+++ b/Data/OpenPGP/Crypto.hs
@@ -101,7 +101,7 @@ verify keys message sigidx =
 -- | Sign data or key/userID pair.  Only supports RSA keys for now.
 sign :: OpenPGP.Message    -- ^ SecretKeys, one of which will be used
         -> OpenPGP.Message -- ^ Message containing data or key to sign, and optional signature packet
-        -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use is signature
+        -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature
         -> String  -- ^ KeyID of key to choose or @[]@ for first
         -> Integer -- ^ Timestamp for signature (unless sig supplied)
         -> OpenPGP.Packet
-- 
cgit v1.2.3


From da82b6a356e6a1571047fdea15d26ec10c869fa4 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 25 Apr 2012 11:11:09 -0500
Subject: 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
---
 Data/OpenPGP.hs        | 79 +++++++++++++++++++++++++++++++++++++++++---------
 Data/OpenPGP/Crypto.hs | 43 +++++++++++++--------------
 tests/suite.hs         | 68 +++++++++++++++++++++----------------------
 3 files changed, 121 insertions(+), 69 deletions(-)

(limited to 'Data')

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"),
-- 
cgit v1.2.3


From b3a00a8206490fdf92762b1db86a06348582b4f7 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 25 Apr 2012 11:17:44 -0500
Subject: s2k values are really optional, not undefined

Should they be grouped in some way?
Should encrypted_data also be grouped with them in some way?
---
 Data/OpenPGP.hs | 32 ++++++++++++++++++--------------
 tests/suite.hs  |  2 +-
 2 files changed, 19 insertions(+), 15 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index d950570..b77b36d 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -48,6 +48,7 @@ module Data.OpenPGP (
 import Control.Monad
 import Data.Bits
 import Data.Word
+import Data.Maybe
 import Data.Map (Map, (!))
 import qualified Data.Map as Map
 import qualified Data.ByteString.Lazy as LZ
@@ -93,12 +94,12 @@ data Packet =
 		timestamp::Word32,
 		key_algorithm::KeyAlgorithm,
 		key::Map Char MPI,
-		s2k_useage::Word8,
-		symmetric_type::Word8,
-		s2k_type::Word8,
-		s2k_hash_algorithm::HashAlgorithm,
-		s2k_salt::Word64,
-		s2k_count::Word32,
+		s2k_useage::Word8, -- determines if the Maybes are Just or Nothing
+		symmetric_type::Maybe Word8,
+		s2k_type::Maybe Word8,
+		s2k_hash_algorithm::Maybe HashAlgorithm,
+		s2k_salt::Maybe Word64,
+		s2k_count::Maybe Word32,
 		encrypted_data::LZ.ByteString,
 		private_hash::Maybe LZ.ByteString -- the hash may be in the encrypted data
 	} |
@@ -253,9 +254,11 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
                               encrypted_data = encrypted_data }) =
 	(LZ.concat $ [p, encode s2k_useage] ++
 	(if s2k_useage `elem` [255, 254] then
-		[encode symmetric_type, encode s2k_type, encode s2k_hash_algo] ++
-		(if s2k_type `elem` [1, 3] then [encode s2k_salt] else []) ++
-		if s2k_type == 3 then [encode $ encode_s2k_count s2k_count] else []
+		[encode $ fromJust symmetric_type, encode s2k_t,
+		 encode $ fromJust s2k_hash_algo] ++
+		(if s2k_t `elem` [1,3] then [encode $ fromJust s2k_salt] else []) ++
+		if s2k_t == 3 then
+			[encode $ encode_s2k_count $ fromJust s2k_count] else []
 	else []) ++
 	(if s2k_useage > 0 then
 		[encrypted_data]
@@ -268,6 +271,7 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
 				LZ.foldl (\c i -> (c + fromIntegral i) `mod` 65536)
 				(0::Integer) (LZ.concat s) :: Word16)]), 5)
 	where
+	(Just s2k_t) = s2k_type
 	p = fst (put_packet $ PublicKeyPacket version timestamp algorithm key
 		:: (LZ.ByteString, Integer)) -- Supress warning
 	s = map (encode . (key !)) (secret_key_fields algorithm)
@@ -363,13 +367,13 @@ parse_packet  5 = do
 				else return undefined
 			s2k_count <- if s2k_type == 3 then fmap decode_s2k_count get else
 				return undefined
-			return (k symmetric_type s2k_type s2k_hash_algorithm
-				s2k_salt s2k_count)
+			return (k (Just symmetric_type) (Just s2k_type)
+				(Just s2k_hash_algorithm) (Just s2k_salt) (Just s2k_count))
 		_ | s2k_useage > 0 ->
 			-- s2k_useage is symmetric_type in this case
-			return (k s2k_useage undefined undefined undefined undefined)
+			return (k (Just s2k_useage) Nothing Nothing Nothing Nothing)
 		_ ->
-			return (k undefined undefined undefined undefined undefined)
+			return (k Nothing Nothing Nothing Nothing Nothing)
 	if s2k_useage > 0 then do {
 		encrypted <- getRemainingLazyByteString;
 		return (k' encrypted Nothing)
@@ -378,7 +382,7 @@ parse_packet  5 = do
 			mpi <- get :: Get MPI
 			return $ Map.insert f mpi m) key (secret_key_fields algorithm)
 		private_hash <- getRemainingLazyByteString
-		return ((k' undefined (Just private_hash)) {key = key})
+		return ((k' LZ.empty (Just private_hash)) {key = key})
 -- PublicKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.2
 parse_packet  6 = do
 	version <- get :: Get Word8
diff --git a/tests/suite.hs b/tests/suite.hs
index 17ab3cb..7ea5e57 100644
--- a/tests/suite.hs
+++ b/tests/suite.hs
@@ -139,8 +139,8 @@ tests secring =
 			testCase "000076-007.secret_subkey" (testSerialization "000076-007.secret_subkey"),
 			testCase "000077-002.sig" (testSerialization "000077-002.sig"),
 			testCase "000078-012.ring_trust" (testSerialization "000078-012.ring_trust"),
-			-- Issue #11 -- testCase "secring.gpg" (testSerialization "secring.gpg"),
 			testCase "pubring.gpg" (testSerialization "pubring.gpg"),
+			testCase "secring.gpg" (testSerialization "secring.gpg"),
 			testCase "compressedsig.gpg" (testSerialization "compressedsig.gpg"),
 			testCase "compressedsig-zlib.gpg" (testSerialization "compressedsig-zlib.gpg"),
 			testCase "compressedsig-bzip2.gpg" (testSerialization "compressedsig-bzip2.gpg"),
-- 
cgit v1.2.3


From 4e01c764e40a1c7ba45ed1e0d1a44677338ac549 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 25 Apr 2012 11:19:10 -0500
Subject: better TODO error

---
 Data/OpenPGP.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index b77b36d..54fc132 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -306,7 +306,7 @@ parse_packet :: Word8 -> Get Packet
 parse_packet  2 = do
 	version <- get
 	case version of
-		3 -> undefined -- TODO: V3 sigs
+		3 -> error "V3 signatures are not supported yet" -- TODO: V3 sigs
 		4 -> do
 			signature_type <- get
 			key_algorithm <- get
-- 
cgit v1.2.3


From 945512be4374fd48bfe09ca4018fc5fe94d3f26e Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 25 Apr 2012 15:05:59 -0500
Subject: Remove BaseConvert

We only use it for hex, which is in base, and base even has a utility
for arbitrary-base conversions.
---
 Data/BaseConvert.hs    | 30 ------------------------------
 Data/OpenPGP.hs        | 12 ++++++------
 Data/OpenPGP/Crypto.hs |  7 ++++---
 Makefile               |  4 ++--
 openpgp.cabal          |  3 ---
 5 files changed, 12 insertions(+), 44 deletions(-)
 delete mode 100644 Data/BaseConvert.hs

(limited to 'Data')

diff --git a/Data/BaseConvert.hs b/Data/BaseConvert.hs
deleted file mode 100644
index 655f593..0000000
--- a/Data/BaseConvert.hs
+++ /dev/null
@@ -1,30 +0,0 @@
-module Data.BaseConvert (toString, toNum, toAlphaDigit, fromAlphaDigit) where
-
-import Data.Sequence
-import Data.Foldable (toList)
-import Data.List
-import Data.Char
-
-digit_alphabet :: [Char]
-digit_alphabet = ['0'..'9'] ++ ['A'..]
-
-toBase :: (Integral a) => a -> a -> [a]
-toBase _ 0 = [0]
-toBase b v = toList $
-	unfoldl (\n -> if n == 0 then Nothing else Just (n `divMod` b)) v
-
-toAlphaDigit :: (Integral a) => a -> Char
-toAlphaDigit = (digit_alphabet !!) . fromIntegral
-
-toString :: (Integral a) => a -> a -> String
-toString b v = map toAlphaDigit (toBase b v)
-
-fromAlphaDigit :: (Num a) => Char -> a
-fromAlphaDigit v = fromIntegral n
-	where Just n = elemIndex (toUpper v) digit_alphabet
-
-fromBase :: (Num a) => a -> [a] -> a
-fromBase b = foldl (\n k -> n * b + k) 0
-
-toNum :: (Num a) => a -> String -> a
-toNum b v = fromBase b (map fromAlphaDigit v)
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 54fc132..a5c2bef 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -45,9 +45,11 @@ module Data.OpenPGP (
 	decode_s2k_count, encode_s2k_count
 ) where
 
+import Numeric
 import Control.Monad
 import Data.Bits
 import Data.Word
+import Data.Char
 import Data.Maybe
 import Data.Map (Map, (!))
 import qualified Data.Map as Map
@@ -61,8 +63,6 @@ import qualified Codec.Compression.Zlib.Raw as Zip
 import qualified Codec.Compression.Zlib as Zlib
 import qualified Codec.Compression.BZip as BZip2
 
-import qualified Data.BaseConvert as BaseConvert
-
 data Packet =
 	SignaturePacket {
 		version::Word8,
@@ -241,7 +241,7 @@ put_packet (OnePassSignaturePacket { version = version,
                                      nested = nested }) =
 	(LZ.concat [ encode version, encode signature_type,
 	             encode hash_algorithm, encode key_algorithm,
-	             encode (BaseConvert.toNum 16 key_id :: Word64),
+	             encode (fst $ head $ readHex key_id :: Word64),
 	             encode nested ], 4)
 put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
                               key_algorithm = algorithm, key = key,
@@ -344,7 +344,7 @@ parse_packet  4 = do
 		signature_type = signature_type,
 		hash_algorithm = hash_algo,
 		key_algorithm = key_algo,
-		key_id = BaseConvert.toString 16 key_id,
+		key_id = map toUpper $ showHex key_id "",
 		nested = nested
 	}
 -- SecretKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.3
@@ -628,7 +628,7 @@ put_signature_subpacket :: SignatureSubpacket -> (LZ.ByteString, Word8)
 put_signature_subpacket (SignatureCreationTimePacket time) =
 	(encode time, 2)
 put_signature_subpacket (IssuerPacket keyid) =
-	(encode (BaseConvert.toNum 16 keyid :: Word64), 16)
+	(encode (fst $ head $ readHex keyid :: Word64), 16)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
@@ -647,7 +647,7 @@ parse_signature_subpacket  2 = fmap SignatureCreationTimePacket get
 -- IssuerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.5
 parse_signature_subpacket 16 = do
 	keyid <- get :: Get Word64
-	return $ IssuerPacket (BaseConvert.toString 16 keyid)
+	return $ IssuerPacket (map toUpper $ showHex keyid "")
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingLazyByteString
diff --git a/Data/OpenPGP/Crypto.hs b/Data/OpenPGP/Crypto.hs
index 173fe08..052489d 100644
--- a/Data/OpenPGP/Crypto.hs
+++ b/Data/OpenPGP/Crypto.hs
@@ -6,7 +6,9 @@
 -- > import qualified Data.OpenPGP.Crypto as OpenPGP
 module Data.OpenPGP.Crypto (sign, verify, fingerprint) where
 
+import Numeric
 import Data.Word
+import Data.Char
 import Data.List (find)
 import Data.Map ((!))
 import qualified Data.ByteString.Lazy as LZ
@@ -22,16 +24,15 @@ import qualified Data.Digest.SHA384 as SHA384
 import qualified Data.Digest.SHA512 as SHA512
 
 import qualified Data.OpenPGP as OpenPGP
-import qualified Data.BaseConvert as BaseConvert
 
 -- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket
 -- <http://tools.ietf.org/html/rfc4880#section-12.2>
 fingerprint :: OpenPGP.Packet -> String
 fingerprint p | OpenPGP.version p == 4 =
-	BaseConvert.toString 16 $ SHA1.toInteger $ SHA1.hash $
+	map toUpper $ (`showHex` "") $ SHA1.toInteger $ SHA1.hash $
 		LZ.unpack (LZ.concat (OpenPGP.fingerprint_material p))
 fingerprint p | OpenPGP.version p `elem` [2, 3] =
-	concatMap (BaseConvert.toString 16) $
+	map toUpper $ foldr showHex "" $
 		MD5.hash $ LZ.unpack (LZ.concat (OpenPGP.fingerprint_material p))
 fingerprint _ = error "Unsupported Packet version or type in fingerprint."
 
diff --git a/Makefile b/Makefile
index 5aa7ef6..10f66fa 100644
--- a/Makefile
+++ b/Makefile
@@ -51,9 +51,9 @@ clean:
 debian/control: openpgp.cabal
 	cabal-debian --update-debianization
 
-dist/build/libHSopenpgp-$(VERSION).a: openpgp.cabal dist/setup-config Data/BaseConvert.hs Data/OpenPGP.hs Data/OpenPGP/Crypto.hs
+dist/build/libHSopenpgp-$(VERSION).a: openpgp.cabal dist/setup-config Data/OpenPGP.hs Data/OpenPGP/Crypto.hs
 	cabal build --ghc-options="$(GHCFLAGS)"
 
-dist/openpgp-$(VERSION).tar.gz: openpgp.cabal dist/setup-config Data/BaseConvert.hs Data/OpenPGP.hs Data/OpenPGP/Crypto.hs README
+dist/openpgp-$(VERSION).tar.gz: openpgp.cabal dist/setup-config Data/OpenPGP.hs Data/OpenPGP/Crypto.hs README
 	cabal check
 	cabal sdist
diff --git a/openpgp.cabal b/openpgp.cabal
index c20f6fc..0a40b94 100644
--- a/openpgp.cabal
+++ b/openpgp.cabal
@@ -128,9 +128,6 @@ library
                 Data.OpenPGP
                 Data.OpenPGP.Crypto
 
-        other-modules:
-                Data.BaseConvert
-
         build-depends:
                 base == 4.*,
                 containers,
-- 
cgit v1.2.3


From 9320bdfde1cceb3db19bb44ad2522e9f57d7b475 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 25 Apr 2012 15:06:39 -0500
Subject: hlint

---
 Data/OpenPGP/Crypto.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP/Crypto.hs b/Data/OpenPGP/Crypto.hs
index 052489d..5049d00 100644
--- a/Data/OpenPGP/Crypto.hs
+++ b/Data/OpenPGP/Crypto.hs
@@ -127,7 +127,7 @@ sign keys message hsh keyid timestamp =
 			LZ.fromString firstUserID
 		]
 	} `LZ.append` OpenPGP.trailer sig
-	sig     = (findSigOrDefault (find OpenPGP.isSignaturePacket m))
+	sig     = findSigOrDefault (find OpenPGP.isSignaturePacket m)
 
 	-- Either a SignaturePacket was found, or we need to make one
 	findSigOrDefault (Just s) = OpenPGP.signaturePacket
-- 
cgit v1.2.3


From 7b3232778f284dd4dd3a6f3287bcbe1fbe10b010 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 25 Apr 2012 16:00:34 -0500
Subject: fix for MD5 without BaseConvert

---
 Data/OpenPGP/Crypto.hs | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP/Crypto.hs b/Data/OpenPGP/Crypto.hs
index 5049d00..54fb81e 100644
--- a/Data/OpenPGP/Crypto.hs
+++ b/Data/OpenPGP/Crypto.hs
@@ -28,13 +28,18 @@ import qualified Data.OpenPGP as OpenPGP
 -- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket
 -- <http://tools.ietf.org/html/rfc4880#section-12.2>
 fingerprint :: OpenPGP.Packet -> String
-fingerprint p | OpenPGP.version p == 4 =
-	map toUpper $ (`showHex` "") $ SHA1.toInteger $ SHA1.hash $
-		LZ.unpack (LZ.concat (OpenPGP.fingerprint_material p))
-fingerprint p | OpenPGP.version p `elem` [2, 3] =
-	map toUpper $ foldr showHex "" $
-		MD5.hash $ LZ.unpack (LZ.concat (OpenPGP.fingerprint_material p))
-fingerprint _ = error "Unsupported Packet version or type in fingerprint."
+fingerprint p
+	| OpenPGP.version p == 4 =
+		map toUpper $ (`showHex` "") $ SHA1.toInteger $ SHA1.hash $
+			LZ.unpack (LZ.concat (OpenPGP.fingerprint_material p))
+	| OpenPGP.version p `elem` [2, 3] =
+		map toUpper $ foldr (pad `oo` showHex) "" $
+			MD5.hash $ LZ.unpack (LZ.concat (OpenPGP.fingerprint_material p))
+	| otherwise = error "Unsupported Packet version or type in fingerprint"
+	where
+	oo = (.) . (.)
+	pad s | odd $ length s = '0':s
+	      | otherwise = s
 
 find_key :: OpenPGP.Message -> String -> Maybe OpenPGP.Packet
 find_key (OpenPGP.Message (x@(OpenPGP.PublicKeyPacket {}):xs)) keyid =
-- 
cgit v1.2.3


From 6b743222684f2b8151dfbdef42f0dc890e590c41 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 25 Apr 2012 17:19:07 -0500
Subject: Split OpenPGP.Crypto out into a seperate package

---
 Data/OpenPGP/Crypto.hs               | 183 -----------------------------------
 Makefile                             |  23 ++---
 README                               |   8 +-
 debian/control                       |  27 ++----
 examples/keygen.hs                   |  43 --------
 examples/sign.hs                     |  23 -----
 examples/verify.hs                   |  14 ---
 openpgp.cabal                        |  22 ++---
 tests/data/encryption-sym-aes256.gpg |   1 -
 tests/data/encryption-sym-cast5.gpg  | Bin 72 -> 0 bytes
 tests/data/encryption.gpg            | Bin 860 -> 0 bytes
 tests/data/msg1.asc                  |   7 --
 tests/suite.hs                       |  57 +----------
 13 files changed, 28 insertions(+), 380 deletions(-)
 delete mode 100644 Data/OpenPGP/Crypto.hs
 delete mode 100644 examples/keygen.hs
 delete mode 100644 examples/sign.hs
 delete mode 100644 examples/verify.hs
 delete mode 100644 tests/data/encryption-sym-aes256.gpg
 delete mode 100644 tests/data/encryption-sym-cast5.gpg
 delete mode 100644 tests/data/encryption.gpg
 delete mode 100644 tests/data/msg1.asc

(limited to 'Data')

diff --git a/Data/OpenPGP/Crypto.hs b/Data/OpenPGP/Crypto.hs
deleted file mode 100644
index 54fb81e..0000000
--- a/Data/OpenPGP/Crypto.hs
+++ /dev/null
@@ -1,183 +0,0 @@
--- | This is a wrapper around <http://hackage.haskell.org/package/Crypto>
--- that currently does fingerprint generation and signature verification.
---
--- The recommended way to import this module is:
---
--- > import qualified Data.OpenPGP.Crypto as OpenPGP
-module Data.OpenPGP.Crypto (sign, verify, fingerprint) where
-
-import Numeric
-import Data.Word
-import Data.Char
-import Data.List (find)
-import Data.Map ((!))
-import qualified Data.ByteString.Lazy as LZ
-import qualified Data.ByteString.Lazy.UTF8 as LZ (fromString)
-
-import Data.Binary
-import Codec.Utils (fromOctets)
-import qualified Codec.Encryption.RSA as RSA
-import qualified Data.Digest.MD5 as MD5
-import qualified Data.Digest.SHA1 as SHA1
-import qualified Data.Digest.SHA256 as SHA256
-import qualified Data.Digest.SHA384 as SHA384
-import qualified Data.Digest.SHA512 as SHA512
-
-import qualified Data.OpenPGP as OpenPGP
-
--- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket
--- <http://tools.ietf.org/html/rfc4880#section-12.2>
-fingerprint :: OpenPGP.Packet -> String
-fingerprint p
-	| OpenPGP.version p == 4 =
-		map toUpper $ (`showHex` "") $ SHA1.toInteger $ SHA1.hash $
-			LZ.unpack (LZ.concat (OpenPGP.fingerprint_material p))
-	| OpenPGP.version p `elem` [2, 3] =
-		map toUpper $ foldr (pad `oo` showHex) "" $
-			MD5.hash $ LZ.unpack (LZ.concat (OpenPGP.fingerprint_material p))
-	| otherwise = error "Unsupported Packet version or type in fingerprint"
-	where
-	oo = (.) . (.)
-	pad s | odd $ length s = '0':s
-	      | otherwise = s
-
-find_key :: OpenPGP.Message -> String -> Maybe OpenPGP.Packet
-find_key (OpenPGP.Message (x@(OpenPGP.PublicKeyPacket {}):xs)) keyid =
-	find_key_ x xs keyid
-find_key (OpenPGP.Message (x@(OpenPGP.SecretKeyPacket {}):xs)) keyid =
-	find_key_ x xs keyid
-find_key (OpenPGP.Message (_:xs)) keyid =
-	find_key (OpenPGP.Message xs) keyid
-find_key _ _ = Nothing
-
-find_key_ :: OpenPGP.Packet -> [OpenPGP.Packet] -> String -> Maybe OpenPGP.Packet
-find_key_ x xs keyid
-	| thisid == keyid = Just x
-	| otherwise = find_key (OpenPGP.Message xs) keyid
-	where
-	thisid = reverse $ take (length keyid) (reverse (fingerprint x))
-
-keyfield_as_octets :: OpenPGP.Packet -> Char -> [Word8]
-keyfield_as_octets k f =
-	LZ.unpack $ LZ.drop 2 (encode (k' ! f))
-	where k' = OpenPGP.key k
-
--- http://tools.ietf.org/html/rfc3447#page-43
-emsa_pkcs1_v1_5_hash_padding :: OpenPGP.HashAlgorithm -> [Word8]
-emsa_pkcs1_v1_5_hash_padding OpenPGP.MD5 = [0x30, 0x20, 0x30, 0x0c, 0x06, 0x08, 0x2a, 0x86, 0x48, 0x86, 0xf7, 0x0d, 0x02, 0x05, 0x05, 0x00, 0x04, 0x10]
-emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA1 = [0x30, 0x21, 0x30, 0x09, 0x06, 0x05, 0x2b, 0x0e, 0x03, 0x02, 0x1a, 0x05, 0x00, 0x04, 0x14]
-emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA256 = [0x30, 0x31, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x01, 0x05, 0x00, 0x04, 0x20]
-emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA384 = [0x30, 0x41, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x02, 0x05, 0x00, 0x04, 0x30]
-emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA512 = [0x30, 0x51, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x03, 0x05, 0x00, 0x04, 0x40]
-emsa_pkcs1_v1_5_hash_padding _ =
-	error "Unsupported HashAlgorithm in emsa_pkcs1_v1_5_hash_padding."
-
-hash :: OpenPGP.HashAlgorithm -> [Word8] -> [Word8]
-hash OpenPGP.MD5 = MD5.hash
-hash OpenPGP.SHA1 = drop 2 . LZ.unpack . encode . OpenPGP.MPI . SHA1.toInteger . SHA1.hash
-hash OpenPGP.SHA256 = SHA256.hash
-hash OpenPGP.SHA384 = SHA384.hash
-hash OpenPGP.SHA512 = SHA512.hash
-hash _ = error "Unsupported HashAlgorithm in hash."
-
-emsa_pkcs1_v1_5_encode :: [Word8] -> Int -> OpenPGP.HashAlgorithm -> [Word8]
-emsa_pkcs1_v1_5_encode m emLen algo =
-	[0, 1] ++ replicate (emLen - length t - 3) 0xff ++ [0] ++ t
-	where t = emsa_pkcs1_v1_5_hash_padding algo ++ hash algo m
-
--- | Verify a message signature.  Only supports RSA keys for now.
-verify :: OpenPGP.Message    -- ^ Keys that may have made the signature
-          -> OpenPGP.Message -- ^ LiteralData message to verify
-          -> Int             -- ^ Index of signature to verify (0th, 1st, etc)
-          -> Bool
-verify keys message sigidx =
-	encoded == RSA.encrypt (n, e) raw_sig
-	where
-	raw_sig = LZ.unpack $ LZ.drop 2 $ encode (OpenPGP.signature sig)
-	encoded = emsa_pkcs1_v1_5_encode signature_over
-		(length n) (OpenPGP.hash_algorithm sig)
-	signature_over = LZ.unpack $ dta `LZ.append` OpenPGP.trailer sig
-	(n, e) = (keyfield_as_octets k 'n', keyfield_as_octets k 'e')
-	Just k = find_key keys issuer
-	Just issuer = OpenPGP.signature_issuer sig
-	sig = sigs !! sigidx
-	(sigs, (OpenPGP.LiteralDataPacket {OpenPGP.content = dta}):_) =
-		OpenPGP.signatures_and_data message
-
--- | Sign data or key/userID pair.  Only supports RSA keys for now.
-sign :: OpenPGP.Message    -- ^ SecretKeys, one of which will be used
-        -> OpenPGP.Message -- ^ Message containing data or key to sign, and optional signature packet
-        -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature
-        -> String  -- ^ KeyID of key to choose or @[]@ for first
-        -> 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
-	}
-	where
-	-- toNum has explicit param so that it can remain polymorphic
-	toNum l = fromOctets (256::Integer) l
-	final   = dropWhile (==0) $ RSA.decrypt (n, d) encoded
-	encoded = emsa_pkcs1_v1_5_encode dta (length n) hsh
-	(n, d)  = (keyfield_as_octets k 'n', keyfield_as_octets k 'd')
-	dta     = LZ.unpack $ case signOver of {
-		OpenPGP.LiteralDataPacket {OpenPGP.content = c} -> c;
-		_ -> LZ.concat $ OpenPGP.fingerprint_material signOver ++ [
-			LZ.singleton 0xB4,
-			encode (fromIntegral (length firstUserID) :: Word32),
-			LZ.fromString firstUserID
-		]
-	} `LZ.append` OpenPGP.trailer sig
-	sig     = findSigOrDefault (find OpenPGP.isSignaturePacket m)
-
-	-- Either a SignaturePacket was found, or we need to make one
-	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]
-		))
-		[]
-		undefined
-		undefined
-
-	keyid'  = reverse $ take 16 $ reverse $ fingerprint k
-	Just k  = find_key keys keyid
-
-	Just (OpenPGP.UserIDPacket firstUserID) = find isUserID m
-
-	defaultStype = case signOver of
-		OpenPGP.LiteralDataPacket {OpenPGP.format = f} ->
-			if f == 'b' then 0x00 else 0x01
-		_ -> 0x13
-
-	Just signOver = find isSignable m
-	OpenPGP.Message m = message
-
-	isSignable (OpenPGP.LiteralDataPacket {}) = True
-	isSignable (OpenPGP.PublicKeyPacket {})   = True
-	isSignable (OpenPGP.SecretKeyPacket {})   = True
-	isSignable _                              = False
-
-	isUserID (OpenPGP.UserIDPacket {})        = True
-	isUserID _                                = False
diff --git a/Makefile b/Makefile
index 10f66fa..85dc9db 100644
--- a/Makefile
+++ b/Makefile
@@ -4,7 +4,7 @@ VERSION=0.3
 
 .PHONY: all clean doc install debian test
 
-all: sign verify keygen test report.html doc dist/build/libHSopenpgp-$(VERSION).a dist/openpgp-$(VERSION).tar.gz
+all: test report.html doc dist/build/libHSopenpgp-$(VERSION).a dist/openpgp-$(VERSION).tar.gz
 
 install: dist/build/libHSopenpgp-$(VERSION).a
 	cabal install
@@ -14,20 +14,11 @@ debian: debian/control
 test: tests/suite
 	tests/suite
 
-sign: examples/sign.hs Data/*.hs Data/OpenPGP/*.hs
+tests/suite: tests/suite.hs Data/OpenPGP.hs
 	ghc --make $(GHCFLAGS) -o $@ $^
 
-verify: examples/verify.hs Data/*.hs Data/OpenPGP/*.hs
-	ghc --make $(GHCFLAGS) -o $@ $^
-
-keygen: examples/keygen.hs Data/*.hs Data/OpenPGP/*.hs
-	ghc --make $(GHCFLAGS) -o $@ $^
-
-tests/suite: tests/suite.hs Data/*.hs Data/OpenPGP/*.hs
-	ghc --make $(GHCFLAGS) -o $@ $^
-
-report.html: examples/*.hs Data/*.hs Data/OpenPGP/*.hs tests/*.hs
-	-hlint $(HLINTFLAGS) --report Data examples
+report.html: Data/OpenPGP.hs tests/suite.hs
+	-hlint $(HLINTFLAGS) --report $^
 
 doc: dist/doc/html/openpgp/index.html README
 
@@ -37,7 +28,7 @@ README: openpgp.cabal
 	-printf ',s/        //g\n,s/^.$$//g\nw\nq\n' | ed $@
 	$(RM) .$@
 
-dist/doc/html/openpgp/index.html: dist/setup-config Data/OpenPGP.hs Data/OpenPGP/Crypto.hs
+dist/doc/html/openpgp/index.html: dist/setup-config Data/OpenPGP.hs
 	cabal haddock --hyperlink-source
 
 dist/setup-config: openpgp.cabal
@@ -51,9 +42,9 @@ clean:
 debian/control: openpgp.cabal
 	cabal-debian --update-debianization
 
-dist/build/libHSopenpgp-$(VERSION).a: openpgp.cabal dist/setup-config Data/OpenPGP.hs Data/OpenPGP/Crypto.hs
+dist/build/libHSopenpgp-$(VERSION).a: openpgp.cabal dist/setup-config Data/OpenPGP.hs
 	cabal build --ghc-options="$(GHCFLAGS)"
 
-dist/openpgp-$(VERSION).tar.gz: openpgp.cabal dist/setup-config Data/OpenPGP.hs Data/OpenPGP/Crypto.hs README
+dist/openpgp-$(VERSION).tar.gz: openpgp.cabal dist/setup-config Data/OpenPGP.hs README
 	cabal check
 	cabal sdist
diff --git a/README b/README
index b5d1332..0bed65f 100644
--- a/README
+++ b/README
@@ -7,12 +7,8 @@ It defines types to represent OpenPGP messages as a series of packets
 and then defines instances of Data.Binary for each to facilitate
 encoding/decoding.
 
-There is also a wrapper around <http://hackage.haskell.org/package/Crypto>
-that currently does fingerprint generation, signature generation, and
-signature verification (for RSA keys only).
+For performing cryptography, see <http://hackage.haskell.org/openpgp-Crypto>
 
-It is intended that you use qualified imports with this library.  If importing
-both modules, something like this will do:
+It is intended that you use qualified imports with this library.
 
 > import qualified Data.OpenPGP as OpenPGP
-> import qualified Data.OpenPGP.Crypto as OpenPGP
diff --git a/debian/control b/debian/control
index a4b9165..679e316 100644
--- a/debian/control
+++ b/debian/control
@@ -7,8 +7,6 @@ Build-Depends: debhelper (>= 7.0),
                cdbs,
                ghc,
                ghc-prof,
-               libghc-crypto-dev,
-               libghc-crypto-prof,
                libghc-binary-dev,
                libghc-binary-prof,
                libghc-bzlib-dev,
@@ -18,7 +16,6 @@ Build-Depends: debhelper (>= 7.0),
                libghc-zlib-dev,
                libghc-zlib-prof
 Build-Depends-Indep: ghc-doc,
-                     libghc-crypto-doc,
                      libghc-binary-doc,
                      libghc-bzlib-doc,
                      libghc-utf8-string-doc,
@@ -44,15 +41,11 @@ Description: Implementation of the OpenPGP message format
  and then defines instances of Data.Binary for each to facilitate
  encoding/decoding.
  .
- There is also a wrapper around <http://hackage.haskell.org/package/Crypto>
- that currently does fingerprint generation, signature generation, and
- signature verification (for RSA keys only).
+ For performing cryptography, see <http://hackage.haskell.org/openpgp-Crypto>
  .
- It is intended that you use qualified imports with this library.  If importing
- both modules, something like this will do:
+ It is intended that you use qualified imports with this library.
  .
  > import qualified Data.OpenPGP as OpenPGP
- > import qualified Data.OpenPGP.Crypto as OpenPGP
  .
   Author: Stephen Paul Weber <singpolyma@singpolyma.net>
   Upstream-Maintainer: Stephen Paul Weber <singpolyma@singpolyma.net>
@@ -76,15 +69,11 @@ Description: Implementation of the OpenPGP message format
  and then defines instances of Data.Binary for each to facilitate
  encoding/decoding.
  .
- There is also a wrapper around <http://hackage.haskell.org/package/Crypto>
- that currently does fingerprint generation, signature generation, and
- signature verification (for RSA keys only).
+ For performing cryptography, see <http://hackage.haskell.org/openpgp-Crypto>
  .
- It is intended that you use qualified imports with this library.  If importing
- both modules, something like this will do:
+ It is intended that you use qualified imports with this library.
  .
  > import qualified Data.OpenPGP as OpenPGP
- > import qualified Data.OpenPGP.Crypto as OpenPGP
  .
   Author: Stephen Paul Weber <singpolyma@singpolyma.net>
   Upstream-Maintainer: Stephen Paul Weber <singpolyma@singpolyma.net>
@@ -108,15 +97,11 @@ Description: Implementation of the OpenPGP message format
  and then defines instances of Data.Binary for each to facilitate
  encoding/decoding.
  .
- There is also a wrapper around <http://hackage.haskell.org/package/Crypto>
- that currently does fingerprint generation, signature generation, and
- signature verification (for RSA keys only).
+ For performing cryptography, see <http://hackage.haskell.org/openpgp-Crypto>
  .
- It is intended that you use qualified imports with this library.  If importing
- both modules, something like this will do:
+ It is intended that you use qualified imports with this library.
  .
  > import qualified Data.OpenPGP as OpenPGP
- > import qualified Data.OpenPGP.Crypto as OpenPGP
  .
   Author: Stephen Paul Weber <singpolyma@singpolyma.net>
   Upstream-Maintainer: Stephen Paul Weber <singpolyma@singpolyma.net>
diff --git a/examples/keygen.hs b/examples/keygen.hs
deleted file mode 100644
index 65c3e33..0000000
--- a/examples/keygen.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-import System.Time (getClockTime, ClockTime(..))
-import qualified Data.Map as Map
-import qualified Data.ByteString.Lazy as LZ
-
-import Data.Binary
-import OpenSSL.RSA
-import Control.Arrow (second)
-import Codec.Encryption.RSA.NumberTheory (extEuclGcd)
-
-import qualified Data.OpenPGP as OpenPGP
-import qualified Data.OpenPGP.Crypto as OpenPGP
-
-main :: IO ()
-main = do
-	time <- getClockTime
-	let TOD t _ = time
-
-	nkey <- generateRSAKey' 1042 65537
-
-	let secretKey = OpenPGP.SecretKeyPacket {
-		OpenPGP.version = 4,
-		OpenPGP.timestamp = fromIntegral t,
-		OpenPGP.key_algorithm = OpenPGP.RSA,
-		OpenPGP.key = Map.fromList $ map (second OpenPGP.MPI)
-			[('n', rsaN nkey), ('e', rsaE nkey),
-			('d', rsaD nkey), ('p', rsaP nkey), ('q', rsaQ nkey),
-			('u', fst $ extEuclGcd (rsaP nkey) (rsaQ nkey))],
-		OpenPGP.s2k_useage = 0,
-		OpenPGP.symmetric_type = undefined,
-		OpenPGP.s2k_type = undefined,
-		OpenPGP.s2k_hash_algorithm = undefined,
-		OpenPGP.s2k_salt = undefined,
-		OpenPGP.s2k_count = undefined,
-		OpenPGP.encrypted_data = undefined,
-		OpenPGP.private_hash = undefined }
-
-	let userID = OpenPGP.UserIDPacket "Test <test@example.com>"
-	let message = OpenPGP.Message[ secretKey, userID ]
-
-	let message' = OpenPGP.Message [ secretKey, userID,
-		OpenPGP.sign message message OpenPGP.SHA256 [] (fromIntegral t)]
-
-	LZ.putStr $ encode message'
diff --git a/examples/sign.hs b/examples/sign.hs
deleted file mode 100644
index e8bea1a..0000000
--- a/examples/sign.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-import System (getArgs)
-import System.Time (getClockTime, ClockTime(..))
-
-import Data.Binary
-
-import qualified Data.OpenPGP as OpenPGP
-import qualified Data.OpenPGP.Crypto as OpenPGP
-import qualified Data.ByteString.Lazy as LZ
-import qualified Data.ByteString.Lazy.UTF8 as LZ
-
-main :: IO ()
-main = do
-	argv <- getArgs
-	time <- getClockTime
-	let TOD t _ = time
-	keys <- decodeFile (argv !! 0)
-	let dataPacket = OpenPGP.LiteralDataPacket 'u' "t.txt"
-			(fromIntegral t) (LZ.fromString "This is a message.")
-	let message = OpenPGP.Message [
-		OpenPGP.sign keys (OpenPGP.Message [dataPacket])
-			OpenPGP.SHA256 [] (fromIntegral t),
-		dataPacket]
-	LZ.putStr $ encode message
diff --git a/examples/verify.hs b/examples/verify.hs
deleted file mode 100644
index b123bd1..0000000
--- a/examples/verify.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-import System (getArgs)
-
-import Data.Binary
-
-import qualified Data.OpenPGP as OpenPGP ()
-import qualified Data.OpenPGP.Crypto as OpenPGP
-
-main :: IO ()
-main = do
-	argv <- getArgs
-	keys <- decodeFile (argv !! 0)
-	message <- decodeFile (argv !! 1)
-	-- Just verify first signature
-	print $ OpenPGP.verify keys message 0
diff --git a/openpgp.cabal b/openpgp.cabal
index 0a40b94..3f3d592 100644
--- a/openpgp.cabal
+++ b/openpgp.cabal
@@ -23,15 +23,11 @@ description:
         and then defines instances of Data.Binary for each to facilitate
         encoding/decoding.
         .
-        There is also a wrapper around <http://hackage.haskell.org/package/Crypto>
-        that currently does fingerprint generation, signature generation, and
-        signature verification (for RSA keys only).
+        For performing cryptography, see <http://hackage.haskell.org/openpgp-Crypto>
         .
-        It is intended that you use qualified imports with this library.  If importing
-        both modules, something like this will do:
+        It is intended that you use qualified imports with this library.
         .
         > import qualified Data.OpenPGP as OpenPGP
-        > import qualified Data.OpenPGP.Crypto as OpenPGP
 
 extra-source-files:
         README,
@@ -114,19 +110,19 @@ extra-source-files:
         tests/data/000076-007.secret_subkey,
         tests/data/000077-002.sig,
         tests/data/000078-012.ring_trust,
+        tests/data/compressedsig-bzip2.gpg,
+        tests/data/compressedsig.gpg,
+        tests/data/compressedsig-zlib.gpg,
+        tests/data/onepass_sig,
         tests/data/pubring.gpg,
         tests/data/secring.gpg,
-        tests/data/compressedsig.gpg,
-        tests/data/msg1.asc,
-        tests/data/uncompressed-ops-rsa.gpg,
         tests/data/uncompressed-ops-dsa.gpg,
         tests/data/uncompressed-ops-dsa-sha384.txt.gpg,
-        tests/data/encryption.gpg
+        tests/data/uncompressed-ops-rsa.gpg
 
 library
         exposed-modules:
                 Data.OpenPGP
-                Data.OpenPGP.Crypto
 
         build-depends:
                 base == 4.*,
@@ -135,8 +131,7 @@ library
                 utf8-string,
                 binary,
                 zlib,
-                bzlib,
-                Crypto
+                bzlib
 
 test-suite tests
         type:       exitcode-stdio-1.0
@@ -150,7 +145,6 @@ test-suite tests
                 binary,
                 zlib,
                 bzlib,
-                Crypto,
                 HUnit,
                 QuickCheck >= 2.4.1.1,
                 test-framework,
diff --git a/tests/data/encryption-sym-aes256.gpg b/tests/data/encryption-sym-aes256.gpg
deleted file mode 100644
index 264ae11..0000000
--- a/tests/data/encryption-sym-aes256.gpg
+++ /dev/null
@@ -1 +0,0 @@
-Œ
	éñ§'6*�W`ÒV
ëLE�¤ÀQæjNp(Y3ÍÃN*ï¨?“º½!ËMÇÃ*Þ*Ûˆ;ë
hLò2À+ÓÙ!x�Ì„×&&\J{q§Äï<16.†-�D	Þ¿ûþé¸
\ No newline at end of file
diff --git a/tests/data/encryption-sym-cast5.gpg b/tests/data/encryption-sym-cast5.gpg
deleted file mode 100644
index 2c552ac..0000000
Binary files a/tests/data/encryption-sym-cast5.gpg and /dev/null differ
diff --git a/tests/data/encryption.gpg b/tests/data/encryption.gpg
deleted file mode 100644
index 9781572..0000000
Binary files a/tests/data/encryption.gpg and /dev/null differ
diff --git a/tests/data/msg1.asc b/tests/data/msg1.asc
deleted file mode 100644
index 832d3bb..0000000
--- a/tests/data/msg1.asc
+++ /dev/null
@@ -1,7 +0,0 @@
------BEGIN PGP MESSAGE-----
-Version: OpenPrivacy 0.99
-
-yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS
-vBSFjNSiVHsuAA==
-=njUN
------END PGP MESSAGE-----
diff --git a/tests/suite.hs b/tests/suite.hs
index 7ea5e57..ad7a8f2 100644
--- a/tests/suite.hs
+++ b/tests/suite.hs
@@ -7,9 +7,7 @@ import Test.HUnit hiding (Test)
 import Data.Word
 import Data.Binary
 import qualified Data.OpenPGP as OpenPGP
-import qualified Data.OpenPGP.Crypto as OpenPGP
 import qualified Data.ByteString.Lazy as LZ
-import qualified Data.ByteString.Lazy.UTF8 as LZ (fromString)
 
 instance Arbitrary OpenPGP.HashAlgorithm where
 	arbitrary = elements [OpenPGP.MD5, OpenPGP.SHA1, OpenPGP.SHA256, OpenPGP.SHA384, OpenPGP.SHA512]
@@ -18,8 +16,8 @@ testSerialization :: FilePath -> Assertion
 testSerialization fp = do
 	bs <- LZ.readFile $ "tests/data/" ++ fp
 	nullShield "First" (decode bs) (\firstpass ->
-			nullShield "Second" (decode $ encode firstpass) (\secondpass ->
-				assertEqual ("for " ++ fp) firstpass secondpass
+			nullShield "Second" (decode $ encode firstpass) (
+				assertEqual ("for " ++ fp) firstpass
 			)
 		)
 	where
@@ -27,38 +25,12 @@ testSerialization fp = do
 		assertFailure $ pass ++ " pass of " ++ fp ++ " decoded to nothing."
 	nullShield _ m f = f m
 
-testFingerprint :: FilePath -> String -> Assertion
-testFingerprint fp kf = do
-	bs <- LZ.readFile $ "tests/data/" ++ fp
-	let (OpenPGP.Message [packet]) = decode bs
-	assertEqual ("for " ++ fp) kf (OpenPGP.fingerprint packet)
-
-testVerifyMessage :: FilePath -> FilePath -> Assertion
-testVerifyMessage keyring message = do
-	keys <- fmap decode $ LZ.readFile $ "tests/data/" ++ keyring
-	m <- fmap decode $ LZ.readFile $ "tests/data/" ++ message
-	let verification = OpenPGP.verify keys m 0
-	assertEqual (keyring ++ " for " ++ message) True verification
-
-prop_sign_and_verify :: OpenPGP.Message -> String -> OpenPGP.HashAlgorithm -> String -> String -> Bool
-prop_sign_and_verify secring kid halgo filename msg =
-	let
-		m = OpenPGP.LiteralDataPacket {
-			OpenPGP.format = 'u',
-			OpenPGP.filename = filename,
-			OpenPGP.timestamp = 12341234,
-			OpenPGP.content = LZ.fromString msg
-		}
-		sig = OpenPGP.sign secring (OpenPGP.Message [m]) halgo kid 12341234
-	in
-		OpenPGP.verify secring (OpenPGP.Message [m,sig]) 0
-
 prop_s2k_count :: Word8 -> Bool
 prop_s2k_count c =
 	c == OpenPGP.encode_s2k_count (OpenPGP.decode_s2k_count c)
 
-tests :: OpenPGP.Message -> [Test]
-tests secring =
+tests :: [Test]
+tests =
 	[
 		testGroup "Serialization" [
 			testCase "000001-006.public_key" (testSerialization "000001-006.public_key"),
@@ -148,29 +120,10 @@ tests secring =
 			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"),
-			testCase "000016-006.public_key" (testFingerprint "000016-006.public_key" "AF95E4D7BAC521EE9740BED75E9F1523413262DC"),
-			testCase "000027-006.public_key" (testFingerprint "000027-006.public_key" "1EB20B2F5A5CC3BEAFD6E5CB7732CF988A63EA86"),
-			testCase "000035-006.public_key" (testFingerprint "000035-006.public_key" "CB7933459F59C70DF1C3FBEEDEDC3ECF689AF56D")
-		],
-		testGroup "Message verification" [
-			--testCase "uncompressed-ops-dsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-dsa.gpg"),
-			--testCase "uncompressed-ops-dsa-sha384" (testVerifyMessage "pubring.gpg" "uncompressed-ops-dsa-sha384.txt.gpg"),
-			testCase "uncompressed-ops-rsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-rsa.gpg"),
-			testCase "compressedsig" (testVerifyMessage "pubring.gpg" "compressedsig.gpg"),
-			testCase "compressedsig-zlib" (testVerifyMessage "pubring.gpg" "compressedsig-zlib.gpg"),
-			testCase "compressedsig-bzip2" (testVerifyMessage "pubring.gpg" "compressedsig-bzip2.gpg")
-		],
-		testGroup "Signing" [
-			testProperty "Crypto signatures verify" (prop_sign_and_verify secring "FEF8AFA0F661C3EE")
-		],
 		testGroup "S2K count" [
 			testProperty "S2K count encode reverses decode" prop_s2k_count
 		]
 	]
 
 main :: IO ()
-main = do
-	secring <- fmap decode $ LZ.readFile "tests/data/secring.gpg"
-	defaultMain (tests secring)
+main = defaultMain tests
-- 
cgit v1.2.3


From 662509025d33190a79c5e38987e6e77b0c572ff8 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 25 Apr 2012 17:39:34 -0500
Subject: fix haddock warning

---
 Data/OpenPGP.hs | 62 ++++++++++++++++++++++++++++++++-------------------------
 1 file changed, 35 insertions(+), 27 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index a5c2bef..7d421dc 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -4,33 +4,41 @@
 --
 -- > import qualified Data.OpenPGP as OpenPGP
 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,
+	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(..),
-- 
cgit v1.2.3


From f71c938026eeaff0ca110960fd78109cca3791ce Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 25 Apr 2012 17:39:56 -0500
Subject: move find_key logit out of Crypto

---
 Data/OpenPGP.hs | 19 ++++++++++++++++++-
 1 file changed, 18 insertions(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 7d421dc..99f241b 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -47,6 +47,7 @@ module Data.OpenPGP (
 	KeyAlgorithm(..),
 	CompressionAlgorithm(..),
 	MPI(..),
+	find_key,
 	fingerprint_material,
 	signatures_and_data,
 	signature_issuer,
@@ -676,7 +677,23 @@ encode_s2k_count iterations
 		| count < 32 = (count, c)
 		| otherwise = encode_s2k_count' (count `shiftR` 1) (c+1)
 
--- SignaturePacket smart constructor
+find_key :: (Packet -> String) -> Message -> String -> Maybe Packet
+find_key fpr (Message (x@(PublicKeyPacket {}):xs)) keyid =
+	find_key' fpr x xs keyid
+find_key fpr (Message (x@(SecretKeyPacket {}):xs)) keyid =
+	find_key' fpr x xs keyid
+find_key fpr (Message (_:xs)) keyid =
+	find_key fpr (Message xs) keyid
+find_key _ _ _ = Nothing
+
+find_key' :: (Packet -> String) -> Packet -> [Packet] -> String -> Maybe Packet
+find_key' fpr x xs keyid
+	| thisid == keyid = Just x
+	| otherwise = find_key fpr (Message xs) keyid
+	where
+	thisid = reverse $ take (length keyid) (reverse (fpr x))
+
+-- | 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 {
-- 
cgit v1.2.3


From 9cb589a33a09f42afa921ed6667f652b0c52a3f0 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 25 Apr 2012 17:40:13 -0500
Subject: this list is always tiny, Data.Map is overkill

---
 Data/OpenPGP.hs | 13 +++++++------
 openpgp.cabal   |  2 --
 2 files changed, 7 insertions(+), 8 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 99f241b..8e1979b 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -60,8 +60,6 @@ import Data.Bits
 import Data.Word
 import Data.Char
 import Data.Maybe
-import Data.Map (Map, (!))
-import qualified Data.Map as Map
 import qualified Data.ByteString.Lazy as LZ
 import qualified Data.ByteString.Lazy.UTF8 as LZ (toString, fromString)
 
@@ -96,13 +94,13 @@ data Packet =
 		version::Word8,
 		timestamp::Word32,
 		key_algorithm::KeyAlgorithm,
-		key::Map Char MPI
+		key::[(Char,MPI)]
 	} |
 	SecretKeyPacket {
 		version::Word8,
 		timestamp::Word32,
 		key_algorithm::KeyAlgorithm,
-		key::Map Char MPI,
+		key::[(Char,MPI)],
 		s2k_useage::Word8, -- determines if the Maybes are Just or Nothing
 		symmetric_type::Maybe Word8,
 		s2k_type::Maybe Word8,
@@ -197,6 +195,9 @@ secret_key_fields ELGAMAL = ['x']
 secret_key_fields DSA     = ['x']
 secret_key_fields _       = undefined -- Nothing in the spec. Maybe empty
 
+(!) :: (Eq k) => [(k,v)] -> k -> v
+(!) xs = fromJust . (`lookup` xs)
+
 -- Need this seperate for trailer calculation
 signature_packet_start :: Packet -> LZ.ByteString
 signature_packet_start (SignaturePacket {
@@ -389,7 +390,7 @@ parse_packet  5 = do
 	} else do
 		key <- foldM (\m f -> do
 			mpi <- get :: Get MPI
-			return $ Map.insert f mpi m) key (secret_key_fields algorithm)
+			return $ (f,mpi):m) key (secret_key_fields algorithm)
 		private_hash <- getRemainingLazyByteString
 		return ((k' LZ.empty (Just private_hash)) {key = key})
 -- PublicKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.2
@@ -406,7 +407,7 @@ parse_packet  6 = do
 				version = 4,
 				timestamp = timestamp,
 				key_algorithm = algorithm,
-				key = Map.fromList key
+				key = key
 			}
 		x -> fail $ "Unsupported PublicKeyPacket version " ++ show x ++ "."
 -- CompressedDataPacket, http://tools.ietf.org/html/rfc4880#section-5.6
diff --git a/openpgp.cabal b/openpgp.cabal
index 3f3d592..18e537a 100644
--- a/openpgp.cabal
+++ b/openpgp.cabal
@@ -126,7 +126,6 @@ library
 
         build-depends:
                 base == 4.*,
-                containers,
                 bytestring,
                 utf8-string,
                 binary,
@@ -139,7 +138,6 @@ test-suite tests
 
         build-depends:
                 base == 4.*,
-                containers,
                 bytestring,
                 utf8-string,
                 binary,
-- 
cgit v1.2.3


From 91e6b9448b36f4775026597e0df1f7b28b5db906 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 25 Apr 2012 19:23:32 -0500
Subject: Higher-order "get until end of input as list"

---
 Data/OpenPGP.hs | 30 ++++++++++++------------------
 1 file changed, 12 insertions(+), 18 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 8e1979b..818c125 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -323,12 +323,12 @@ parse_packet  2 = do
 			hash_algorithm <- get
 			hashed_size <- fmap fromIntegral (get :: Get Word16)
 			hashed_data <- getLazyByteString hashed_size
-			let hashed = runGet get_signature_subpackets hashed_data
+			let hashed = runGet listUntilEnd hashed_data
 			unhashed_size <- fmap fromIntegral (get :: Get Word16)
 			unhashed_data <- getLazyByteString unhashed_size
-			let unhashed = runGet get_signature_subpackets unhashed_data
+			let unhashed = runGet listUntilEnd unhashed_data
 			hash_head <- get
-			signature <- get
+			signature <- listUntilEnd
 			return SignaturePacket {
 				version = version,
 				signature_type = signature_type,
@@ -558,12 +558,7 @@ instance Binary Message where
 	put (Message (x:xs)) = do
 		put x
 		put (Message xs)
-	get = do
-		done <- isEmpty
-		if done then return (Message []) else do
-			next_packet <- get
-			(Message tail) <- get
-			return $ Message (next_packet:tail)
+	get = fmap Message listUntilEnd
 
 -- | Extract all signature and data packets from a 'Message'
 signatures_and_data :: Message -> ([Packet], [Packet])
@@ -593,6 +588,14 @@ instance Binary MPI where
 		return (MPI (LZ.foldl (\a b ->
 			a `shiftL` 8 .|. fromIntegral b) 0 bytes))
 
+listUntilEnd :: (Binary a) => Get [a]
+listUntilEnd = do
+	done <- isEmpty
+	if done then return [] else do
+		next <- get
+		rest <- listUntilEnd
+		return (next:rest)
+
 data SignatureSubpacket =
 	SignatureCreationTimePacket Word32 |
 	IssuerPacket String |
@@ -642,15 +645,6 @@ put_signature_subpacket (IssuerPacket keyid) =
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
-get_signature_subpackets :: Get [SignatureSubpacket]
-get_signature_subpackets = do
-	done <- isEmpty
-	if done then return [] else do {
-		next_packet <- get :: Get SignatureSubpacket;
-		tail <- get_signature_subpackets;
-		return (next_packet:tail);
-	}
-
 parse_signature_subpacket :: Word8 -> Get SignatureSubpacket
 -- SignatureCreationTimePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.4
 parse_signature_subpacket  2 = fmap SignatureCreationTimePacket get
-- 
cgit v1.2.3


From 0a474e49af677d1b9dd9570e3f54b5f52f8ab901 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 25 Apr 2012 19:23:50 -0500
Subject: Use mapM_ for Message put

---
 Data/OpenPGP.hs | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 818c125..06aa930 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -554,10 +554,7 @@ instance Binary CompressionAlgorithm where
 -- A message is encoded as a list that takes the entire file
 newtype Message = Message [Packet] deriving (Show, Read, Eq)
 instance Binary Message where
-	put (Message []) = return ()
-	put (Message (x:xs)) = do
-		put x
-		put (Message xs)
+	put (Message xs) = mapM_ put xs
 	get = fmap Message listUntilEnd
 
 -- | Extract all signature and data packets from a 'Message'
-- 
cgit v1.2.3


From 70c479af48b201228884bbe31b05ca6bcd832ebf Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 25 Apr 2012 19:24:14 -0500
Subject: A signature may be multiple MPIs

---
 Data/OpenPGP.hs | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 06aa930..8c248d8 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -79,7 +79,7 @@ data Packet =
 		hashed_subpackets::[SignatureSubpacket],
 		unhashed_subpackets::[SignatureSubpacket],
 		hash_head::Word16,
-		signature::MPI,
+		signature::[MPI],
 		trailer::LZ.ByteString
 	} |
 	OnePassSignaturePacket {
@@ -236,10 +236,11 @@ put_packet (SignaturePacket { version = 4,
                               hash_head = hash_head,
                               signature = signature,
                               trailer = trailer }) =
-	(LZ.concat [ trailer_top,
-	            encode (fromIntegral $ LZ.length unhashed :: Word16),
-	            unhashed,
-	            encode hash_head, encode signature ], 2)
+	(LZ.concat $ [
+		trailer_top,
+		encode (fromIntegral $ LZ.length unhashed :: Word16),
+		unhashed, encode hash_head
+	] ++ map encode signature, 2)
 	where
 	trailer_top = LZ.reverse $ LZ.drop 6 $ LZ.reverse trailer
 	unhashed = LZ.concat $ map encode unhashed_subpackets
@@ -686,7 +687,7 @@ find_key' fpr x xs keyid
 	thisid = reverse $ take (length keyid) (reverse (fpr x))
 
 -- | SignaturePacket smart constructor
-signaturePacket :: Word8 -> Word8 -> KeyAlgorithm -> HashAlgorithm -> [SignatureSubpacket] -> [SignatureSubpacket] -> Word16 -> MPI -> Packet
+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,
-- 
cgit v1.2.3


From 913c09eb763e35bfba79f655c3fe3a6cec593a56 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Thu, 26 Apr 2012 22:04:18 -0500
Subject: Second openpgp-cereal package using CPP

When you compile with make CEREAL=1
---
 Data/OpenPGP.hs | 236 +++++++++++++++++++++++++++++++++++---------------------
 Makefile        |  22 +++++-
 tests/suite.hs  |  23 ++++--
 3 files changed, 184 insertions(+), 97 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 8c248d8..7c3e8ba 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 -- | Main implementation of the OpenPGP message format <http://tools.ietf.org/html/rfc4880>
 --
 -- The recommended way to import this module is:
@@ -61,15 +62,83 @@ import Data.Word
 import Data.Char
 import Data.Maybe
 import qualified Data.ByteString.Lazy as LZ
-import qualified Data.ByteString.Lazy.UTF8 as LZ (toString, fromString)
 
+#ifdef CEREAL
+import Data.Serialize
+import qualified Data.ByteString as B
+import qualified Data.ByteString.UTF8 as B (toString, fromString)
+#define BINARY_CLASS Serialize
+#else
 import Data.Binary
 import Data.Binary.Get
 import Data.Binary.Put
+import qualified Data.ByteString.Lazy as B
+import qualified Data.ByteString.Lazy.UTF8 as B (toString, fromString)
+#define BINARY_CLASS Binary
+#endif
+
 import qualified Codec.Compression.Zlib.Raw as Zip
 import qualified Codec.Compression.Zlib as Zlib
 import qualified Codec.Compression.BZip as BZip2
 
+#ifdef CEREAL
+getRemainingByteString :: Get B.ByteString
+getRemainingByteString = remaining >>= getByteString
+
+getSomeByteString :: Word64 -> Get B.ByteString
+getSomeByteString = getByteString . fromIntegral
+
+putSomeByteString :: B.ByteString -> Put
+putSomeByteString = putByteString
+
+unsafeRunGet :: Get a -> B.ByteString -> a
+unsafeRunGet g bs = let Right v = runGet g bs in v
+
+compress :: CompressionAlgorithm -> B.ByteString -> B.ByteString
+compress algo = toStrictBS . lazyCompress algo . toLazyBS
+
+decompress :: CompressionAlgorithm -> B.ByteString -> B.ByteString
+decompress algo = toStrictBS . lazyDecompress algo . toLazyBS
+
+toStrictBS :: LZ.ByteString -> B.ByteString
+toStrictBS = B.concat . LZ.toChunks
+
+toLazyBS :: B.ByteString -> LZ.ByteString
+toLazyBS = LZ.fromChunks . (:[])
+#else
+getRemainingByteString :: Get B.ByteString
+getRemainingByteString = getRemainingLazyByteString
+
+getSomeByteString :: Word64 -> Get B.ByteString
+getSomeByteString = getLazyByteString . fromIntegral
+
+putSomeByteString :: B.ByteString -> Put
+putSomeByteString = putLazyByteString
+
+unsafeRunGet :: Get a -> B.ByteString -> a
+unsafeRunGet = runGet
+
+compress :: CompressionAlgorithm -> B.ByteString -> B.ByteString
+compress = lazyCompress
+
+decompress :: CompressionAlgorithm -> B.ByteString -> B.ByteString
+decompress = lazyDecompress
+#endif
+
+lazyCompress :: CompressionAlgorithm -> LZ.ByteString -> LZ.ByteString
+lazyCompress Uncompressed = id
+lazyCompress ZIP          = Zip.compress
+lazyCompress ZLIB         = Zlib.compress
+lazyCompress BZip2        = BZip2.compress
+lazyCompress x            = error ("No implementation for " ++ show x)
+
+lazyDecompress :: CompressionAlgorithm -> LZ.ByteString -> LZ.ByteString
+lazyDecompress Uncompressed = id
+lazyDecompress ZIP          = Zip.decompress
+lazyDecompress ZLIB         = Zlib.decompress
+lazyDecompress BZip2        = BZip2.decompress
+lazyDecompress x            = error ("No implementation for " ++ show x)
+
 data Packet =
 	SignaturePacket {
 		version::Word8,
@@ -80,7 +149,7 @@ data Packet =
 		unhashed_subpackets::[SignatureSubpacket],
 		hash_head::Word16,
 		signature::[MPI],
-		trailer::LZ.ByteString
+		trailer::B.ByteString
 	} |
 	OnePassSignaturePacket {
 		version::Word8,
@@ -107,8 +176,8 @@ data Packet =
 		s2k_hash_algorithm::Maybe HashAlgorithm,
 		s2k_salt::Maybe Word64,
 		s2k_count::Maybe Word32,
-		encrypted_data::LZ.ByteString,
-		private_hash::Maybe LZ.ByteString -- the hash may be in the encrypted data
+		encrypted_data::B.ByteString,
+		private_hash::Maybe B.ByteString -- the hash may be in the encrypted data
 	} |
 	CompressedDataPacket {
 		compression_algorithm::CompressionAlgorithm,
@@ -118,20 +187,20 @@ data Packet =
 		format::Char,
 		filename::String,
 		timestamp::Word32,
-		content::LZ.ByteString
+		content::B.ByteString
 	} |
 	UserIDPacket String |
-	UnsupportedPacket Word8 LZ.ByteString
+	UnsupportedPacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
-instance Binary Packet where
+instance BINARY_CLASS Packet where
 	put p = do
 		-- First two bits are 1 for new packet format
 		put ((tag .|. 0xC0) :: Word8)
 		-- Use 5-octet lengths
 		put (255 :: Word8)
-		put ((fromIntegral $ LZ.length body) :: Word32)
-		putLazyByteString body
+		put ((fromIntegral $ B.length body) :: Word32)
+		putSomeByteString body
 		where
 		(body, tag) = put_packet p
 	get = do
@@ -143,8 +212,8 @@ instance Binary Packet where
 				((tag `shiftR` 2) .&. 15, parse_old_length tag)
 		len <- l
 		-- This forces the whole packet to be consumed
-		packet <- getLazyByteString (fromIntegral len)
-		return $ runGet (parse_packet t) packet
+		packet <- getSomeByteString (fromIntegral len)
+		return $ unsafeRunGet (parse_packet t) packet
 
 -- http://tools.ietf.org/html/rfc4880#section-4.2.2
 parse_new_length :: Get Word32
@@ -199,7 +268,7 @@ secret_key_fields _       = undefined -- Nothing in the spec. Maybe empty
 (!) xs = fromJust . (`lookup` xs)
 
 -- Need this seperate for trailer calculation
-signature_packet_start :: Packet -> LZ.ByteString
+signature_packet_start :: Packet -> B.ByteString
 signature_packet_start (SignaturePacket {
 	version = 4,
 	signature_type = signature_type,
@@ -207,50 +276,50 @@ signature_packet_start (SignaturePacket {
 	hash_algorithm = hash_algorithm,
 	hashed_subpackets = hashed_subpackets
 }) =
-	LZ.concat [
+	B.concat [
 		encode (0x04 :: Word8),
 		encode signature_type,
 		encode key_algorithm,
 		encode hash_algorithm,
-		encode ((fromIntegral $ LZ.length hashed_subs) :: Word16),
+		encode ((fromIntegral $ B.length hashed_subs) :: Word16),
 		hashed_subs
 	]
 	where
-	hashed_subs = LZ.concat $ map encode hashed_subpackets
+	hashed_subs = B.concat $ map encode hashed_subpackets
 signature_packet_start _ =
 	error "Trying to get start of signature packet for non signature packet."
 
 -- The trailer is just the top of the body plus some crap
-calculate_signature_trailer :: Packet -> LZ.ByteString
+calculate_signature_trailer :: Packet -> B.ByteString
 calculate_signature_trailer p =
-	LZ.concat [
+	B.concat [
 		signature_packet_start p,
 		encode (0x04 :: Word8),
 		encode (0xff :: Word8),
-		encode (fromIntegral (LZ.length $ signature_packet_start p) :: Word32)
+		encode (fromIntegral (B.length $ signature_packet_start p) :: Word32)
 	]
 
-put_packet :: (Num a) => Packet -> (LZ.ByteString, a)
+put_packet :: (Num a) => Packet -> (B.ByteString, a)
 put_packet (SignaturePacket { version = 4,
                               unhashed_subpackets = unhashed_subpackets,
                               hash_head = hash_head,
                               signature = signature,
                               trailer = trailer }) =
-	(LZ.concat $ [
+	(B.concat $ [
 		trailer_top,
-		encode (fromIntegral $ LZ.length unhashed :: Word16),
+		encode (fromIntegral $ B.length unhashed :: Word16),
 		unhashed, encode hash_head
 	] ++ map encode signature, 2)
 	where
-	trailer_top = LZ.reverse $ LZ.drop 6 $ LZ.reverse trailer
-	unhashed = LZ.concat $ map encode unhashed_subpackets
+	trailer_top = B.reverse $ B.drop 6 $ B.reverse trailer
+	unhashed = B.concat $ map encode unhashed_subpackets
 put_packet (OnePassSignaturePacket { version = version,
                                      signature_type = signature_type,
                                      hash_algorithm = hash_algorithm,
                                      key_algorithm = key_algorithm,
                                      key_id = key_id,
                                      nested = nested }) =
-	(LZ.concat [ encode version, encode signature_type,
+	(B.concat [ encode version, encode signature_type,
 	             encode hash_algorithm, encode key_algorithm,
 	             encode (fst $ head $ readHex key_id :: Word64),
 	             encode nested ], 4)
@@ -263,7 +332,7 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
                               s2k_salt = s2k_salt,
                               s2k_count = s2k_count,
                               encrypted_data = encrypted_data }) =
-	(LZ.concat $ [p, encode s2k_useage] ++
+	(B.concat $ [p, encode s2k_useage] ++
 	(if s2k_useage `elem` [255, 254] then
 		[encode $ fromJust symmetric_type, encode s2k_t,
 		 encode $ fromJust s2k_hash_algo] ++
@@ -276,39 +345,32 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
 	else s ++
 		-- XXX: Checksum is part of encrypted_data for V4 ONLY
 		if s2k_useage == 254 then
-			[LZ.replicate 20 0] -- TODO SHA1 Checksum
+			[B.replicate 20 0] -- TODO SHA1 Checksum
 		else
 			[encode (fromIntegral $
-				LZ.foldl (\c i -> (c + fromIntegral i) `mod` 65536)
-				(0::Integer) (LZ.concat s) :: Word16)]), 5)
+				B.foldl (\c i -> (c + fromIntegral i) `mod` 65536)
+				(0::Integer) (B.concat s) :: Word16)]), 5)
 	where
 	(Just s2k_t) = s2k_type
 	p = fst (put_packet $ PublicKeyPacket version timestamp algorithm key
-		:: (LZ.ByteString, Integer)) -- Supress warning
+		:: (B.ByteString, Integer)) -- Supress warning
 	s = map (encode . (key !)) (secret_key_fields algorithm)
 put_packet (PublicKeyPacket { version = 4, timestamp = timestamp,
                               key_algorithm = algorithm, key = key }) =
-	(LZ.concat $ [LZ.singleton 4, encode timestamp, encode algorithm] ++
+	(B.concat $ [B.singleton 4, encode timestamp, encode algorithm] ++
 		map (encode . (key !)) (public_key_fields algorithm), 6)
 put_packet (CompressedDataPacket { compression_algorithm = algorithm,
                                    message = message }) =
-	(LZ.append (encode algorithm) $ compress $ encode message, 8)
-	where
-	compress = case algorithm of
-		Uncompressed -> id
-		ZIP          -> Zip.compress
-		ZLIB         -> Zlib.compress
-		BZip2        -> BZip2.compress
-		x            -> error ("No implementation for " ++ show x)
+	(B.append (encode algorithm) $ compress algorithm $ encode message, 8)
 put_packet (LiteralDataPacket { format = format, filename = filename,
                                 timestamp = timestamp, content = content
                               }) =
-	(LZ.concat [encode format, encode filename_l, lz_filename,
+	(B.concat [encode format, encode filename_l, lz_filename,
 	            encode timestamp, content], 11)
 	where
-	filename_l  = (fromIntegral $ LZ.length lz_filename) :: Word8
-	lz_filename = LZ.fromString filename
-put_packet (UserIDPacket txt) = (LZ.fromString txt, 13)
+	filename_l  = (fromIntegral $ B.length lz_filename) :: Word8
+	lz_filename = B.fromString filename
+put_packet (UserIDPacket txt) = (B.fromString txt, 13)
 put_packet (UnsupportedPacket tag bytes) = (bytes, fromIntegral tag)
 put_packet _ = error "Unsupported Packet version or type in put_packet."
 
@@ -323,11 +385,11 @@ parse_packet  2 = do
 			key_algorithm <- get
 			hash_algorithm <- get
 			hashed_size <- fmap fromIntegral (get :: Get Word16)
-			hashed_data <- getLazyByteString hashed_size
-			let hashed = runGet listUntilEnd hashed_data
+			hashed_data <- getSomeByteString hashed_size
+			let hashed = unsafeRunGet listUntilEnd hashed_data
 			unhashed_size <- fmap fromIntegral (get :: Get Word16)
-			unhashed_data <- getLazyByteString unhashed_size
-			let unhashed = runGet listUntilEnd unhashed_data
+			unhashed_data <- getSomeByteString unhashed_size
+			let unhashed = unsafeRunGet listUntilEnd unhashed_data
 			hash_head <- get
 			signature <- listUntilEnd
 			return SignaturePacket {
@@ -339,7 +401,7 @@ parse_packet  2 = do
 				unhashed_subpackets = unhashed,
 				hash_head = hash_head,
 				signature = signature,
-				trailer = LZ.concat [encode version, encode signature_type, encode key_algorithm, encode hash_algorithm, encode (fromIntegral hashed_size :: Word16), hashed_data, LZ.pack [4, 0xff], encode ((6 + fromIntegral hashed_size) :: Word32)]
+				trailer = B.concat [encode version, encode signature_type, encode key_algorithm, encode hash_algorithm, encode (fromIntegral hashed_size :: Word16), hashed_data, B.pack [4, 0xff], encode ((6 + fromIntegral hashed_size) :: Word32)]
 			}
 		x -> fail $ "Unknown SignaturePacket version " ++ show x ++ "."
 -- OnePassSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.4
@@ -386,14 +448,14 @@ parse_packet  5 = do
 		_ ->
 			return (k Nothing Nothing Nothing Nothing Nothing)
 	if s2k_useage > 0 then do {
-		encrypted <- getRemainingLazyByteString;
+		encrypted <- getRemainingByteString;
 		return (k' encrypted Nothing)
 	} else do
 		key <- foldM (\m f -> do
 			mpi <- get :: Get MPI
 			return $ (f,mpi):m) key (secret_key_fields algorithm)
-		private_hash <- getRemainingLazyByteString
-		return ((k' LZ.empty (Just private_hash)) {key = key})
+		private_hash <- getRemainingByteString
+		return ((k' B.empty (Just private_hash)) {key = key})
 -- PublicKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.2
 parse_packet  6 = do
 	version <- get :: Get Word8
@@ -414,51 +476,45 @@ parse_packet  6 = do
 -- CompressedDataPacket, http://tools.ietf.org/html/rfc4880#section-5.6
 parse_packet  8 = do
 	algorithm <- get
-	message <- getRemainingLazyByteString
-	let decompress = case algorithm of
-		Uncompressed -> id
-		ZIP          -> Zip.decompress
-		ZLIB         -> Zlib.decompress
-		BZip2        -> BZip2.decompress
-		x            -> error ("No implementation for " ++ show x)
+	message <- getRemainingByteString
 	return CompressedDataPacket {
 		compression_algorithm = algorithm,
-		message = runGet (get :: Get Message) (decompress message)
+		message = unsafeRunGet get (decompress algorithm message)
 	}
 -- LiteralDataPacket, http://tools.ietf.org/html/rfc4880#section-5.9
 parse_packet 11 = do
 	format <- get
 	filenameLength <- get :: Get Word8
-	filename <- getLazyByteString (fromIntegral filenameLength)
+	filename <- getSomeByteString (fromIntegral filenameLength)
 	timestamp <- get
-	content <- getRemainingLazyByteString
+	content <- getRemainingByteString
 	return LiteralDataPacket {
 		format = format,
-		filename = LZ.toString filename,
+		filename = B.toString filename,
 		timestamp = timestamp,
 		content = content
 	}
 -- UserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.11
 parse_packet 13 =
-	fmap (UserIDPacket . LZ.toString) getRemainingLazyByteString
+	fmap (UserIDPacket . B.toString) getRemainingByteString
 -- Represent unsupported packets as their tag and literal bytes
-parse_packet tag = fmap (UnsupportedPacket tag) getRemainingLazyByteString
+parse_packet tag = fmap (UnsupportedPacket tag) getRemainingByteString
 
 -- | Helper method for fingerprints and such
-fingerprint_material :: Packet -> [LZ.ByteString]
+fingerprint_material :: Packet -> [B.ByteString]
 fingerprint_material (PublicKeyPacket {version = 4,
                       timestamp = timestamp,
                       key_algorithm = algorithm,
                       key = key}) =
 	[
-		LZ.singleton 0x99,
-		encode (6 + fromIntegral (LZ.length material) :: Word16),
-		LZ.singleton 4, encode timestamp, encode algorithm,
+		B.singleton 0x99,
+		encode (6 + fromIntegral (B.length material) :: Word16),
+		B.singleton 4, encode timestamp, encode algorithm,
 		material
 	]
 	where
 	material =
-		LZ.concat $ map (encode . (key !)) (public_key_fields algorithm)
+		B.concat $ map (encode . (key !)) (public_key_fields algorithm)
 -- Proxy to make SecretKeyPacket work
 fingerprint_material (SecretKeyPacket {version = 4,
                       timestamp = timestamp,
@@ -470,8 +526,8 @@ fingerprint_material (SecretKeyPacket {version = 4,
                       key = key}
 fingerprint_material p | version p `elem` [2, 3] = [n, e]
 	where
-	n = LZ.drop 2 (encode (key p ! 'n'))
-	e = LZ.drop 2 (encode (key p ! 'e'))
+	n = B.drop 2 (encode (key p ! 'n'))
+	e = B.drop 2 (encode (key p ! 'e'))
 fingerprint_material _ =
 	error "Unsupported Packet version or type in fingerprint_material."
 
@@ -502,7 +558,7 @@ instance Enum HashAlgorithm where
 	fromEnum SHA224    = 11
 	fromEnum (HashAlgorithm x) = fromIntegral x
 
-instance Binary HashAlgorithm where
+instance BINARY_CLASS HashAlgorithm where
 	put = put . enum_to_word8
 	get = fmap enum_from_word8 get
 
@@ -529,7 +585,7 @@ instance Enum KeyAlgorithm where
 	fromEnum DH      = 21
 	fromEnum (KeyAlgorithm x) = fromIntegral x
 
-instance Binary KeyAlgorithm where
+instance BINARY_CLASS KeyAlgorithm where
 	put = put . enum_to_word8
 	get = fmap enum_from_word8 get
 
@@ -548,13 +604,13 @@ instance Enum CompressionAlgorithm where
 	fromEnum BZip2        = 3
 	fromEnum (CompressionAlgorithm x) = fromIntegral x
 
-instance Binary CompressionAlgorithm where
+instance BINARY_CLASS CompressionAlgorithm where
 	put = put . enum_to_word8
 	get = fmap enum_from_word8 get
 
 -- A message is encoded as a list that takes the entire file
 newtype Message = Message [Packet] deriving (Show, Read, Eq)
-instance Binary Message where
+instance BINARY_CLASS Message where
 	put (Message xs) = mapM_ put xs
 	get = fmap Message listUntilEnd
 
@@ -569,24 +625,24 @@ signatures_and_data (Message lst) =
 	isDta _ = False
 
 newtype MPI = MPI Integer deriving (Show, Read, Eq, Ord)
-instance Binary MPI where
+instance BINARY_CLASS MPI where
 	put (MPI i) = do
-		put (((fromIntegral . LZ.length $ bytes) - 1) * 8
-			+ floor (logBase (2::Double) $ fromIntegral (bytes `LZ.index` 0))
+		put (((fromIntegral . B.length $ bytes) - 1) * 8
+			+ floor (logBase (2::Double) $ fromIntegral (bytes `B.index` 0))
 			+ 1 :: Word16)
-		putLazyByteString bytes
+		putSomeByteString bytes
 		where
-		bytes = LZ.reverse $ LZ.unfoldr (\x ->
+		bytes = B.reverse $ B.unfoldr (\x ->
 				if x == 0 then Nothing else
 					Just (fromIntegral x, x `shiftR` 8)
 			) i
 	get = do
 		length <- fmap fromIntegral (get :: Get Word16)
-		bytes <- getLazyByteString ((length + 7) `div` 8)
-		return (MPI (LZ.foldl (\a b ->
+		bytes <- getSomeByteString ((length + 7) `div` 8)
+		return (MPI (B.foldl (\a b ->
 			a `shiftL` 8 .|. fromIntegral b) 0 bytes))
 
-listUntilEnd :: (Binary a) => Get [a]
+listUntilEnd :: (BINARY_CLASS a) => Get [a]
 listUntilEnd = do
 	done <- isEmpty
 	if done then return [] else do
@@ -597,16 +653,16 @@ listUntilEnd = do
 data SignatureSubpacket =
 	SignatureCreationTimePacket Word32 |
 	IssuerPacket String |
-	UnsupportedSignatureSubpacket Word8 LZ.ByteString
+	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
-instance Binary SignatureSubpacket where
+instance BINARY_CLASS SignatureSubpacket where
 	put p = do
 		-- Use 5-octet-length + 1 for tag as the first packet body octet
 		put (255 :: Word8)
-		put (fromIntegral (LZ.length body) + 1 :: Word32)
+		put (fromIntegral (B.length body) + 1 :: Word32)
 		put tag
-		putLazyByteString body
+		putSomeByteString body
 		where
 		(body, tag) = put_signature_subpacket p
 	get = do
@@ -621,8 +677,8 @@ instance Binary SignatureSubpacket where
 				return len
 		tag <- get :: Get Word8
 		-- This forces the whole packet to be consumed
-		packet <- getLazyByteString (len-1)
-		return $ runGet (parse_signature_subpacket tag) packet
+		packet <- getSomeByteString (len-1)
+		return $ unsafeRunGet (parse_signature_subpacket tag) packet
 
 -- | Find the keyid that issued a SignaturePacket
 signature_issuer :: Packet -> Maybe String
@@ -635,7 +691,7 @@ signature_issuer (SignaturePacket {hashed_subpackets = hashed,
 	      isIssuer _ = False
 signature_issuer _ = Nothing
 
-put_signature_subpacket :: SignatureSubpacket -> (LZ.ByteString, Word8)
+put_signature_subpacket :: SignatureSubpacket -> (B.ByteString, Word8)
 put_signature_subpacket (SignatureCreationTimePacket time) =
 	(encode time, 2)
 put_signature_subpacket (IssuerPacket keyid) =
@@ -652,7 +708,7 @@ parse_signature_subpacket 16 = do
 	return $ IssuerPacket (map toUpper $ showHex keyid "")
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
-	fmap (UnsupportedSignatureSubpacket tag) getRemainingLazyByteString
+	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
 
 decode_s2k_count :: Word8 -> Word32
 decode_s2k_count c =  (16 + (fromIntegral c .&. 15)) `shiftL`
diff --git a/Makefile b/Makefile
index 85dc9db..865498c 100644
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,10 @@
-GHCFLAGS=-Wall -XNoCPP -fno-warn-name-shadowing -XHaskell98
-HLINTFLAGS=-XHaskell98 -XNoCPP -i 'Use camelCase' -i 'Use String' -i 'Use head' -i 'Use string literal' -i 'Use list comprehension' --utf8
+ifdef CEREAL
+GHCFLAGS=-Wall -DCEREAL -fno-warn-name-shadowing -XHaskell98
+else
+GHCFLAGS=-Wall -fno-warn-name-shadowing -XHaskell98
+endif
+
+HLINTFLAGS=-XHaskell98 -XCPP -i 'Use camelCase' -i 'Use String' -i 'Use head' -i 'Use string literal' -i 'Use list comprehension' --utf8
 VERSION=0.3
 
 .PHONY: all clean doc install debian test
@@ -28,13 +33,26 @@ README: openpgp.cabal
 	-printf ',s/        //g\n,s/^.$$//g\nw\nq\n' | ed $@
 	$(RM) .$@
 
+# XXX: Is there a way to make this just pass through $(GHCFLAGS)
+ifdef CEREAL
+dist/doc/html/openpgp/index.html: dist/setup-config Data/OpenPGP.hs
+	cabal haddock --hyperlink-source --haddock-options="--optghc=-DCEREAL"
+else
 dist/doc/html/openpgp/index.html: dist/setup-config Data/OpenPGP.hs
 	cabal haddock --hyperlink-source
+endif
 
+ifdef CEREAL
+dist/setup-config: openpgp.cabal
+	-printf '1c\nname:            openpgp-cereal\n.\n,s/binary,$$/cereal,/g\nw\nq\n' | ed openpgp.cabal
+	cabal configure
+else
 dist/setup-config: openpgp.cabal
 	cabal configure
+endif
 
 clean:
+	-printf '1c\nname:            openpgp\n.\n,s/cereal,$$/binary,/g\nw\nq\n' | ed openpgp.cabal
 	find -name '*.o' -o -name '*.hi' | xargs $(RM)
 	$(RM) sign verify keygen tests/suite
 	$(RM) -r dist dist-ghc
diff --git a/tests/suite.hs b/tests/suite.hs
index f5c8946..3f15a75 100644
--- a/tests/suite.hs
+++ b/tests/suite.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 import Test.Framework (defaultMain, testGroup, Test)
 import Test.Framework.Providers.HUnit
 import Test.Framework.Providers.QuickCheck2
@@ -5,18 +6,30 @@ import Test.QuickCheck
 import Test.HUnit hiding (Test)
 
 import Data.Word
-import Data.Binary
 import qualified Data.OpenPGP as OpenPGP
-import qualified Data.ByteString.Lazy as LZ
+
+#ifdef CEREAL
+import Data.Serialize
+import qualified Data.ByteString as B
+
+decode' :: (Serialize a) => B.ByteString -> a
+decode' x = let Right v = decode x in v
+#else
+import Data.Binary
+import qualified Data.ByteString.Lazy as B
+
+decode' :: (Binary a) => B.ByteString -> a
+decode' = decode
+#endif
 
 instance Arbitrary OpenPGP.HashAlgorithm where
 	arbitrary = elements [OpenPGP.MD5, OpenPGP.SHA1, OpenPGP.SHA256, OpenPGP.SHA384, OpenPGP.SHA512]
 
 testSerialization :: FilePath -> Assertion
 testSerialization fp = do
-	bs <- LZ.readFile $ "tests/data/" ++ fp
-	nullShield "First" (decode bs) (\firstpass ->
-			nullShield "Second" (decode $ encode firstpass) (
+	bs <- B.readFile $ "tests/data/" ++ fp
+	nullShield "First" (decode' bs) (\firstpass ->
+			nullShield "Second" (decode' $encode firstpass) (
 				assertEqual ("for " ++ fp) firstpass
 			)
 		)
-- 
cgit v1.2.3


From 5b1532529dd4850e5b94730c628f8285c30d1771 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 10:54:16 -0500
Subject: Hide internal stuff that is used by tests

---
 Data/OpenPGP.hs          | 20 ++------------------
 Data/OpenPGP/Internal.hs | 20 ++++++++++++++++++++
 Makefile                 | 12 ++++++------
 openpgp.cabal            |  3 +++
 tests/suite.hs           |  1 +
 5 files changed, 32 insertions(+), 24 deletions(-)
 create mode 100644 Data/OpenPGP/Internal.hs

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 7c3e8ba..e48dcf6 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -51,8 +51,7 @@ module Data.OpenPGP (
 	find_key,
 	fingerprint_material,
 	signatures_and_data,
-	signature_issuer,
-	decode_s2k_count, encode_s2k_count
+	signature_issuer
 ) where
 
 import Numeric
@@ -61,6 +60,7 @@ import Data.Bits
 import Data.Word
 import Data.Char
 import Data.Maybe
+import Data.OpenPGP.Internal
 import qualified Data.ByteString.Lazy as LZ
 
 #ifdef CEREAL
@@ -710,22 +710,6 @@ parse_signature_subpacket 16 = do
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
 
-decode_s2k_count :: Word8 -> Word32
-decode_s2k_count c =  (16 + (fromIntegral c .&. 15)) `shiftL`
-	((fromIntegral c `shiftR` 4) + 6)
-
-encode_s2k_count :: Word32 -> Word8
-encode_s2k_count iterations
-	| iterations >= 65011712 = 255
-	| decode_s2k_count result < iterations = result+1
-	| otherwise = result
-	where
-	result = fromIntegral $ (fromIntegral c `shiftL` 4) .|. (count - 16)
-	(count, c) = encode_s2k_count' (iterations `shiftR` 6) (0::Word8)
-	encode_s2k_count' count c
-		| count < 32 = (count, c)
-		| otherwise = encode_s2k_count' (count `shiftR` 1) (c+1)
-
 find_key :: (Packet -> String) -> Message -> String -> Maybe Packet
 find_key fpr (Message (x@(PublicKeyPacket {}):xs)) keyid =
 	find_key' fpr x xs keyid
diff --git a/Data/OpenPGP/Internal.hs b/Data/OpenPGP/Internal.hs
new file mode 100644
index 0000000..b2bd506
--- /dev/null
+++ b/Data/OpenPGP/Internal.hs
@@ -0,0 +1,20 @@
+module Data.OpenPGP.Internal where
+
+import Data.Word
+import Data.Bits
+
+decode_s2k_count :: Word8 -> Word32
+decode_s2k_count c =  (16 + (fromIntegral c .&. 15)) `shiftL`
+	((fromIntegral c `shiftR` 4) + 6)
+
+encode_s2k_count :: Word32 -> Word8
+encode_s2k_count iterations
+	| iterations >= 65011712 = 255
+	| decode_s2k_count result < iterations = result+1
+	| otherwise = result
+	where
+	result = fromIntegral $ (fromIntegral c `shiftL` 4) .|. (count - 16)
+	(count, c) = encode_s2k_count' (iterations `shiftR` 6) (0::Word8)
+	encode_s2k_count' count c
+		| count < 32 = (count, c)
+		| otherwise = encode_s2k_count' (count `shiftR` 1) (c+1)
diff --git a/Makefile b/Makefile
index 865498c..2d9b719 100644
--- a/Makefile
+++ b/Makefile
@@ -19,10 +19,10 @@ debian: debian/control
 test: tests/suite
 	tests/suite
 
-tests/suite: tests/suite.hs Data/OpenPGP.hs
+tests/suite: tests/suite.hs Data/OpenPGP.hs Data/OpenPGP/Internal.hs
 	ghc --make $(GHCFLAGS) -o $@ $^
 
-report.html: Data/OpenPGP.hs tests/suite.hs
+report.html: tests/suite.hs Data/OpenPGP.hs Data/OpenPGP/Internal.hs
 	-hlint $(HLINTFLAGS) --report $^
 
 doc: dist/doc/html/openpgp/index.html README
@@ -35,10 +35,10 @@ README: openpgp.cabal
 
 # XXX: Is there a way to make this just pass through $(GHCFLAGS)
 ifdef CEREAL
-dist/doc/html/openpgp/index.html: dist/setup-config Data/OpenPGP.hs
+dist/doc/html/openpgp/index.html: dist/setup-config Data/OpenPGP.hs Data/OpenPGP/Internal.hs
 	cabal haddock --hyperlink-source --haddock-options="--optghc=-DCEREAL"
 else
-dist/doc/html/openpgp/index.html: dist/setup-config Data/OpenPGP.hs
+dist/doc/html/openpgp/index.html: dist/setup-config Data/OpenPGP.hs Data/OpenPGP/Internal.hs
 	cabal haddock --hyperlink-source
 endif
 
@@ -60,9 +60,9 @@ clean:
 debian/control: openpgp.cabal
 	cabal-debian --update-debianization
 
-dist/build/libHSopenpgp-$(VERSION).a: openpgp.cabal dist/setup-config Data/OpenPGP.hs
+dist/build/libHSopenpgp-$(VERSION).a: openpgp.cabal dist/setup-config Data/OpenPGP.hs Data/OpenPGP/Internal.hs
 	cabal build --ghc-options="$(GHCFLAGS)"
 
-dist/openpgp-$(VERSION).tar.gz: openpgp.cabal dist/setup-config Data/OpenPGP.hs README
+dist/openpgp-$(VERSION).tar.gz: openpgp.cabal dist/setup-config README Data/OpenPGP.hs Data/OpenPGP/Internal.hs
 	cabal check
 	cabal sdist
diff --git a/openpgp.cabal b/openpgp.cabal
index 18e537a..90cddb4 100644
--- a/openpgp.cabal
+++ b/openpgp.cabal
@@ -124,6 +124,9 @@ library
         exposed-modules:
                 Data.OpenPGP
 
+        other-modules:
+                Data.OpenPGP.Internal
+
         build-depends:
                 base == 4.*,
                 bytestring,
diff --git a/tests/suite.hs b/tests/suite.hs
index 3f15a75..60bcd25 100644
--- a/tests/suite.hs
+++ b/tests/suite.hs
@@ -7,6 +7,7 @@ import Test.HUnit hiding (Test)
 
 import Data.Word
 import qualified Data.OpenPGP as OpenPGP
+import qualified Data.OpenPGP.Internal as OpenPGP
 
 #ifdef CEREAL
 import Data.Serialize
-- 
cgit v1.2.3


From 67d36d8979d50ead14d40cb4c94ed6da153d0232 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 12:29:16 -0500
Subject: Handle signature subpacket critical bit

Currently throws away the data.  Suboptimal
---
 Data/OpenPGP.hs | 28 ++++++++++++++++------------
 1 file changed, 16 insertions(+), 12 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index e48dcf6..d1aac6a 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -675,21 +675,14 @@ instance BINARY_CLASS SignatureSubpacket where
 				fmap fromIntegral (get :: Get Word32)
 			_ -> -- One octet length, no furthur processing
 				return len
-		tag <- get :: Get Word8
+		tag <- fmap stripCrit get :: Get Word8
 		-- This forces the whole packet to be consumed
 		packet <- getSomeByteString (len-1)
 		return $ unsafeRunGet (parse_signature_subpacket tag) packet
-
--- | Find the keyid that issued a SignaturePacket
-signature_issuer :: Packet -> Maybe String
-signature_issuer (SignaturePacket {hashed_subpackets = hashed,
-                                   unhashed_subpackets = unhashed}) =
-	if length issuers > 0 then Just issuer else Nothing
-	where IssuerPacket issuer = issuers !! 0
-	      issuers = filter isIssuer hashed ++ filter isIssuer unhashed
-	      isIssuer (IssuerPacket {}) = True
-	      isIssuer _ = False
-signature_issuer _ = Nothing
+		where
+		-- TODO: Decide how to actually encode the "is critical" data
+		-- instead of just ignoring it
+		stripCrit tag = if tag .&. 0x80 == 0x80 then tag .&. 0x7f else tag
 
 put_signature_subpacket :: SignatureSubpacket -> (B.ByteString, Word8)
 put_signature_subpacket (SignatureCreationTimePacket time) =
@@ -710,6 +703,17 @@ parse_signature_subpacket 16 = do
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
 
+-- | Find the keyid that issued a SignaturePacket
+signature_issuer :: Packet -> Maybe String
+signature_issuer (SignaturePacket {hashed_subpackets = hashed,
+                                   unhashed_subpackets = unhashed}) =
+	if length issuers > 0 then Just issuer else Nothing
+	where IssuerPacket issuer = issuers !! 0
+	      issuers = filter isIssuer hashed ++ filter isIssuer unhashed
+	      isIssuer (IssuerPacket {}) = True
+	      isIssuer _ = False
+signature_issuer _ = Nothing
+
 find_key :: (Packet -> String) -> Message -> String -> Maybe Packet
 find_key fpr (Message (x@(PublicKeyPacket {}):xs)) keyid =
 	find_key' fpr x xs keyid
-- 
cgit v1.2.3


From c45d72cdb08ab9f1f362910c7be9205ce282e934 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 12:30:05 -0500
Subject: SignatureExpirationTimePacket, ExportableCertificationPacket,
 TrustSignaturePacket

---
 Data/OpenPGP.hs | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index d1aac6a..bf7cdf5 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -650,8 +650,12 @@ listUntilEnd = do
 		rest <- listUntilEnd
 		return (next:rest)
 
+-- http://tools.ietf.org/html/rfc4880#section-5.2.3.1
 data SignatureSubpacket =
 	SignatureCreationTimePacket Word32 |
+	SignatureExpirationTimePacket Word32 | -- seconds after CreationTime
+	ExportableCertificationPacket Bool |
+	TrustSignaturePacket {depth::Word8, trust::Word8} |
 	IssuerPacket String |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
@@ -687,6 +691,12 @@ instance BINARY_CLASS SignatureSubpacket where
 put_signature_subpacket :: SignatureSubpacket -> (B.ByteString, Word8)
 put_signature_subpacket (SignatureCreationTimePacket time) =
 	(encode time, 2)
+put_signature_subpacket (SignatureExpirationTimePacket time) =
+	(encode time, 3)
+put_signature_subpacket (ExportableCertificationPacket exportable) =
+	(encode $ enum_to_word8 exportable, 4)
+put_signature_subpacket (TrustSignaturePacket depth trust) =
+	(B.concat [encode depth, encode trust], 5)
 put_signature_subpacket (IssuerPacket keyid) =
 	(encode (fst $ head $ readHex keyid :: Word64), 16)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
@@ -695,6 +705,14 @@ put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 parse_signature_subpacket :: Word8 -> Get SignatureSubpacket
 -- SignatureCreationTimePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.4
 parse_signature_subpacket  2 = fmap SignatureCreationTimePacket get
+-- SignatureExpirationTimePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.10
+parse_signature_subpacket  3 = fmap SignatureExpirationTimePacket get
+-- ExportableCertificationPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.11
+parse_signature_subpacket  4 =
+	fmap (ExportableCertificationPacket . enum_from_word8) get
+-- TrustSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.13
+parse_signature_subpacket  5 =
+	liftM2 TrustSignaturePacket get get
 -- IssuerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.5
 parse_signature_subpacket 16 = do
 	keyid <- get :: Get Word64
-- 
cgit v1.2.3


From 16f0cd61f101ad1de2da3b3445b7f31b124de317 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 13:07:54 -0500
Subject: MPI encode/decode QuickCheck

---
 Arbitrary.patch | 9 +++++++++
 Data/OpenPGP.hs | 6 ++++--
 tests/suite.hs  | 5 +++++
 3 files changed, 18 insertions(+), 2 deletions(-)

(limited to 'Data')

diff --git a/Arbitrary.patch b/Arbitrary.patch
index 11b6b51..28bd37e 100644
--- a/Arbitrary.patch
+++ b/Arbitrary.patch
@@ -10,6 +10,15 @@
                     1 -> do x1 <- arbitrary
                             x2 <- arbitrary
                             x3 <- arbitrary
+@@ -116,7 +115,7 @@
+
+ instance Arbitrary MPI where
+         arbitrary
+-          = do x1 <- arbitrary
++          = do x1 <- suchThat arbitrary (>=0)
+                return (MPI x1)
+
+
 @@ -133,9 +132,8 @@
                     3 -> do x1 <- arbitrary
                             x2 <- arbitrary
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index bf7cdf5..63d4dc1 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -56,6 +56,7 @@ module Data.OpenPGP (
 
 import Numeric
 import Control.Monad
+import Control.Exception (assert)
 import Data.Bits
 import Data.Word
 import Data.Char
@@ -632,10 +633,11 @@ instance BINARY_CLASS MPI where
 			+ 1 :: Word16)
 		putSomeByteString bytes
 		where
-		bytes = B.reverse $ B.unfoldr (\x ->
+		bytes = if B.null bytes' then B.singleton 0 else bytes'
+		bytes' = B.reverse $ B.unfoldr (\x ->
 				if x == 0 then Nothing else
 					Just (fromIntegral x, x `shiftR` 8)
-			) i
+			) (assert (i>=0) i)
 	get = do
 		length <- fmap fromIntegral (get :: Get Word16)
 		bytes <- getSomeByteString ((length + 7) `div` 8)
diff --git a/tests/suite.hs b/tests/suite.hs
index 694a70a..afadc35 100644
--- a/tests/suite.hs
+++ b/tests/suite.hs
@@ -40,6 +40,10 @@ prop_s2k_count :: Word8 -> Bool
 prop_s2k_count c =
 	c == OpenPGP.encode_s2k_count (OpenPGP.decode_s2k_count c)
 
+prop_MPI_serialization_loop :: OpenPGP.MPI -> Bool
+prop_MPI_serialization_loop mpi =
+	mpi == decode (encode mpi)
+
 prop_SignatureSubpacket_serialization_loop :: OpenPGP.SignatureSubpacket -> Bool
 prop_SignatureSubpacket_serialization_loop packet =
 	packet == decode (encode packet)
@@ -135,6 +139,7 @@ tests =
 			testCase "uncompressed-ops-dsa.gpg" (testSerialization "uncompressed-ops-dsa.gpg"),
 			testCase "uncompressed-ops-dsa-sha384.txt.gpg" (testSerialization "uncompressed-ops-dsa-sha384.txt.gpg"),
 			testCase "uncompressed-ops-rsa.gpg" (testSerialization "uncompressed-ops-rsa.gpg"),
+			testProperty "MPI encode/decode" prop_MPI_serialization_loop,
 			testProperty "SignatureSubpacket encode/decode" prop_SignatureSubpacket_serialization_loop
 		],
 		testGroup "S2K count" [
-- 
cgit v1.2.3


From bca49f3b15fcb8d52fe9d67cd96d702fe06741b5 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 14:42:24 -0500
Subject: TrustSignaturePacket

---
 Arbitrary.patch | 12 ++++++------
 Data/OpenPGP.hs |  6 ++++++
 2 files changed, 12 insertions(+), 6 deletions(-)

(limited to 'Data')

diff --git a/Arbitrary.patch b/Arbitrary.patch
index 28bd37e..e82de3d 100644
--- a/Arbitrary.patch
+++ b/Arbitrary.patch
@@ -19,14 +19,14 @@
                 return (MPI x1)
 
 
-@@ -133,9 +132,8 @@
-                    3 -> do x1 <- arbitrary
-                            x2 <- arbitrary
+@@ -135,9 +134,8 @@
                             return (TrustSignaturePacket x1 x2)
--                   4 -> do x1 <- arbitrary
-+                   4 -> do x1 <- fmap (map toUpper . (`showHex` "")) (arbitrary :: Gen Word64)
+                    4 -> do x1 <- arbitrary
+                            return (RegularExpressionPacket x1)
+-                   5 -> do x1 <- arbitrary
++                   5 -> do x1 <- fmap (map toUpper . (`showHex` "")) (arbitrary :: Gen Word64)
                             return (IssuerPacket x1)
-                    5 -> do x1 <- arbitrary
+                    6 -> do x1 <- arbitrary
 -                           x2 <- arbitrary
 -                           return (UnsupportedSignatureSubpacket x1 x2)
 +                           return (UnsupportedSignatureSubpacket 105 x1)
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 63d4dc1..1fc3192 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -658,6 +658,7 @@ data SignatureSubpacket =
 	SignatureExpirationTimePacket Word32 | -- seconds after CreationTime
 	ExportableCertificationPacket Bool |
 	TrustSignaturePacket {depth::Word8, trust::Word8} |
+	RegularExpressionPacket String |
 	IssuerPacket String |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
@@ -699,6 +700,8 @@ put_signature_subpacket (ExportableCertificationPacket exportable) =
 	(encode $ enum_to_word8 exportable, 4)
 put_signature_subpacket (TrustSignaturePacket depth trust) =
 	(B.concat [encode depth, encode trust], 5)
+put_signature_subpacket (RegularExpressionPacket regex) =
+	(B.concat [B.fromString regex, B.singleton 0], 6)
 put_signature_subpacket (IssuerPacket keyid) =
 	(encode (fst $ head $ readHex keyid :: Word64), 16)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
@@ -715,6 +718,9 @@ parse_signature_subpacket  4 =
 -- TrustSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.13
 parse_signature_subpacket  5 =
 	liftM2 TrustSignaturePacket get get
+-- TrustSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.14
+parse_signature_subpacket  6 = fmap
+	(RegularExpressionPacket . B.toString . B.init) getRemainingByteString
 -- IssuerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.5
 parse_signature_subpacket 16 = do
 	keyid <- get :: Get Word64
-- 
cgit v1.2.3


From cb2a5013f8c831591841404cb4a7c8201c522ad2 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 15:01:11 -0500
Subject: formatting

---
 Data/OpenPGP.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 1fc3192..68c3d51 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -716,8 +716,7 @@ parse_signature_subpacket  3 = fmap SignatureExpirationTimePacket get
 parse_signature_subpacket  4 =
 	fmap (ExportableCertificationPacket . enum_from_word8) get
 -- TrustSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.13
-parse_signature_subpacket  5 =
-	liftM2 TrustSignaturePacket get get
+parse_signature_subpacket  5 = liftM2 TrustSignaturePacket get get
 -- TrustSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.14
 parse_signature_subpacket  6 = fmap
 	(RegularExpressionPacket . B.toString . B.init) getRemainingByteString
-- 
cgit v1.2.3


From bb537f6275d9c83ed11ab477eefdb33ccb38428f Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 15:01:47 -0500
Subject: RevocablePacket

---
 Arbitrary.patch | 14 +++++---------
 Data/OpenPGP.hs |  6 ++++++
 2 files changed, 11 insertions(+), 9 deletions(-)

(limited to 'Data')

diff --git a/Arbitrary.patch b/Arbitrary.patch
index e82de3d..b003906 100644
--- a/Arbitrary.patch
+++ b/Arbitrary.patch
@@ -19,15 +19,11 @@
                 return (MPI x1)
 
 
-@@ -135,9 +134,8 @@
-                            return (TrustSignaturePacket x1 x2)
-                    4 -> do x1 <- arbitrary
-                            return (RegularExpressionPacket x1)
--                   5 -> do x1 <- arbitrary
-+                   5 -> do x1 <- fmap (map toUpper . (`showHex` "")) (arbitrary :: Gen Word64)
-                            return (IssuerPacket x1)
-                    6 -> do x1 <- arbitrary
+                    _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
+@@ -140 +139 @@
+-                   6 -> do x1 <- arbitrary
++                   6 -> do x1 <- fmap (map toUpper . (`showHex` "")) (arbitrary :: Gen Word64)
+@@ -143,2 +142 @@
 -                           x2 <- arbitrary
 -                           return (UnsupportedSignatureSubpacket x1 x2)
 +                           return (UnsupportedSignatureSubpacket 105 x1)
-                    _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 68c3d51..b9a4836 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -659,6 +659,7 @@ data SignatureSubpacket =
 	ExportableCertificationPacket Bool |
 	TrustSignaturePacket {depth::Word8, trust::Word8} |
 	RegularExpressionPacket String |
+	RevocablePacket Bool |
 	IssuerPacket String |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
@@ -702,6 +703,8 @@ put_signature_subpacket (TrustSignaturePacket depth trust) =
 	(B.concat [encode depth, encode trust], 5)
 put_signature_subpacket (RegularExpressionPacket regex) =
 	(B.concat [B.fromString regex, B.singleton 0], 6)
+put_signature_subpacket (RevocablePacket exportable) =
+	(encode $ enum_to_word8 exportable, 7)
 put_signature_subpacket (IssuerPacket keyid) =
 	(encode (fst $ head $ readHex keyid :: Word64), 16)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
@@ -720,6 +723,9 @@ parse_signature_subpacket  5 = liftM2 TrustSignaturePacket get get
 -- TrustSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.14
 parse_signature_subpacket  6 = fmap
 	(RegularExpressionPacket . B.toString . B.init) getRemainingByteString
+-- RevocablePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.12
+parse_signature_subpacket  7 =
+	fmap (RevocablePacket . enum_from_word8) get
 -- IssuerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.5
 parse_signature_subpacket 16 = do
 	keyid <- get :: Get Word64
-- 
cgit v1.2.3


From d9b4face488cb3eb1a914f37b24751bb5dd9aeac Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 15:06:12 -0500
Subject: KeyExpirationTimePacket

---
 Arbitrary.patch | 4 ++--
 Data/OpenPGP.hs | 5 +++++
 2 files changed, 7 insertions(+), 2 deletions(-)

(limited to 'Data')

diff --git a/Arbitrary.patch b/Arbitrary.patch
index b003906..9c753cb 100644
--- a/Arbitrary.patch
+++ b/Arbitrary.patch
@@ -21,8 +21,8 @@
 
                     _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
 @@ -140 +139 @@
--                   6 -> do x1 <- arbitrary
-+                   6 -> do x1 <- fmap (map toUpper . (`showHex` "")) (arbitrary :: Gen Word64)
+-                   7 -> do x1 <- arbitrary
++                   7 -> do x1 <- fmap (map toUpper . (`showHex` "")) (arbitrary :: Gen Word64)
 @@ -143,2 +142 @@
 -                           x2 <- arbitrary
 -                           return (UnsupportedSignatureSubpacket x1 x2)
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index b9a4836..acf5fb6 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -660,6 +660,7 @@ data SignatureSubpacket =
 	TrustSignaturePacket {depth::Word8, trust::Word8} |
 	RegularExpressionPacket String |
 	RevocablePacket Bool |
+	KeyExpirationTimePacket Word32 | -- seconds after key CreationTime
 	IssuerPacket String |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
@@ -705,6 +706,8 @@ put_signature_subpacket (RegularExpressionPacket regex) =
 	(B.concat [B.fromString regex, B.singleton 0], 6)
 put_signature_subpacket (RevocablePacket exportable) =
 	(encode $ enum_to_word8 exportable, 7)
+put_signature_subpacket (KeyExpirationTimePacket time) =
+	(encode time, 9)
 put_signature_subpacket (IssuerPacket keyid) =
 	(encode (fst $ head $ readHex keyid :: Word64), 16)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
@@ -726,6 +729,8 @@ parse_signature_subpacket  6 = fmap
 -- RevocablePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.12
 parse_signature_subpacket  7 =
 	fmap (RevocablePacket . enum_from_word8) get
+-- KeyExpirationTimePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.6
+parse_signature_subpacket  9 = fmap KeyExpirationTimePacket get
 -- IssuerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.5
 parse_signature_subpacket 16 = do
 	keyid <- get :: Get Word64
-- 
cgit v1.2.3


From 26f1db51b6146ee09a119113506dc8f58559fbcf Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 15:23:20 -0500
Subject: SymmetricAlgorithm

---
 Arbitrary.patch |  9 +++++++++
 Data/OpenPGP.hs | 30 ++++++++++++++++++++++++++++++
 2 files changed, 39 insertions(+)

(limited to 'Data')

diff --git a/Arbitrary.patch b/Arbitrary.patch
index 9c753cb..6d855f1 100644
--- a/Arbitrary.patch
+++ b/Arbitrary.patch
@@ -10,6 +10,15 @@
                     1 -> do x1 <- arbitrary
                             x2 <- arbitrary
                             x3 <- arbitrary
+@@ -108,7 +107,7 @@
+                    6 -> return AES192
+                    7 -> return AES256
+                    8 -> return Twofish
+-                   9 -> do x1 <- arbitrary
++                   9 -> do x1 <- suchThat arbitrary (`notElem` [00,01,02,03,04,07,08,09,10])
+                            return (SymmetricAlgorithm x1)
+                    _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
+
 @@ -116,7 +115,7 @@
 
  instance Arbitrary MPI where
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index acf5fb6..878fb99 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -46,6 +46,7 @@ module Data.OpenPGP (
 	SignatureSubpacket(..),
 	HashAlgorithm(..),
 	KeyAlgorithm(..),
+	SymmetricAlgorithm(..),
 	CompressionAlgorithm(..),
 	MPI(..),
 	find_key,
@@ -590,6 +591,35 @@ instance BINARY_CLASS KeyAlgorithm where
 	put = put . enum_to_word8
 	get = fmap enum_from_word8 get
 
+data SymmetricAlgorithm = Unencrypted | IDEA | TripleDES | CAST5 | Blowfish | AES128 | AES192 | AES256 | Twofish | SymmetricAlgorithm Word8
+	deriving (Show, Read, Eq)
+
+instance Enum SymmetricAlgorithm where
+	toEnum 00 = Unencrypted
+	toEnum 01 = IDEA
+	toEnum 02 = TripleDES
+	toEnum 03 = CAST5
+	toEnum 04 = Blowfish
+	toEnum 07 = AES128
+	toEnum 08 = AES192
+	toEnum 09 = AES256
+	toEnum 10 = Twofish
+	toEnum x  = SymmetricAlgorithm $ fromIntegral x
+	fromEnum Unencrypted = 00
+	fromEnum IDEA        = 01
+	fromEnum TripleDES   = 02
+	fromEnum CAST5       = 03
+	fromEnum Blowfish    = 04
+	fromEnum AES128      = 07
+	fromEnum AES192      = 08
+	fromEnum AES256      = 09
+	fromEnum Twofish     = 10
+	fromEnum (SymmetricAlgorithm x) = fromIntegral x
+
+instance BINARY_CLASS SymmetricAlgorithm where
+	put = put . enum_to_word8
+	get = fmap enum_from_word8 get
+
 data CompressionAlgorithm = Uncompressed | ZIP | ZLIB | BZip2 | CompressionAlgorithm Word8
 	deriving (Show, Read, Eq)
 
-- 
cgit v1.2.3


From d0cbb7b8d6525466edcfeebe8fc06e69f1fbcf1b Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 15:24:07 -0500
Subject: PreferredSymmetricAlgorithmsPacket

---
 Arbitrary.patch | 4 ++--
 Data/OpenPGP.hs | 6 ++++++
 2 files changed, 8 insertions(+), 2 deletions(-)

(limited to 'Data')

diff --git a/Arbitrary.patch b/Arbitrary.patch
index 6d855f1..8de13ad 100644
--- a/Arbitrary.patch
+++ b/Arbitrary.patch
@@ -30,8 +30,8 @@
 
                     _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
 @@ -140 +139 @@
--                   7 -> do x1 <- arbitrary
-+                   7 -> do x1 <- fmap (map toUpper . (`showHex` "")) (arbitrary :: Gen Word64)
+-                   8 -> do x1 <- arbitrary
++                   8 -> do x1 <- fmap (map toUpper . (`showHex` "")) (arbitrary :: Gen Word64)
 @@ -143,2 +142 @@
 -                           x2 <- arbitrary
 -                           return (UnsupportedSignatureSubpacket x1 x2)
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 878fb99..3534ccf 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -691,6 +691,7 @@ data SignatureSubpacket =
 	RegularExpressionPacket String |
 	RevocablePacket Bool |
 	KeyExpirationTimePacket Word32 | -- seconds after key CreationTime
+	PreferredSymmetricAlgorithmsPacket [SymmetricAlgorithm] |
 	IssuerPacket String |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
@@ -738,6 +739,8 @@ put_signature_subpacket (RevocablePacket exportable) =
 	(encode $ enum_to_word8 exportable, 7)
 put_signature_subpacket (KeyExpirationTimePacket time) =
 	(encode time, 9)
+put_signature_subpacket (PreferredSymmetricAlgorithmsPacket algos) =
+	(B.concat $ map encode algos, 11)
 put_signature_subpacket (IssuerPacket keyid) =
 	(encode (fst $ head $ readHex keyid :: Word64), 16)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
@@ -761,6 +764,9 @@ parse_signature_subpacket  7 =
 	fmap (RevocablePacket . enum_from_word8) get
 -- KeyExpirationTimePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.6
 parse_signature_subpacket  9 = fmap KeyExpirationTimePacket get
+-- KeyExpirationTimePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.6
+parse_signature_subpacket 11 =
+	fmap PreferredSymmetricAlgorithmsPacket listUntilEnd
 -- IssuerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.5
 parse_signature_subpacket 16 = do
 	keyid <- get :: Get Word64
-- 
cgit v1.2.3


From ca2ff90effdda221e16a201071d5fef0110596be Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 16:13:41 -0500
Subject: pad keyids with 0 on the left

---
 Arbitrary.patch | 15 +++++++--------
 Data/OpenPGP.hs |  8 ++++++--
 2 files changed, 13 insertions(+), 10 deletions(-)

(limited to 'Data')

diff --git a/Arbitrary.patch b/Arbitrary.patch
index 8de13ad..aa09db0 100644
--- a/Arbitrary.patch
+++ b/Arbitrary.patch
@@ -28,11 +28,10 @@
                 return (MPI x1)
 
 
-                    _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
-@@ -140 +139 @@
--                   8 -> do x1 <- arbitrary
-+                   8 -> do x1 <- fmap (map toUpper . (`showHex` "")) (arbitrary :: Gen Word64)
-@@ -143,2 +142 @@
--                           x2 <- arbitrary
--                           return (UnsupportedSignatureSubpacket x1 x2)
-+                           return (UnsupportedSignatureSubpacket 105 x1)
+@@ -166 +165 @@
+-                   9 -> do x1 <- arbitrary
++                   9 -> do x1 <- vectorOf 16 (elements (['0'..'9'] ++ ['A'..'F']))
+@@ -169,2 +168 @@
+-                            x2 <- arbitrary
+-                            return (UnsupportedSignatureSubpacket x1 x2)
++                            return (UnsupportedSignatureSubpacket 105 x1)
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 3534ccf..90450f5 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -419,9 +419,11 @@ parse_packet  4 = do
 		signature_type = signature_type,
 		hash_algorithm = hash_algo,
 		key_algorithm = key_algo,
-		key_id = map toUpper $ showHex key_id "",
+		key_id = pad $ map toUpper $ showHex key_id "",
 		nested = nested
 	}
+	where
+	pad s = replicate (16 - length s) '0' ++ s
 -- SecretKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.3
 parse_packet  5 = do
 	-- Parse PublicKey part
@@ -770,7 +772,9 @@ parse_signature_subpacket 11 =
 -- IssuerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.5
 parse_signature_subpacket 16 = do
 	keyid <- get :: Get Word64
-	return $ IssuerPacket (map toUpper $ showHex keyid "")
+	return $ IssuerPacket (pad $ map toUpper $ showHex keyid "")
+	where
+	pad s = replicate (16 - length s) '0' ++ s
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
-- 
cgit v1.2.3


From 4eb6591ec2d2efeb9fb55d23d3d6e6f54534f128 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 16:14:04 -0500
Subject: RevocationKeyPacket

---
 Arbitrary.patch |  9 ++++++++-
 Data/OpenPGP.hs | 27 +++++++++++++++++++++++++++
 2 files changed, 35 insertions(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Arbitrary.patch b/Arbitrary.patch
index aa09db0..b86896d 100644
--- a/Arbitrary.patch
+++ b/Arbitrary.patch
@@ -19,7 +19,7 @@
                             return (SymmetricAlgorithm x1)
                     _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
 
-@@ -116,7 +115,7 @@
+@@ -134,7 +133,7 @@
 
  instance Arbitrary MPI where
          arbitrary
@@ -28,6 +28,13 @@
                 return (MPI x1)
 
 
+@@ -160,5 +160,5 @@
+                            return (PreferredSymmetricAlgorithmsPacket x1)
+                    8 -> do x1 <- arbitrary
+                            x2 <- arbitrary
+-                           x3 <- arbitrary
++                           x3 <- vectorOf 40 (elements (['0'..'9'] ++ ['A'..'F']))
+                            return (RevocationKeyPacket x1 x2 x3)
 @@ -166 +165 @@
 -                   9 -> do x1 <- arbitrary
 +                   9 -> do x1 <- vectorOf 16 (elements (['0'..'9'] ++ ['A'..'F']))
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 90450f5..194cccf 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -694,6 +694,11 @@ data SignatureSubpacket =
 	RevocablePacket Bool |
 	KeyExpirationTimePacket Word32 | -- seconds after key CreationTime
 	PreferredSymmetricAlgorithmsPacket [SymmetricAlgorithm] |
+	RevocationKeyPacket {
+		sensitive::Bool,
+		revocation_key_algorithm::KeyAlgorithm,
+		revocation_key_fingerprint::String
+	} |
 	IssuerPacket String |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
@@ -743,6 +748,12 @@ put_signature_subpacket (KeyExpirationTimePacket time) =
 	(encode time, 9)
 put_signature_subpacket (PreferredSymmetricAlgorithmsPacket algos) =
 	(B.concat $ map encode algos, 11)
+put_signature_subpacket (RevocationKeyPacket sensitive kalgo fpr) =
+	(B.concat [encode bitfield, encode kalgo, fprb], 12)
+	where
+	bitfield = 0x80 .|. (if sensitive then 0x40 else 0x0) :: Word8
+	fprb = B.drop 2 $ encode (MPI fpri)
+	fpri = fst $ head $ readHex fpr
 put_signature_subpacket (IssuerPacket keyid) =
 	(encode (fst $ head $ readHex keyid :: Word64), 16)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
@@ -769,6 +780,22 @@ parse_signature_subpacket  9 = fmap KeyExpirationTimePacket get
 -- KeyExpirationTimePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.6
 parse_signature_subpacket 11 =
 	fmap PreferredSymmetricAlgorithmsPacket listUntilEnd
+-- RevocationKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.15
+parse_signature_subpacket 12 = do
+	bitfield <- get :: Get Word8
+	kalgo <- get
+	fpr <- getSomeByteString 20
+	-- bitfield must have bit 0x80 set, says the spec
+	return $ RevocationKeyPacket {
+		sensitive = if bitfield .&. 0x40 == 0x40 then True else False,
+		revocation_key_algorithm = kalgo,
+		revocation_key_fingerprint =
+			map toUpper $ foldr (pad `oo` showHex) "" (B.unpack fpr)
+	}
+	where
+	oo = (.) . (.)
+	pad s | odd $ length s = '0':s
+	      | otherwise = s
 -- IssuerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.5
 parse_signature_subpacket 16 = do
 	keyid <- get :: Get Word64
-- 
cgit v1.2.3


From 5170c6cbfc5e6f2bb3eb901bbadb8eed9eb15640 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 16:14:15 -0500
Subject: fix comment

---
 Data/OpenPGP.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 194cccf..f152aeb 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -777,7 +777,7 @@ parse_signature_subpacket  7 =
 	fmap (RevocablePacket . enum_from_word8) get
 -- KeyExpirationTimePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.6
 parse_signature_subpacket  9 = fmap KeyExpirationTimePacket get
--- KeyExpirationTimePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.6
+-- PreferredSymmetricAlgorithms, http://tools.ietf.org/html/rfc4880#section-5.2.3.7
 parse_signature_subpacket 11 =
 	fmap PreferredSymmetricAlgorithmsPacket listUntilEnd
 -- RevocationKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.15
-- 
cgit v1.2.3


From db574b20691ba16f64f33d797b8135d256835ca3 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 16:52:23 -0500
Subject: NotationDataPacket

---
 Data/OpenPGP.hs | 31 +++++++++++++++++++++++++++++++
 1 file changed, 31 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index f152aeb..dff3ae5 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -700,6 +700,11 @@ data SignatureSubpacket =
 		revocation_key_fingerprint::String
 	} |
 	IssuerPacket String |
+	NotationDataPacket {
+		human_readable::Bool,
+		notation_name::String,
+		notation_value::String
+	} |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
@@ -756,6 +761,18 @@ put_signature_subpacket (RevocationKeyPacket sensitive kalgo fpr) =
 	fpri = fst $ head $ readHex fpr
 put_signature_subpacket (IssuerPacket keyid) =
 	(encode (fst $ head $ readHex keyid :: Word64), 16)
+put_signature_subpacket (NotationDataPacket human_readable name value) =
+	(B.concat [
+		B.pack [flag1,0,0,0],
+		encode (fromIntegral (B.length namebs) :: Word16),
+		encode (fromIntegral (B.length valuebs) :: Word16),
+		namebs,
+		valuebs
+	], 20)
+	where
+	valuebs = B.fromString value
+	namebs = B.fromString name
+	flag1 = if human_readable then 0x80 else 0x0
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
@@ -802,6 +819,20 @@ parse_signature_subpacket 16 = do
 	return $ IssuerPacket (pad $ map toUpper $ showHex keyid "")
 	where
 	pad s = replicate (16 - length s) '0' ++ s
+-- NotationDataPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.16
+parse_signature_subpacket 20 = do
+	(flag1,_,_,_) <- get4word8
+	(m,n) <- liftM2 (,) get get :: Get (Word16,Word16)
+	name <- fmap B.toString $ getSomeByteString $ fromIntegral m
+	value <- fmap B.toString $ getSomeByteString $ fromIntegral n
+	return $ NotationDataPacket {
+		human_readable = flag1 == 0x80,
+		notation_name = name,
+		notation_value = value
+	}
+	where
+	get4word8 :: Get (Word8,Word8,Word8,Word8)
+	get4word8 = liftM4 (,,,) get get get get
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
-- 
cgit v1.2.3


From 36f0fb4baf0b144a5bfcb52c0256f3b94d550b99 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 16:59:52 -0500
Subject: PreferredHashAlgorithmsPacket

---
 Arbitrary.patch | 9 +++++++++
 Data/OpenPGP.hs | 6 ++++++
 2 files changed, 15 insertions(+)

(limited to 'Data')

diff --git a/Arbitrary.patch b/Arbitrary.patch
index b86896d..aa51d2d 100644
--- a/Arbitrary.patch
+++ b/Arbitrary.patch
@@ -10,6 +10,15 @@
                     1 -> do x1 <- arbitrary
                             x2 <- arbitrary
                             x3 <- arbitrary
+@@ -73,7 +72,7 @@
+                    4 -> return SHA384
+                    5 -> return SHA512
+                    6 -> return SHA224
+-                   7 -> do x1 <- arbitrary
++                   7 -> do x1 <- suchThat arbitrary (`notElem` [01,02,03,08,09,10,11])
+                            return (HashAlgorithm x1)
+                    _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
+
 @@ -108,7 +107,7 @@
                     6 -> return AES192
                     7 -> return AES256
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index dff3ae5..051bd5d 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -705,6 +705,7 @@ data SignatureSubpacket =
 		notation_name::String,
 		notation_value::String
 	} |
+	PreferredHashAlgorithmsPacket [HashAlgorithm] |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
@@ -773,6 +774,8 @@ put_signature_subpacket (NotationDataPacket human_readable name value) =
 	valuebs = B.fromString value
 	namebs = B.fromString name
 	flag1 = if human_readable then 0x80 else 0x0
+put_signature_subpacket (PreferredHashAlgorithmsPacket algos) =
+	(B.concat $ map encode algos, 21)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
@@ -833,6 +836,9 @@ parse_signature_subpacket 20 = do
 	where
 	get4word8 :: Get (Word8,Word8,Word8,Word8)
 	get4word8 = liftM4 (,,,) get get get get
+-- PreferredHashAlgorithmsPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.8
+parse_signature_subpacket 21 =
+	fmap PreferredHashAlgorithmsPacket listUntilEnd
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
-- 
cgit v1.2.3


From 6a0708513d22e8b0908beeeedc10cd9c89cfacd0 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 17:12:22 -0500
Subject: PreferredCompressionAlgorithms

---
 Arbitrary.patch | 9 +++++++++
 Data/OpenPGP.hs | 6 ++++++
 2 files changed, 15 insertions(+)

(limited to 'Data')

diff --git a/Arbitrary.patch b/Arbitrary.patch
index aa51d2d..0c2175d 100644
--- a/Arbitrary.patch
+++ b/Arbitrary.patch
@@ -28,6 +28,15 @@
                             return (SymmetricAlgorithm x1)
                     _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
 
+@@ -121,7 +120,7 @@
+                    1 -> return ZIP
+                    2 -> return ZLIB
+                    3 -> return BZip2
+-                   4 -> do x1 <- arbitrary
++                   4 -> do x1 <- suchThat arbitrary (`notElem` [0,1,2,3])
+                            return (CompressionAlgorithm x1)
+                    _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
+
 @@ -134,7 +133,7 @@
 
  instance Arbitrary MPI where
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 051bd5d..41a5d4e 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -706,6 +706,7 @@ data SignatureSubpacket =
 		notation_value::String
 	} |
 	PreferredHashAlgorithmsPacket [HashAlgorithm] |
+	PreferredCompressionAlgorithmsPacket [CompressionAlgorithm] |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
@@ -776,6 +777,8 @@ put_signature_subpacket (NotationDataPacket human_readable name value) =
 	flag1 = if human_readable then 0x80 else 0x0
 put_signature_subpacket (PreferredHashAlgorithmsPacket algos) =
 	(B.concat $ map encode algos, 21)
+put_signature_subpacket (PreferredCompressionAlgorithmsPacket algos) =
+	(B.concat $ map encode algos, 22)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
@@ -839,6 +842,9 @@ parse_signature_subpacket 20 = do
 -- PreferredHashAlgorithmsPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.8
 parse_signature_subpacket 21 =
 	fmap PreferredHashAlgorithmsPacket listUntilEnd
+-- PreferredCompressionAlgorithms, http://tools.ietf.org/html/rfc4880#section-5.2.3.9
+parse_signature_subpacket 22 =
+	fmap PreferredCompressionAlgorithmsPacket listUntilEnd
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
-- 
cgit v1.2.3


From af48ca0db78ad9ccce5e8ae2130611486c717d56 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 17:19:41 -0500
Subject: ensure full fingerprint padding

---
 Data/OpenPGP.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 41a5d4e..cbc801e 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -813,12 +813,13 @@ parse_signature_subpacket 12 = do
 		sensitive = if bitfield .&. 0x40 == 0x40 then True else False,
 		revocation_key_algorithm = kalgo,
 		revocation_key_fingerprint =
-			map toUpper $ foldr (pad `oo` showHex) "" (B.unpack fpr)
+			pad $ map toUpper $ foldr (padB `oo` showHex) "" (B.unpack fpr)
 	}
 	where
 	oo = (.) . (.)
-	pad s | odd $ length s = '0':s
-	      | otherwise = s
+	padB s | odd $ length s = '0':s
+	       | otherwise = s
+	pad s = replicate (40 - length s) '0' ++ s
 -- IssuerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.5
 parse_signature_subpacket 16 = do
 	keyid <- get :: Get Word64
-- 
cgit v1.2.3


From 91de0d55771dcecd776fdf03210748dd0225c583 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 17:29:39 -0500
Subject: fix comment

---
 Data/OpenPGP.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index cbc801e..4df32c5 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -843,7 +843,7 @@ parse_signature_subpacket 20 = do
 -- PreferredHashAlgorithmsPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.8
 parse_signature_subpacket 21 =
 	fmap PreferredHashAlgorithmsPacket listUntilEnd
--- PreferredCompressionAlgorithms, http://tools.ietf.org/html/rfc4880#section-5.2.3.9
+-- PreferredCompressionAlgorithmsPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.9
 parse_signature_subpacket 22 =
 	fmap PreferredCompressionAlgorithmsPacket listUntilEnd
 -- Represent unsupported packets as their tag and literal bytes
-- 
cgit v1.2.3


From 00752abf7f58d0339179c13d60f1bcbe9c4820bc Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 17:29:49 -0500
Subject: KeyServerPreferencesPacket

---
 Data/OpenPGP.hs | 10 ++++++++++
 1 file changed, 10 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 4df32c5..0895d83 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -707,6 +707,7 @@ data SignatureSubpacket =
 	} |
 	PreferredHashAlgorithmsPacket [HashAlgorithm] |
 	PreferredCompressionAlgorithmsPacket [CompressionAlgorithm] |
+	KeyServerPreferencesPacket {keyserver_no_modify::Bool} |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
@@ -779,6 +780,8 @@ put_signature_subpacket (PreferredHashAlgorithmsPacket algos) =
 	(B.concat $ map encode algos, 21)
 put_signature_subpacket (PreferredCompressionAlgorithmsPacket algos) =
 	(B.concat $ map encode algos, 22)
+put_signature_subpacket (KeyServerPreferencesPacket no_modify) =
+	(B.singleton (if no_modify then 0x80 else 0x0), 23)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
@@ -846,6 +849,13 @@ parse_signature_subpacket 21 =
 -- PreferredCompressionAlgorithmsPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.9
 parse_signature_subpacket 22 =
 	fmap PreferredCompressionAlgorithmsPacket listUntilEnd
+-- KeyServerPreferencesPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.17
+parse_signature_subpacket 23 = do
+	empty <- isEmpty
+	flag1 <- if empty then return 0 else get :: Get Word8
+	return $ KeyServerPreferencesPacket {
+		keyserver_no_modify = if flag1 == 0x80 then True else False
+	}
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
-- 
cgit v1.2.3


From 1b13c5f127b31c1b52bc8fb87415f62c2e769346 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 17:33:50 -0500
Subject: PreferredKeyServerPacket

---
 Data/OpenPGP.hs | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 0895d83..39dd053 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -708,6 +708,7 @@ data SignatureSubpacket =
 	PreferredHashAlgorithmsPacket [HashAlgorithm] |
 	PreferredCompressionAlgorithmsPacket [CompressionAlgorithm] |
 	KeyServerPreferencesPacket {keyserver_no_modify::Bool} |
+	PreferredKeyServerPacket String |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
@@ -782,6 +783,8 @@ put_signature_subpacket (PreferredCompressionAlgorithmsPacket algos) =
 	(B.concat $ map encode algos, 22)
 put_signature_subpacket (KeyServerPreferencesPacket no_modify) =
 	(B.singleton (if no_modify then 0x80 else 0x0), 23)
+put_signature_subpacket (PreferredKeyServerPacket uri) =
+	(B.fromString uri, 24)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
@@ -856,6 +859,9 @@ parse_signature_subpacket 23 = do
 	return $ KeyServerPreferencesPacket {
 		keyserver_no_modify = if flag1 == 0x80 then True else False
 	}
+-- PreferredKeyServerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.18
+parse_signature_subpacket 24 =
+	fmap (PreferredKeyServerPacket . B.toString) getRemainingByteString
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
-- 
cgit v1.2.3


From 996a38e28204b33429f5064386bfd54709d06d6e Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 17:37:26 -0500
Subject: PrimaryUserIDPacket

---
 Data/OpenPGP.hs | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 39dd053..16f7d81 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -709,6 +709,7 @@ data SignatureSubpacket =
 	PreferredCompressionAlgorithmsPacket [CompressionAlgorithm] |
 	KeyServerPreferencesPacket {keyserver_no_modify::Bool} |
 	PreferredKeyServerPacket String |
+	PrimaryUserIDPacket Bool |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
@@ -785,6 +786,8 @@ put_signature_subpacket (KeyServerPreferencesPacket no_modify) =
 	(B.singleton (if no_modify then 0x80 else 0x0), 23)
 put_signature_subpacket (PreferredKeyServerPacket uri) =
 	(B.fromString uri, 24)
+put_signature_subpacket (PrimaryUserIDPacket isprimary) =
+	(encode $ enum_to_word8 isprimary, 25)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
@@ -862,6 +865,9 @@ parse_signature_subpacket 23 = do
 -- PreferredKeyServerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.18
 parse_signature_subpacket 24 =
 	fmap (PreferredKeyServerPacket . B.toString) getRemainingByteString
+-- PrimaryUserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.19
+parse_signature_subpacket 25 =
+	fmap (PrimaryUserIDPacket . enum_from_word8) get
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
-- 
cgit v1.2.3


From 35a71015787428c322a2f06068965cdff1f2f200 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 17:39:13 -0500
Subject: PolicyURIPacket

---
 Data/OpenPGP.hs | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 16f7d81..8128a2d 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -710,6 +710,7 @@ data SignatureSubpacket =
 	KeyServerPreferencesPacket {keyserver_no_modify::Bool} |
 	PreferredKeyServerPacket String |
 	PrimaryUserIDPacket Bool |
+	PolicyURIPacket String |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
@@ -788,6 +789,8 @@ put_signature_subpacket (PreferredKeyServerPacket uri) =
 	(B.fromString uri, 24)
 put_signature_subpacket (PrimaryUserIDPacket isprimary) =
 	(encode $ enum_to_word8 isprimary, 25)
+put_signature_subpacket (PolicyURIPacket uri) =
+	(B.fromString uri, 26)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
@@ -868,6 +871,9 @@ parse_signature_subpacket 24 =
 -- PrimaryUserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.19
 parse_signature_subpacket 25 =
 	fmap (PrimaryUserIDPacket . enum_from_word8) get
+-- PolicyURIPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.20
+parse_signature_subpacket 26 =
+	fmap (PolicyURIPacket . B.toString) getRemainingByteString
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
-- 
cgit v1.2.3


From fa19e9b7e8fab70d9c817890e7efe6918e49df74 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 17:42:28 -0500
Subject: flags are bit fields

---
 Data/OpenPGP.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 8128a2d..bf99198 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -845,7 +845,7 @@ parse_signature_subpacket 20 = do
 	name <- fmap B.toString $ getSomeByteString $ fromIntegral m
 	value <- fmap B.toString $ getSomeByteString $ fromIntegral n
 	return $ NotationDataPacket {
-		human_readable = flag1 == 0x80,
+		human_readable = flag1 .&. 0x80 == 0x80,
 		notation_name = name,
 		notation_value = value
 	}
@@ -863,7 +863,7 @@ parse_signature_subpacket 23 = do
 	empty <- isEmpty
 	flag1 <- if empty then return 0 else get :: Get Word8
 	return $ KeyServerPreferencesPacket {
-		keyserver_no_modify = if flag1 == 0x80 then True else False
+		keyserver_no_modify = if flag1 .&. 0x80 == 0x80 then True else False
 	}
 -- PreferredKeyServerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.18
 parse_signature_subpacket 24 =
-- 
cgit v1.2.3


From b572d14100eabd30869a6886e972d988e21183cf Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 17:56:09 -0500
Subject: KeyFlagsPacket

---
 Data/OpenPGP.hs | 35 +++++++++++++++++++++++++++++++++++
 1 file changed, 35 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index bf99198..28a0941 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -711,6 +711,15 @@ data SignatureSubpacket =
 	PreferredKeyServerPacket String |
 	PrimaryUserIDPacket Bool |
 	PolicyURIPacket String |
+	KeyFlagsPacket {
+		certify_keys::Bool,
+		sign_data::Bool,
+		encrypt_communication::Bool,
+		encrypt_storage::Bool,
+		split_key::Bool,
+		authentication::Bool,
+		group_key::Bool
+	} |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
@@ -791,6 +800,19 @@ put_signature_subpacket (PrimaryUserIDPacket isprimary) =
 	(encode $ enum_to_word8 isprimary, 25)
 put_signature_subpacket (PolicyURIPacket uri) =
 	(B.fromString uri, 26)
+put_signature_subpacket (KeyFlagsPacket certify sign encryptC encryptS split auth group) =
+	( B.singleton $
+		flag 0x01 certify  .|.
+		flag 0x02 sign     .|.
+		flag 0x04 encryptC .|.
+		flag 0x08 encryptS .|.
+		flag 0x10 split    .|.
+		flag 0x20 auth     .|.
+		flag 0x80 group
+	, 27)
+	where
+	flag x True = x
+	flag _ False = 0x0
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
@@ -874,6 +896,19 @@ parse_signature_subpacket 25 =
 -- PolicyURIPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.20
 parse_signature_subpacket 26 =
 	fmap (PolicyURIPacket . B.toString) getRemainingByteString
+-- KeyFlagsPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.21
+parse_signature_subpacket 27 = do
+	empty <- isEmpty
+	flag1 <- if empty then return 0 else get :: Get Word8
+	return $ KeyFlagsPacket {
+		certify_keys          = flag1 .&. 0x01 == 0x01,
+		sign_data             = flag1 .&. 0x02 == 0x02,
+		encrypt_communication = flag1 .&. 0x04 == 0x04,
+		encrypt_storage       = flag1 .&. 0x08 == 0x08,
+		split_key             = flag1 .&. 0x10 == 0x10,
+		authentication        = flag1 .&. 0x20 == 0x20,
+		group_key             = flag1 .&. 0x80 == 0x80
+	}
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
-- 
cgit v1.2.3


From 275ed12ff3682622dfb5cffbb6a52056fa8bf49b Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 17:59:12 -0500
Subject: SignerUserIDPacket

---
 Data/OpenPGP.hs | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 28a0941..e3a0a54 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -720,6 +720,7 @@ data SignatureSubpacket =
 		authentication::Bool,
 		group_key::Bool
 	} |
+	SignerUserIDPacket String |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
@@ -813,6 +814,8 @@ put_signature_subpacket (KeyFlagsPacket certify sign encryptC encryptS split aut
 	where
 	flag x True = x
 	flag _ False = 0x0
+put_signature_subpacket (SignerUserIDPacket userid) =
+	(B.fromString userid, 28)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
@@ -909,6 +912,9 @@ parse_signature_subpacket 27 = do
 		authentication        = flag1 .&. 0x20 == 0x20,
 		group_key             = flag1 .&. 0x80 == 0x80
 	}
+-- SignerUserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.22
+parse_signature_subpacket 28 =
+	fmap (SignerUserIDPacket . B.toString) getRemainingByteString
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
-- 
cgit v1.2.3


From 00f3838fdb81fef2fed80554582f0f17a59c6977 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 18:13:11 -0500
Subject: whitespace

---
 Data/OpenPGP.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index e3a0a54..012eead 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -802,7 +802,7 @@ put_signature_subpacket (PrimaryUserIDPacket isprimary) =
 put_signature_subpacket (PolicyURIPacket uri) =
 	(B.fromString uri, 26)
 put_signature_subpacket (KeyFlagsPacket certify sign encryptC encryptS split auth group) =
-	( B.singleton $
+	(B.singleton $
 		flag 0x01 certify  .|.
 		flag 0x02 sign     .|.
 		flag 0x04 encryptC .|.
-- 
cgit v1.2.3


From dc97a42a4e0432b7aaca1b55612d90e82c5ca853 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 27 Apr 2012 18:13:25 -0500
Subject: ReasonForRevocationPacket

---
 Data/OpenPGP.hs | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 012eead..4bbaf84 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -48,6 +48,7 @@ module Data.OpenPGP (
 	KeyAlgorithm(..),
 	SymmetricAlgorithm(..),
 	CompressionAlgorithm(..),
+	RevocationCode(..),
 	MPI(..),
 	find_key,
 	fingerprint_material,
@@ -641,6 +642,26 @@ instance BINARY_CLASS CompressionAlgorithm where
 	put = put . enum_to_word8
 	get = fmap enum_from_word8 get
 
+data RevocationCode = NoReason | KeySuperseded | KeyCompromised | KeyRetired | UserIDInvalid | RevocationCode Word8 deriving (Show, Read, Eq)
+
+instance Enum RevocationCode where
+	toEnum 00 = NoReason
+	toEnum 01 = KeySuperseded
+	toEnum 02 = KeyCompromised
+	toEnum 03 = KeyRetired
+	toEnum 32 = UserIDInvalid
+	toEnum  x = RevocationCode $ fromIntegral x
+	fromEnum NoReason       = 00
+	fromEnum KeySuperseded  = 01
+	fromEnum KeyCompromised = 02
+	fromEnum KeyRetired     = 03
+	fromEnum UserIDInvalid  = 32
+	fromEnum (RevocationCode x) = fromIntegral x
+
+instance BINARY_CLASS RevocationCode where
+	put = put . enum_to_word8
+	get = fmap enum_from_word8 get
+
 -- A message is encoded as a list that takes the entire file
 newtype Message = Message [Packet] deriving (Show, Read, Eq)
 instance BINARY_CLASS Message where
@@ -721,6 +742,7 @@ data SignatureSubpacket =
 		group_key::Bool
 	} |
 	SignerUserIDPacket String |
+	ReasonForRevocationPacket RevocationCode String |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
@@ -816,6 +838,8 @@ put_signature_subpacket (KeyFlagsPacket certify sign encryptC encryptS split aut
 	flag _ False = 0x0
 put_signature_subpacket (SignerUserIDPacket userid) =
 	(B.fromString userid, 28)
+put_signature_subpacket (ReasonForRevocationPacket code string) =
+	(B.concat [encode code, B.fromString string], 29)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
@@ -915,6 +939,9 @@ parse_signature_subpacket 27 = do
 -- SignerUserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.22
 parse_signature_subpacket 28 =
 	fmap (SignerUserIDPacket . B.toString) getRemainingByteString
+-- ReasonForRevocationPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.23
+parse_signature_subpacket 29 = liftM2 ReasonForRevocationPacket get
+	(fmap B.toString getRemainingByteString)
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
-- 
cgit v1.2.3


From 0850e09ef537bc5ba883df371e5f6c68e573b2a2 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 30 Apr 2012 08:50:45 -0500
Subject: FeaturesPacket

---
 Data/OpenPGP.hs | 10 ++++++++++
 1 file changed, 10 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 4bbaf84..e83d874 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -743,6 +743,7 @@ data SignatureSubpacket =
 	} |
 	SignerUserIDPacket String |
 	ReasonForRevocationPacket RevocationCode String |
+	FeaturesPacket {supports_mdc::Bool} |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
@@ -840,6 +841,8 @@ put_signature_subpacket (SignerUserIDPacket userid) =
 	(B.fromString userid, 28)
 put_signature_subpacket (ReasonForRevocationPacket code string) =
 	(B.concat [encode code, B.fromString string], 29)
+put_signature_subpacket (FeaturesPacket supports_mdc) =
+	(B.singleton $ if supports_mdc then 0x01 else 0x00, 30)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
@@ -942,6 +945,13 @@ parse_signature_subpacket 28 =
 -- ReasonForRevocationPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.23
 parse_signature_subpacket 29 = liftM2 ReasonForRevocationPacket get
 	(fmap B.toString getRemainingByteString)
+-- FeaturesPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.24
+parse_signature_subpacket 30 = do
+	empty <- isEmpty
+	flag1 <- if empty then return 0 else get :: Get Word8
+	return $  FeaturesPacket {
+		supports_mdc = flag1 .&. 0x01 == 0x01
+	}
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
-- 
cgit v1.2.3


From 7f3399b05626d1e7fb35a615702810e37781f83b Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 30 Apr 2012 08:50:57 -0500
Subject: SignatureTargetPacket

---
 Data/OpenPGP.hs | 10 ++++++++++
 1 file changed, 10 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index e83d874..ea0d19f 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -744,6 +744,11 @@ data SignatureSubpacket =
 	SignerUserIDPacket String |
 	ReasonForRevocationPacket RevocationCode String |
 	FeaturesPacket {supports_mdc::Bool} |
+	SignatureTargetPacket {
+		target_key_algorithm::KeyAlgorithm,
+		target_hash_algorithm::HashAlgorithm,
+		hash::B.ByteString
+	} |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
@@ -843,6 +848,8 @@ put_signature_subpacket (ReasonForRevocationPacket code string) =
 	(B.concat [encode code, B.fromString string], 29)
 put_signature_subpacket (FeaturesPacket supports_mdc) =
 	(B.singleton $ if supports_mdc then 0x01 else 0x00, 30)
+put_signature_subpacket (SignatureTargetPacket kalgo halgo hash) =
+	(B.concat [encode kalgo, encode halgo, hash], 31)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
@@ -952,6 +959,9 @@ parse_signature_subpacket 30 = do
 	return $  FeaturesPacket {
 		supports_mdc = flag1 .&. 0x01 == 0x01
 	}
+-- SignatureTargetPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.25
+parse_signature_subpacket 31 =
+	liftM3 SignatureTargetPacket get get getRemainingByteString
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
-- 
cgit v1.2.3


From 9877a30e04b83d8ed24aee704ffe150dd0678d8d Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 30 Apr 2012 08:51:09 -0500
Subject: do not use if returning Bool

---
 Data/OpenPGP.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index ea0d19f..a9a5b4e 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -881,7 +881,7 @@ parse_signature_subpacket 12 = do
 	fpr <- getSomeByteString 20
 	-- bitfield must have bit 0x80 set, says the spec
 	return $ RevocationKeyPacket {
-		sensitive = if bitfield .&. 0x40 == 0x40 then True else False,
+		sensitive = bitfield .&. 0x40 == 0x40,
 		revocation_key_algorithm = kalgo,
 		revocation_key_fingerprint =
 			pad $ map toUpper $ foldr (padB `oo` showHex) "" (B.unpack fpr)
@@ -922,7 +922,7 @@ parse_signature_subpacket 23 = do
 	empty <- isEmpty
 	flag1 <- if empty then return 0 else get :: Get Word8
 	return $ KeyServerPreferencesPacket {
-		keyserver_no_modify = if flag1 .&. 0x80 == 0x80 then True else False
+		keyserver_no_modify = flag1 .&. 0x80 == 0x80
 	}
 -- PreferredKeyServerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.18
 parse_signature_subpacket 24 =
-- 
cgit v1.2.3


From 905e4e82e295b2fa0f547e7c8d458c3f35944bcc Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 30 Apr 2012 09:38:03 -0500
Subject: EmbeddedSignaturePacket

---
 Arbitrary.patch | 16 +++++++++++++---
 Data/OpenPGP.hs | 13 +++++++++++--
 2 files changed, 24 insertions(+), 5 deletions(-)

(limited to 'Data')

diff --git a/Arbitrary.patch b/Arbitrary.patch
index 8967f0b..f1f3824 100644
--- a/Arbitrary.patch
+++ b/Arbitrary.patch
@@ -1,12 +1,19 @@
 --- Data/OpenPGP/Arbitrary.hs	2012-04-27 12:38:11.492411339 -0500
 +++ arb.s	2012-04-27 12:37:57.176469214 -0500
-@@ -19,8 +19,7 @@
+@@ -14,13 +14,11 @@
+                    0 -> do x1 <- arbitrary
+                            x2 <- arbitrary
+                            x3 <- arbitrary
+-                           x4 <- arbitrary
+-                           x5 <- arbitrary
++                           x4 <- resize 10 (listOf arbitrary)
++                           x5 <- resize 10 (listOf arbitrary)
                             x6 <- arbitrary
                             x7 <- arbitrary
-                            x8 <- arbitrary
+-                           x8 <- arbitrary
 -                           x9 <- arbitrary
 -                           return (SignaturePacket x1 x2 x3 x4 x5 x6 x7 x8 x9)
-+                           return (signaturePacket x1 x2 x3 x4 x5 x6 x7 x8)
++                           return (signaturePacket 4 x1 x2 x3 x4 x5 x6 x7)
                     1 -> do x1 <- arbitrary
                             x2 <- arbitrary
                             x3 <- arbitrary
@@ -74,6 +81,9 @@
 @@ -166 +165 @@
 -                   9 -> do x1 <- arbitrary
 +                   9 -> do x1 <- vectorOf 16 (elements (['0'..'9'] ++ ['A'..'F']))
+@@ -217 +216 @@
+-                   22 -> do x1 <- arbitrary
++                   22 -> do x1 <- suchThat arbitrary isSignaturePacket
 @@ -169,2 +168 @@
 -                            x2 <- arbitrary
 -                            return (UnsupportedSignatureSubpacket x1 x2)
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index a9a5b4e..6e488eb 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -289,8 +289,8 @@ signature_packet_start (SignaturePacket {
 	]
 	where
 	hashed_subs = B.concat $ map encode hashed_subpackets
-signature_packet_start _ =
-	error "Trying to get start of signature packet for non signature packet."
+signature_packet_start x =
+	error ("Trying to get start of signature packet for: " ++ show x)
 
 -- The trailer is just the top of the body plus some crap
 calculate_signature_trailer :: Packet -> B.ByteString
@@ -749,6 +749,7 @@ data SignatureSubpacket =
 		target_hash_algorithm::HashAlgorithm,
 		hash::B.ByteString
 	} |
+	EmbeddedSignaturePacket Packet |
 	UnsupportedSignatureSubpacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
@@ -850,6 +851,8 @@ put_signature_subpacket (FeaturesPacket supports_mdc) =
 	(B.singleton $ if supports_mdc then 0x01 else 0x00, 30)
 put_signature_subpacket (SignatureTargetPacket kalgo halgo hash) =
 	(B.concat [encode kalgo, encode halgo, hash], 31)
+put_signature_subpacket (EmbeddedSignaturePacket packet) =
+	(encode (assert (isSignaturePacket packet) packet), 32)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
@@ -962,6 +965,12 @@ parse_signature_subpacket 30 = do
 -- SignatureTargetPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.25
 parse_signature_subpacket 31 =
 	liftM3 SignatureTargetPacket get get getRemainingByteString
+-- EmbeddedSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.26
+parse_signature_subpacket 32 =
+	fmap (EmbeddedSignaturePacket . forceSignature) get
+	where
+	forceSignature x@(SignaturePacket {}) = x
+	forceSignature _ = error "EmbeddedSignature must contain signature"
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
-- 
cgit v1.2.3


From 19f938bb73e4ecb378ca2a81c4bd92ac2e325d53 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 30 Apr 2012 10:05:14 -0500
Subject: hlint

---
 Data/OpenPGP.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 6e488eb..a05a980 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -883,7 +883,7 @@ parse_signature_subpacket 12 = do
 	kalgo <- get
 	fpr <- getSomeByteString 20
 	-- bitfield must have bit 0x80 set, says the spec
-	return $ RevocationKeyPacket {
+	return RevocationKeyPacket {
 		sensitive = bitfield .&. 0x40 == 0x40,
 		revocation_key_algorithm = kalgo,
 		revocation_key_fingerprint =
@@ -906,7 +906,7 @@ parse_signature_subpacket 20 = do
 	(m,n) <- liftM2 (,) get get :: Get (Word16,Word16)
 	name <- fmap B.toString $ getSomeByteString $ fromIntegral m
 	value <- fmap B.toString $ getSomeByteString $ fromIntegral n
-	return $ NotationDataPacket {
+	return NotationDataPacket {
 		human_readable = flag1 .&. 0x80 == 0x80,
 		notation_name = name,
 		notation_value = value
@@ -924,7 +924,7 @@ parse_signature_subpacket 22 =
 parse_signature_subpacket 23 = do
 	empty <- isEmpty
 	flag1 <- if empty then return 0 else get :: Get Word8
-	return $ KeyServerPreferencesPacket {
+	return KeyServerPreferencesPacket {
 		keyserver_no_modify = flag1 .&. 0x80 == 0x80
 	}
 -- PreferredKeyServerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.18
@@ -940,7 +940,7 @@ parse_signature_subpacket 26 =
 parse_signature_subpacket 27 = do
 	empty <- isEmpty
 	flag1 <- if empty then return 0 else get :: Get Word8
-	return $ KeyFlagsPacket {
+	return KeyFlagsPacket {
 		certify_keys          = flag1 .&. 0x01 == 0x01,
 		sign_data             = flag1 .&. 0x02 == 0x02,
 		encrypt_communication = flag1 .&. 0x04 == 0x04,
@@ -959,7 +959,7 @@ parse_signature_subpacket 29 = liftM2 ReasonForRevocationPacket get
 parse_signature_subpacket 30 = do
 	empty <- isEmpty
 	flag1 <- if empty then return 0 else get :: Get Word8
-	return $  FeaturesPacket {
+	return FeaturesPacket {
 		supports_mdc = flag1 .&. 0x01 == 0x01
 	}
 -- SignatureTargetPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.25
-- 
cgit v1.2.3


From ad6cd0274c52c17c41ee863cd13fc8e70becf5b8 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 30 Apr 2012 12:20:08 -0500
Subject: MarkerPacket

---
 Data/OpenPGP.hs | 5 +++++
 1 file changed, 5 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index a05a980..5041a37 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -10,6 +10,7 @@ module Data.OpenPGP (
 		PublicKeyPacket,
 		SecretKeyPacket,
 		CompressedDataPacket,
+		MarkerPacket,
 		LiteralDataPacket,
 		UserIDPacket,
 		UnsupportedPacket,
@@ -186,6 +187,7 @@ data Packet =
 		compression_algorithm::CompressionAlgorithm,
 		message::Message
 	} |
+	MarkerPacket |
 	LiteralDataPacket {
 		format::Char,
 		filename::String,
@@ -365,6 +367,7 @@ put_packet (PublicKeyPacket { version = 4, timestamp = timestamp,
 put_packet (CompressedDataPacket { compression_algorithm = algorithm,
                                    message = message }) =
 	(B.append (encode algorithm) $ compress algorithm $ encode message, 8)
+put_packet MarkerPacket = (B.fromString "PGP", 10)
 put_packet (LiteralDataPacket { format = format, filename = filename,
                                 timestamp = timestamp, content = content
                               }) =
@@ -486,6 +489,8 @@ parse_packet  8 = do
 		compression_algorithm = algorithm,
 		message = unsafeRunGet get (decompress algorithm message)
 	}
+-- MarkerPacket, http://tools.ietf.org/html/rfc4880#section-5.8
+parse_packet 10 = return MarkerPacket
 -- LiteralDataPacket, http://tools.ietf.org/html/rfc4880#section-5.9
 parse_packet 11 = do
 	format <- get
-- 
cgit v1.2.3


From be7580e37a1233be35131dcb957fe502cd47aa2f Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 30 Apr 2012 12:38:16 -0500
Subject: ModificationDetectionCodePacket

---
 Data/OpenPGP.hs | 26 ++++++++++++++++++++------
 1 file changed, 20 insertions(+), 6 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 5041a37..4904e54 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -13,6 +13,7 @@ module Data.OpenPGP (
 		MarkerPacket,
 		LiteralDataPacket,
 		UserIDPacket,
+		ModificationDetectionCodePacket,
 		UnsupportedPacket,
 		compression_algorithm,
 		content,
@@ -143,6 +144,9 @@ lazyDecompress ZLIB         = Zlib.decompress
 lazyDecompress BZip2        = BZip2.decompress
 lazyDecompress x            = error ("No implementation for " ++ show x)
 
+assertProp :: (a -> Bool) -> a -> a
+assertProp f x = assert (f x) x
+
 data Packet =
 	SignaturePacket {
 		version::Word8,
@@ -195,6 +199,7 @@ data Packet =
 		content::B.ByteString
 	} |
 	UserIDPacket String |
+	ModificationDetectionCodePacket B.ByteString |
 	UnsupportedPacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
@@ -202,11 +207,16 @@ instance BINARY_CLASS Packet where
 	put p = do
 		-- First two bits are 1 for new packet format
 		put ((tag .|. 0xC0) :: Word8)
-		-- Use 5-octet lengths
-		put (255 :: Word8)
-		put ((fromIntegral $ B.length body) :: Word32)
-		putSomeByteString body
+		case tag of
+			19 -> put (assertProp (<192) blen :: Word8)
+			_  -> do
+				-- Use 5-octet lengths
+				put (255 :: Word8)
+				put (blen :: Word32)
+				putSomeByteString body
 		where
+		blen :: (Num a) => a
+		blen = fromIntegral $ B.length body
 		(body, tag) = put_packet p
 	get = do
 		tag <- get :: Get Word8
@@ -377,6 +387,7 @@ put_packet (LiteralDataPacket { format = format, filename = filename,
 	filename_l  = (fromIntegral $ B.length lz_filename) :: Word8
 	lz_filename = B.fromString filename
 put_packet (UserIDPacket txt) = (B.fromString txt, 13)
+put_packet (ModificationDetectionCodePacket bstr) = (bstr, 19)
 put_packet (UnsupportedPacket tag bytes) = (bytes, fromIntegral tag)
 put_packet _ = error "Unsupported Packet version or type in put_packet."
 
@@ -507,6 +518,9 @@ parse_packet 11 = do
 -- UserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.11
 parse_packet 13 =
 	fmap (UserIDPacket . B.toString) getRemainingByteString
+-- ModificationDetectionCodePacket, http://tools.ietf.org/html/rfc4880#section-5.14
+parse_packet 19 =
+	fmap ModificationDetectionCodePacket getRemainingByteString
 -- Represent unsupported packets as their tag and literal bytes
 parse_packet tag = fmap (UnsupportedPacket tag) getRemainingByteString
 
@@ -695,7 +709,7 @@ instance BINARY_CLASS MPI where
 		bytes' = B.reverse $ B.unfoldr (\x ->
 				if x == 0 then Nothing else
 					Just (fromIntegral x, x `shiftR` 8)
-			) (assert (i>=0) i)
+			) (assertProp (>=0) i)
 	get = do
 		length <- fmap fromIntegral (get :: Get Word16)
 		bytes <- getSomeByteString ((length + 7) `div` 8)
@@ -857,7 +871,7 @@ put_signature_subpacket (FeaturesPacket supports_mdc) =
 put_signature_subpacket (SignatureTargetPacket kalgo halgo hash) =
 	(B.concat [encode kalgo, encode halgo, hash], 31)
 put_signature_subpacket (EmbeddedSignaturePacket packet) =
-	(encode (assert (isSignaturePacket packet) packet), 32)
+	(encode (assertProp isSignaturePacket packet), 32)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
-- 
cgit v1.2.3


From eca03631b66b623c42677d4ca1af393c4322cb84 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 30 Apr 2012 13:03:43 -0500
Subject: support subkeys

---
 Data/OpenPGP.hs | 38 +++++++++++++++++++++++++++-----------
 1 file changed, 27 insertions(+), 11 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 4904e54..d6da9de 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -171,7 +171,8 @@ data Packet =
 		version::Word8,
 		timestamp::Word32,
 		key_algorithm::KeyAlgorithm,
-		key::[(Char,MPI)]
+		key::[(Char,MPI)],
+		is_subkey::Bool
 	} |
 	SecretKeyPacket {
 		version::Word8,
@@ -185,7 +186,8 @@ data Packet =
 		s2k_salt::Maybe Word64,
 		s2k_count::Maybe Word32,
 		encrypted_data::B.ByteString,
-		private_hash::Maybe B.ByteString -- the hash may be in the encrypted data
+		private_hash::Maybe B.ByteString, -- the hash may be in the encrypted data
+		is_subkey::Bool
 	} |
 	CompressedDataPacket {
 		compression_algorithm::CompressionAlgorithm,
@@ -346,7 +348,8 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
                               s2k_hash_algorithm = s2k_hash_algo,
                               s2k_salt = s2k_salt,
                               s2k_count = s2k_count,
-                              encrypted_data = encrypted_data }) =
+                              encrypted_data = encrypted_data,
+                              is_subkey = is_subkey }) =
 	(B.concat $ [p, encode s2k_useage] ++
 	(if s2k_useage `elem` [255, 254] then
 		[encode $ fromJust symmetric_type, encode s2k_t,
@@ -364,16 +367,20 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
 		else
 			[encode (fromIntegral $
 				B.foldl (\c i -> (c + fromIntegral i) `mod` 65536)
-				(0::Integer) (B.concat s) :: Word16)]), 5)
+				(0::Integer) (B.concat s) :: Word16)]),
+	if is_subkey then 7 else 5)
 	where
 	(Just s2k_t) = s2k_type
-	p = fst (put_packet $ PublicKeyPacket version timestamp algorithm key
+	p = fst (put_packet $
+		PublicKeyPacket version timestamp algorithm key False
 		:: (B.ByteString, Integer)) -- Supress warning
 	s = map (encode . (key !)) (secret_key_fields algorithm)
 put_packet (PublicKeyPacket { version = 4, timestamp = timestamp,
-                              key_algorithm = algorithm, key = key }) =
+                              key_algorithm = algorithm, key = key,
+                              is_subkey = is_subkey }) =
 	(B.concat $ [B.singleton 4, encode timestamp, encode algorithm] ++
-		map (encode . (key !)) (public_key_fields algorithm), 6)
+		map (encode . (key !)) (public_key_fields algorithm),
+	if is_subkey then 14 else 6)
 put_packet (CompressedDataPacket { compression_algorithm = algorithm,
                                    message = message }) =
 	(B.append (encode algorithm) $ compress algorithm $ encode message, 8)
@@ -468,13 +475,13 @@ parse_packet  5 = do
 			return (k Nothing Nothing Nothing Nothing Nothing)
 	if s2k_useage > 0 then do {
 		encrypted <- getRemainingByteString;
-		return (k' encrypted Nothing)
+		return (k' encrypted Nothing False)
 	} else do
 		key <- foldM (\m f -> do
 			mpi <- get :: Get MPI
 			return $ (f,mpi):m) key (secret_key_fields algorithm)
 		private_hash <- getRemainingByteString
-		return ((k' B.empty (Just private_hash)) {key = key})
+		return ((k' B.empty (Just private_hash) False) {key = key})
 -- PublicKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.2
 parse_packet  6 = do
 	version <- get :: Get Word8
@@ -489,9 +496,14 @@ parse_packet  6 = do
 				version = 4,
 				timestamp = timestamp,
 				key_algorithm = algorithm,
-				key = key
+				key = key,
+				is_subkey = False
 			}
 		x -> fail $ "Unsupported PublicKeyPacket version " ++ show x ++ "."
+-- Secret-SubKey Packet, http://tools.ietf.org/html/rfc4880#section-5.5.1.4
+parse_packet  7 = do
+	p <- parse_packet 5
+	return p {is_subkey = True}
 -- CompressedDataPacket, http://tools.ietf.org/html/rfc4880#section-5.6
 parse_packet  8 = do
 	algorithm <- get
@@ -518,6 +530,10 @@ parse_packet 11 = do
 -- UserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.11
 parse_packet 13 =
 	fmap (UserIDPacket . B.toString) getRemainingByteString
+-- Public-Subkey Packet, http://tools.ietf.org/html/rfc4880#section-5.5.1.2
+parse_packet 14 = do
+	p <- parse_packet 6
+	return p {is_subkey = True}
 -- ModificationDetectionCodePacket, http://tools.ietf.org/html/rfc4880#section-5.14
 parse_packet 19 =
 	fmap ModificationDetectionCodePacket getRemainingByteString
@@ -547,7 +563,7 @@ fingerprint_material (SecretKeyPacket {version = 4,
 	fingerprint_material PublicKeyPacket {version = 4,
                       timestamp = timestamp,
                       key_algorithm = algorithm,
-                      key = key}
+                      key = key, is_subkey = False}
 fingerprint_material p | version p `elem` [2, 3] = [n, e]
 	where
 	n = B.drop 2 (encode (key p ! 'n'))
-- 
cgit v1.2.3


From d25ae59b2072891c95e5e1747fee87f9b98bb1f5 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 11 May 2012 18:58:10 -0500
Subject: Fix EmbeddedSignaturePacket

---
 Data/OpenPGP.hs           |   4 ++--
 tests/data/002182-002.sig | Bin 0 -> 363 bytes
 tests/suite.hs            |   1 +
 3 files changed, 3 insertions(+), 2 deletions(-)
 create mode 100644 tests/data/002182-002.sig

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index d6da9de..12bef74 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -887,7 +887,7 @@ put_signature_subpacket (FeaturesPacket supports_mdc) =
 put_signature_subpacket (SignatureTargetPacket kalgo halgo hash) =
 	(B.concat [encode kalgo, encode halgo, hash], 31)
 put_signature_subpacket (EmbeddedSignaturePacket packet) =
-	(encode (assertProp isSignaturePacket packet), 32)
+	(fst $ put_packet (assertProp isSignaturePacket packet), 32)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
@@ -1002,7 +1002,7 @@ parse_signature_subpacket 31 =
 	liftM3 SignatureTargetPacket get get getRemainingByteString
 -- EmbeddedSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.26
 parse_signature_subpacket 32 =
-	fmap (EmbeddedSignaturePacket . forceSignature) get
+	fmap (EmbeddedSignaturePacket . forceSignature) (parse_packet 2)
 	where
 	forceSignature x@(SignaturePacket {}) = x
 	forceSignature _ = error "EmbeddedSignature must contain signature"
diff --git a/tests/data/002182-002.sig b/tests/data/002182-002.sig
new file mode 100644
index 0000000..2bc6679
Binary files /dev/null and b/tests/data/002182-002.sig differ
diff --git a/tests/suite.hs b/tests/suite.hs
index 0ddc770..3094214 100644
--- a/tests/suite.hs
+++ b/tests/suite.hs
@@ -130,6 +130,7 @@ tests =
 			testCase "000076-007.secret_subkey" (testSerialization "000076-007.secret_subkey"),
 			testCase "000077-002.sig" (testSerialization "000077-002.sig"),
 			testCase "000078-012.ring_trust" (testSerialization "000078-012.ring_trust"),
+			testCase "002182-002.sig" (testSerialization "002182-002.sig"),
 			testCase "pubring.gpg" (testSerialization "pubring.gpg"),
 			testCase "secring.gpg" (testSerialization "secring.gpg"),
 			testCase "compressedsig.gpg" (testSerialization "compressedsig.gpg"),
-- 
cgit v1.2.3


From 4898b00a5221c9ceaa36d04ceea406bcdd12ccd8 Mon Sep 17 00:00:00 2001
From: Clint Adams <clint@debian.org>
Date: Mon, 21 May 2012 22:56:00 -0400
Subject: Parse V3 signature packets.

---
 Data/OpenPGP.hs | 21 ++++++++++++++++++++-
 1 file changed, 20 insertions(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 12bef74..4fd32e2 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -403,7 +403,26 @@ parse_packet :: Word8 -> Get Packet
 parse_packet  2 = do
 	version <- get
 	case version of
-		3 -> error "V3 signatures are not supported yet" -- TODO: V3 sigs
+		3 -> do
+			_ <- fmap (assertProp (==5)) (get :: Get Word8)
+			signature_type <- get
+			creation_time <- get :: Get Word32
+			key_id <- get :: Get Word64
+			key_algorithm <- get
+			hash_algorithm <- get
+			hash_head <- get
+			signature <- listUntilEnd
+			return SignaturePacket {
+				version = version,
+				signature_type = signature_type,
+				key_algorithm = key_algorithm,
+				hash_algorithm = hash_algorithm,
+				hashed_subpackets = [],
+				unhashed_subpackets = [],
+				hash_head = hash_head,
+				signature = signature,
+				trailer = B.concat [encode creation_time, encode key_id] -- TODO: put this somewhere better
+			}
 		4 -> do
 			signature_type <- get
 			key_algorithm <- get
-- 
cgit v1.2.3


From 98b6518c73aaa805b991be548586d126f89b9bc0 Mon Sep 17 00:00:00 2001
From: Clint Adams <clint@debian.org>
Date: Mon, 21 May 2012 23:03:45 -0400
Subject: Parse V3 pubkey packets.

---
 Data/OpenPGP.hs | 12 ++++++++++++
 1 file changed, 12 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 4fd32e2..9ddb19f 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -505,6 +505,18 @@ parse_packet  5 = do
 parse_packet  6 = do
 	version <- get :: Get Word8
 	case version of
+		3 -> do
+			timestamp <- get
+			_ <- get :: Get Word16 -- TODO: preserve days_of_validity somehow
+			algorithm <- get
+			key <- mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm)
+			return PublicKeyPacket {
+				version = version,
+				timestamp = timestamp,
+				key_algorithm = algorithm,
+				key = key,
+				is_subkey = False
+			}
 		4 -> do
 			timestamp <- get
 			algorithm <- get
-- 
cgit v1.2.3


From 57b5e98c50e57aa9bfc7e71311e0999967a0e24c Mon Sep 17 00:00:00 2001
From: Clint Adams <clint@debian.org>
Date: Mon, 21 May 2012 23:33:44 -0400
Subject: Parse V2 signatures the same way as V3 signatures.

---
 Data/OpenPGP.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 9ddb19f..26ec335 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -403,7 +403,7 @@ parse_packet :: Word8 -> Get Packet
 parse_packet  2 = do
 	version <- get
 	case version of
-		3 -> do
+		_ | version `elem` [2,3] -> do
 			_ <- fmap (assertProp (==5)) (get :: Get Word8)
 			signature_type <- get
 			creation_time <- get :: Get Word32
-- 
cgit v1.2.3


From 5c851e7727ee261c498d6128805b9705f3f677f1 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 6 Aug 2012 10:20:58 -0500
Subject: Simulated subpackets + proper trailer for v2/3 sig

Store expiry and issuer data in subpackets, for uniform UI, even though
there aren't really subpackets in the data.

Create the correct trailer data for v2/3 sigs.
---
 Data/OpenPGP.hs | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 26ec335..5e735d0 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -418,10 +418,13 @@ parse_packet  2 = do
 				key_algorithm = key_algorithm,
 				hash_algorithm = hash_algorithm,
 				hashed_subpackets = [],
-				unhashed_subpackets = [],
+				unhashed_subpackets = [
+					SignatureCreationTimePacket creation_time,
+					IssuerPacket $ pad $ map toUpper $ showHex keyid ""
+				],
 				hash_head = hash_head,
 				signature = signature,
-				trailer = B.concat [encode creation_time, encode key_id] -- TODO: put this somewhere better
+				trailer = B.concat [encode signature_type, encode creation_time]
 			}
 		4 -> do
 			signature_type <- get
@@ -447,6 +450,8 @@ parse_packet  2 = do
 				trailer = B.concat [encode version, encode signature_type, encode key_algorithm, encode hash_algorithm, encode (fromIntegral hashed_size :: Word16), hashed_data, B.pack [4, 0xff], encode ((6 + fromIntegral hashed_size) :: Word32)]
 			}
 		x -> fail $ "Unknown SignaturePacket version " ++ show x ++ "."
+	where
+	pad s = replicate (16 - length s) '0' ++ s
 -- OnePassSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.4
 parse_packet  4 = do
 	version <- get
-- 
cgit v1.2.3


From dcf4e3a203c4a93389e35c23b6fa5c79469a1dcf Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 6 Aug 2012 10:22:47 -0500
Subject: Put v2/3 signatures as well

Add trailer calculation for v2/3
Add code to put these packets back out
Change Arbitrary instance to allow for these kinds of signatures
Tests pass
---
 Arbitrary.patch | 11 +++++++++--
 Data/OpenPGP.hs | 41 +++++++++++++++++++++++++++++++++++++++--
 2 files changed, 48 insertions(+), 4 deletions(-)

(limited to 'Data')

diff --git a/Arbitrary.patch b/Arbitrary.patch
index f1f3824..fa78846 100644
--- a/Arbitrary.patch
+++ b/Arbitrary.patch
@@ -1,6 +1,6 @@
 --- Data/OpenPGP/Arbitrary.hs	2012-04-27 12:38:11.492411339 -0500
 +++ arb.s	2012-04-27 12:37:57.176469214 -0500
-@@ -14,13 +14,11 @@
+@@ -14,13 +14,18 @@
                     0 -> do x1 <- arbitrary
                             x2 <- arbitrary
                             x3 <- arbitrary
@@ -13,7 +13,14 @@
 -                           x8 <- arbitrary
 -                           x9 <- arbitrary
 -                           return (SignaturePacket x1 x2 x3 x4 x5 x6 x7 x8 x9)
-+                           return (signaturePacket 4 x1 x2 x3 x4 x5 x6 x7)
++                           version <- choose (2 :: Word8, 4)
++                           case version of
++                                   4 ->
++                                           return (signaturePacket 4 x1 x2 x3 x4 x5 x6 x7)
++                                   _ -> do
++                                           creation_time <- arbitrary
++                                           keyid <- vectorOf 16 (elements (['0'..'9'] ++ ['A'..'F']))
++                                           return (signaturePacket version x1 x2 x3 [] [SignatureCreationTimePacket creation_time, IssuerPacket keyid] x6 x7)
                     1 -> do x1 <- arbitrary
                             x2 <- arbitrary
                             x3 <- arbitrary
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 5e735d0..e6076fa 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -65,6 +65,7 @@ import Data.Bits
 import Data.Word
 import Data.Char
 import Data.Maybe
+import Data.List
 import Data.OpenPGP.Internal
 import qualified Data.ByteString.Lazy as LZ
 
@@ -308,15 +309,51 @@ signature_packet_start x =
 
 -- The trailer is just the top of the body plus some crap
 calculate_signature_trailer :: Packet -> B.ByteString
-calculate_signature_trailer p =
+calculate_signature_trailer (SignaturePacket { version = v,
+                                               signature_type = signature_type,
+                                               unhashed_subpackets = unhashed_subpackets
+                                             }) | v `elem` [2,3] =
+	B.concat [
+		encode signature_type,
+		encode creation_time
+	]
+	where
+	Just (SignatureCreationTimePacket creation_time) = find isCreation unhashed_subpackets
+	isCreation (SignatureCreationTimePacket {}) = True
+	isCreation _ = False
+calculate_signature_trailer p@(SignaturePacket {version = 4}) =
 	B.concat [
 		signature_packet_start p,
 		encode (0x04 :: Word8),
 		encode (0xff :: Word8),
 		encode (fromIntegral (B.length $ signature_packet_start p) :: Word32)
 	]
+calculate_signature_trailer x =
+	error ("Trying to calculate signature trailer for: " ++ show x)
 
 put_packet :: (Num a) => Packet -> (B.ByteString, a)
+put_packet (SignaturePacket { version = v,
+                              unhashed_subpackets = unhashed_subpackets,
+                              key_algorithm = key_algorithm,
+                              hash_algorithm = hash_algorithm,
+                              hash_head = hash_head,
+                              signature = signature,
+                              trailer = trailer }) | v `elem` [2,3] =
+	-- TODO: Assert that there are no subpackets we cannot encode?
+	(B.concat $ [
+		B.singleton v,
+		B.singleton 0x05,
+		trailer, -- signature_type and creation_time
+		encode keyid,
+		encode key_algorithm,
+		encode hash_algorithm,
+		encode hash_head
+	] ++ map encode signature, 2)
+	where
+	keyid = fst $ head $ readHex keyidS :: Word64
+	Just (IssuerPacket keyidS) = find isIssuer unhashed_subpackets
+	isIssuer (IssuerPacket {}) = True
+	isIssuer _ = False
 put_packet (SignaturePacket { version = 4,
                               unhashed_subpackets = unhashed_subpackets,
                               hash_head = hash_head,
@@ -407,7 +444,7 @@ parse_packet  2 = do
 			_ <- fmap (assertProp (==5)) (get :: Get Word8)
 			signature_type <- get
 			creation_time <- get :: Get Word32
-			key_id <- get :: Get Word64
+			keyid <- get :: Get Word64
 			key_algorithm <- get
 			hash_algorithm <- get
 			hash_head <- get
-- 
cgit v1.2.3


From a90fec088355aeb4f670b272dd62acc7369e07ef Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 6 Aug 2012 10:46:40 -0500
Subject: Full roundtrip for v3 PublicKey

Added some examples to HUnit tests.
Made Put work for v3 PublicKey
Store validity as v3_days_of_validity (Maybe Word16)
v4 Get learns some things from the v3 Get
---
 Data/OpenPGP.hs        |  39 ++++++++++++++++++++++++++-------------
 tests/data/pubring.gpg | Bin 7368 -> 179272 bytes
 2 files changed, 26 insertions(+), 13 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index e6076fa..ce6ab90 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -24,6 +24,8 @@ module Data.OpenPGP (
 		hashed_subpackets,
 		hash_head,
 		key,
+		is_subkey,
+		v3_days_of_validity,
 		key_algorithm,
 		key_id,
 		message,
@@ -173,7 +175,8 @@ data Packet =
 		timestamp::Word32,
 		key_algorithm::KeyAlgorithm,
 		key::[(Char,MPI)],
-		is_subkey::Bool
+		is_subkey::Bool,
+		v3_days_of_validity::Maybe Word16
 	} |
 	SecretKeyPacket {
 		version::Word8,
@@ -409,15 +412,25 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
 	where
 	(Just s2k_t) = s2k_type
 	p = fst (put_packet $
-		PublicKeyPacket version timestamp algorithm key False
+		PublicKeyPacket version timestamp algorithm key False Nothing
 		:: (B.ByteString, Integer)) -- Supress warning
 	s = map (encode . (key !)) (secret_key_fields algorithm)
-put_packet (PublicKeyPacket { version = 4, timestamp = timestamp,
+put_packet p@(PublicKeyPacket { version = v, timestamp = timestamp,
                               key_algorithm = algorithm, key = key,
-                              is_subkey = is_subkey }) =
-	(B.concat $ [B.singleton 4, encode timestamp, encode algorithm] ++
-		map (encode . (key !)) (public_key_fields algorithm),
-	if is_subkey then 14 else 6)
+                              is_subkey = is_subkey })
+	| v == 3 =
+		final (B.concat $ [
+			B.singleton 3, encode timestamp,
+			encode (fromJust $ v3_days_of_validity p),
+			encode algorithm
+		] ++ material)
+	| v == 4 =
+		final (B.concat $ [
+			B.singleton 4, encode timestamp, encode algorithm
+		] ++ material)
+	where
+	final x = (x, if is_subkey then 14 else 6)
+	material = map (encode . (key !)) (public_key_fields algorithm)
 put_packet (CompressedDataPacket { compression_algorithm = algorithm,
                                    message = message }) =
 	(B.append (encode algorithm) $ compress algorithm $ encode message, 8)
@@ -549,7 +562,7 @@ parse_packet  6 = do
 	case version of
 		3 -> do
 			timestamp <- get
-			_ <- get :: Get Word16 -- TODO: preserve days_of_validity somehow
+			days <- get
 			algorithm <- get
 			key <- mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm)
 			return PublicKeyPacket {
@@ -557,20 +570,20 @@ parse_packet  6 = do
 				timestamp = timestamp,
 				key_algorithm = algorithm,
 				key = key,
-				is_subkey = False
+				is_subkey = False,
+				v3_days_of_validity = Just days
 			}
 		4 -> do
 			timestamp <- get
 			algorithm <- get
-			key <- mapM (\f -> do
-				mpi <- get :: Get MPI
-				return (f, mpi)) (public_key_fields algorithm)
+			key <- mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm)
 			return PublicKeyPacket {
 				version = 4,
 				timestamp = timestamp,
 				key_algorithm = algorithm,
 				key = key,
-				is_subkey = False
+				is_subkey = False,
+				v3_days_of_validity = Nothing
 			}
 		x -> fail $ "Unsupported PublicKeyPacket version " ++ show x ++ "."
 -- Secret-SubKey Packet, http://tools.ietf.org/html/rfc4880#section-5.5.1.4
diff --git a/tests/data/pubring.gpg b/tests/data/pubring.gpg
index 56e0599..a1519ee 100644
Binary files a/tests/data/pubring.gpg and b/tests/data/pubring.gpg differ
-- 
cgit v1.2.3


From 1934db51341286a76cb623c0d84c06f9869794b4 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 6 Aug 2012 10:49:03 -0500
Subject: Better error message

---
 Data/OpenPGP.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index ce6ab90..23e2bbb 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -446,7 +446,7 @@ put_packet (LiteralDataPacket { format = format, filename = filename,
 put_packet (UserIDPacket txt) = (B.fromString txt, 13)
 put_packet (ModificationDetectionCodePacket bstr) = (bstr, 19)
 put_packet (UnsupportedPacket tag bytes) = (bytes, fromIntegral tag)
-put_packet _ = error "Unsupported Packet version or type in put_packet."
+put_packet x = error ("Unsupported Packet version or type in put_packet: " ++ show x)
 
 parse_packet :: Word8 -> Get Packet
 -- SignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2
-- 
cgit v1.2.3


From 30a9a7735ce2dd4f25c92c6beeb5ae927c01958d Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 6 Aug 2012 10:49:21 -0500
Subject: Cleaner fingerprint material extractor

---
 Data/OpenPGP.hs | 20 ++++----------------
 1 file changed, 4 insertions(+), 16 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 23e2bbb..70bd29a 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -628,28 +628,16 @@ parse_packet tag = fmap (UnsupportedPacket tag) getRemainingByteString
 
 -- | Helper method for fingerprints and such
 fingerprint_material :: Packet -> [B.ByteString]
-fingerprint_material (PublicKeyPacket {version = 4,
-                      timestamp = timestamp,
-                      key_algorithm = algorithm,
-                      key = key}) =
+fingerprint_material p | version p == 4 =
 	[
 		B.singleton 0x99,
 		encode (6 + fromIntegral (B.length material) :: Word16),
-		B.singleton 4, encode timestamp, encode algorithm,
+		B.singleton 4, encode (timestamp p), encode (key_algorithm p),
 		material
 	]
 	where
-	material =
-		B.concat $ map (encode . (key !)) (public_key_fields algorithm)
--- Proxy to make SecretKeyPacket work
-fingerprint_material (SecretKeyPacket {version = 4,
-                      timestamp = timestamp,
-                      key_algorithm = algorithm,
-                      key = key}) =
-	fingerprint_material PublicKeyPacket {version = 4,
-                      timestamp = timestamp,
-                      key_algorithm = algorithm,
-                      key = key, is_subkey = False}
+	material = B.concat $ map (encode . (key p !))
+		(public_key_fields $ key_algorithm p)
 fingerprint_material p | version p `elem` [2, 3] = [n, e]
 	where
 	n = B.drop 2 (encode (key p ! 'n'))
-- 
cgit v1.2.3


From a595481760fe5c4dc2e970a3a164ac12d4005d73 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Tue, 11 Sep 2012 11:34:49 -0500
Subject: Better bit counting. Handle the bitlength of 0

Closes #17
---
 Data/OpenPGP.hs | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 70bd29a..a268dff 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -62,6 +62,7 @@ module Data.OpenPGP (
 
 import Numeric
 import Control.Monad
+import Control.Arrow
 import Control.Exception (assert)
 import Data.Bits
 import Data.Word
@@ -790,19 +791,23 @@ signatures_and_data (Message lst) =
 newtype MPI = MPI Integer deriving (Show, Read, Eq, Ord)
 instance BINARY_CLASS MPI where
 	put (MPI i) = do
-		put (((fromIntegral . B.length $ bytes) - 1) * 8
-			+ floor (logBase (2::Double) $ fromIntegral (bytes `B.index` 0))
-			+ 1 :: Word16)
+		put (bitl :: Word16)
 		putSomeByteString bytes
 		where
-		bytes = if B.null bytes' then B.singleton 0 else bytes'
+		(bytes, bitl)
+			| B.null bytes' = (B.singleton 0, 1)
+			| otherwise     =
+				(bytes', (fromIntegral (B.length bytes') - 1) * 8 + sigBit)
+
+		sigBit = fst $ until ((==0) . snd)
+			(first (+1) . second (`shiftR` 1)) (0,B.index bytes 0)
 		bytes' = B.reverse $ B.unfoldr (\x ->
 				if x == 0 then Nothing else
 					Just (fromIntegral x, x `shiftR` 8)
 			) (assertProp (>=0) i)
 	get = do
 		length <- fmap fromIntegral (get :: Get Word16)
-		bytes <- getSomeByteString ((length + 7) `div` 8)
+		bytes <- getSomeByteString (assertProp (>0) $ (length + 7) `div` 8)
 		return (MPI (B.foldl (\a b ->
 			a `shiftL` 8 .|. fromIntegral b) 0 bytes))
 
-- 
cgit v1.2.3


From 1ef98205821990faa671dcb8efd949134e5e4c02 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 30 Nov 2012 17:53:25 -0500
Subject: Stop using !! 0

---
 Data/OpenPGP.hs  | 12 +++++++-----
 Makefile         |  2 +-
 debian/changelog |  6 ++++++
 debian/control   | 12 +++++++++---
 4 files changed, 23 insertions(+), 9 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index a268dff..94bcb6d 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -1093,11 +1093,13 @@ parse_signature_subpacket tag =
 signature_issuer :: Packet -> Maybe String
 signature_issuer (SignaturePacket {hashed_subpackets = hashed,
                                    unhashed_subpackets = unhashed}) =
-	if length issuers > 0 then Just issuer else Nothing
-	where IssuerPacket issuer = issuers !! 0
-	      issuers = filter isIssuer hashed ++ filter isIssuer unhashed
-	      isIssuer (IssuerPacket {}) = True
-	      isIssuer _ = False
+	case issuers of
+		IssuerPacket issuer : _ -> Just issuer
+		_                       -> Nothing
+	where
+	issuers = filter isIssuer hashed ++ filter isIssuer unhashed
+	isIssuer (IssuerPacket {}) = True
+	isIssuer _ = False
 signature_issuer _ = Nothing
 
 find_key :: (Packet -> String) -> Message -> String -> Maybe Packet
diff --git a/Makefile b/Makefile
index 67e823b..076b00a 100644
--- a/Makefile
+++ b/Makefile
@@ -4,7 +4,7 @@ else
 GHCFLAGS=-Wall -O2 -fno-warn-name-shadowing -XHaskell98
 endif
 
-HLINTFLAGS=-XHaskell98 -XCPP -i 'Use camelCase' -i 'Use String' -i 'Use head' -i 'Use string literal' -i 'Use list comprehension' --utf8
+HLINTFLAGS=-u -XHaskell98 -XCPP -i 'Use camelCase' -i 'Use String' -i 'Use string literal' -i 'Use list comprehension'
 VERSION=0.4
 
 .PHONY: all clean doc install debian test
diff --git a/debian/changelog b/debian/changelog
index 31d5882..60634f7 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+haskell-openpgp (0.4-1~hackage1) unstable; urgency=low
+
+  * Debianization generated by cabal-debian
+
+ -- Stephen Paul Weber <singpolyma@singpolyma.net>  Thu, 01 Nov 2012 14:31:20 -0500
+
 haskell-openpgp (0.3-1~hackage1) unstable; urgency=low
 
   * Debianization generated by cabal-debian
diff --git a/debian/control b/debian/control
index 679e316..14b26b0 100644
--- a/debian/control
+++ b/debian/control
@@ -41,7 +41,9 @@ Description: Implementation of the OpenPGP message format
  and then defines instances of Data.Binary for each to facilitate
  encoding/decoding.
  .
- For performing cryptography, see <http://hackage.haskell.org/openpgp-Crypto>
+ For performing cryptography, see
+ <http://hackage.haskell.org/package/openpgp-crypto-api> or
+ <http://hackage.haskell.org/package/openpgp-Crypto>
  .
  It is intended that you use qualified imports with this library.
  .
@@ -69,7 +71,9 @@ Description: Implementation of the OpenPGP message format
  and then defines instances of Data.Binary for each to facilitate
  encoding/decoding.
  .
- For performing cryptography, see <http://hackage.haskell.org/openpgp-Crypto>
+ For performing cryptography, see
+ <http://hackage.haskell.org/package/openpgp-crypto-api> or
+ <http://hackage.haskell.org/package/openpgp-Crypto>
  .
  It is intended that you use qualified imports with this library.
  .
@@ -97,7 +101,9 @@ Description: Implementation of the OpenPGP message format
  and then defines instances of Data.Binary for each to facilitate
  encoding/decoding.
  .
- For performing cryptography, see <http://hackage.haskell.org/openpgp-Crypto>
+ For performing cryptography, see
+ <http://hackage.haskell.org/package/openpgp-crypto-api> or
+ <http://hackage.haskell.org/package/openpgp-Crypto>
  .
  It is intended that you use qualified imports with this library.
  .
-- 
cgit v1.2.3


From bd378deb253f33a9cd32f8534ecc44f17921401b Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Fri, 30 Nov 2012 18:08:48 -0500
Subject: formatting

---
 Data/OpenPGP.hs | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 94bcb6d..ccdc70a 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -377,10 +377,12 @@ put_packet (OnePassSignaturePacket { version = version,
                                      key_algorithm = key_algorithm,
                                      key_id = key_id,
                                      nested = nested }) =
-	(B.concat [ encode version, encode signature_type,
-	             encode hash_algorithm, encode key_algorithm,
-	             encode (fst $ head $ readHex key_id :: Word64),
-	             encode nested ], 4)
+	(B.concat [
+		encode version, encode signature_type,
+		encode hash_algorithm, encode key_algorithm,
+		encode (fst $ head $ readHex key_id :: Word64),
+		encode nested
+	], 4)
 put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
                               key_algorithm = algorithm, key = key,
                               s2k_useage = s2k_useage,
@@ -439,8 +441,10 @@ put_packet MarkerPacket = (B.fromString "PGP", 10)
 put_packet (LiteralDataPacket { format = format, filename = filename,
                                 timestamp = timestamp, content = content
                               }) =
-	(B.concat [encode format, encode filename_l, lz_filename,
-	            encode timestamp, content], 11)
+	(B.concat [
+		encode format, encode filename_l, lz_filename,
+		encode timestamp, content
+	], 11)
 	where
 	filename_l  = (fromIntegral $ B.length lz_filename) :: Word8
 	lz_filename = B.fromString filename
-- 
cgit v1.2.3


From a0405223def95a6d8238d4ac25c4ea8eb6523a0c Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 29 Dec 2012 10:45:35 -0500
Subject: Share pad function

---
 Data/OpenPGP.hs | 18 +++++++-----------
 1 file changed, 7 insertions(+), 11 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index ccdc70a..e0d0501 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -151,6 +151,9 @@ lazyDecompress x            = error ("No implementation for " ++ show x)
 assertProp :: (a -> Bool) -> a -> a
 assertProp f x = assert (f x) x
 
+pad :: Int -> String -> String
+pad l s = replicate (l - length s) '0' ++ s
+
 data Packet =
 	SignaturePacket {
 		version::Word8,
@@ -475,7 +478,7 @@ parse_packet  2 = do
 				hashed_subpackets = [],
 				unhashed_subpackets = [
 					SignatureCreationTimePacket creation_time,
-					IssuerPacket $ pad $ map toUpper $ showHex keyid ""
+					IssuerPacket $ pad 16 $ map toUpper $ showHex keyid ""
 				],
 				hash_head = hash_head,
 				signature = signature,
@@ -505,8 +508,6 @@ parse_packet  2 = do
 				trailer = B.concat [encode version, encode signature_type, encode key_algorithm, encode hash_algorithm, encode (fromIntegral hashed_size :: Word16), hashed_data, B.pack [4, 0xff], encode ((6 + fromIntegral hashed_size) :: Word32)]
 			}
 		x -> fail $ "Unknown SignaturePacket version " ++ show x ++ "."
-	where
-	pad s = replicate (16 - length s) '0' ++ s
 -- OnePassSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.4
 parse_packet  4 = do
 	version <- get
@@ -520,11 +521,9 @@ parse_packet  4 = do
 		signature_type = signature_type,
 		hash_algorithm = hash_algo,
 		key_algorithm = key_algo,
-		key_id = pad $ map toUpper $ showHex key_id "",
+		key_id = pad 16 $ map toUpper $ showHex key_id "",
 		nested = nested
 	}
-	where
-	pad s = replicate (16 - length s) '0' ++ s
 -- SecretKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.3
 parse_packet  5 = do
 	-- Parse PublicKey part
@@ -1005,19 +1004,16 @@ parse_signature_subpacket 12 = do
 		sensitive = bitfield .&. 0x40 == 0x40,
 		revocation_key_algorithm = kalgo,
 		revocation_key_fingerprint =
-			pad $ map toUpper $ foldr (padB `oo` showHex) "" (B.unpack fpr)
+			pad 40 $ map toUpper $ foldr (padB `oo` showHex) "" (B.unpack fpr)
 	}
 	where
 	oo = (.) . (.)
 	padB s | odd $ length s = '0':s
 	       | otherwise = s
-	pad s = replicate (40 - length s) '0' ++ s
 -- IssuerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.5
 parse_signature_subpacket 16 = do
 	keyid <- get :: Get Word64
-	return $ IssuerPacket (pad $ map toUpper $ showHex keyid "")
-	where
-	pad s = replicate (16 - length s) '0' ++ s
+	return $ IssuerPacket (pad 16 $ map toUpper $ showHex keyid "")
 -- NotationDataPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.16
 parse_signature_subpacket 20 = do
 	(flag1,_,_,_) <- get4word8
-- 
cgit v1.2.3


From c431df57562913b0f8a80badcff3293354cea86e Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 29 Dec 2012 10:45:55 -0500
Subject: Get rid of unnecessary polymorphism

---
 Data/OpenPGP.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index e0d0501..c9a7840 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -338,7 +338,7 @@ calculate_signature_trailer p@(SignaturePacket {version = 4}) =
 calculate_signature_trailer x =
 	error ("Trying to calculate signature trailer for: " ++ show x)
 
-put_packet :: (Num a) => Packet -> (B.ByteString, a)
+put_packet :: Packet -> (B.ByteString, Word8)
 put_packet (SignaturePacket { version = v,
                               unhashed_subpackets = unhashed_subpackets,
                               key_algorithm = key_algorithm,
@@ -418,8 +418,7 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
 	where
 	(Just s2k_t) = s2k_type
 	p = fst (put_packet $
-		PublicKeyPacket version timestamp algorithm key False Nothing
-		:: (B.ByteString, Integer)) -- Supress warning
+		PublicKeyPacket version timestamp algorithm key False Nothing)
 	s = map (encode . (key !)) (secret_key_fields algorithm)
 put_packet p@(PublicKeyPacket { version = v, timestamp = timestamp,
                               key_algorithm = algorithm, key = key,
-- 
cgit v1.2.3


From 86d6407eccd1ed9f44f4e1a0e495e504d393c1d8 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 29 Dec 2012 10:52:15 -0500
Subject: AsymmetricSessionKeyPacket

---
 Arbitrary.patch |  4 ++--
 Data/OpenPGP.hs | 21 +++++++++++++++++++++
 2 files changed, 23 insertions(+), 2 deletions(-)

(limited to 'Data')

diff --git a/Arbitrary.patch b/Arbitrary.patch
index fa78846..641609f 100644
--- a/Arbitrary.patch
+++ b/Arbitrary.patch
@@ -1,7 +1,7 @@
 --- Data/OpenPGP/Arbitrary.hs	2012-04-27 12:38:11.492411339 -0500
 +++ arb.s	2012-04-27 12:37:57.176469214 -0500
 @@ -14,13 +14,18 @@
-                    0 -> do x1 <- arbitrary
+                    1 -> do x1 <- arbitrary
                             x2 <- arbitrary
                             x3 <- arbitrary
 -                           x4 <- arbitrary
@@ -21,7 +21,7 @@
 +                                           creation_time <- arbitrary
 +                                           keyid <- vectorOf 16 (elements (['0'..'9'] ++ ['A'..'F']))
 +                                           return (signaturePacket version x1 x2 x3 [] [SignatureCreationTimePacket creation_time, IssuerPacket keyid] x6 x7)
-                    1 -> do x1 <- arbitrary
+                    2 -> do x1 <- arbitrary
                             x2 <- arbitrary
                             x3 <- arbitrary
 @@ -73,7 +72,7 @@
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index c9a7840..dca7838 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -6,6 +6,7 @@
 -- > import qualified Data.OpenPGP as OpenPGP
 module Data.OpenPGP (
 	Packet(
+		AsymmetricSessionKeyPacket,
 		OnePassSignaturePacket,
 		PublicKeyPacket,
 		SecretKeyPacket,
@@ -63,6 +64,7 @@ module Data.OpenPGP (
 import Numeric
 import Control.Monad
 import Control.Arrow
+import Control.Applicative
 import Control.Exception (assert)
 import Data.Bits
 import Data.Word
@@ -155,6 +157,12 @@ pad :: Int -> String -> String
 pad l s = replicate (l - length s) '0' ++ s
 
 data Packet =
+	AsymmetricSessionKeyPacket {
+		version::Word8,
+		key_id::String,
+		key_algorithm::KeyAlgorithm,
+		encrypted_data::B.ByteString
+	} |
 	SignaturePacket {
 		version::Word8,
 		signature_type::Word8,
@@ -339,6 +347,13 @@ calculate_signature_trailer x =
 	error ("Trying to calculate signature trailer for: " ++ show x)
 
 put_packet :: Packet -> (B.ByteString, Word8)
+put_packet (AsymmetricSessionKeyPacket version key_id key_algorithm dta) =
+	(B.concat [
+		encode version,
+		encode (fst $ head $ readHex key_id :: Word64),
+		encode key_algorithm,
+		dta
+	], 1)
 put_packet (SignaturePacket { version = v,
                               unhashed_subpackets = unhashed_subpackets,
                               key_algorithm = key_algorithm,
@@ -456,6 +471,12 @@ put_packet (UnsupportedPacket tag bytes) = (bytes, fromIntegral tag)
 put_packet x = error ("Unsupported Packet version or type in put_packet: " ++ show x)
 
 parse_packet :: Word8 -> Get Packet
+-- AsymmetricSessionKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.1
+parse_packet  1 = AsymmetricSessionKeyPacket
+	<$> fmap (assertProp (==3)) get
+	<*> fmap (pad 16 . map toUpper . flip showHex "") (get :: Get Word64)
+	<*> get
+	<*> getRemainingByteString
 -- SignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2
 parse_packet  2 = do
 	version <- get
-- 
cgit v1.2.3


From 4b5e0e3d27973f8627ed3d83013f55c3b365b306 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 29 Dec 2012 11:14:38 -0500
Subject: Support partial lengths

---
 Data/OpenPGP.hs | 38 +++++++++++++++++++++++---------------
 1 file changed, 23 insertions(+), 15 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index dca7838..c6c22e4 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -237,31 +237,39 @@ instance BINARY_CLASS Packet where
 		blen = fromIntegral $ B.length body
 		(body, tag) = put_packet p
 	get = do
-		tag <- get :: Get Word8
-		let (t, l) =
-			if (tag .&. 64) /= 0 then
-				(tag .&. 63, parse_new_length)
-			else
-				((tag `shiftR` 2) .&. 15, parse_old_length tag)
-		len <- l
-		-- This forces the whole packet to be consumed
-		packet <- getSomeByteString (fromIntegral len)
-		return $ unsafeRunGet (parse_packet t) packet
+		(t, packet) <- get_packet_bytes
+		return $ unsafeRunGet (parse_packet t) (B.concat packet)
+
+get_packet_bytes :: Get (Word8, [B.ByteString])
+get_packet_bytes = do
+	tag <- get
+	let (t, l) =
+		if (tag .&. 64) /= 0 then
+			(tag .&. 63, parse_new_length)
+		else
+			((tag `shiftR` 2) .&. 15, (,) <$> parse_old_length tag <*> pure False)
+	(len, partial) <- l
+	-- This forces the whole packet to be consumed
+	packet <- getSomeByteString (fromIntegral len)
+	if not partial then return (t, [packet]) else
+		(,) t <$> ((packet:) . snd) <$> get_packet_bytes
 
 -- http://tools.ietf.org/html/rfc4880#section-4.2.2
-parse_new_length :: Get Word32
+parse_new_length :: Get (Word32, Bool)
 parse_new_length = do
 	len <- fmap fromIntegral (get :: Get Word8)
 	case len of
 		-- One octet length
-		_ | len < 192 -> return len
+		_ | len < 192 -> return (len, False)
 		-- Two octet length
 		_ | len > 191 && len < 224 -> do
 			second <- fmap fromIntegral (get :: Get Word8)
-			return $ ((len - 192) `shiftL` 8) + second + 192
+			return (((len - 192) `shiftL` 8) + second + 192, False)
 		-- Five octet length
-		255 -> get :: Get Word32
-		-- TODO: Partial body lengths. 1 << (len & 0x1F)
+		255 -> (,) <$> (get :: Get Word32) <*> pure False
+		-- Partial length (streaming)
+		_ | len >= 224 && len < 255 ->
+			return (1 `shiftL` (fromIntegral len .&. 0x1F), True)
 		_ -> fail "Unsupported new packet length."
 
 -- http://tools.ietf.org/html/rfc4880#section-4.2.1
-- 
cgit v1.2.3


From 3bd37771256f6a8f98c2e112c10e3bba84d6de78 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 29 Dec 2012 11:34:25 -0500
Subject: EncryptedDataPacket

---
 Data/OpenPGP.hs | 12 ++++++++++++
 1 file changed, 12 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index c6c22e4..90c254f 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -14,6 +14,7 @@ module Data.OpenPGP (
 		MarkerPacket,
 		LiteralDataPacket,
 		UserIDPacket,
+		EncryptedDataPacket,
 		ModificationDetectionCodePacket,
 		UnsupportedPacket,
 		compression_algorithm,
@@ -217,6 +218,10 @@ data Packet =
 		content::B.ByteString
 	} |
 	UserIDPacket String |
+	EncryptedDataPacket {
+		version::Word8, -- 0 for old-skool no-MDC (tag 9)
+		encrypted_data::B.ByteString
+	} |
 	ModificationDetectionCodePacket B.ByteString |
 	UnsupportedPacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
@@ -474,6 +479,9 @@ put_packet (LiteralDataPacket { format = format, filename = filename,
 	filename_l  = (fromIntegral $ B.length lz_filename) :: Word8
 	lz_filename = B.fromString filename
 put_packet (UserIDPacket txt) = (B.fromString txt, 13)
+put_packet (EncryptedDataPacket 0 encrypted_data) = (encrypted_data, 9)
+put_packet (EncryptedDataPacket version encrypted_data) =
+	(B.concat [encode version, encrypted_data], 18)
 put_packet (ModificationDetectionCodePacket bstr) = (bstr, 19)
 put_packet (UnsupportedPacket tag bytes) = (bytes, fromIntegral tag)
 put_packet x = error ("Unsupported Packet version or type in put_packet: " ++ show x)
@@ -630,6 +638,8 @@ parse_packet  8 = do
 		compression_algorithm = algorithm,
 		message = unsafeRunGet get (decompress algorithm message)
 	}
+-- EncryptedDataPacket, http://tools.ietf.org/html/rfc4880#section-5.7
+parse_packet  9 = EncryptedDataPacket 0 <$> getRemainingByteString
 -- MarkerPacket, http://tools.ietf.org/html/rfc4880#section-5.8
 parse_packet 10 = return MarkerPacket
 -- LiteralDataPacket, http://tools.ietf.org/html/rfc4880#section-5.9
@@ -652,6 +662,8 @@ parse_packet 13 =
 parse_packet 14 = do
 	p <- parse_packet 6
 	return p {is_subkey = True}
+-- EncryptedDataPacket, http://tools.ietf.org/html/rfc4880#section-5.13
+parse_packet 18 = EncryptedDataPacket <$> get <*> getRemainingByteString
 -- ModificationDetectionCodePacket, http://tools.ietf.org/html/rfc4880#section-5.14
 parse_packet 19 =
 	fmap ModificationDetectionCodePacket getRemainingByteString
-- 
cgit v1.2.3


From 60b8c7b116681349fa5bdbe3703094539e8c2eeb Mon Sep 17 00:00:00 2001
From: Markus Barenhoff <alios@alios.org>
Date: Fri, 29 Jun 2012 16:50:02 +0200
Subject: implemented TrustPacket

Merged a18c579af7771763a64c84891ce7912b87bd3a75
---
 Data/OpenPGP.hs | 5 +++++
 1 file changed, 5 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 90c254f..98622a1 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -13,6 +13,7 @@ module Data.OpenPGP (
 		CompressedDataPacket,
 		MarkerPacket,
 		LiteralDataPacket,
+		TrustPacket,
 		UserIDPacket,
 		EncryptedDataPacket,
 		ModificationDetectionCodePacket,
@@ -217,6 +218,7 @@ data Packet =
 		timestamp::Word32,
 		content::B.ByteString
 	} |
+	TrustPacket B.ByteString |
 	UserIDPacket String |
 	EncryptedDataPacket {
 		version::Word8, -- 0 for old-skool no-MDC (tag 9)
@@ -478,6 +480,7 @@ put_packet (LiteralDataPacket { format = format, filename = filename,
 	where
 	filename_l  = (fromIntegral $ B.length lz_filename) :: Word8
 	lz_filename = B.fromString filename
+put_packet (TrustPacket bytes) = (bytes, 12)
 put_packet (UserIDPacket txt) = (B.fromString txt, 13)
 put_packet (EncryptedDataPacket 0 encrypted_data) = (encrypted_data, 9)
 put_packet (EncryptedDataPacket version encrypted_data) =
@@ -655,6 +658,8 @@ parse_packet 11 = do
 		timestamp = timestamp,
 		content = content
 	}
+-- TrustPacket, http://tools.ietf.org/html/rfc4880#section-5.10
+parse_packet 12 = fmap TrustPacket getRemainingByteString
 -- UserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.11
 parse_packet 13 =
 	fmap (UserIDPacket . B.toString) getRemainingByteString
-- 
cgit v1.2.3


From 133b04ccbf83bab6406898b3906c0851d740fa67 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 29 Dec 2012 14:51:58 -0500
Subject: Fingerprint must always be 20 octets

---
 Data/OpenPGP.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 98622a1..02b4a1a 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -158,6 +158,9 @@ assertProp f x = assert (f x) x
 pad :: Int -> String -> String
 pad l s = replicate (l - length s) '0' ++ s
 
+padBS :: Int -> B.ByteString -> B.ByteString
+padBS l s = B.replicate (fromIntegral l - B.length s) 0 `B.append` s
+
 data Packet =
 	AsymmetricSessionKeyPacket {
 		version::Word8,
@@ -964,7 +967,7 @@ put_signature_subpacket (RevocationKeyPacket sensitive kalgo fpr) =
 	(B.concat [encode bitfield, encode kalgo, fprb], 12)
 	where
 	bitfield = 0x80 .|. (if sensitive then 0x40 else 0x0) :: Word8
-	fprb = B.drop 2 $ encode (MPI fpri)
+	fprb = padBS 20 $ B.drop 2 $ encode (MPI fpri)
 	fpri = fst $ head $ readHex fpr
 put_signature_subpacket (IssuerPacket keyid) =
 	(encode (fst $ head $ readHex keyid :: Word64), 16)
-- 
cgit v1.2.3


From e8e14f2cc9023794dfd2cf77943650ce28e2b36c Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 29 Dec 2012 14:52:53 -0500
Subject: Support for better error handling.

Requires binary 0.6.4.0
---
 Data/OpenPGP.hs | 70 ++++++++++++++++++++++++++++++++-------------------------
 Makefile        |  6 ++---
 openpgp.cabal   |  4 ++--
 3 files changed, 45 insertions(+), 35 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 02b4a1a..a3b7b62 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -67,7 +67,6 @@ import Numeric
 import Control.Monad
 import Control.Arrow
 import Control.Applicative
-import Control.Exception (assert)
 import Data.Bits
 import Data.Word
 import Data.Char
@@ -104,8 +103,10 @@ getSomeByteString = getByteString . fromIntegral
 putSomeByteString :: B.ByteString -> Put
 putSomeByteString = putByteString
 
-unsafeRunGet :: Get a -> B.ByteString -> a
-unsafeRunGet g bs = let Right v = runGet g bs in v
+localGet :: Get a -> B.ByteString -> Get a
+localGet g bs = case runGet g bs of
+	Left s -> fail s
+	Right v -> return v
 
 compress :: CompressionAlgorithm -> B.ByteString -> B.ByteString
 compress algo = toStrictBS . lazyCompress algo . toLazyBS
@@ -128,8 +129,12 @@ getSomeByteString = getLazyByteString . fromIntegral
 putSomeByteString :: B.ByteString -> Put
 putSomeByteString = putLazyByteString
 
-unsafeRunGet :: Get a -> B.ByteString -> a
-unsafeRunGet = runGet
+localGet :: Get a -> B.ByteString -> Get a
+localGet g bs = case runGetOrFail g bs of
+	Left (_,_,s) -> fail s
+	Right (leftover,_,v)
+		| B.null leftover -> return v
+		| otherwise -> fail $ "Leftover in localGet: " ++ show leftover
 
 compress :: CompressionAlgorithm -> B.ByteString -> B.ByteString
 compress = lazyCompress
@@ -152,8 +157,10 @@ lazyDecompress ZLIB         = Zlib.decompress
 lazyDecompress BZip2        = BZip2.decompress
 lazyDecompress x            = error ("No implementation for " ++ show x)
 
-assertProp :: (a -> Bool) -> a -> a
-assertProp f x = assert (f x) x
+assertProp :: (Monad m, Show a) => (a -> Bool) -> a -> m a
+assertProp f x
+	| f x = return $! x
+	| otherwise = fail $ "Assertion failed for: " ++ show x
 
 pad :: Int -> String -> String
 pad l s = replicate (l - length s) '0' ++ s
@@ -236,7 +243,7 @@ instance BINARY_CLASS Packet where
 		-- First two bits are 1 for new packet format
 		put ((tag .|. 0xC0) :: Word8)
 		case tag of
-			19 -> put (assertProp (<192) blen :: Word8)
+			19 -> put =<< assertProp (<192) (blen :: Word8)
 			_  -> do
 				-- Use 5-octet lengths
 				put (255 :: Word8)
@@ -248,19 +255,19 @@ instance BINARY_CLASS Packet where
 		(body, tag) = put_packet p
 	get = do
 		(t, packet) <- get_packet_bytes
-		return $ unsafeRunGet (parse_packet t) (B.concat packet)
+		localGet (parse_packet t) (B.concat packet)
 
 get_packet_bytes :: Get (Word8, [B.ByteString])
 get_packet_bytes = do
 	tag <- get
 	let (t, l) =
 		if (tag .&. 64) /= 0 then
-			(tag .&. 63, parse_new_length)
+			(tag .&. 63, fmap (first Just) parse_new_length)
 		else
 			((tag `shiftR` 2) .&. 15, (,) <$> parse_old_length tag <*> pure False)
 	(len, partial) <- l
 	-- This forces the whole packet to be consumed
-	packet <- getSomeByteString (fromIntegral len)
+	packet <- maybe getRemainingByteString (getSomeByteString . fromIntegral) len
 	if not partial then return (t, [packet]) else
 		(,) t <$> ((packet:) . snd) <$> get_packet_bytes
 
@@ -283,17 +290,17 @@ parse_new_length = do
 		_ -> fail "Unsupported new packet length."
 
 -- http://tools.ietf.org/html/rfc4880#section-4.2.1
-parse_old_length :: Word8 -> Get Word32
+parse_old_length :: Word8 -> Get (Maybe Word32)
 parse_old_length tag =
 	case tag .&. 3 of
 		-- One octet length
-		0 -> fmap fromIntegral (get :: Get Word8)
+		0 -> fmap (Just . fromIntegral) (get :: Get Word8)
 		-- Two octet length
-		1 -> fmap fromIntegral (get :: Get Word16)
+		1 -> fmap (Just . fromIntegral) (get :: Get Word16)
 		-- Four octet length
-		2 -> get
+		2 -> fmap Just get
 		-- Indeterminate length
-		3 -> fmap fromIntegral remaining
+		3 -> return Nothing
 		-- Error
 		_ -> fail "Unsupported old packet length."
 
@@ -495,7 +502,7 @@ put_packet x = error ("Unsupported Packet version or type in put_packet: " ++ sh
 parse_packet :: Word8 -> Get Packet
 -- AsymmetricSessionKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.1
 parse_packet  1 = AsymmetricSessionKeyPacket
-	<$> fmap (assertProp (==3)) get
+	<$> (assertProp (==3) =<< get)
 	<*> fmap (pad 16 . map toUpper . flip showHex "") (get :: Get Word64)
 	<*> get
 	<*> getRemainingByteString
@@ -504,7 +511,7 @@ parse_packet  2 = do
 	version <- get
 	case version of
 		_ | version `elem` [2,3] -> do
-			_ <- fmap (assertProp (==5)) (get :: Get Word8)
+			_ <- assertProp (==5) =<< (get :: Get Word8)
 			signature_type <- get
 			creation_time <- get :: Get Word32
 			keyid <- get :: Get Word64
@@ -532,10 +539,10 @@ parse_packet  2 = do
 			hash_algorithm <- get
 			hashed_size <- fmap fromIntegral (get :: Get Word16)
 			hashed_data <- getSomeByteString hashed_size
-			let hashed = unsafeRunGet listUntilEnd hashed_data
+			hashed <- localGet listUntilEnd hashed_data
 			unhashed_size <- fmap fromIntegral (get :: Get Word16)
 			unhashed_data <- getSomeByteString unhashed_size
-			let unhashed = unsafeRunGet listUntilEnd unhashed_data
+			unhashed <- localGet listUntilEnd unhashed_data
 			hash_head <- get
 			signature <- listUntilEnd
 			return SignaturePacket {
@@ -639,10 +646,10 @@ parse_packet  7 = do
 -- CompressedDataPacket, http://tools.ietf.org/html/rfc4880#section-5.6
 parse_packet  8 = do
 	algorithm <- get
-	message <- getRemainingByteString
+	message <- localGet get =<< (decompress algorithm <$> getRemainingByteString)
 	return CompressedDataPacket {
 		compression_algorithm = algorithm,
-		message = unsafeRunGet get (decompress algorithm message)
+		message = message
 	}
 -- EncryptedDataPacket, http://tools.ietf.org/html/rfc4880#section-5.7
 parse_packet  9 = EncryptedDataPacket 0 <$> getRemainingByteString
@@ -841,9 +848,11 @@ signatures_and_data (Message lst) =
 
 newtype MPI = MPI Integer deriving (Show, Read, Eq, Ord)
 instance BINARY_CLASS MPI where
-	put (MPI i) = do
-		put (bitl :: Word16)
-		putSomeByteString bytes
+	put (MPI i)
+		| i >= 0 = do
+			put (bitl :: Word16)
+			putSomeByteString bytes
+		| otherwise = fail $ "MPI is less than 0: " ++ show i
 		where
 		(bytes, bitl)
 			| B.null bytes' = (B.singleton 0, 1)
@@ -855,10 +864,10 @@ instance BINARY_CLASS MPI where
 		bytes' = B.reverse $ B.unfoldr (\x ->
 				if x == 0 then Nothing else
 					Just (fromIntegral x, x `shiftR` 8)
-			) (assertProp (>=0) i)
+			) i
 	get = do
 		length <- fmap fromIntegral (get :: Get Word16)
-		bytes <- getSomeByteString (assertProp (>0) $ (length + 7) `div` 8)
+		bytes <- getSomeByteString =<< assertProp (>0) ((length + 7) `div` 8)
 		return (MPI (B.foldl (\a b ->
 			a `shiftL` 8 .|. fromIntegral b) 0 bytes))
 
@@ -940,7 +949,7 @@ instance BINARY_CLASS SignatureSubpacket where
 		tag <- fmap stripCrit get :: Get Word8
 		-- This forces the whole packet to be consumed
 		packet <- getSomeByteString (len-1)
-		return $ unsafeRunGet (parse_signature_subpacket tag) packet
+		localGet (parse_signature_subpacket tag) packet
 		where
 		-- TODO: Decide how to actually encode the "is critical" data
 		-- instead of just ignoring it
@@ -1016,8 +1025,9 @@ put_signature_subpacket (FeaturesPacket supports_mdc) =
 	(B.singleton $ if supports_mdc then 0x01 else 0x00, 30)
 put_signature_subpacket (SignatureTargetPacket kalgo halgo hash) =
 	(B.concat [encode kalgo, encode halgo, hash], 31)
-put_signature_subpacket (EmbeddedSignaturePacket packet) =
-	(fst $ put_packet (assertProp isSignaturePacket packet), 32)
+put_signature_subpacket (EmbeddedSignaturePacket packet)
+	| isSignaturePacket packet = (fst $ put_packet packet, 32)
+	| otherwise = error $ "Tried to put non-SignaturePacket in EmbeddedSignaturePacket: " ++ show packet
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
 	(bytes, tag)
 
diff --git a/Makefile b/Makefile
index 929d0c4..9cb9cf4 100644
--- a/Makefile
+++ b/Makefile
@@ -48,15 +48,15 @@ endif
 
 ifdef CEREAL
 dist/setup-config: openpgp.cabal
-	-printf '1c\nname:            openpgp-cereal\n.\n,s/binary,$$/cereal,/g\nw\nq\n' | ed openpgp.cabal
-	cabal configure
+	-printf '1c\nname:            openpgp-cereal\n.\n,s/binary >= 0.6.4.0,$$/cereal,/g\nw\nq\n' | ed openpgp.cabal
+	cabal configure --enable-tests
 else
 dist/setup-config: openpgp.cabal
 	cabal configure --enable-tests
 endif
 
 clean:
-	-printf '1c\nname:            openpgp\n.\n,s/cereal,$$/binary,/g\nw\nq\n' | ed openpgp.cabal
+	-printf '1c\nname:            openpgp\n.\n,s/cereal,$$/binary >= 0.6.4.0,/g\nw\nq\n' | ed openpgp.cabal
 	find -name '*.o' -o -name '*.hi' | xargs $(RM)
 	$(RM) sign verify keygen tests/suite
 	$(RM) -r dist dist-ghc
diff --git a/openpgp.cabal b/openpgp.cabal
index 84a099a..c20dc2e 100644
--- a/openpgp.cabal
+++ b/openpgp.cabal
@@ -134,7 +134,7 @@ library
                 base == 4.*,
                 bytestring,
                 utf8-string,
-                binary,
+                binary >= 0.6.4.0,
                 zlib,
                 bzlib
 
@@ -149,7 +149,7 @@ test-suite tests
                 base == 4.*,
                 bytestring,
                 utf8-string,
-                binary,
+                binary >= 0.6.4.0,
                 zlib,
                 bzlib,
                 HUnit,
-- 
cgit v1.2.3


From 55330cc47562d6b5010fcc4ec25175191788a9e4 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 29 Dec 2012 15:39:48 -0500
Subject: More documentation

---
 Data/OpenPGP.hs | 52 +++++++++++++++++++++++++++++++++++++++-------------
 README          |  3 +++
 openpgp.cabal   |  3 +++
 3 files changed, 45 insertions(+), 13 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index a3b7b62..4d049dd 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -175,6 +175,7 @@ data Packet =
 		key_algorithm::KeyAlgorithm,
 		encrypted_data::B.ByteString
 	} |
+	-- ^ <http://tools.ietf.org/html/rfc4880#section-5.1>
 	SignaturePacket {
 		version::Word8,
 		signature_type::Word8,
@@ -186,6 +187,7 @@ data Packet =
 		signature::[MPI],
 		trailer::B.ByteString
 	} |
+	-- ^ <http://tools.ietf.org/html/rfc4880#section-5.2>
 	OnePassSignaturePacket {
 		version::Word8,
 		signature_type::Word8,
@@ -194,6 +196,7 @@ data Packet =
 		key_id::String,
 		nested::Word8
 	} |
+	-- ^ <http://tools.ietf.org/html/rfc4880#section-5.4>
 	PublicKeyPacket {
 		version::Word8,
 		timestamp::Word32,
@@ -202,39 +205,45 @@ data Packet =
 		is_subkey::Bool,
 		v3_days_of_validity::Maybe Word16
 	} |
+	-- ^ <http://tools.ietf.org/html/rfc4880#section-5.5.1.1> (also subkey)
 	SecretKeyPacket {
 		version::Word8,
 		timestamp::Word32,
 		key_algorithm::KeyAlgorithm,
 		key::[(Char,MPI)],
-		s2k_useage::Word8, -- determines if the Maybes are Just or Nothing
+		s2k_useage::Word8, -- ^ determines if the 'Maybe's are 'Just' or 'Nothing'
 		symmetric_type::Maybe Word8,
 		s2k_type::Maybe Word8,
 		s2k_hash_algorithm::Maybe HashAlgorithm,
 		s2k_salt::Maybe Word64,
 		s2k_count::Maybe Word32,
 		encrypted_data::B.ByteString,
-		private_hash::Maybe B.ByteString, -- the hash may be in the encrypted data
+		private_hash::Maybe B.ByteString, -- ^ the hash may be in the encrypted data
 		is_subkey::Bool
 	} |
+	-- ^ <http://tools.ietf.org/html/rfc4880#section-5.5.1.3> (also subkey)
 	CompressedDataPacket {
 		compression_algorithm::CompressionAlgorithm,
 		message::Message
 	} |
-	MarkerPacket |
+	-- ^ <http://tools.ietf.org/html/rfc4880#section-5.6>
+	MarkerPacket | -- ^ <http://tools.ietf.org/html/rfc4880#section-5.8>
 	LiteralDataPacket {
 		format::Char,
 		filename::String,
 		timestamp::Word32,
 		content::B.ByteString
 	} |
-	TrustPacket B.ByteString |
-	UserIDPacket String |
+	-- ^ <http://tools.ietf.org/html/rfc4880#section-5.9>
+	TrustPacket B.ByteString | -- ^ <http://tools.ietf.org/html/rfc4880#section-5.10>
+	UserIDPacket String | -- ^ <http://tools.ietf.org/html/rfc4880#section-5.11>
 	EncryptedDataPacket {
-		version::Word8, -- 0 for old-skool no-MDC (tag 9)
+		version::Word8,
 		encrypted_data::B.ByteString
 	} |
-	ModificationDetectionCodePacket B.ByteString |
+	-- ^ <http://tools.ietf.org/html/rfc4880#section-5.13>
+	-- or <http://tools.ietf.org/html/rfc4880#section-5.7> when version is 0
+	ModificationDetectionCodePacket B.ByteString | -- ^ <http://tools.ietf.org/html/rfc4880#section-5.14>
 	UnsupportedPacket Word8 B.ByteString
 	deriving (Show, Read, Eq)
 
@@ -830,7 +839,7 @@ instance BINARY_CLASS RevocationCode where
 	put = put . enum_to_word8
 	get = fmap enum_from_word8 get
 
--- A message is encoded as a list that takes the entire file
+-- | A message is encoded as a list that takes the entire file
 newtype Message = Message [Packet] deriving (Show, Read, Eq)
 instance BINARY_CLASS Message where
 	put (Message xs) = mapM_ put xs
@@ -846,6 +855,7 @@ signatures_and_data (Message lst) =
 	isDta (LiteralDataPacket {}) = True
 	isDta _ = False
 
+-- | <http://tools.ietf.org/html/rfc4880#section-3.2>
 newtype MPI = MPI Integer deriving (Show, Read, Eq, Ord)
 instance BINARY_CLASS MPI where
 	put (MPI i)
@@ -879,15 +889,15 @@ listUntilEnd = do
 		rest <- listUntilEnd
 		return (next:rest)
 
--- http://tools.ietf.org/html/rfc4880#section-5.2.3.1
+-- | <http://tools.ietf.org/html/rfc4880#section-5.2.3.1>
 data SignatureSubpacket =
 	SignatureCreationTimePacket Word32 |
-	SignatureExpirationTimePacket Word32 | -- seconds after CreationTime
+	SignatureExpirationTimePacket Word32 | -- ^ seconds after CreationTime
 	ExportableCertificationPacket Bool |
 	TrustSignaturePacket {depth::Word8, trust::Word8} |
 	RegularExpressionPacket String |
 	RevocablePacket Bool |
-	KeyExpirationTimePacket Word32 | -- seconds after key CreationTime
+	KeyExpirationTimePacket Word32 | -- ^ seconds after key CreationTime
 	PreferredSymmetricAlgorithmsPacket [SymmetricAlgorithm] |
 	RevocationKeyPacket {
 		sensitive::Bool,
@@ -1160,7 +1170,12 @@ signature_issuer (SignaturePacket {hashed_subpackets = hashed,
 	isIssuer _ = False
 signature_issuer _ = Nothing
 
-find_key :: (Packet -> String) -> Message -> String -> Maybe Packet
+-- | Find a key with the given Fingerprint/KeyID
+find_key ::
+	(Packet -> String) -- ^ Extract Fingerprint/KeyID from packet
+	-> Message         -- ^ List of packets (some of which are keys)
+	-> String          -- ^ Fingerprint/KeyID to search for
+	-> Maybe Packet
 find_key fpr (Message (x@(PublicKeyPacket {}):xs)) keyid =
 	find_key' fpr x xs keyid
 find_key fpr (Message (x@(SecretKeyPacket {}):xs)) keyid =
@@ -1177,7 +1192,18 @@ find_key' fpr x xs keyid
 	thisid = reverse $ take (length keyid) (reverse (fpr x))
 
 -- | SignaturePacket smart constructor
-signaturePacket :: Word8 -> Word8 -> KeyAlgorithm -> HashAlgorithm -> [SignatureSubpacket] -> [SignatureSubpacket] -> Word16 -> [MPI] -> Packet
+--
+--   <http://tools.ietf.org/html/rfc4880#section-5.2>
+signaturePacket ::
+	Word8    -- ^ Signature version (probably 4)
+	-> Word8 -- ^ Signature type <http://tools.ietf.org/html/rfc4880#section-5.2.1>
+	-> KeyAlgorithm
+	-> HashAlgorithm
+	-> [SignatureSubpacket] -- ^ Hashed subpackets (these get signed)
+	-> [SignatureSubpacket] -- ^ Unhashed subpackets (these do not get signed)
+	-> Word16 -- ^ Left 16 bits of the signed hash value
+	-> [MPI] -- ^ The raw MPIs of the signature
+	-> Packet
 signaturePacket version signature_type key_algorithm hash_algorithm hashed_subpackets unhashed_subpackets hash_head signature =
 	let p = SignaturePacket {
 		version = version,
diff --git a/README b/README
index 01f82f5..ddad150 100644
--- a/README
+++ b/README
@@ -11,6 +11,9 @@ For performing cryptography, see
 <http://hackage.haskell.org/package/openpgp-crypto-api> or
 <http://hackage.haskell.org/package/openpgp-Crypto>
 
+For dealing with ASCII armor, see
+<http://hackage.haskell.org/package/openpgp-asciiarmor>
+
 It is intended that you use qualified imports with this library.
 
 > import qualified Data.OpenPGP as OpenPGP
diff --git a/openpgp.cabal b/openpgp.cabal
index 69def36..9a92e22 100644
--- a/openpgp.cabal
+++ b/openpgp.cabal
@@ -27,6 +27,9 @@ description:
         <http://hackage.haskell.org/package/openpgp-crypto-api> or
         <http://hackage.haskell.org/package/openpgp-Crypto>
         .
+        For dealing with ASCII armor, see
+        <http://hackage.haskell.org/package/openpgp-asciiarmor>
+        .
         It is intended that you use qualified imports with this library.
         .
         > import qualified Data.OpenPGP as OpenPGP
-- 
cgit v1.2.3


From 3cb201b180254612a1661301377fa5753cddeb32 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sun, 30 Dec 2012 15:22:38 -0500
Subject: Fix partial packet length support

---
 Data/OpenPGP.hs | 27 +++++++++++++--------------
 1 file changed, 13 insertions(+), 14 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 4d049dd..55458b8 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -263,26 +263,25 @@ instance BINARY_CLASS Packet where
 		blen = fromIntegral $ B.length body
 		(body, tag) = put_packet p
 	get = do
-		(t, packet) <- get_packet_bytes
+		tag <- get
+		let (t, l) =
+			if (tag .&. 64) /= 0 then
+				(tag .&. 63, parse_new_length)
+			else
+				((tag `shiftR` 2) .&. 15, (,) <$> parse_old_length tag <*> pure False)
+		packet <- uncurry get_packet_bytes =<< l
 		localGet (parse_packet t) (B.concat packet)
 
-get_packet_bytes :: Get (Word8, [B.ByteString])
-get_packet_bytes = do
-	tag <- get
-	let (t, l) =
-		if (tag .&. 64) /= 0 then
-			(tag .&. 63, fmap (first Just) parse_new_length)
-		else
-			((tag `shiftR` 2) .&. 15, (,) <$> parse_old_length tag <*> pure False)
-	(len, partial) <- l
+get_packet_bytes :: Maybe Word32 -> Bool -> Get [B.ByteString]
+get_packet_bytes len partial = do
 	-- This forces the whole packet to be consumed
 	packet <- maybe getRemainingByteString (getSomeByteString . fromIntegral) len
-	if not partial then return (t, [packet]) else
-		(,) t <$> ((packet:) . snd) <$> get_packet_bytes
+	if not partial then return [packet] else
+		(packet:) <$> (uncurry get_packet_bytes =<< parse_new_length)
 
 -- http://tools.ietf.org/html/rfc4880#section-4.2.2
-parse_new_length :: Get (Word32, Bool)
-parse_new_length = do
+parse_new_length :: Get (Maybe Word32, Bool)
+parse_new_length = fmap (first Just) $ do
 	len <- fmap fromIntegral (get :: Get Word8)
 	case len of
 		-- One octet length
-- 
cgit v1.2.3


From ae07fedd5976d0d57961a1d825487c4c9c50341f Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 31 Dec 2012 12:54:30 -0500
Subject: Put out body for MDC packet

---
 Data/OpenPGP.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 55458b8..6ffeba4 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -257,7 +257,7 @@ instance BINARY_CLASS Packet where
 				-- Use 5-octet lengths
 				put (255 :: Word8)
 				put (blen :: Word32)
-				putSomeByteString body
+		putSomeByteString body
 		where
 		blen :: (Num a) => a
 		blen = fromIntegral $ B.length body
-- 
cgit v1.2.3


From 06f96ec8d862e43d12cfb4c3ad8650395cfc662c Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 31 Dec 2012 12:54:41 -0500
Subject: Safe to put full fingerprint in packet

We don't type restrict the length of the key ids, so we shouldn't assume
the length is the one we wanted.
---
 Data/OpenPGP.hs | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 6ffeba4..4dad404 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -383,7 +383,7 @@ put_packet :: Packet -> (B.ByteString, Word8)
 put_packet (AsymmetricSessionKeyPacket version key_id key_algorithm dta) =
 	(B.concat [
 		encode version,
-		encode (fst $ head $ readHex key_id :: Word64),
+		encode (fst $ head $ readHex $ takeFromEnd 16 key_id :: Word64),
 		encode key_algorithm,
 		dta
 	], 1)
@@ -431,7 +431,7 @@ put_packet (OnePassSignaturePacket { version = version,
 	(B.concat [
 		encode version, encode signature_type,
 		encode hash_algorithm, encode key_algorithm,
-		encode (fst $ head $ readHex key_id :: Word64),
+		encode (fst $ head $ readHex $ takeFromEnd 16 key_id :: Word64),
 		encode nested
 	], 4)
 put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
@@ -988,7 +988,7 @@ put_signature_subpacket (RevocationKeyPacket sensitive kalgo fpr) =
 	fprb = padBS 20 $ B.drop 2 $ encode (MPI fpri)
 	fpri = fst $ head $ readHex fpr
 put_signature_subpacket (IssuerPacket keyid) =
-	(encode (fst $ head $ readHex keyid :: Word64), 16)
+	(encode (fst $ head $ readHex $ takeFromEnd 16 keyid :: Word64), 16)
 put_signature_subpacket (NotationDataPacket human_readable name value) =
 	(B.concat [
 		B.pack [flag1,0,0,0],
@@ -1188,7 +1188,10 @@ find_key' fpr x xs keyid
 	| thisid == keyid = Just x
 	| otherwise = find_key fpr (Message xs) keyid
 	where
-	thisid = reverse $ take (length keyid) (reverse (fpr x))
+	thisid = takeFromEnd (length keyid) (fpr x)
+
+takeFromEnd :: Int -> String -> String
+takeFromEnd l = reverse . take l . reverse
 
 -- | SignaturePacket smart constructor
 --
-- 
cgit v1.2.3


From 9e4f996c68c3901bab4a5e1e70638c2531a85994 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Tue, 1 Jan 2013 13:08:12 -0500
Subject: Proper S2K type

S2K is a seperate concept and is used in both secret key packets and
SymmetricallyEncryptedSessionKey packets.  It should have its own parser
and thus its own type.  This also cleans up the SecretKeyPacket record
considerably (the many Maybe fields were a smell).

SecretKeyPacket.s2k should be set to (Just $ SimpleS2K MD5) in fallback
cases.  symmetric_algorithm should be set to Unencrypted when s2k_useage
is 0.  s2k_useage itself is only needed for the different between 255
and 254 (different checksum).

Round trip encode/decode tests for S2K work.
---
 Arbitrary.patch |  8 ++++++
 Data/OpenPGP.hs | 86 ++++++++++++++++++++++++++++-----------------------------
 Makefile        |  2 +-
 tests/suite.hs  |  5 ++++
 4 files changed, 57 insertions(+), 44 deletions(-)

(limited to 'Data')

diff --git a/Arbitrary.patch b/Arbitrary.patch
index 641609f..2d14399 100644
--- a/Arbitrary.patch
+++ b/Arbitrary.patch
@@ -24,6 +24,14 @@
                     2 -> do x1 <- arbitrary
                             x2 <- arbitrary
                             x3 <- arbitrary
+@@ -88,5 +93,5 @@
+                            x2 <- arbitrary
+-                           x3 <- arbitrary
++                           x3 <- fmap decode_s2k_count arbitrary
+                            return (IteratedSaltedS2K x1 x2 x3)
+-                   3 -> do x1 <- arbitrary
++                   3 -> do x1 <- suchThat arbitrary (`notElem` [0,1,3])
+                            x2 <- arbitrary
 @@ -73,7 +72,7 @@
                     4 -> return SHA384
                     5 -> return SHA512
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 4dad404..5e62d1a 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -34,14 +34,11 @@ module Data.OpenPGP (
 		message,
 		nested,
 		private_hash,
-		s2k_count,
-		s2k_hash_algorithm,
-		s2k_salt,
-		s2k_type,
 		s2k_useage,
+		s2k,
 		signature,
 		signature_type,
-		symmetric_type,
+		symmetric_algorithm,
 		timestamp,
 		trailer,
 		unhashed_subpackets,
@@ -51,6 +48,7 @@ module Data.OpenPGP (
 	signaturePacket,
 	Message(..),
 	SignatureSubpacket(..),
+	S2K(..),
 	HashAlgorithm(..),
 	KeyAlgorithm(..),
 	SymmetricAlgorithm(..),
@@ -211,12 +209,9 @@ data Packet =
 		timestamp::Word32,
 		key_algorithm::KeyAlgorithm,
 		key::[(Char,MPI)],
-		s2k_useage::Word8, -- ^ determines if the 'Maybe's are 'Just' or 'Nothing'
-		symmetric_type::Maybe Word8,
-		s2k_type::Maybe Word8,
-		s2k_hash_algorithm::Maybe HashAlgorithm,
-		s2k_salt::Maybe Word64,
-		s2k_count::Maybe Word32,
+		s2k_useage::Word8,
+		s2k::Maybe S2K,
+		symmetric_algorithm::SymmetricAlgorithm,
 		encrypted_data::B.ByteString,
 		private_hash::Maybe B.ByteString, -- ^ the hash may be in the encrypted data
 		is_subkey::Bool
@@ -436,23 +431,16 @@ put_packet (OnePassSignaturePacket { version = version,
 	], 4)
 put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
                               key_algorithm = algorithm, key = key,
-                              s2k_useage = s2k_useage,
-                              symmetric_type = symmetric_type,
-                              s2k_type = s2k_type,
-                              s2k_hash_algorithm = s2k_hash_algo,
-                              s2k_salt = s2k_salt,
-                              s2k_count = s2k_count,
+                              s2k_useage = s2k_useage, s2k = s2k,
+                              symmetric_algorithm = symmetric_algorithm,
                               encrypted_data = encrypted_data,
                               is_subkey = is_subkey }) =
-	(B.concat $ [p, encode s2k_useage] ++
-	(if s2k_useage `elem` [255, 254] then
-		[encode $ fromJust symmetric_type, encode s2k_t,
-		 encode $ fromJust s2k_hash_algo] ++
-		(if s2k_t `elem` [1,3] then [encode $ fromJust s2k_salt] else []) ++
-		if s2k_t == 3 then
-			[encode $ encode_s2k_count $ fromJust s2k_count] else []
-	else []) ++
-	(if s2k_useage > 0 then
+	(B.concat $ p :
+	(case s2k of
+		Just s2k -> [encode s2k_useage, encode symmetric_algorithm, encode s2k]
+		Nothing -> [encode symmetric_algorithm]
+	) ++
+	(if symmetric_algorithm /= Unencrypted then
 		[encrypted_data]
 	else s ++
 		-- XXX: Checksum is part of encrypted_data for V4 ONLY
@@ -464,7 +452,6 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
 				(0::Integer) (B.concat s) :: Word16)]),
 	if is_subkey then 7 else 5)
 	where
-	(Just s2k_t) = s2k_type
 	p = fst (put_packet $
 		PublicKeyPacket version timestamp algorithm key False Nothing)
 	s = map (encode . (key !)) (secret_key_fields algorithm)
@@ -592,31 +579,22 @@ parse_packet  5 = do
 	}) <- parse_packet 6
 	s2k_useage <- get :: Get Word8
 	let k = SecretKeyPacket version timestamp algorithm key s2k_useage
-	k' <- case s2k_useage of
-		_ | s2k_useage `elem` [255, 254] -> do
-			symmetric_type <- get
-			s2k_type <- get
-			s2k_hash_algorithm <- get
-			s2k_salt <- if s2k_type `elem` [1, 3] then get
-				else return undefined
-			s2k_count <- if s2k_type == 3 then fmap decode_s2k_count get else
-				return undefined
-			return (k (Just symmetric_type) (Just s2k_type)
-				(Just s2k_hash_algorithm) (Just s2k_salt) (Just s2k_count))
+	(symmetric_algorithm, s2k) <- case () of
+		_ | s2k_useage `elem` [255, 254] -> (,) <$> get <*> fmap Just get
 		_ | s2k_useage > 0 ->
 			-- s2k_useage is symmetric_type in this case
-			return (k (Just s2k_useage) Nothing Nothing Nothing Nothing)
+			return (decode $ encode s2k_useage, Just $ SimpleS2K MD5)
 		_ ->
-			return (k Nothing Nothing Nothing Nothing Nothing)
-	if s2k_useage > 0 then do {
+			return (Unencrypted, Nothing)
+	if symmetric_algorithm /= Unencrypted then do {
 		encrypted <- getRemainingByteString;
-		return (k' encrypted Nothing False)
+		return (k s2k symmetric_algorithm encrypted Nothing False)
 	} else do
 		key <- foldM (\m f -> do
 			mpi <- get :: Get MPI
 			return $ (f,mpi):m) key (secret_key_fields algorithm)
 		private_hash <- getRemainingByteString
-		return ((k' B.empty (Just private_hash) False) {key = key})
+		return ((k s2k symmetric_algorithm B.empty (Just private_hash) False) {key = key})
 -- PublicKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.2
 parse_packet  6 = do
 	version <- get :: Get Word8
@@ -718,6 +696,28 @@ enum_to_word8 = fromIntegral . fromEnum
 enum_from_word8 :: (Enum a) => Word8 -> a
 enum_from_word8 = toEnum . fromIntegral
 
+data S2K =
+	SimpleS2K HashAlgorithm |
+	SaltedS2K HashAlgorithm Word64 |
+	IteratedSaltedS2K HashAlgorithm Word64 Word32 |
+	S2K Word8 B.ByteString
+	deriving (Show, Read, Eq)
+
+instance BINARY_CLASS S2K where
+	put (SimpleS2K halgo) = put (0::Word8) >> put halgo
+	put (SaltedS2K halgo salt) = put (1::Word8) >> put halgo >> put salt
+	put (IteratedSaltedS2K halgo salt count) = put (3::Word8) >> put halgo
+		>> put salt >> put (encode_s2k_count count)
+	put (S2K t body) = put t >> putSomeByteString body
+
+	get = do
+		t <- get :: Get Word8
+		case t of
+			0 -> SimpleS2K <$> get
+			1 -> SaltedS2K <$> get <*> get
+			3 -> IteratedSaltedS2K <$> get <*> get <*> (decode_s2k_count <$> get)
+			_ -> S2K t <$> getRemainingByteString
+
 data HashAlgorithm = MD5 | SHA1 | RIPEMD160 | SHA256 | SHA384 | SHA512 | SHA224 | HashAlgorithm Word8
 	deriving (Show, Read, Eq)
 
diff --git a/Makefile b/Makefile
index 35b6523..4f03424 100644
--- a/Makefile
+++ b/Makefile
@@ -23,7 +23,7 @@ tests/suite: tests/suite.hs Data/OpenPGP.hs Data/OpenPGP/Internal.hs Data/OpenPG
 	ghc --make $(GHCFLAGS) -o $@ $^
 
 Data/OpenPGP/Arbitrary.hs: Data/OpenPGP.hs Arbitrary.patch
-	derive -d Arbitrary -m Data.OpenPGP.Arbitrary -iData.OpenPGP -iTest.QuickCheck -iTest.QuickCheck.Instances -iNumeric -iData.Char -iData.Word -o $@ Data/OpenPGP.hs
+	derive -d Arbitrary -m Data.OpenPGP.Arbitrary -iData.OpenPGP -iData.OpenPGP.Internal -iTest.QuickCheck -iTest.QuickCheck.Instances -iNumeric -iData.Char -iData.Word -o $@ Data/OpenPGP.hs
 	patch $@ Arbitrary.patch
 
 report.html: tests/suite.hs Data/OpenPGP.hs Data/OpenPGP/Internal.hs
diff --git a/tests/suite.hs b/tests/suite.hs
index 3094214..feb5fe6 100644
--- a/tests/suite.hs
+++ b/tests/suite.hs
@@ -44,6 +44,10 @@ prop_MPI_serialization_loop :: OpenPGP.MPI -> Bool
 prop_MPI_serialization_loop mpi =
 	mpi == decode' (encode mpi)
 
+prop_S2K_serialization_loop :: OpenPGP.S2K -> Bool
+prop_S2K_serialization_loop s2k =
+	s2k == decode' (encode s2k)
+
 prop_SignatureSubpacket_serialization_loop :: OpenPGP.SignatureSubpacket -> Bool
 prop_SignatureSubpacket_serialization_loop packet =
 	packet == decode' (encode packet)
@@ -141,6 +145,7 @@ tests =
 			testCase "uncompressed-ops-dsa-sha384.txt.gpg" (testSerialization "uncompressed-ops-dsa-sha384.txt.gpg"),
 			testCase "uncompressed-ops-rsa.gpg" (testSerialization "uncompressed-ops-rsa.gpg"),
 			testProperty "MPI encode/decode" prop_MPI_serialization_loop,
+			testProperty "S2K encode/decode" prop_S2K_serialization_loop,
 			testProperty "SignatureSubpacket encode/decode" prop_SignatureSubpacket_serialization_loop
 		],
 		testGroup "S2K count" [
-- 
cgit v1.2.3


From e5d953a676a9077ff03fd9222083ab696de711a3 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Tue, 1 Jan 2013 13:11:44 -0500
Subject: No more fromJust

---
 Data/OpenPGP.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 5e62d1a..266cd9b 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -68,7 +68,6 @@ import Control.Applicative
 import Data.Bits
 import Data.Word
 import Data.Char
-import Data.Maybe
 import Data.List
 import Data.OpenPGP.Internal
 import qualified Data.ByteString.Lazy as LZ
@@ -326,7 +325,7 @@ secret_key_fields DSA     = ['x']
 secret_key_fields _       = undefined -- Nothing in the spec. Maybe empty
 
 (!) :: (Eq k) => [(k,v)] -> k -> v
-(!) xs = fromJust . (`lookup` xs)
+(!) xs k = let Just x = lookup k xs in x
 
 -- Need this seperate for trailer calculation
 signature_packet_start :: Packet -> B.ByteString
@@ -461,7 +460,7 @@ put_packet p@(PublicKeyPacket { version = v, timestamp = timestamp,
 	| v == 3 =
 		final (B.concat $ [
 			B.singleton 3, encode timestamp,
-			encode (fromJust $ v3_days_of_validity p),
+			encode v3_days,
 			encode algorithm
 		] ++ material)
 	| v == 4 =
@@ -469,6 +468,7 @@ put_packet p@(PublicKeyPacket { version = v, timestamp = timestamp,
 			B.singleton 4, encode timestamp, encode algorithm
 		] ++ material)
 	where
+	Just v3_days = v3_days_of_validity p
 	final x = (x, if is_subkey then 14 else 6)
 	material = map (encode . (key !)) (public_key_fields algorithm)
 put_packet (CompressedDataPacket { compression_algorithm = algorithm,
-- 
cgit v1.2.3


From e2f93583af0942b855b451c74ffe11dcf702ae7e Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Tue, 1 Jan 2013 13:27:34 -0500
Subject: SymmetricSessionKeyPacket

---
 Data/OpenPGP.hs                    |  31 ++++++++++++++++++++++++-------
 openpgp.cabal                      |   1 +
 tests/data/symmetrically_encrypted | Bin 0 -> 528 bytes
 tests/suite.hs                     |   1 +
 4 files changed, 26 insertions(+), 7 deletions(-)
 create mode 100644 tests/data/symmetrically_encrypted

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 266cd9b..e71e48a 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -8,6 +8,7 @@ module Data.OpenPGP (
 	Packet(
 		AsymmetricSessionKeyPacket,
 		OnePassSignaturePacket,
+		SymmetricSessionKeyPacket,
 		PublicKeyPacket,
 		SecretKeyPacket,
 		CompressedDataPacket,
@@ -185,6 +186,13 @@ data Packet =
 		trailer::B.ByteString
 	} |
 	-- ^ <http://tools.ietf.org/html/rfc4880#section-5.2>
+	SymmetricSessionKeyPacket {
+		version::Word8,
+		symmetric_algorithm::SymmetricAlgorithm,
+		s2k::S2K,
+		encrypted_data::B.ByteString
+	} |
+	-- ^ <http://tools.ietf.org/html/rfc4880#section-5.3>
 	OnePassSignaturePacket {
 		version::Word8,
 		signature_type::Word8,
@@ -209,7 +217,7 @@ data Packet =
 		key_algorithm::KeyAlgorithm,
 		key::[(Char,MPI)],
 		s2k_useage::Word8,
-		s2k::Maybe S2K,
+		s2k::S2K, -- ^ This is meaningless if symmetric_algorithm == Unencrypted
 		symmetric_algorithm::SymmetricAlgorithm,
 		encrypted_data::B.ByteString,
 		private_hash::Maybe B.ByteString, -- ^ the hash may be in the encrypted data
@@ -403,6 +411,8 @@ put_packet (SignaturePacket { version = v,
 	Just (IssuerPacket keyidS) = find isIssuer unhashed_subpackets
 	isIssuer (IssuerPacket {}) = True
 	isIssuer _ = False
+put_packet (SymmetricSessionKeyPacket version salgo s2k encd) =
+	(B.concat [encode version, encode salgo, encode s2k, encd], 3)
 put_packet (SignaturePacket { version = 4,
                               unhashed_subpackets = unhashed_subpackets,
                               hash_head = hash_head,
@@ -435,9 +445,10 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
                               encrypted_data = encrypted_data,
                               is_subkey = is_subkey }) =
 	(B.concat $ p :
-	(case s2k of
-		Just s2k -> [encode s2k_useage, encode symmetric_algorithm, encode s2k]
-		Nothing -> [encode symmetric_algorithm]
+	(if s2k_useage `elem` [254,255] then
+		[encode s2k_useage, encode symmetric_algorithm, encode s2k]
+	else
+		[encode symmetric_algorithm]
 	) ++
 	(if symmetric_algorithm /= Unencrypted then
 		[encrypted_data]
@@ -552,6 +563,12 @@ parse_packet  2 = do
 				trailer = B.concat [encode version, encode signature_type, encode key_algorithm, encode hash_algorithm, encode (fromIntegral hashed_size :: Word16), hashed_data, B.pack [4, 0xff], encode ((6 + fromIntegral hashed_size) :: Word32)]
 			}
 		x -> fail $ "Unknown SignaturePacket version " ++ show x ++ "."
+-- SymmetricSessionKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.3
+parse_packet  3 = SymmetricSessionKeyPacket
+	<$> (assertProp (==4) =<< get)
+	<*> get
+	<*> get
+	<*> getRemainingByteString
 -- OnePassSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.4
 parse_packet  4 = do
 	version <- get
@@ -580,12 +597,12 @@ parse_packet  5 = do
 	s2k_useage <- get :: Get Word8
 	let k = SecretKeyPacket version timestamp algorithm key s2k_useage
 	(symmetric_algorithm, s2k) <- case () of
-		_ | s2k_useage `elem` [255, 254] -> (,) <$> get <*> fmap Just get
+		_ | s2k_useage `elem` [255, 254] -> (,) <$> get <*> get
 		_ | s2k_useage > 0 ->
 			-- s2k_useage is symmetric_type in this case
-			return (decode $ encode s2k_useage, Just $ SimpleS2K MD5)
+			return (decode $ encode s2k_useage, SimpleS2K MD5)
 		_ ->
-			return (Unencrypted, Nothing)
+			return (Unencrypted, S2K 100 B.empty)
 	if symmetric_algorithm /= Unencrypted then do {
 		encrypted <- getRemainingByteString;
 		return (k s2k symmetric_algorithm encrypted Nothing False)
diff --git a/openpgp.cabal b/openpgp.cabal
index 9a92e22..3a1e054 100644
--- a/openpgp.cabal
+++ b/openpgp.cabal
@@ -120,6 +120,7 @@ extra-source-files:
         tests/data/compressedsig.gpg,
         tests/data/compressedsig-zlib.gpg,
         tests/data/onepass_sig,
+        tests/data/symmetrically_encrypted,
         tests/data/pubring.gpg,
         tests/data/secring.gpg,
         tests/data/uncompressed-ops-dsa.gpg,
diff --git a/tests/data/symmetrically_encrypted b/tests/data/symmetrically_encrypted
new file mode 100644
index 0000000..129155a
Binary files /dev/null and b/tests/data/symmetrically_encrypted differ
diff --git a/tests/suite.hs b/tests/suite.hs
index feb5fe6..4bee6d6 100644
--- a/tests/suite.hs
+++ b/tests/suite.hs
@@ -141,6 +141,7 @@ tests =
 			testCase "compressedsig-zlib.gpg" (testSerialization "compressedsig-zlib.gpg"),
 			testCase "compressedsig-bzip2.gpg" (testSerialization "compressedsig-bzip2.gpg"),
 			testCase "onepass_sig" (testSerialization "onepass_sig"),
+			testCase "symmetrically_encrypted" (testSerialization "symmetrically_encrypted"),
 			testCase "uncompressed-ops-dsa.gpg" (testSerialization "uncompressed-ops-dsa.gpg"),
 			testCase "uncompressed-ops-dsa-sha384.txt.gpg" (testSerialization "uncompressed-ops-dsa-sha384.txt.gpg"),
 			testCase "uncompressed-ops-rsa.gpg" (testSerialization "uncompressed-ops-rsa.gpg"),
-- 
cgit v1.2.3


From d9651545a5e0f4b4f6498caa3f4a1c9e2a1f3be2 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 2 Jan 2013 00:14:20 -0500
Subject: string2key utility function

Interpret the S2K systems, modulo the actual hashing.
---
 Data/OpenPGP.hs | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index e71e48a..9a50fa0 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -50,6 +50,7 @@ module Data.OpenPGP (
 	Message(..),
 	SignatureSubpacket(..),
 	S2K(..),
+	string2key,
 	HashAlgorithm(..),
 	KeyAlgorithm(..),
 	SymmetricAlgorithm(..),
@@ -71,6 +72,7 @@ import Data.Word
 import Data.Char
 import Data.List
 import Data.OpenPGP.Internal
+import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LZ
 
 #ifdef CEREAL
@@ -735,6 +737,26 @@ instance BINARY_CLASS S2K where
 			3 -> IteratedSaltedS2K <$> get <*> get <*> (decode_s2k_count <$> get)
 			_ -> S2K t <$> getRemainingByteString
 
+-- | Take a hash function and an 'S2K' value and generate the bytes
+--   needed for creating a symmetric key.
+--
+-- Return value is always infinite length.
+-- Take the first n bytes you need for your keysize.
+string2key :: (HashAlgorithm -> LZ.ByteString -> BS.ByteString) -> S2K -> LZ.ByteString -> LZ.ByteString
+string2key hsh (SimpleS2K halgo) s = infiniHashes (hsh halgo) s
+string2key hsh (SaltedS2K halgo salt) s =
+	infiniHashes (hsh halgo) (encode salt `LZ.append` s)
+string2key hsh (IteratedSaltedS2K halgo salt count) s =
+	infiniHashes (hsh halgo) $
+	LZ.take (max (fromIntegral count) (LZ.length s))
+	(LZ.cycle $ encode salt `LZ.append` s)
+string2key _ s2k _ = error $ "Unsupported S2K specifier: " ++ show s2k
+
+infiniHashes :: (LZ.ByteString -> BS.ByteString) -> LZ.ByteString -> LZ.ByteString
+infiniHashes hsh s = LZ.fromChunks (hs 0)
+	where
+	hs c = hsh (LZ.replicate c 0 `LZ.append` s) : hs (c+1)
+
 data HashAlgorithm = MD5 | SHA1 | RIPEMD160 | SHA256 | SHA384 | SHA512 | SHA224 | HashAlgorithm Word8
 	deriving (Show, Read, Eq)
 
-- 
cgit v1.2.3


From a9e3593f6f45638447de0238a48f15883324321d Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 2 Jan 2013 11:41:06 -0500
Subject: Monoid instance for Message

---
 Data/OpenPGP.hs | 5 +++++
 1 file changed, 5 insertions(+)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 9a50fa0..0df2e98 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -67,6 +67,7 @@ import Numeric
 import Control.Monad
 import Control.Arrow
 import Control.Applicative
+import Data.Monoid
 import Data.Bits
 import Data.Word
 import Data.Char
@@ -883,6 +884,10 @@ instance BINARY_CLASS Message where
 	put (Message xs) = mapM_ put xs
 	get = fmap Message listUntilEnd
 
+instance Monoid Message where
+	mempty = Message []
+	mappend (Message a) (Message b) = Message (a ++ b)
+
 -- | Extract all signature and data packets from a 'Message'
 signatures_and_data :: Message -> ([Packet], [Packet])
 signatures_and_data (Message ((CompressedDataPacket {message = m}):_)) =
-- 
cgit v1.2.3


From e9df3b08a0ec2fa73b8959ec7a70478fb028990a Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Thu, 3 Jan 2013 12:25:35 -0500
Subject: Need to verify the checksum, not store it.

---
 Data/OpenPGP.hs | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 0df2e98..2460a29 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -34,7 +34,6 @@ module Data.OpenPGP (
 		key_id,
 		message,
 		nested,
-		private_hash,
 		s2k_useage,
 		s2k,
 		signature,
@@ -223,7 +222,6 @@ data Packet =
 		s2k::S2K, -- ^ This is meaningless if symmetric_algorithm == Unencrypted
 		symmetric_algorithm::SymmetricAlgorithm,
 		encrypted_data::B.ByteString,
-		private_hash::Maybe B.ByteString, -- ^ the hash may be in the encrypted data
 		is_subkey::Bool
 	} |
 	-- ^ <http://tools.ietf.org/html/rfc4880#section-5.5.1.3> (also subkey)
@@ -456,7 +454,7 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
 	(if symmetric_algorithm /= Unencrypted then
 		[encrypted_data]
 	else s ++
-		-- XXX: Checksum is part of encrypted_data for V4 ONLY
+		-- TODO: Checksum is part of encrypted_data for V4 ONLY
 		if s2k_useage == 254 then
 			[B.replicate 20 0] -- TODO SHA1 Checksum
 		else
@@ -608,13 +606,14 @@ parse_packet  5 = do
 			return (Unencrypted, S2K 100 B.empty)
 	if symmetric_algorithm /= Unencrypted then do {
 		encrypted <- getRemainingByteString;
-		return (k s2k symmetric_algorithm encrypted Nothing False)
+		return (k s2k symmetric_algorithm encrypted False)
 	} else do
 		key <- foldM (\m f -> do
 			mpi <- get :: Get MPI
 			return $ (f,mpi):m) key (secret_key_fields algorithm)
-		private_hash <- getRemainingByteString
-		return ((k s2k symmetric_algorithm B.empty (Just private_hash) False) {key = key})
+		checksum <- getRemainingByteString
+		-- TODO: verify checksum
+		return ((k s2k symmetric_algorithm B.empty False) {key = key})
 -- PublicKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.2
 parse_packet  6 = do
 	version <- get :: Get Word8
-- 
cgit v1.2.3


From 77ee44a5ba50aacc8520b24614bbc044b6cf48f7 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Thu, 3 Jan 2013 12:25:53 -0500
Subject: Export the list of secret key fields

---
 Data/OpenPGP.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 2460a29..61d6dfd 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -59,7 +59,9 @@ module Data.OpenPGP (
 	find_key,
 	fingerprint_material,
 	signatures_and_data,
-	signature_issuer
+	signature_issuer,
+	public_key_fields,
+	secret_key_fields
 ) where
 
 import Numeric
-- 
cgit v1.2.3


From fc9dd0707c349e8e8e822d8e5a624dd46ac961f2 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Thu, 3 Jan 2013 13:53:55 -0500
Subject: Properly verify secret key checksums

---
 Data/OpenPGP.hs | 25 +++++++++++++------------
 1 file changed, 13 insertions(+), 12 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 61d6dfd..209d876 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -170,6 +170,10 @@ pad l s = replicate (l - length s) '0' ++ s
 padBS :: Int -> B.ByteString -> B.ByteString
 padBS l s = B.replicate (fromIntegral l - B.length s) 0 `B.append` s
 
+checksum :: B.ByteString -> Word16
+checksum = fromIntegral .
+	B.foldl (\c i -> (c + fromIntegral i) `mod` 65536) (0::Integer)
+
 data Packet =
 	AsymmetricSessionKeyPacket {
 		version::Word8,
@@ -454,15 +458,11 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
 		[encode symmetric_algorithm]
 	) ++
 	(if symmetric_algorithm /= Unencrypted then
+		-- For V3 keys, the "encrypted data" has an unencrypted checksum
+		-- of the unencrypted MPIs on the end
 		[encrypted_data]
 	else s ++
-		-- TODO: Checksum is part of encrypted_data for V4 ONLY
-		if s2k_useage == 254 then
-			[B.replicate 20 0] -- TODO SHA1 Checksum
-		else
-			[encode (fromIntegral $
-				B.foldl (\c i -> (c + fromIntegral i) `mod` 65536)
-				(0::Integer) (B.concat s) :: Word16)]),
+		[encode $ checksum $ B.concat s]),
 	if is_subkey then 7 else 5)
 	where
 	p = fst (put_packet $
@@ -610,12 +610,13 @@ parse_packet  5 = do
 		encrypted <- getRemainingByteString;
 		return (k s2k symmetric_algorithm encrypted False)
 	} else do
-		key <- foldM (\m f -> do
+		skey <- foldM (\m f -> do
 			mpi <- get :: Get MPI
-			return $ (f,mpi):m) key (secret_key_fields algorithm)
-		checksum <- getRemainingByteString
-		-- TODO: verify checksum
-		return ((k s2k symmetric_algorithm B.empty False) {key = key})
+			return $ (f,mpi):m) [] (secret_key_fields algorithm)
+		chk <- get
+		when (checksum (B.concat $ map (encode . snd) skey) /= chk) $
+			fail "Checksum verification failed for unencrypted secret key"
+		return ((k s2k symmetric_algorithm B.empty False) {key = key ++ skey})
 -- PublicKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.2
 parse_packet  6 = do
 	version <- get :: Get Word8
-- 
cgit v1.2.3


From 6c1805b9f9fd0ce6f9387fb63c34ad99205e0736 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Thu, 3 Jan 2013 16:16:40 -0500
Subject: Missed one fingerprint truncation

---
 Data/OpenPGP.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 209d876..ede0caa 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -414,7 +414,7 @@ put_packet (SignaturePacket { version = v,
 		encode hash_head
 	] ++ map encode signature, 2)
 	where
-	keyid = fst $ head $ readHex keyidS :: Word64
+	keyid = fst $ head $ readHex $ takeFromEnd 16 keyidS :: Word64
 	Just (IssuerPacket keyidS) = find isIssuer unhashed_subpackets
 	isIssuer (IssuerPacket {}) = True
 	isIssuer _ = False
-- 
cgit v1.2.3


From 431f879dbb29790f731c841b0e40876e1debce60 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Thu, 3 Jan 2013 16:40:47 -0500
Subject: More generic signature extraction

---
 Data/OpenPGP.hs | 50 +++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 43 insertions(+), 7 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index ede0caa..1108aa8 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -58,7 +58,8 @@ module Data.OpenPGP (
 	MPI(..),
 	find_key,
 	fingerprint_material,
-	signatures_and_data,
+	SignatureOver(..),
+	signatures,
 	signature_issuer,
 	public_key_fields,
 	secret_key_fields
@@ -890,16 +891,51 @@ instance Monoid Message where
 	mempty = Message []
 	mappend (Message a) (Message b) = Message (a ++ b)
 
--- | Extract all signature and data packets from a 'Message'
-signatures_and_data :: Message -> ([Packet], [Packet])
-signatures_and_data (Message ((CompressedDataPacket {message = m}):_)) =
-	signatures_and_data m
-signatures_and_data (Message lst) =
-	(filter isSignaturePacket lst, filter isDta lst)
+-- | Data needed to verify a signature
+data SignatureOver =
+	DataSignature Packet [Packet] |
+	-- ^ LiteralData, [Signature]
+	KeySignature Packet [Packet]  |
+	-- ^ Revocation. Key, [Signature]
+	SubkeySignature Packet Packet [Packet]  |
+	-- ^ Revocation or subkey binding. Key, Subkey, [Signature]
+	CertificationSignature Packet Packet [Packet]
+	-- ^ KeyPacket, (UserID | UserAttribute), [Signature]
+
+-- | Extract signed objects from a well-formatted message
+--
+-- Recurses into CompressedDataPacket
+--
+-- <http://tools.ietf.org/html/rfc4880#section-11>
+signatures :: Message -> [SignatureOver]
+signatures (Message [CompressedDataPacket _ m]) = signatures m
+signatures (Message ps) =
+	maybe (paired_sigs Nothing ps) (\p -> [DataSignature p sigs]) (find isDta ps)
 	where
+	sigs = filter isSignaturePacket ps
 	isDta (LiteralDataPacket {}) = True
 	isDta _ = False
 
+-- TODO: UserAttribute
+paired_sigs :: Maybe Packet -> [Packet] -> [SignatureOver]
+paired_sigs _ [] = []
+paired_sigs _ (p@(PublicKeyPacket {is_subkey = False}):ps) =
+	KeySignature p (takeWhile isSignaturePacket ps) :
+	paired_sigs (Just p) (dropWhile isSignaturePacket ps)
+paired_sigs _ (p@(SecretKeyPacket {is_subkey = False}):ps) =
+	KeySignature p (takeWhile isSignaturePacket ps) :
+	paired_sigs (Just p) (dropWhile isSignaturePacket ps)
+paired_sigs (Just k) (p@(PublicKeyPacket {is_subkey = True}):ps) =
+	SubkeySignature k p (takeWhile isSignaturePacket ps) :
+	paired_sigs (Just p) (dropWhile isSignaturePacket ps)
+paired_sigs (Just k) (p@(SecretKeyPacket {is_subkey = True}):ps) =
+	SubkeySignature k p (takeWhile isSignaturePacket ps) :
+	paired_sigs (Just p) (dropWhile isSignaturePacket ps)
+paired_sigs (Just k) (p@(UserIDPacket {}):ps) =
+	CertificationSignature k p (takeWhile isSignaturePacket ps) :
+	paired_sigs (Just p) (dropWhile isSignaturePacket ps)
+paired_sigs k (_:ps) = paired_sigs k ps
+
 -- | <http://tools.ietf.org/html/rfc4880#section-3.2>
 newtype MPI = MPI Integer deriving (Show, Read, Eq, Ord)
 instance BINARY_CLASS MPI where
-- 
cgit v1.2.3


From 9a7ae71134ec96fcf1485d4564a8ce55c8c9aff8 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 5 Jan 2013 11:07:21 -0500
Subject: Fix the cereal version so that it works

---
 Data/OpenPGP.hs | 16 +++++++++++-----
 1 file changed, 11 insertions(+), 5 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 1108aa8..459925e 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -79,12 +79,12 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LZ
 
 #ifdef CEREAL
-import Data.Serialize
+import Data.Serialize hiding (decode)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.UTF8 as B (toString, fromString)
 #define BINARY_CLASS Serialize
 #else
-import Data.Binary
+import Data.Binary hiding (decode)
 import Data.Binary.Get
 import Data.Binary.Put
 import qualified Data.ByteString.Lazy as B
@@ -122,6 +122,9 @@ toStrictBS = B.concat . LZ.toChunks
 
 toLazyBS :: B.ByteString -> LZ.ByteString
 toLazyBS = LZ.fromChunks . (:[])
+
+lazyEncode :: (Serialize a) => a -> LZ.ByteString
+lazyEncode = toLazyBS . encode
 #else
 getRemainingByteString :: Get B.ByteString
 getRemainingByteString = getRemainingLazyByteString
@@ -144,6 +147,9 @@ compress = lazyCompress
 
 decompress :: CompressionAlgorithm -> B.ByteString -> B.ByteString
 decompress = lazyDecompress
+
+lazyEncode :: (Binary a) => a -> LZ.ByteString
+lazyEncode = encode
 #endif
 
 lazyCompress :: CompressionAlgorithm -> LZ.ByteString -> LZ.ByteString
@@ -604,7 +610,7 @@ parse_packet  5 = do
 		_ | s2k_useage `elem` [255, 254] -> (,) <$> get <*> get
 		_ | s2k_useage > 0 ->
 			-- s2k_useage is symmetric_type in this case
-			return (decode $ encode s2k_useage, SimpleS2K MD5)
+			(,) <$> localGet get (encode s2k_useage) <*> pure (SimpleS2K MD5)
 		_ ->
 			return (Unencrypted, S2K 100 B.empty)
 	if symmetric_algorithm /= Unencrypted then do {
@@ -749,11 +755,11 @@ instance BINARY_CLASS S2K where
 string2key :: (HashAlgorithm -> LZ.ByteString -> BS.ByteString) -> S2K -> LZ.ByteString -> LZ.ByteString
 string2key hsh (SimpleS2K halgo) s = infiniHashes (hsh halgo) s
 string2key hsh (SaltedS2K halgo salt) s =
-	infiniHashes (hsh halgo) (encode salt `LZ.append` s)
+	infiniHashes (hsh halgo) (lazyEncode salt `LZ.append` s)
 string2key hsh (IteratedSaltedS2K halgo salt count) s =
 	infiniHashes (hsh halgo) $
 	LZ.take (max (fromIntegral count) (LZ.length s))
-	(LZ.cycle $ encode salt `LZ.append` s)
+	(LZ.cycle $ lazyEncode salt `LZ.append` s)
 string2key _ s2k _ = error $ "Unsupported S2K specifier: " ++ show s2k
 
 infiniHashes :: (LZ.ByteString -> BS.ByteString) -> LZ.ByteString -> LZ.ByteString
-- 
cgit v1.2.3


From 0ca9f45c940a765105cc52c4c004f2f46b03357d Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 5 Jan 2013 14:24:22 -0500
Subject: Extract data from a SignatureOver

---
 Data/OpenPGP.hs | 31 +++++++++++++++++++++++--------
 1 file changed, 23 insertions(+), 8 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 459925e..092e6ff 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -899,14 +899,29 @@ instance Monoid Message where
 
 -- | Data needed to verify a signature
 data SignatureOver =
-	DataSignature Packet [Packet] |
-	-- ^ LiteralData, [Signature]
-	KeySignature Packet [Packet]  |
-	-- ^ Revocation. Key, [Signature]
-	SubkeySignature Packet Packet [Packet]  |
-	-- ^ Revocation or subkey binding. Key, Subkey, [Signature]
-	CertificationSignature Packet Packet [Packet]
-	-- ^ KeyPacket, (UserID | UserAttribute), [Signature]
+	DataSignature {literal::Packet, signatures_over::[Packet]} |
+	KeySignature {topkey::Packet, signatures_over::[Packet]} |
+	SubkeySignature {topkey::Packet, subkey::Packet, signatures_over::[Packet]} |
+	CertificationSignature {topkey::Packet, user_id::Packet, signatures_over::[Packet]}
+	deriving (Show, Read, Eq)
+
+-- To get the signed-over bytes
+instance BINARY_CLASS SignatureOver where
+	put (DataSignature (LiteralDataPacket {content = c}) _) =
+		putSomeByteString c
+	put (KeySignature k _) = mapM_ putSomeByteString (fingerprint_material k)
+	put (SubkeySignature k s _) = mapM_ (mapM_ putSomeByteString)
+		[fingerprint_material k, fingerprint_material s]
+	put (CertificationSignature k (UserIDPacket s) _) =
+		mapM_ (mapM_ putSomeByteString) [fingerprint_material k, [
+			B.singleton 0xB4,
+			encode ((fromIntegral $ B.length bs) :: Word32),
+			bs
+		]]
+		where
+		bs = B.fromString s
+	put x = fail $ "Malformed signature: " ++ show x
+	get = fail "Cannot meaningfully parse bytes to be signed over."
 
 -- | Extract signed objects from a well-formatted message
 --
-- 
cgit v1.2.3


From 7e2ea83cede38226850369a92c8023c19fba3238 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 16 Mar 2013 12:32:07 -0500
Subject: Fix extraction of UserID signatures

---
 Data/OpenPGP.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 092e6ff..7433889 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -954,7 +954,7 @@ paired_sigs (Just k) (p@(SecretKeyPacket {is_subkey = True}):ps) =
 	paired_sigs (Just p) (dropWhile isSignaturePacket ps)
 paired_sigs (Just k) (p@(UserIDPacket {}):ps) =
 	CertificationSignature k p (takeWhile isSignaturePacket ps) :
-	paired_sigs (Just p) (dropWhile isSignaturePacket ps)
+	paired_sigs (Just k) (dropWhile isSignaturePacket ps)
 paired_sigs k (_:ps) = paired_sigs k ps
 
 -- | <http://tools.ietf.org/html/rfc4880#section-3.2>
-- 
cgit v1.2.3


From bdc1636bf130c46bbc5ce550d737e6dabe80a059 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 10 Aug 2013 13:34:33 -0500
Subject: Remove useless extra check.

---
 Data/OpenPGP.hs | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 7433889..3008fc2 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -1251,10 +1251,7 @@ parse_signature_subpacket 31 =
 	liftM3 SignatureTargetPacket get get getRemainingByteString
 -- EmbeddedSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.26
 parse_signature_subpacket 32 =
-	fmap (EmbeddedSignaturePacket . forceSignature) (parse_packet 2)
-	where
-	forceSignature x@(SignaturePacket {}) = x
-	forceSignature _ = error "EmbeddedSignature must contain signature"
+	fmap EmbeddedSignaturePacket (parse_packet 2)
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
 	fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
-- 
cgit v1.2.3


From 66e02f12198b4c9497d6193920ff80bc13551821 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 10 Aug 2013 13:34:54 -0500
Subject: Fix bug in parsing signature subpacket lengths.

---
 Data/OpenPGP.hs                           |   4 ++--
 tests/data/3F5BBA0B0694BEB6000005-002.sig | Bin 0 -> 1089 bytes
 tests/data/3F5BBA0B0694BEB6000017-002.sig | Bin 0 -> 1089 bytes
 tests/suite.hs                            |   2 ++
 4 files changed, 4 insertions(+), 2 deletions(-)
 create mode 100644 tests/data/3F5BBA0B0694BEB6000005-002.sig
 create mode 100644 tests/data/3F5BBA0B0694BEB6000017-002.sig

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 3008fc2..7995d89 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -1051,9 +1051,9 @@ instance BINARY_CLASS SignatureSubpacket where
 	get = do
 		len <- fmap fromIntegral (get :: Get Word8)
 		len <- case len of
-			_ | len > 190 && len < 255 -> do -- Two octet length
+			_ | len >= 192 && len < 255 -> do -- Two octet length
 				second <- fmap fromIntegral (get :: Get Word8)
-				return $ ((len - 192) `shiftR` 8) + second + 192
+				return $ ((len - 192) `shiftL` 8) + second + 192
 			255 -> -- Five octet length
 				fmap fromIntegral (get :: Get Word32)
 			_ -> -- One octet length, no furthur processing
diff --git a/tests/data/3F5BBA0B0694BEB6000005-002.sig b/tests/data/3F5BBA0B0694BEB6000005-002.sig
new file mode 100644
index 0000000..94055af
Binary files /dev/null and b/tests/data/3F5BBA0B0694BEB6000005-002.sig differ
diff --git a/tests/data/3F5BBA0B0694BEB6000017-002.sig b/tests/data/3F5BBA0B0694BEB6000017-002.sig
new file mode 100644
index 0000000..b22f23b
Binary files /dev/null and b/tests/data/3F5BBA0B0694BEB6000017-002.sig differ
diff --git a/tests/suite.hs b/tests/suite.hs
index 4bee6d6..cb4f4aa 100644
--- a/tests/suite.hs
+++ b/tests/suite.hs
@@ -145,6 +145,8 @@ tests =
 			testCase "uncompressed-ops-dsa.gpg" (testSerialization "uncompressed-ops-dsa.gpg"),
 			testCase "uncompressed-ops-dsa-sha384.txt.gpg" (testSerialization "uncompressed-ops-dsa-sha384.txt.gpg"),
 			testCase "uncompressed-ops-rsa.gpg" (testSerialization "uncompressed-ops-rsa.gpg"),
+			testCase "3F5BBA0B0694BEB6000005-002.sig" (testSerialization "3F5BBA0B0694BEB6000005-002.sig"),
+			testCase "3F5BBA0B0694BEB6000017-002.sig" (testSerialization "3F5BBA0B0694BEB6000017-002.sig"),
 			testProperty "MPI encode/decode" prop_MPI_serialization_loop,
 			testProperty "S2K encode/decode" prop_S2K_serialization_loop,
 			testProperty "SignatureSubpacket encode/decode" prop_SignatureSubpacket_serialization_loop
-- 
cgit v1.2.3


From eba7e4fdce3de6622b4ec3862b405b0acd016377 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 10 Aug 2013 23:23:15 -0500
Subject: Preserve topkey for all subkeys

---
 Data/OpenPGP.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 7995d89..1f0ff34 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -948,10 +948,10 @@ paired_sigs _ (p@(SecretKeyPacket {is_subkey = False}):ps) =
 	paired_sigs (Just p) (dropWhile isSignaturePacket ps)
 paired_sigs (Just k) (p@(PublicKeyPacket {is_subkey = True}):ps) =
 	SubkeySignature k p (takeWhile isSignaturePacket ps) :
-	paired_sigs (Just p) (dropWhile isSignaturePacket ps)
+	paired_sigs (Just k) (dropWhile isSignaturePacket ps)
 paired_sigs (Just k) (p@(SecretKeyPacket {is_subkey = True}):ps) =
 	SubkeySignature k p (takeWhile isSignaturePacket ps) :
-	paired_sigs (Just p) (dropWhile isSignaturePacket ps)
+	paired_sigs (Just k) (dropWhile isSignaturePacket ps)
 paired_sigs (Just k) (p@(UserIDPacket {}):ps) =
 	CertificationSignature k p (takeWhile isSignaturePacket ps) :
 	paired_sigs (Just k) (dropWhile isSignaturePacket ps)
-- 
cgit v1.2.3


From 4d07a761391c265edc7ee704a11035a07153f504 Mon Sep 17 00:00:00 2001
From: joe <joe@blackbird>
Date: Sat, 4 Jan 2014 19:10:58 -0500
Subject: ECDSA support and build-for-jessie

---
 Data/OpenPGP.hs | 53 ++++++++++++++++++++++++++++++++++++++++++++++-------
 openpgp.cabal   |  2 +-
 2 files changed, 47 insertions(+), 8 deletions(-)

(limited to 'Data')

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 1f0ff34..74aae5f 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -74,17 +74,18 @@ import Data.Bits
 import Data.Word
 import Data.Char
 import Data.List
+import Data.Maybe
 import Data.OpenPGP.Internal
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LZ
 
 #ifdef CEREAL
-import Data.Serialize hiding (decode)
+import Data.Serialize
 import qualified Data.ByteString as B
 import qualified Data.ByteString.UTF8 as B (toString, fromString)
 #define BINARY_CLASS Serialize
 #else
-import Data.Binary hiding (decode)
+import Data.Binary
 import Data.Binary.Get
 import Data.Binary.Put
 import qualified Data.ByteString.Lazy as B
@@ -135,12 +136,17 @@ getSomeByteString = getLazyByteString . fromIntegral
 putSomeByteString :: B.ByteString -> Put
 putSomeByteString = putLazyByteString
 
+#if MIN_VERSION_binary(0,6,4)
 localGet :: Get a -> B.ByteString -> Get a
 localGet g bs = case runGetOrFail g bs of
 	Left (_,_,s) -> fail s
 	Right (leftover,_,v)
 		| B.null leftover -> return v
 		| otherwise -> fail $ "Leftover in localGet: " ++ show leftover
+#else
+localGet :: Get a -> B.ByteString -> Get a
+localGet g bs = return $ runGet g bs
+#endif
 
 compress :: CompressionAlgorithm -> B.ByteString -> B.ByteString
 compress = lazyCompress
@@ -335,6 +341,7 @@ public_key_fields RSA_E   = public_key_fields RSA
 public_key_fields RSA_S   = public_key_fields RSA
 public_key_fields ELGAMAL = ['p', 'g', 'y']
 public_key_fields DSA     = ['p', 'q', 'g', 'y']
+public_key_fields ECDSA   = ['c','l','x', 'y']
 public_key_fields _       = undefined -- Nothing in the spec. Maybe empty
 
 -- http://tools.ietf.org/html/rfc4880#section-5.5.3
@@ -344,6 +351,7 @@ secret_key_fields RSA_E   = secret_key_fields RSA
 secret_key_fields RSA_S   = secret_key_fields RSA
 secret_key_fields ELGAMAL = ['x']
 secret_key_fields DSA     = ['x']
+secret_key_fields ECDSA   = ['d']
 secret_key_fields _       = undefined -- Nothing in the spec. Maybe empty
 
 (!) :: (Eq k) => [(k,v)] -> k -> v
@@ -395,6 +403,38 @@ calculate_signature_trailer p@(SignaturePacket {version = 4}) =
 calculate_signature_trailer x =
 	error ("Trying to calculate signature trailer for: " ++ show x)
 
+
+encode_public_key_material :: Packet -> [B.ByteString]
+encode_public_key_material k | key_algorithm k == ECDSA  = do
+    -- http://tools.ietf.org/html/rfc6637
+    c <- maybeToList $ lookup 'c' (key k)
+    MPI l <- maybeToList $ lookup 'l' (key k)
+    MPI x <- maybeToList $ lookup 'x' (key k)
+    MPI y <- maybeToList $ lookup 'y' (key k)
+    let (bitlen,oid) = B.splitAt 2 (encode c)
+        len16 = decode bitlen :: Word16
+        (fullbytes,rembits) = len16 `quotRem` 8
+        len8 = fromIntegral (fullbytes + if rembits/=0 then 1 else 0) :: Word8
+        xy = 4*(4^l) + x*(2^l) + y
+    [ len8 `B.cons` oid, encode (MPI xy) ]
+encode_public_key_material k = map (encode . (key k !)) (public_key_fields $ key_algorithm k)
+
+decode_public_key_material :: KeyAlgorithm -> Get [(Char,MPI)]
+decode_public_key_material ECDSA = do
+    -- http://tools.ietf.org/html/rfc6637
+    oidlen <- get :: Get Word8
+    oidbytes <- getSomeByteString (fromIntegral oidlen)
+    let mpiFromBytes bytes = MPI (B.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0 bytes)
+        oid = mpiFromBytes oidbytes
+    MPI xy <- get
+    let integerBytesize i = fromIntegral $ LZ.length (encode (MPI i)) - 2
+        width = ( integerBytesize xy - 1 ) `div` 2
+        (fx,y) = xy `quotRem` (256^width)
+        x = fx `rem` (256^width)
+        l = width*8
+    return [('c',oid), ('l',MPI l), ('x',MPI x), ('y',MPI y)]
+decode_public_key_material algorithm = mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm)
+
 put_packet :: Packet -> (B.ByteString, Word8)
 put_packet (AsymmetricSessionKeyPacket version key_id key_algorithm dta) =
 	(B.concat [
@@ -491,7 +531,7 @@ put_packet p@(PublicKeyPacket { version = v, timestamp = timestamp,
 	where
 	Just v3_days = v3_days_of_validity p
 	final x = (x, if is_subkey then 14 else 6)
-	material = map (encode . (key !)) (public_key_fields algorithm)
+	material = encode_public_key_material p
 put_packet (CompressedDataPacket { compression_algorithm = algorithm,
                                    message = message }) =
 	(B.append (encode algorithm) $ compress algorithm $ encode message, 8)
@@ -632,7 +672,7 @@ parse_packet  6 = do
 			timestamp <- get
 			days <- get
 			algorithm <- get
-			key <- mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm)
+			key <- decode_public_key_material algorithm
 			return PublicKeyPacket {
 				version = version,
 				timestamp = timestamp,
@@ -644,7 +684,7 @@ parse_packet  6 = do
 		4 -> do
 			timestamp <- get
 			algorithm <- get
-			key <- mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm)
+			key <- decode_public_key_material algorithm
 			return PublicKeyPacket {
 				version = 4,
 				timestamp = timestamp,
@@ -710,8 +750,7 @@ fingerprint_material p | version p == 4 =
 		material
 	]
 	where
-	material = B.concat $ map (encode . (key p !))
-		(public_key_fields $ key_algorithm p)
+	material = B.concat $ encode_public_key_material p
 fingerprint_material p | version p `elem` [2, 3] = [n, e]
 	where
 	n = B.drop 2 (encode (key p ! 'n'))
diff --git a/openpgp.cabal b/openpgp.cabal
index 7214bf5..d9af124 100644
--- a/openpgp.cabal
+++ b/openpgp.cabal
@@ -138,7 +138,7 @@ library
                 base == 4.*,
                 bytestring,
                 utf8-string,
-                binary >= 0.6.4.0,
+                binary >= 0.5.1.1,
                 zlib,
                 bzlib
 
-- 
cgit v1.2.3