summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2016-04-14 12:50:25 -0400
committerjoe <joe@jerkface.net>2016-04-14 12:51:36 -0400
commit47fbb4b70ee6c74937ed4b55540b612aacc3de80 (patch)
tree3d3577a0e3706512cd2c49938e91acf72e203249
parent880f16b4e52bbf96dd531c1c4b864423b057b770 (diff)
parent37d5a99e9f2303780a7cdbf4730ace6eff58a466 (diff)
Merged openpgp package into openpgp-util
Diffstat
-rw-r--r--.gitignore19
-rw-r--r--.travis.yml3
-rw-r--r--Arbitrary.patch108
-rw-r--r--Data/OpenPGP.hs1363
-rw-r--r--Data/OpenPGP/Internal.hs20
-rw-r--r--Makefile76
-rw-r--r--README19
-rw-r--r--debian/changelog5
-rw-r--r--debian/compat1
-rw-r--r--debian/control138
-rw-r--r--debian/copyright31
-rwxr-xr-xdebian/rules7
-rw-r--r--openpgp.cabal168
-rw-r--r--tests/data/000001-006.public_keybin0 -> 171 bytes
-rw-r--r--tests/data/000002-013.user_id1
-rw-r--r--tests/data/000003-002.sigbin0 -> 113 bytes
-rw-r--r--tests/data/000004-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000005-002.sigbin0 -> 113 bytes
-rw-r--r--tests/data/000006-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000007-002.sigbin0 -> 220 bytes
-rw-r--r--tests/data/000008-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000009-002.sigbin0 -> 158 bytes
-rw-r--r--tests/data/000010-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000011-002.sigbin0 -> 96 bytes
-rw-r--r--tests/data/000012-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000013-014.public_subkeybin0 -> 171 bytes
-rw-r--r--tests/data/000014-002.sigbin0 -> 195 bytes
-rw-r--r--tests/data/000015-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000016-006.public_keybin0 -> 1201 bytes
-rw-r--r--tests/data/000017-002.sigbin0 -> 123 bytes
-rw-r--r--tests/data/000018-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000019-013.user_id1
-rw-r--r--tests/data/000020-002.sigbin0 -> 130 bytes
-rw-r--r--tests/data/000021-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000022-002.sigbin0 -> 186 bytes
-rw-r--r--tests/data/000023-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000024-014.public_subkeybin0 -> 608 bytes
-rw-r--r--tests/data/000025-002.sigbin0 -> 105 bytes
-rw-r--r--tests/data/000026-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000027-006.public_keybin0 -> 421 bytes
-rw-r--r--tests/data/000028-002.sigbin0 -> 99 bytes
-rw-r--r--tests/data/000029-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000030-013.user_id1
-rw-r--r--tests/data/000031-002.sigbin0 -> 132 bytes
-rw-r--r--tests/data/000032-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000033-002.sigbin0 -> 96 bytes
-rw-r--r--tests/data/000034-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000035-006.public_keybin0 -> 143 bytes
-rw-r--r--tests/data/000036-013.user_id1
-rw-r--r--tests/data/000037-002.sigbin0 -> 192 bytes
-rw-r--r--tests/data/000038-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000039-002.sigbin0 -> 72 bytes
-rw-r--r--tests/data/000040-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000041-017.attributebin0 -> 1761 bytes
-rw-r--r--tests/data/000042-002.sigbin0 -> 192 bytes
-rw-r--r--tests/data/000043-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000044-014.public_subkeybin0 -> 272 bytes
-rw-r--r--tests/data/000045-002.sigbin0 -> 161 bytes
-rw-r--r--tests/data/000046-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000047-005.secret_keybin0 -> 610 bytes
-rw-r--r--tests/data/000048-013.user_id1
-rw-r--r--tests/data/000049-002.sigbin0 -> 220 bytes
-rw-r--r--tests/data/000050-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000051-007.secret_subkeybin0 -> 611 bytes
-rw-r--r--tests/data/000052-002.sigbin0 -> 195 bytes
-rw-r--r--tests/data/000053-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000054-005.secret_keybin0 -> 1275 bytes
-rw-r--r--tests/data/000055-002.sigbin0 -> 123 bytes
-rw-r--r--tests/data/000056-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000057-013.user_id1
-rw-r--r--tests/data/000058-002.sigbin0 -> 130 bytes
-rw-r--r--tests/data/000059-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000060-007.secret_subkeybin0 -> 698 bytes
-rw-r--r--tests/data/000061-002.sigbin0 -> 104 bytes
-rw-r--r--tests/data/000062-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000063-005.secret_keybin0 -> 484 bytes
-rw-r--r--tests/data/000064-002.sigbin0 -> 99 bytes
-rw-r--r--tests/data/000065-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000066-013.user_id1
-rw-r--r--tests/data/000067-002.sigbin0 -> 106 bytes
-rw-r--r--tests/data/000068-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000069-005.secret_keybin0 -> 513 bytes
-rw-r--r--tests/data/000070-013.user_id1
-rw-r--r--tests/data/000071-002.sigbin0 -> 192 bytes
-rw-r--r--tests/data/000072-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000073-017.attributebin0 -> 1761 bytes
-rw-r--r--tests/data/000074-002.sigbin0 -> 192 bytes
-rw-r--r--tests/data/000075-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/000076-007.secret_subkeybin0 -> 961 bytes
-rw-r--r--tests/data/000077-002.sigbin0 -> 161 bytes
-rw-r--r--tests/data/000078-012.ring_trustbin0 -> 4 bytes
-rw-r--r--tests/data/002182-002.sigbin0 -> 363 bytes
-rw-r--r--tests/data/3F5BBA0B0694BEB6000005-002.sigbin0 -> 1089 bytes
-rw-r--r--tests/data/3F5BBA0B0694BEB6000017-002.sigbin0 -> 1089 bytes
-rw-r--r--tests/data/compressedsig-bzip2.gpgbin0 -> 442 bytes
-rw-r--r--tests/data/compressedsig-zlib.gpgbin0 -> 322 bytes
-rw-r--r--tests/data/compressedsig.gpgbin0 -> 324 bytes
-rw-r--r--tests/data/onepass_sigbin0 -> 15 bytes
-rw-r--r--tests/data/pubring.gpgbin0 -> 179272 bytes
-rw-r--r--tests/data/secring.gpgbin0 -> 9329 bytes
-rw-r--r--tests/data/symmetrically_encryptedbin0 -> 528 bytes
-rw-r--r--tests/data/uncompressed-ops-dsa-sha384.txt.gpgbin0 -> 150 bytes
-rw-r--r--tests/data/uncompressed-ops-dsa.gpgbin0 -> 150 bytes
-rw-r--r--tests/data/uncompressed-ops-rsa.gpgbin0 -> 236 bytes
-rw-r--r--tests/suite.hs160
105 files changed, 1944 insertions, 182 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..9929e9d
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,19 @@
1*.[ao]
2*.hi
3*.swp*
4*.orig
5*.rej
6Data/OpenPGP/Arbitrary.hs
7verify
8sign
9keygen
10tests/suite
11dist/*
12report.html
13dist-ghc/*
14build-*-stamp
15debian/files
16debian/hlibrary.setup
17debian/libghc*
18debian/tmp*
19debian/dh_*
diff --git a/.travis.yml b/.travis.yml
new file mode 100644
index 0000000..14a357b
--- /dev/null
+++ b/.travis.yml
@@ -0,0 +1,3 @@
1language: haskell
2before_install: "cabal install hlint derive cereal"
3script: "make Data/OpenPGP/Arbitrary.hs && make report.html && [ ! -e report.html ] && make dist/setup-config && make tests/suite && tests/suite --plain && make clean && make Data/OpenPGP/Arbitrary.hs && make CEREAL=1 dist/setup-config && make CEREAL=1 tests/suite && tests/suite --plain"
diff --git a/Arbitrary.patch b/Arbitrary.patch
new file mode 100644
index 0000000..fdbfba6
--- /dev/null
+++ b/Arbitrary.patch
@@ -0,0 +1,108 @@
1--- Data/OpenPGP/Arbitrary.hs 2012-04-27 12:38:11.492411339 -0500
2+++ arb.s 2012-04-27 12:37:57.176469214 -0500
3@@ -1 +1,2 @@
4+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-imports #-}
5 module Data.OpenPGP.Arbitrary where
6@@ -14,13 +14,18 @@
7 1 -> do x1 <- arbitrary
8 x2 <- arbitrary
9 x3 <- arbitrary
10- x4 <- arbitrary
11- x5 <- arbitrary
12+ x4 <- resize 10 (listOf arbitrary)
13+ x5 <- resize 10 (listOf arbitrary)
14 x6 <- arbitrary
15 x7 <- arbitrary
16- x8 <- arbitrary
17- x9 <- arbitrary
18- return (SignaturePacket x1 x2 x3 x4 x5 x6 x7 x8 x9)
19+ version <- choose (2 :: Word8, 4)
20+ case version of
21+ 4 ->
22+ return (signaturePacket 4 x1 x2 x3 x4 x5 x6 x7)
23+ _ -> do
24+ creation_time <- arbitrary
25+ keyid <- vectorOf 16 (elements (['0'..'9'] ++ ['A'..'F']))
26+ return (signaturePacket version x1 x2 x3 [] [SignatureCreationTimePacket creation_time, IssuerPacket keyid] x6 x7)
27 2 -> do x1 <- arbitrary
28 x2 <- arbitrary
29 x3 <- arbitrary
30@@ -88,5 +93,5 @@
31 x2 <- arbitrary
32- x3 <- arbitrary
33+ x3 <- fmap decode_s2k_count arbitrary
34 return (IteratedSaltedS2K x1 x2 x3)
35- 3 -> do x1 <- arbitrary
36+ 3 -> do x1 <- suchThat arbitrary (`notElem` [0,1,3])
37 x2 <- arbitrary
38@@ -73,7 +72,7 @@
39 4 -> return SHA384
40 5 -> return SHA512
41 6 -> return SHA224
42- 7 -> do x1 <- arbitrary
43+ 7 -> do x1 <- suchThat arbitrary (`notElem` [01,02,03,08,09,10,11])
44 return (HashAlgorithm x1)
45 _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
46
47@@ -90,7 +89,7 @@
48 5 -> return ECC
49 6 -> return ECDSA
50 7 -> return DH
51- 8 -> do x1 <- arbitrary
52+ 8 -> do x1 <- suchThat arbitrary (`notElem` [01,02,03,16,17,18,19,21])
53 return (KeyAlgorithm x1)
54 _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
55
56@@ -108,7 +107,7 @@
57 6 -> return AES192
58 7 -> return AES256
59 8 -> return Twofish
60- 9 -> do x1 <- arbitrary
61+ 9 -> do x1 <- suchThat arbitrary (`notElem` [00,01,02,03,04,07,08,09,10])
62 return (SymmetricAlgorithm x1)
63 _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
64
65@@ -121,7 +120,7 @@
66 1 -> return ZIP
67 2 -> return ZLIB
68 3 -> return BZip2
69- 4 -> do x1 <- arbitrary
70+ 4 -> do x1 <- suchThat arbitrary (`notElem` [0,1,2,3])
71 return (CompressionAlgorithm x1)
72 _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
73
74@@ -135,7 +134,7 @@
75 2 -> return KeyCompromised
76 3 -> return KeyRetired
77 4 -> return UserIDInvalid
78- 5 -> do x1 <- arbitrary
79+ 5 -> do x1 <- suchThat arbitrary (`notElem` [00,01,02,03,32])
80 return (RevocationCode x1)
81 _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
82
83@@ -134,7 +133,7 @@
84
85 instance Arbitrary MPI where
86 arbitrary
87- = do x1 <- arbitrary
88+ = do x1 <- suchThat arbitrary (>=0)
89 return (MPI x1)
90
91
92@@ -160,5 +160,5 @@
93 return (PreferredSymmetricAlgorithmsPacket x1)
94 8 -> do x1 <- arbitrary
95 x2 <- arbitrary
96- x3 <- arbitrary
97+ x3 <- vectorOf 40 (elements (['0'..'9'] ++ ['A'..'F']))
98 return (RevocationKeyPacket x1 x2 x3)
99@@ -166 +165 @@
100- 9 -> do x1 <- arbitrary
101+ 9 -> do x1 <- vectorOf 16 (elements (['0'..'9'] ++ ['A'..'F']))
102@@ -217 +216 @@
103- 22 -> do x1 <- arbitrary
104+ 22 -> do x1 <- suchThat arbitrary isSignaturePacket
105@@ -169,2 +168 @@
106- x2 <- arbitrary
107- return (UnsupportedSignatureSubpacket x1 x2)
108+ return (UnsupportedSignatureSubpacket 105 x1)
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
new file mode 100644
index 0000000..74aae5f
--- /dev/null
+++ b/Data/OpenPGP.hs
@@ -0,0 +1,1363 @@
1{-# LANGUAGE CPP #-}
2-- | Main implementation of the OpenPGP message format <http://tools.ietf.org/html/rfc4880>
3--
4-- The recommended way to import this module is:
5--
6-- > import qualified Data.OpenPGP as OpenPGP
7module Data.OpenPGP (
8 Packet(
9 AsymmetricSessionKeyPacket,
10 OnePassSignaturePacket,
11 SymmetricSessionKeyPacket,
12 PublicKeyPacket,
13 SecretKeyPacket,
14 CompressedDataPacket,
15 MarkerPacket,
16 LiteralDataPacket,
17 TrustPacket,
18 UserIDPacket,
19 EncryptedDataPacket,
20 ModificationDetectionCodePacket,
21 UnsupportedPacket,
22 compression_algorithm,
23 content,
24 encrypted_data,
25 filename,
26 format,
27 hash_algorithm,
28 hashed_subpackets,
29 hash_head,
30 key,
31 is_subkey,
32 v3_days_of_validity,
33 key_algorithm,
34 key_id,
35 message,
36 nested,
37 s2k_useage,
38 s2k,
39 signature,
40 signature_type,
41 symmetric_algorithm,
42 timestamp,
43 trailer,
44 unhashed_subpackets,
45 version
46 ),
47 isSignaturePacket,
48 signaturePacket,
49 Message(..),
50 SignatureSubpacket(..),
51 S2K(..),
52 string2key,
53 HashAlgorithm(..),
54 KeyAlgorithm(..),
55 SymmetricAlgorithm(..),
56 CompressionAlgorithm(..),
57 RevocationCode(..),
58 MPI(..),
59 find_key,
60 fingerprint_material,
61 SignatureOver(..),
62 signatures,
63 signature_issuer,
64 public_key_fields,
65 secret_key_fields
66) where
67
68import Numeric
69import Control.Monad
70import Control.Arrow
71import Control.Applicative
72import Data.Monoid
73import Data.Bits
74import Data.Word
75import Data.Char
76import Data.List
77import Data.Maybe
78import Data.OpenPGP.Internal
79import qualified Data.ByteString as BS
80import qualified Data.ByteString.Lazy as LZ
81
82#ifdef CEREAL
83import Data.Serialize
84import qualified Data.ByteString as B
85import qualified Data.ByteString.UTF8 as B (toString, fromString)
86#define BINARY_CLASS Serialize
87#else
88import Data.Binary
89import Data.Binary.Get
90import Data.Binary.Put
91import qualified Data.ByteString.Lazy as B
92import qualified Data.ByteString.Lazy.UTF8 as B (toString, fromString)
93#define BINARY_CLASS Binary
94#endif
95
96import qualified Codec.Compression.Zlib.Raw as Zip
97import qualified Codec.Compression.Zlib as Zlib
98import qualified Codec.Compression.BZip as BZip2
99
100#ifdef CEREAL
101getRemainingByteString :: Get B.ByteString
102getRemainingByteString = remaining >>= getByteString
103
104getSomeByteString :: Word64 -> Get B.ByteString
105getSomeByteString = getByteString . fromIntegral
106
107putSomeByteString :: B.ByteString -> Put
108putSomeByteString = putByteString
109
110localGet :: Get a -> B.ByteString -> Get a
111localGet g bs = case runGet g bs of
112 Left s -> fail s
113 Right v -> return v
114
115compress :: CompressionAlgorithm -> B.ByteString -> B.ByteString
116compress algo = toStrictBS . lazyCompress algo . toLazyBS
117
118decompress :: CompressionAlgorithm -> B.ByteString -> B.ByteString
119decompress algo = toStrictBS . lazyDecompress algo . toLazyBS
120
121toStrictBS :: LZ.ByteString -> B.ByteString
122toStrictBS = B.concat . LZ.toChunks
123
124toLazyBS :: B.ByteString -> LZ.ByteString
125toLazyBS = LZ.fromChunks . (:[])
126
127lazyEncode :: (Serialize a) => a -> LZ.ByteString
128lazyEncode = toLazyBS . encode
129#else
130getRemainingByteString :: Get B.ByteString
131getRemainingByteString = getRemainingLazyByteString
132
133getSomeByteString :: Word64 -> Get B.ByteString
134getSomeByteString = getLazyByteString . fromIntegral
135
136putSomeByteString :: B.ByteString -> Put
137putSomeByteString = putLazyByteString
138
139#if MIN_VERSION_binary(0,6,4)
140localGet :: Get a -> B.ByteString -> Get a
141localGet g bs = case runGetOrFail g bs of
142 Left (_,_,s) -> fail s
143 Right (leftover,_,v)
144 | B.null leftover -> return v
145 | otherwise -> fail $ "Leftover in localGet: " ++ show leftover
146#else
147localGet :: Get a -> B.ByteString -> Get a
148localGet g bs = return $ runGet g bs
149#endif
150
151compress :: CompressionAlgorithm -> B.ByteString -> B.ByteString
152compress = lazyCompress
153
154decompress :: CompressionAlgorithm -> B.ByteString -> B.ByteString
155decompress = lazyDecompress
156
157lazyEncode :: (Binary a) => a -> LZ.ByteString
158lazyEncode = encode
159#endif
160
161lazyCompress :: CompressionAlgorithm -> LZ.ByteString -> LZ.ByteString
162lazyCompress Uncompressed = id
163lazyCompress ZIP = Zip.compress
164lazyCompress ZLIB = Zlib.compress
165lazyCompress BZip2 = BZip2.compress
166lazyCompress x = error ("No implementation for " ++ show x)
167
168lazyDecompress :: CompressionAlgorithm -> LZ.ByteString -> LZ.ByteString
169lazyDecompress Uncompressed = id
170lazyDecompress ZIP = Zip.decompress
171lazyDecompress ZLIB = Zlib.decompress
172lazyDecompress BZip2 = BZip2.decompress
173lazyDecompress x = error ("No implementation for " ++ show x)
174
175assertProp :: (Monad m, Show a) => (a -> Bool) -> a -> m a
176assertProp f x
177 | f x = return $! x
178 | otherwise = fail $ "Assertion failed for: " ++ show x
179
180pad :: Int -> String -> String
181pad l s = replicate (l - length s) '0' ++ s
182
183padBS :: Int -> B.ByteString -> B.ByteString
184padBS l s = B.replicate (fromIntegral l - B.length s) 0 `B.append` s
185
186checksum :: B.ByteString -> Word16
187checksum = fromIntegral .
188 B.foldl (\c i -> (c + fromIntegral i) `mod` 65536) (0::Integer)
189
190data Packet =
191 AsymmetricSessionKeyPacket {
192 version::Word8,
193 key_id::String,
194 key_algorithm::KeyAlgorithm,
195 encrypted_data::B.ByteString
196 } |
197 -- ^ <http://tools.ietf.org/html/rfc4880#section-5.1>
198 SignaturePacket {
199 version::Word8,
200 signature_type::Word8,
201 key_algorithm::KeyAlgorithm,
202 hash_algorithm::HashAlgorithm,
203 hashed_subpackets::[SignatureSubpacket],
204 unhashed_subpackets::[SignatureSubpacket],
205 hash_head::Word16,
206 signature::[MPI],
207 trailer::B.ByteString
208 } |
209 -- ^ <http://tools.ietf.org/html/rfc4880#section-5.2>
210 SymmetricSessionKeyPacket {
211 version::Word8,
212 symmetric_algorithm::SymmetricAlgorithm,
213 s2k::S2K,
214 encrypted_data::B.ByteString
215 } |
216 -- ^ <http://tools.ietf.org/html/rfc4880#section-5.3>
217 OnePassSignaturePacket {
218 version::Word8,
219 signature_type::Word8,
220 hash_algorithm::HashAlgorithm,
221 key_algorithm::KeyAlgorithm,
222 key_id::String,
223 nested::Word8
224 } |
225 -- ^ <http://tools.ietf.org/html/rfc4880#section-5.4>
226 PublicKeyPacket {
227 version::Word8,
228 timestamp::Word32,
229 key_algorithm::KeyAlgorithm,
230 key::[(Char,MPI)],
231 is_subkey::Bool,
232 v3_days_of_validity::Maybe Word16
233 } |
234 -- ^ <http://tools.ietf.org/html/rfc4880#section-5.5.1.1> (also subkey)
235 SecretKeyPacket {
236 version::Word8,
237 timestamp::Word32,
238 key_algorithm::KeyAlgorithm,
239 key::[(Char,MPI)],
240 s2k_useage::Word8,
241 s2k::S2K, -- ^ This is meaningless if symmetric_algorithm == Unencrypted
242 symmetric_algorithm::SymmetricAlgorithm,
243 encrypted_data::B.ByteString,
244 is_subkey::Bool
245 } |
246 -- ^ <http://tools.ietf.org/html/rfc4880#section-5.5.1.3> (also subkey)
247 CompressedDataPacket {
248 compression_algorithm::CompressionAlgorithm,
249 message::Message
250 } |
251 -- ^ <http://tools.ietf.org/html/rfc4880#section-5.6>
252 MarkerPacket | -- ^ <http://tools.ietf.org/html/rfc4880#section-5.8>
253 LiteralDataPacket {
254 format::Char,
255 filename::String,
256 timestamp::Word32,
257 content::B.ByteString
258 } |
259 -- ^ <http://tools.ietf.org/html/rfc4880#section-5.9>
260 TrustPacket B.ByteString | -- ^ <http://tools.ietf.org/html/rfc4880#section-5.10>
261 UserIDPacket String | -- ^ <http://tools.ietf.org/html/rfc4880#section-5.11>
262 EncryptedDataPacket {
263 version::Word8,
264 encrypted_data::B.ByteString
265 } |
266 -- ^ <http://tools.ietf.org/html/rfc4880#section-5.13>
267 -- or <http://tools.ietf.org/html/rfc4880#section-5.7> when version is 0
268 ModificationDetectionCodePacket B.ByteString | -- ^ <http://tools.ietf.org/html/rfc4880#section-5.14>
269 UnsupportedPacket Word8 B.ByteString
270 deriving (Show, Read, Eq)
271
272instance BINARY_CLASS Packet where
273 put p = do
274 -- First two bits are 1 for new packet format
275 put ((tag .|. 0xC0) :: Word8)
276 case tag of
277 19 -> put =<< assertProp (<192) (blen :: Word8)
278 _ -> do
279 -- Use 5-octet lengths
280 put (255 :: Word8)
281 put (blen :: Word32)
282 putSomeByteString body
283 where
284 blen :: (Num a) => a
285 blen = fromIntegral $ B.length body
286 (body, tag) = put_packet p
287 get = do
288 tag <- get
289 let (t, l) =
290 if (tag .&. 64) /= 0 then
291 (tag .&. 63, parse_new_length)
292 else
293 ((tag `shiftR` 2) .&. 15, (,) <$> parse_old_length tag <*> pure False)
294 packet <- uncurry get_packet_bytes =<< l
295 localGet (parse_packet t) (B.concat packet)
296
297get_packet_bytes :: Maybe Word32 -> Bool -> Get [B.ByteString]
298get_packet_bytes len partial = do
299 -- This forces the whole packet to be consumed
300 packet <- maybe getRemainingByteString (getSomeByteString . fromIntegral) len
301 if not partial then return [packet] else
302 (packet:) <$> (uncurry get_packet_bytes =<< parse_new_length)
303
304-- http://tools.ietf.org/html/rfc4880#section-4.2.2
305parse_new_length :: Get (Maybe Word32, Bool)
306parse_new_length = fmap (first Just) $ do
307 len <- fmap fromIntegral (get :: Get Word8)
308 case len of
309 -- One octet length
310 _ | len < 192 -> return (len, False)
311 -- Two octet length
312 _ | len > 191 && len < 224 -> do
313 second <- fmap fromIntegral (get :: Get Word8)
314 return (((len - 192) `shiftL` 8) + second + 192, False)
315 -- Five octet length
316 255 -> (,) <$> (get :: Get Word32) <*> pure False
317 -- Partial length (streaming)
318 _ | len >= 224 && len < 255 ->
319 return (1 `shiftL` (fromIntegral len .&. 0x1F), True)
320 _ -> fail "Unsupported new packet length."
321
322-- http://tools.ietf.org/html/rfc4880#section-4.2.1
323parse_old_length :: Word8 -> Get (Maybe Word32)
324parse_old_length tag =
325 case tag .&. 3 of
326 -- One octet length
327 0 -> fmap (Just . fromIntegral) (get :: Get Word8)
328 -- Two octet length
329 1 -> fmap (Just . fromIntegral) (get :: Get Word16)
330 -- Four octet length
331 2 -> fmap Just get
332 -- Indeterminate length
333 3 -> return Nothing
334 -- Error
335 _ -> fail "Unsupported old packet length."
336
337-- http://tools.ietf.org/html/rfc4880#section-5.5.2
338public_key_fields :: KeyAlgorithm -> [Char]
339public_key_fields RSA = ['n', 'e']
340public_key_fields RSA_E = public_key_fields RSA
341public_key_fields RSA_S = public_key_fields RSA
342public_key_fields ELGAMAL = ['p', 'g', 'y']
343public_key_fields DSA = ['p', 'q', 'g', 'y']
344public_key_fields ECDSA = ['c','l','x', 'y']
345public_key_fields _ = undefined -- Nothing in the spec. Maybe empty
346
347-- http://tools.ietf.org/html/rfc4880#section-5.5.3
348secret_key_fields :: KeyAlgorithm -> [Char]
349secret_key_fields RSA = ['d', 'p', 'q', 'u']
350secret_key_fields RSA_E = secret_key_fields RSA
351secret_key_fields RSA_S = secret_key_fields RSA
352secret_key_fields ELGAMAL = ['x']
353secret_key_fields DSA = ['x']
354secret_key_fields ECDSA = ['d']
355secret_key_fields _ = undefined -- Nothing in the spec. Maybe empty
356
357(!) :: (Eq k) => [(k,v)] -> k -> v
358(!) xs k = let Just x = lookup k xs in x
359
360-- Need this seperate for trailer calculation
361signature_packet_start :: Packet -> B.ByteString
362signature_packet_start (SignaturePacket {
363 version = 4,
364 signature_type = signature_type,
365 key_algorithm = key_algorithm,
366 hash_algorithm = hash_algorithm,
367 hashed_subpackets = hashed_subpackets
368}) =
369 B.concat [
370 encode (0x04 :: Word8),
371 encode signature_type,
372 encode key_algorithm,
373 encode hash_algorithm,
374 encode ((fromIntegral $ B.length hashed_subs) :: Word16),
375 hashed_subs
376 ]
377 where
378 hashed_subs = B.concat $ map encode hashed_subpackets
379signature_packet_start x =
380 error ("Trying to get start of signature packet for: " ++ show x)
381
382-- The trailer is just the top of the body plus some crap
383calculate_signature_trailer :: Packet -> B.ByteString
384calculate_signature_trailer (SignaturePacket { version = v,
385 signature_type = signature_type,
386 unhashed_subpackets = unhashed_subpackets
387 }) | v `elem` [2,3] =
388 B.concat [
389 encode signature_type,
390 encode creation_time
391 ]
392 where
393 Just (SignatureCreationTimePacket creation_time) = find isCreation unhashed_subpackets
394 isCreation (SignatureCreationTimePacket {}) = True
395 isCreation _ = False
396calculate_signature_trailer p@(SignaturePacket {version = 4}) =
397 B.concat [
398 signature_packet_start p,
399 encode (0x04 :: Word8),
400 encode (0xff :: Word8),
401 encode (fromIntegral (B.length $ signature_packet_start p) :: Word32)
402 ]
403calculate_signature_trailer x =
404 error ("Trying to calculate signature trailer for: " ++ show x)
405
406
407encode_public_key_material :: Packet -> [B.ByteString]
408encode_public_key_material k | key_algorithm k == ECDSA = do
409 -- http://tools.ietf.org/html/rfc6637
410 c <- maybeToList $ lookup 'c' (key k)
411 MPI l <- maybeToList $ lookup 'l' (key k)
412 MPI x <- maybeToList $ lookup 'x' (key k)
413 MPI y <- maybeToList $ lookup 'y' (key k)
414 let (bitlen,oid) = B.splitAt 2 (encode c)
415 len16 = decode bitlen :: Word16
416 (fullbytes,rembits) = len16 `quotRem` 8
417 len8 = fromIntegral (fullbytes + if rembits/=0 then 1 else 0) :: Word8
418 xy = 4*(4^l) + x*(2^l) + y
419 [ len8 `B.cons` oid, encode (MPI xy) ]
420encode_public_key_material k = map (encode . (key k !)) (public_key_fields $ key_algorithm k)
421
422decode_public_key_material :: KeyAlgorithm -> Get [(Char,MPI)]
423decode_public_key_material ECDSA = do
424 -- http://tools.ietf.org/html/rfc6637
425 oidlen <- get :: Get Word8
426 oidbytes <- getSomeByteString (fromIntegral oidlen)
427 let mpiFromBytes bytes = MPI (B.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0 bytes)
428 oid = mpiFromBytes oidbytes
429 MPI xy <- get
430 let integerBytesize i = fromIntegral $ LZ.length (encode (MPI i)) - 2
431 width = ( integerBytesize xy - 1 ) `div` 2
432 (fx,y) = xy `quotRem` (256^width)
433 x = fx `rem` (256^width)
434 l = width*8
435 return [('c',oid), ('l',MPI l), ('x',MPI x), ('y',MPI y)]
436decode_public_key_material algorithm = mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm)
437
438put_packet :: Packet -> (B.ByteString, Word8)
439put_packet (AsymmetricSessionKeyPacket version key_id key_algorithm dta) =
440 (B.concat [
441 encode version,
442 encode (fst $ head $ readHex $ takeFromEnd 16 key_id :: Word64),
443 encode key_algorithm,
444 dta
445 ], 1)
446put_packet (SignaturePacket { version = v,
447 unhashed_subpackets = unhashed_subpackets,
448 key_algorithm = key_algorithm,
449 hash_algorithm = hash_algorithm,
450 hash_head = hash_head,
451 signature = signature,
452 trailer = trailer }) | v `elem` [2,3] =
453 -- TODO: Assert that there are no subpackets we cannot encode?
454 (B.concat $ [
455 B.singleton v,
456 B.singleton 0x05,
457 trailer, -- signature_type and creation_time
458 encode keyid,
459 encode key_algorithm,
460 encode hash_algorithm,
461 encode hash_head
462 ] ++ map encode signature, 2)
463 where
464 keyid = fst $ head $ readHex $ takeFromEnd 16 keyidS :: Word64
465 Just (IssuerPacket keyidS) = find isIssuer unhashed_subpackets
466 isIssuer (IssuerPacket {}) = True
467 isIssuer _ = False
468put_packet (SymmetricSessionKeyPacket version salgo s2k encd) =
469 (B.concat [encode version, encode salgo, encode s2k, encd], 3)
470put_packet (SignaturePacket { version = 4,
471 unhashed_subpackets = unhashed_subpackets,
472 hash_head = hash_head,
473 signature = signature,
474 trailer = trailer }) =
475 (B.concat $ [
476 trailer_top,
477 encode (fromIntegral $ B.length unhashed :: Word16),
478 unhashed, encode hash_head
479 ] ++ map encode signature, 2)
480 where
481 trailer_top = B.reverse $ B.drop 6 $ B.reverse trailer
482 unhashed = B.concat $ map encode unhashed_subpackets
483put_packet (OnePassSignaturePacket { version = version,
484 signature_type = signature_type,
485 hash_algorithm = hash_algorithm,
486 key_algorithm = key_algorithm,
487 key_id = key_id,
488 nested = nested }) =
489 (B.concat [
490 encode version, encode signature_type,
491 encode hash_algorithm, encode key_algorithm,
492 encode (fst $ head $ readHex $ takeFromEnd 16 key_id :: Word64),
493 encode nested
494 ], 4)
495put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
496 key_algorithm = algorithm, key = key,
497 s2k_useage = s2k_useage, s2k = s2k,
498 symmetric_algorithm = symmetric_algorithm,
499 encrypted_data = encrypted_data,
500 is_subkey = is_subkey }) =
501 (B.concat $ p :
502 (if s2k_useage `elem` [254,255] then
503 [encode s2k_useage, encode symmetric_algorithm, encode s2k]
504 else
505 [encode symmetric_algorithm]
506 ) ++
507 (if symmetric_algorithm /= Unencrypted then
508 -- For V3 keys, the "encrypted data" has an unencrypted checksum
509 -- of the unencrypted MPIs on the end
510 [encrypted_data]
511 else s ++
512 [encode $ checksum $ B.concat s]),
513 if is_subkey then 7 else 5)
514 where
515 p = fst (put_packet $
516 PublicKeyPacket version timestamp algorithm key False Nothing)
517 s = map (encode . (key !)) (secret_key_fields algorithm)
518put_packet p@(PublicKeyPacket { version = v, timestamp = timestamp,
519 key_algorithm = algorithm, key = key,
520 is_subkey = is_subkey })
521 | v == 3 =
522 final (B.concat $ [
523 B.singleton 3, encode timestamp,
524 encode v3_days,
525 encode algorithm
526 ] ++ material)
527 | v == 4 =
528 final (B.concat $ [
529 B.singleton 4, encode timestamp, encode algorithm
530 ] ++ material)
531 where
532 Just v3_days = v3_days_of_validity p
533 final x = (x, if is_subkey then 14 else 6)
534 material = encode_public_key_material p
535put_packet (CompressedDataPacket { compression_algorithm = algorithm,
536 message = message }) =
537 (B.append (encode algorithm) $ compress algorithm $ encode message, 8)
538put_packet MarkerPacket = (B.fromString "PGP", 10)
539put_packet (LiteralDataPacket { format = format, filename = filename,
540 timestamp = timestamp, content = content
541 }) =
542 (B.concat [
543 encode format, encode filename_l, lz_filename,
544 encode timestamp, content
545 ], 11)
546 where
547 filename_l = (fromIntegral $ B.length lz_filename) :: Word8
548 lz_filename = B.fromString filename
549put_packet (TrustPacket bytes) = (bytes, 12)
550put_packet (UserIDPacket txt) = (B.fromString txt, 13)
551put_packet (EncryptedDataPacket 0 encrypted_data) = (encrypted_data, 9)
552put_packet (EncryptedDataPacket version encrypted_data) =
553 (B.concat [encode version, encrypted_data], 18)
554put_packet (ModificationDetectionCodePacket bstr) = (bstr, 19)
555put_packet (UnsupportedPacket tag bytes) = (bytes, fromIntegral tag)
556put_packet x = error ("Unsupported Packet version or type in put_packet: " ++ show x)
557
558parse_packet :: Word8 -> Get Packet
559-- AsymmetricSessionKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.1
560parse_packet 1 = AsymmetricSessionKeyPacket
561 <$> (assertProp (==3) =<< get)
562 <*> fmap (pad 16 . map toUpper . flip showHex "") (get :: Get Word64)
563 <*> get
564 <*> getRemainingByteString
565-- SignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2
566parse_packet 2 = do
567 version <- get
568 case version of
569 _ | version `elem` [2,3] -> do
570 _ <- assertProp (==5) =<< (get :: Get Word8)
571 signature_type <- get
572 creation_time <- get :: Get Word32
573 keyid <- get :: Get Word64
574 key_algorithm <- get
575 hash_algorithm <- get
576 hash_head <- get
577 signature <- listUntilEnd
578 return SignaturePacket {
579 version = version,
580 signature_type = signature_type,
581 key_algorithm = key_algorithm,
582 hash_algorithm = hash_algorithm,
583 hashed_subpackets = [],
584 unhashed_subpackets = [
585 SignatureCreationTimePacket creation_time,
586 IssuerPacket $ pad 16 $ map toUpper $ showHex keyid ""
587 ],
588 hash_head = hash_head,
589 signature = signature,
590 trailer = B.concat [encode signature_type, encode creation_time]
591 }
592 4 -> do
593 signature_type <- get
594 key_algorithm <- get
595 hash_algorithm <- get
596 hashed_size <- fmap fromIntegral (get :: Get Word16)
597 hashed_data <- getSomeByteString hashed_size
598 hashed <- localGet listUntilEnd hashed_data
599 unhashed_size <- fmap fromIntegral (get :: Get Word16)
600 unhashed_data <- getSomeByteString unhashed_size
601 unhashed <- localGet listUntilEnd unhashed_data
602 hash_head <- get
603 signature <- listUntilEnd
604 return SignaturePacket {
605 version = version,
606 signature_type = signature_type,
607 key_algorithm = key_algorithm,
608 hash_algorithm = hash_algorithm,
609 hashed_subpackets = hashed,
610 unhashed_subpackets = unhashed,
611 hash_head = hash_head,
612 signature = signature,
613 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)]
614 }
615 x -> fail $ "Unknown SignaturePacket version " ++ show x ++ "."
616-- SymmetricSessionKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.3
617parse_packet 3 = SymmetricSessionKeyPacket
618 <$> (assertProp (==4) =<< get)
619 <*> get
620 <*> get
621 <*> getRemainingByteString
622-- OnePassSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.4
623parse_packet 4 = do
624 version <- get
625 signature_type <- get
626 hash_algo <- get
627 key_algo <- get
628 key_id <- get :: Get Word64
629 nested <- get
630 return OnePassSignaturePacket {
631 version = version,
632 signature_type = signature_type,
633 hash_algorithm = hash_algo,
634 key_algorithm = key_algo,
635 key_id = pad 16 $ map toUpper $ showHex key_id "",
636 nested = nested
637 }
638-- SecretKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.3
639parse_packet 5 = do
640 -- Parse PublicKey part
641 (PublicKeyPacket {
642 version = version,
643 timestamp = timestamp,
644 key_algorithm = algorithm,
645 key = key
646 }) <- parse_packet 6
647 s2k_useage <- get :: Get Word8
648 let k = SecretKeyPacket version timestamp algorithm key s2k_useage
649 (symmetric_algorithm, s2k) <- case () of
650 _ | s2k_useage `elem` [255, 254] -> (,) <$> get <*> get
651 _ | s2k_useage > 0 ->
652 -- s2k_useage is symmetric_type in this case
653 (,) <$> localGet get (encode s2k_useage) <*> pure (SimpleS2K MD5)
654 _ ->
655 return (Unencrypted, S2K 100 B.empty)
656 if symmetric_algorithm /= Unencrypted then do {
657 encrypted <- getRemainingByteString;
658 return (k s2k symmetric_algorithm encrypted False)
659 } else do
660 skey <- foldM (\m f -> do
661 mpi <- get :: Get MPI
662 return $ (f,mpi):m) [] (secret_key_fields algorithm)
663 chk <- get
664 when (checksum (B.concat $ map (encode . snd) skey) /= chk) $
665 fail "Checksum verification failed for unencrypted secret key"
666 return ((k s2k symmetric_algorithm B.empty False) {key = key ++ skey})
667-- PublicKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.2
668parse_packet 6 = do
669 version <- get :: Get Word8
670 case version of
671 3 -> do
672 timestamp <- get
673 days <- get
674 algorithm <- get
675 key <- decode_public_key_material algorithm
676 return PublicKeyPacket {
677 version = version,
678 timestamp = timestamp,
679 key_algorithm = algorithm,
680 key = key,
681 is_subkey = False,
682 v3_days_of_validity = Just days
683 }
684 4 -> do
685 timestamp <- get
686 algorithm <- get
687 key <- decode_public_key_material algorithm
688 return PublicKeyPacket {
689 version = 4,
690 timestamp = timestamp,
691 key_algorithm = algorithm,
692 key = key,
693 is_subkey = False,
694 v3_days_of_validity = Nothing
695 }
696 x -> fail $ "Unsupported PublicKeyPacket version " ++ show x ++ "."
697-- Secret-SubKey Packet, http://tools.ietf.org/html/rfc4880#section-5.5.1.4
698parse_packet 7 = do
699 p <- parse_packet 5
700 return p {is_subkey = True}
701-- CompressedDataPacket, http://tools.ietf.org/html/rfc4880#section-5.6
702parse_packet 8 = do
703 algorithm <- get
704 message <- localGet get =<< (decompress algorithm <$> getRemainingByteString)
705 return CompressedDataPacket {
706 compression_algorithm = algorithm,
707 message = message
708 }
709-- EncryptedDataPacket, http://tools.ietf.org/html/rfc4880#section-5.7
710parse_packet 9 = EncryptedDataPacket 0 <$> getRemainingByteString
711-- MarkerPacket, http://tools.ietf.org/html/rfc4880#section-5.8
712parse_packet 10 = return MarkerPacket
713-- LiteralDataPacket, http://tools.ietf.org/html/rfc4880#section-5.9
714parse_packet 11 = do
715 format <- get
716 filenameLength <- get :: Get Word8
717 filename <- getSomeByteString (fromIntegral filenameLength)
718 timestamp <- get
719 content <- getRemainingByteString
720 return LiteralDataPacket {
721 format = format,
722 filename = B.toString filename,
723 timestamp = timestamp,
724 content = content
725 }
726-- TrustPacket, http://tools.ietf.org/html/rfc4880#section-5.10
727parse_packet 12 = fmap TrustPacket getRemainingByteString
728-- UserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.11
729parse_packet 13 =
730 fmap (UserIDPacket . B.toString) getRemainingByteString
731-- Public-Subkey Packet, http://tools.ietf.org/html/rfc4880#section-5.5.1.2
732parse_packet 14 = do
733 p <- parse_packet 6
734 return p {is_subkey = True}
735-- EncryptedDataPacket, http://tools.ietf.org/html/rfc4880#section-5.13
736parse_packet 18 = EncryptedDataPacket <$> get <*> getRemainingByteString
737-- ModificationDetectionCodePacket, http://tools.ietf.org/html/rfc4880#section-5.14
738parse_packet 19 =
739 fmap ModificationDetectionCodePacket getRemainingByteString
740-- Represent unsupported packets as their tag and literal bytes
741parse_packet tag = fmap (UnsupportedPacket tag) getRemainingByteString
742
743-- | Helper method for fingerprints and such
744fingerprint_material :: Packet -> [B.ByteString]
745fingerprint_material p | version p == 4 =
746 [
747 B.singleton 0x99,
748 encode (6 + fromIntegral (B.length material) :: Word16),
749 B.singleton 4, encode (timestamp p), encode (key_algorithm p),
750 material
751 ]
752 where
753 material = B.concat $ encode_public_key_material p
754fingerprint_material p | version p `elem` [2, 3] = [n, e]
755 where
756 n = B.drop 2 (encode (key p ! 'n'))
757 e = B.drop 2 (encode (key p ! 'e'))
758fingerprint_material _ =
759 error "Unsupported Packet version or type in fingerprint_material."
760
761enum_to_word8 :: (Enum a) => a -> Word8
762enum_to_word8 = fromIntegral . fromEnum
763
764enum_from_word8 :: (Enum a) => Word8 -> a
765enum_from_word8 = toEnum . fromIntegral
766
767data S2K =
768 SimpleS2K HashAlgorithm |
769 SaltedS2K HashAlgorithm Word64 |
770 IteratedSaltedS2K HashAlgorithm Word64 Word32 |
771 S2K Word8 B.ByteString
772 deriving (Show, Read, Eq)
773
774instance BINARY_CLASS S2K where
775 put (SimpleS2K halgo) = put (0::Word8) >> put halgo
776 put (SaltedS2K halgo salt) = put (1::Word8) >> put halgo >> put salt
777 put (IteratedSaltedS2K halgo salt count) = put (3::Word8) >> put halgo
778 >> put salt >> put (encode_s2k_count count)
779 put (S2K t body) = put t >> putSomeByteString body
780
781 get = do
782 t <- get :: Get Word8
783 case t of
784 0 -> SimpleS2K <$> get
785 1 -> SaltedS2K <$> get <*> get
786 3 -> IteratedSaltedS2K <$> get <*> get <*> (decode_s2k_count <$> get)
787 _ -> S2K t <$> getRemainingByteString
788
789-- | Take a hash function and an 'S2K' value and generate the bytes
790-- needed for creating a symmetric key.
791--
792-- Return value is always infinite length.
793-- Take the first n bytes you need for your keysize.
794string2key :: (HashAlgorithm -> LZ.ByteString -> BS.ByteString) -> S2K -> LZ.ByteString -> LZ.ByteString
795string2key hsh (SimpleS2K halgo) s = infiniHashes (hsh halgo) s
796string2key hsh (SaltedS2K halgo salt) s =
797 infiniHashes (hsh halgo) (lazyEncode salt `LZ.append` s)
798string2key hsh (IteratedSaltedS2K halgo salt count) s =
799 infiniHashes (hsh halgo) $
800 LZ.take (max (fromIntegral count) (LZ.length s))
801 (LZ.cycle $ lazyEncode salt `LZ.append` s)
802string2key _ s2k _ = error $ "Unsupported S2K specifier: " ++ show s2k
803
804infiniHashes :: (LZ.ByteString -> BS.ByteString) -> LZ.ByteString -> LZ.ByteString
805infiniHashes hsh s = LZ.fromChunks (hs 0)
806 where
807 hs c = hsh (LZ.replicate c 0 `LZ.append` s) : hs (c+1)
808
809data HashAlgorithm = MD5 | SHA1 | RIPEMD160 | SHA256 | SHA384 | SHA512 | SHA224 | HashAlgorithm Word8
810 deriving (Show, Read, Eq)
811
812instance Enum HashAlgorithm where
813 toEnum 01 = MD5
814 toEnum 02 = SHA1
815 toEnum 03 = RIPEMD160
816 toEnum 08 = SHA256
817 toEnum 09 = SHA384
818 toEnum 10 = SHA512
819 toEnum 11 = SHA224
820 toEnum x = HashAlgorithm $ fromIntegral x
821 fromEnum MD5 = 01
822 fromEnum SHA1 = 02
823 fromEnum RIPEMD160 = 03
824 fromEnum SHA256 = 08
825 fromEnum SHA384 = 09
826 fromEnum SHA512 = 10
827 fromEnum SHA224 = 11
828 fromEnum (HashAlgorithm x) = fromIntegral x
829
830instance BINARY_CLASS HashAlgorithm where
831 put = put . enum_to_word8
832 get = fmap enum_from_word8 get
833
834data KeyAlgorithm = RSA | RSA_E | RSA_S | ELGAMAL | DSA | ECC | ECDSA | DH | KeyAlgorithm Word8
835 deriving (Show, Read, Eq)
836
837instance Enum KeyAlgorithm where
838 toEnum 01 = RSA
839 toEnum 02 = RSA_E
840 toEnum 03 = RSA_S
841 toEnum 16 = ELGAMAL
842 toEnum 17 = DSA
843 toEnum 18 = ECC
844 toEnum 19 = ECDSA
845 toEnum 21 = DH
846 toEnum x = KeyAlgorithm $ fromIntegral x
847 fromEnum RSA = 01
848 fromEnum RSA_E = 02
849 fromEnum RSA_S = 03
850 fromEnum ELGAMAL = 16
851 fromEnum DSA = 17
852 fromEnum ECC = 18
853 fromEnum ECDSA = 19
854 fromEnum DH = 21
855 fromEnum (KeyAlgorithm x) = fromIntegral x
856
857instance BINARY_CLASS KeyAlgorithm where
858 put = put . enum_to_word8
859 get = fmap enum_from_word8 get
860
861data SymmetricAlgorithm = Unencrypted | IDEA | TripleDES | CAST5 | Blowfish | AES128 | AES192 | AES256 | Twofish | SymmetricAlgorithm Word8
862 deriving (Show, Read, Eq)
863
864instance Enum SymmetricAlgorithm where
865 toEnum 00 = Unencrypted
866 toEnum 01 = IDEA
867 toEnum 02 = TripleDES
868 toEnum 03 = CAST5
869 toEnum 04 = Blowfish
870 toEnum 07 = AES128
871 toEnum 08 = AES192
872 toEnum 09 = AES256
873 toEnum 10 = Twofish
874 toEnum x = SymmetricAlgorithm $ fromIntegral x
875 fromEnum Unencrypted = 00
876 fromEnum IDEA = 01
877 fromEnum TripleDES = 02
878 fromEnum CAST5 = 03
879 fromEnum Blowfish = 04
880 fromEnum AES128 = 07
881 fromEnum AES192 = 08
882 fromEnum AES256 = 09
883 fromEnum Twofish = 10
884 fromEnum (SymmetricAlgorithm x) = fromIntegral x
885
886instance BINARY_CLASS SymmetricAlgorithm where
887 put = put . enum_to_word8
888 get = fmap enum_from_word8 get
889
890data CompressionAlgorithm = Uncompressed | ZIP | ZLIB | BZip2 | CompressionAlgorithm Word8
891 deriving (Show, Read, Eq)
892
893instance Enum CompressionAlgorithm where
894 toEnum 0 = Uncompressed
895 toEnum 1 = ZIP
896 toEnum 2 = ZLIB
897 toEnum 3 = BZip2
898 toEnum x = CompressionAlgorithm $ fromIntegral x
899 fromEnum Uncompressed = 0
900 fromEnum ZIP = 1
901 fromEnum ZLIB = 2
902 fromEnum BZip2 = 3
903 fromEnum (CompressionAlgorithm x) = fromIntegral x
904
905instance BINARY_CLASS CompressionAlgorithm where
906 put = put . enum_to_word8
907 get = fmap enum_from_word8 get
908
909data RevocationCode = NoReason | KeySuperseded | KeyCompromised | KeyRetired | UserIDInvalid | RevocationCode Word8 deriving (Show, Read, Eq)
910
911instance Enum RevocationCode where
912 toEnum 00 = NoReason
913 toEnum 01 = KeySuperseded
914 toEnum 02 = KeyCompromised
915 toEnum 03 = KeyRetired
916 toEnum 32 = UserIDInvalid
917 toEnum x = RevocationCode $ fromIntegral x
918 fromEnum NoReason = 00
919 fromEnum KeySuperseded = 01
920 fromEnum KeyCompromised = 02
921 fromEnum KeyRetired = 03
922 fromEnum UserIDInvalid = 32
923 fromEnum (RevocationCode x) = fromIntegral x
924
925instance BINARY_CLASS RevocationCode where
926 put = put . enum_to_word8
927 get = fmap enum_from_word8 get
928
929-- | A message is encoded as a list that takes the entire file
930newtype Message = Message [Packet] deriving (Show, Read, Eq)
931instance BINARY_CLASS Message where
932 put (Message xs) = mapM_ put xs
933 get = fmap Message listUntilEnd
934
935instance Monoid Message where
936 mempty = Message []
937 mappend (Message a) (Message b) = Message (a ++ b)
938
939-- | Data needed to verify a signature
940data SignatureOver =
941 DataSignature {literal::Packet, signatures_over::[Packet]} |
942 KeySignature {topkey::Packet, signatures_over::[Packet]} |
943 SubkeySignature {topkey::Packet, subkey::Packet, signatures_over::[Packet]} |
944 CertificationSignature {topkey::Packet, user_id::Packet, signatures_over::[Packet]}
945 deriving (Show, Read, Eq)
946
947-- To get the signed-over bytes
948instance BINARY_CLASS SignatureOver where
949 put (DataSignature (LiteralDataPacket {content = c}) _) =
950 putSomeByteString c
951 put (KeySignature k _) = mapM_ putSomeByteString (fingerprint_material k)
952 put (SubkeySignature k s _) = mapM_ (mapM_ putSomeByteString)
953 [fingerprint_material k, fingerprint_material s]
954 put (CertificationSignature k (UserIDPacket s) _) =
955 mapM_ (mapM_ putSomeByteString) [fingerprint_material k, [
956 B.singleton 0xB4,
957 encode ((fromIntegral $ B.length bs) :: Word32),
958 bs
959 ]]
960 where
961 bs = B.fromString s
962 put x = fail $ "Malformed signature: " ++ show x
963 get = fail "Cannot meaningfully parse bytes to be signed over."
964
965-- | Extract signed objects from a well-formatted message
966--
967-- Recurses into CompressedDataPacket
968--
969-- <http://tools.ietf.org/html/rfc4880#section-11>
970signatures :: Message -> [SignatureOver]
971signatures (Message [CompressedDataPacket _ m]) = signatures m
972signatures (Message ps) =
973 maybe (paired_sigs Nothing ps) (\p -> [DataSignature p sigs]) (find isDta ps)
974 where
975 sigs = filter isSignaturePacket ps
976 isDta (LiteralDataPacket {}) = True
977 isDta _ = False
978
979-- TODO: UserAttribute
980paired_sigs :: Maybe Packet -> [Packet] -> [SignatureOver]
981paired_sigs _ [] = []
982paired_sigs _ (p@(PublicKeyPacket {is_subkey = False}):ps) =
983 KeySignature p (takeWhile isSignaturePacket ps) :
984 paired_sigs (Just p) (dropWhile isSignaturePacket ps)
985paired_sigs _ (p@(SecretKeyPacket {is_subkey = False}):ps) =
986 KeySignature p (takeWhile isSignaturePacket ps) :
987 paired_sigs (Just p) (dropWhile isSignaturePacket ps)
988paired_sigs (Just k) (p@(PublicKeyPacket {is_subkey = True}):ps) =
989 SubkeySignature k p (takeWhile isSignaturePacket ps) :
990 paired_sigs (Just k) (dropWhile isSignaturePacket ps)
991paired_sigs (Just k) (p@(SecretKeyPacket {is_subkey = True}):ps) =
992 SubkeySignature k p (takeWhile isSignaturePacket ps) :
993 paired_sigs (Just k) (dropWhile isSignaturePacket ps)
994paired_sigs (Just k) (p@(UserIDPacket {}):ps) =
995 CertificationSignature k p (takeWhile isSignaturePacket ps) :
996 paired_sigs (Just k) (dropWhile isSignaturePacket ps)
997paired_sigs k (_:ps) = paired_sigs k ps
998
999-- | <http://tools.ietf.org/html/rfc4880#section-3.2>
1000newtype MPI = MPI Integer deriving (Show, Read, Eq, Ord)
1001instance BINARY_CLASS MPI where
1002 put (MPI i)
1003 | i >= 0 = do
1004 put (bitl :: Word16)
1005 putSomeByteString bytes
1006 | otherwise = fail $ "MPI is less than 0: " ++ show i
1007 where
1008 (bytes, bitl)
1009 | B.null bytes' = (B.singleton 0, 1)
1010 | otherwise =
1011 (bytes', (fromIntegral (B.length bytes') - 1) * 8 + sigBit)
1012
1013 sigBit = fst $ until ((==0) . snd)
1014 (first (+1) . second (`shiftR` 1)) (0,B.index bytes 0)
1015 bytes' = B.reverse $ B.unfoldr (\x ->
1016 if x == 0 then Nothing else
1017 Just (fromIntegral x, x `shiftR` 8)
1018 ) i
1019 get = do
1020 length <- fmap fromIntegral (get :: Get Word16)
1021 bytes <- getSomeByteString =<< assertProp (>0) ((length + 7) `div` 8)
1022 return (MPI (B.foldl (\a b ->
1023 a `shiftL` 8 .|. fromIntegral b) 0 bytes))
1024
1025listUntilEnd :: (BINARY_CLASS a) => Get [a]
1026listUntilEnd = do
1027 done <- isEmpty
1028 if done then return [] else do
1029 next <- get
1030 rest <- listUntilEnd
1031 return (next:rest)
1032
1033-- | <http://tools.ietf.org/html/rfc4880#section-5.2.3.1>
1034data SignatureSubpacket =
1035 SignatureCreationTimePacket Word32 |
1036 SignatureExpirationTimePacket Word32 | -- ^ seconds after CreationTime
1037 ExportableCertificationPacket Bool |
1038 TrustSignaturePacket {depth::Word8, trust::Word8} |
1039 RegularExpressionPacket String |
1040 RevocablePacket Bool |
1041 KeyExpirationTimePacket Word32 | -- ^ seconds after key CreationTime
1042 PreferredSymmetricAlgorithmsPacket [SymmetricAlgorithm] |
1043 RevocationKeyPacket {
1044 sensitive::Bool,
1045 revocation_key_algorithm::KeyAlgorithm,
1046 revocation_key_fingerprint::String
1047 } |
1048 IssuerPacket String |
1049 NotationDataPacket {
1050 human_readable::Bool,
1051 notation_name::String,
1052 notation_value::String
1053 } |
1054 PreferredHashAlgorithmsPacket [HashAlgorithm] |
1055 PreferredCompressionAlgorithmsPacket [CompressionAlgorithm] |
1056 KeyServerPreferencesPacket {keyserver_no_modify::Bool} |
1057 PreferredKeyServerPacket String |
1058 PrimaryUserIDPacket Bool |
1059 PolicyURIPacket String |
1060 KeyFlagsPacket {
1061 certify_keys::Bool,
1062 sign_data::Bool,
1063 encrypt_communication::Bool,
1064 encrypt_storage::Bool,
1065 split_key::Bool,
1066 authentication::Bool,
1067 group_key::Bool
1068 } |
1069 SignerUserIDPacket String |
1070 ReasonForRevocationPacket RevocationCode String |
1071 FeaturesPacket {supports_mdc::Bool} |
1072 SignatureTargetPacket {
1073 target_key_algorithm::KeyAlgorithm,
1074 target_hash_algorithm::HashAlgorithm,
1075 hash::B.ByteString
1076 } |
1077 EmbeddedSignaturePacket Packet |
1078 UnsupportedSignatureSubpacket Word8 B.ByteString
1079 deriving (Show, Read, Eq)
1080
1081instance BINARY_CLASS SignatureSubpacket where
1082 put p = do
1083 -- Use 5-octet-length + 1 for tag as the first packet body octet
1084 put (255 :: Word8)
1085 put (fromIntegral (B.length body) + 1 :: Word32)
1086 put tag
1087 putSomeByteString body
1088 where
1089 (body, tag) = put_signature_subpacket p
1090 get = do
1091 len <- fmap fromIntegral (get :: Get Word8)
1092 len <- case len of
1093 _ | len >= 192 && len < 255 -> do -- Two octet length
1094 second <- fmap fromIntegral (get :: Get Word8)
1095 return $ ((len - 192) `shiftL` 8) + second + 192
1096 255 -> -- Five octet length
1097 fmap fromIntegral (get :: Get Word32)
1098 _ -> -- One octet length, no furthur processing
1099 return len
1100 tag <- fmap stripCrit get :: Get Word8
1101 -- This forces the whole packet to be consumed
1102 packet <- getSomeByteString (len-1)
1103 localGet (parse_signature_subpacket tag) packet
1104 where
1105 -- TODO: Decide how to actually encode the "is critical" data
1106 -- instead of just ignoring it
1107 stripCrit tag = if tag .&. 0x80 == 0x80 then tag .&. 0x7f else tag
1108
1109put_signature_subpacket :: SignatureSubpacket -> (B.ByteString, Word8)
1110put_signature_subpacket (SignatureCreationTimePacket time) =
1111 (encode time, 2)
1112put_signature_subpacket (SignatureExpirationTimePacket time) =
1113 (encode time, 3)
1114put_signature_subpacket (ExportableCertificationPacket exportable) =
1115 (encode $ enum_to_word8 exportable, 4)
1116put_signature_subpacket (TrustSignaturePacket depth trust) =
1117 (B.concat [encode depth, encode trust], 5)
1118put_signature_subpacket (RegularExpressionPacket regex) =
1119 (B.concat [B.fromString regex, B.singleton 0], 6)
1120put_signature_subpacket (RevocablePacket exportable) =
1121 (encode $ enum_to_word8 exportable, 7)
1122put_signature_subpacket (KeyExpirationTimePacket time) =
1123 (encode time, 9)
1124put_signature_subpacket (PreferredSymmetricAlgorithmsPacket algos) =
1125 (B.concat $ map encode algos, 11)
1126put_signature_subpacket (RevocationKeyPacket sensitive kalgo fpr) =
1127 (B.concat [encode bitfield, encode kalgo, fprb], 12)
1128 where
1129 bitfield = 0x80 .|. (if sensitive then 0x40 else 0x0) :: Word8
1130 fprb = padBS 20 $ B.drop 2 $ encode (MPI fpri)
1131 fpri = fst $ head $ readHex fpr
1132put_signature_subpacket (IssuerPacket keyid) =
1133 (encode (fst $ head $ readHex $ takeFromEnd 16 keyid :: Word64), 16)
1134put_signature_subpacket (NotationDataPacket human_readable name value) =
1135 (B.concat [
1136 B.pack [flag1,0,0,0],
1137 encode (fromIntegral (B.length namebs) :: Word16),
1138 encode (fromIntegral (B.length valuebs) :: Word16),
1139 namebs,
1140 valuebs
1141 ], 20)
1142 where
1143 valuebs = B.fromString value
1144 namebs = B.fromString name
1145 flag1 = if human_readable then 0x80 else 0x0
1146put_signature_subpacket (PreferredHashAlgorithmsPacket algos) =
1147 (B.concat $ map encode algos, 21)
1148put_signature_subpacket (PreferredCompressionAlgorithmsPacket algos) =
1149 (B.concat $ map encode algos, 22)
1150put_signature_subpacket (KeyServerPreferencesPacket no_modify) =
1151 (B.singleton (if no_modify then 0x80 else 0x0), 23)
1152put_signature_subpacket (PreferredKeyServerPacket uri) =
1153 (B.fromString uri, 24)
1154put_signature_subpacket (PrimaryUserIDPacket isprimary) =
1155 (encode $ enum_to_word8 isprimary, 25)
1156put_signature_subpacket (PolicyURIPacket uri) =
1157 (B.fromString uri, 26)
1158put_signature_subpacket (KeyFlagsPacket certify sign encryptC encryptS split auth group) =
1159 (B.singleton $
1160 flag 0x01 certify .|.
1161 flag 0x02 sign .|.
1162 flag 0x04 encryptC .|.
1163 flag 0x08 encryptS .|.
1164 flag 0x10 split .|.
1165 flag 0x20 auth .|.
1166 flag 0x80 group
1167 , 27)
1168 where
1169 flag x True = x
1170 flag _ False = 0x0
1171put_signature_subpacket (SignerUserIDPacket userid) =
1172 (B.fromString userid, 28)
1173put_signature_subpacket (ReasonForRevocationPacket code string) =
1174 (B.concat [encode code, B.fromString string], 29)
1175put_signature_subpacket (FeaturesPacket supports_mdc) =
1176 (B.singleton $ if supports_mdc then 0x01 else 0x00, 30)
1177put_signature_subpacket (SignatureTargetPacket kalgo halgo hash) =
1178 (B.concat [encode kalgo, encode halgo, hash], 31)
1179put_signature_subpacket (EmbeddedSignaturePacket packet)
1180 | isSignaturePacket packet = (fst $ put_packet packet, 32)
1181 | otherwise = error $ "Tried to put non-SignaturePacket in EmbeddedSignaturePacket: " ++ show packet
1182put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
1183 (bytes, tag)
1184
1185parse_signature_subpacket :: Word8 -> Get SignatureSubpacket
1186-- SignatureCreationTimePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.4
1187parse_signature_subpacket 2 = fmap SignatureCreationTimePacket get
1188-- SignatureExpirationTimePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.10
1189parse_signature_subpacket 3 = fmap SignatureExpirationTimePacket get
1190-- ExportableCertificationPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.11
1191parse_signature_subpacket 4 =
1192 fmap (ExportableCertificationPacket . enum_from_word8) get
1193-- TrustSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.13
1194parse_signature_subpacket 5 = liftM2 TrustSignaturePacket get get
1195-- TrustSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.14
1196parse_signature_subpacket 6 = fmap
1197 (RegularExpressionPacket . B.toString . B.init) getRemainingByteString
1198-- RevocablePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.12
1199parse_signature_subpacket 7 =
1200 fmap (RevocablePacket . enum_from_word8) get
1201-- KeyExpirationTimePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.6
1202parse_signature_subpacket 9 = fmap KeyExpirationTimePacket get
1203-- PreferredSymmetricAlgorithms, http://tools.ietf.org/html/rfc4880#section-5.2.3.7
1204parse_signature_subpacket 11 =
1205 fmap PreferredSymmetricAlgorithmsPacket listUntilEnd
1206-- RevocationKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.15
1207parse_signature_subpacket 12 = do
1208 bitfield <- get :: Get Word8
1209 kalgo <- get
1210 fpr <- getSomeByteString 20
1211 -- bitfield must have bit 0x80 set, says the spec
1212 return RevocationKeyPacket {
1213 sensitive = bitfield .&. 0x40 == 0x40,
1214 revocation_key_algorithm = kalgo,
1215 revocation_key_fingerprint =
1216 pad 40 $ map toUpper $ foldr (padB `oo` showHex) "" (B.unpack fpr)
1217 }
1218 where
1219 oo = (.) . (.)
1220 padB s | odd $ length s = '0':s
1221 | otherwise = s
1222-- IssuerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.5
1223parse_signature_subpacket 16 = do
1224 keyid <- get :: Get Word64
1225 return $ IssuerPacket (pad 16 $ map toUpper $ showHex keyid "")
1226-- NotationDataPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.16
1227parse_signature_subpacket 20 = do
1228 (flag1,_,_,_) <- get4word8
1229 (m,n) <- liftM2 (,) get get :: Get (Word16,Word16)
1230 name <- fmap B.toString $ getSomeByteString $ fromIntegral m
1231 value <- fmap B.toString $ getSomeByteString $ fromIntegral n
1232 return NotationDataPacket {
1233 human_readable = flag1 .&. 0x80 == 0x80,
1234 notation_name = name,
1235 notation_value = value
1236 }
1237 where
1238 get4word8 :: Get (Word8,Word8,Word8,Word8)
1239 get4word8 = liftM4 (,,,) get get get get
1240-- PreferredHashAlgorithmsPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.8
1241parse_signature_subpacket 21 =
1242 fmap PreferredHashAlgorithmsPacket listUntilEnd
1243-- PreferredCompressionAlgorithmsPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.9
1244parse_signature_subpacket 22 =
1245 fmap PreferredCompressionAlgorithmsPacket listUntilEnd
1246-- KeyServerPreferencesPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.17
1247parse_signature_subpacket 23 = do
1248 empty <- isEmpty
1249 flag1 <- if empty then return 0 else get :: Get Word8
1250 return KeyServerPreferencesPacket {
1251 keyserver_no_modify = flag1 .&. 0x80 == 0x80
1252 }
1253-- PreferredKeyServerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.18
1254parse_signature_subpacket 24 =
1255 fmap (PreferredKeyServerPacket . B.toString) getRemainingByteString
1256-- PrimaryUserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.19
1257parse_signature_subpacket 25 =
1258 fmap (PrimaryUserIDPacket . enum_from_word8) get
1259-- PolicyURIPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.20
1260parse_signature_subpacket 26 =
1261 fmap (PolicyURIPacket . B.toString) getRemainingByteString
1262-- KeyFlagsPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.21
1263parse_signature_subpacket 27 = do
1264 empty <- isEmpty
1265 flag1 <- if empty then return 0 else get :: Get Word8
1266 return KeyFlagsPacket {
1267 certify_keys = flag1 .&. 0x01 == 0x01,
1268 sign_data = flag1 .&. 0x02 == 0x02,
1269 encrypt_communication = flag1 .&. 0x04 == 0x04,
1270 encrypt_storage = flag1 .&. 0x08 == 0x08,
1271 split_key = flag1 .&. 0x10 == 0x10,
1272 authentication = flag1 .&. 0x20 == 0x20,
1273 group_key = flag1 .&. 0x80 == 0x80
1274 }
1275-- SignerUserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.22
1276parse_signature_subpacket 28 =
1277 fmap (SignerUserIDPacket . B.toString) getRemainingByteString
1278-- ReasonForRevocationPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.23
1279parse_signature_subpacket 29 = liftM2 ReasonForRevocationPacket get
1280 (fmap B.toString getRemainingByteString)
1281-- FeaturesPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.24
1282parse_signature_subpacket 30 = do
1283 empty <- isEmpty
1284 flag1 <- if empty then return 0 else get :: Get Word8
1285 return FeaturesPacket {
1286 supports_mdc = flag1 .&. 0x01 == 0x01
1287 }
1288-- SignatureTargetPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.25
1289parse_signature_subpacket 31 =
1290 liftM3 SignatureTargetPacket get get getRemainingByteString
1291-- EmbeddedSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.26
1292parse_signature_subpacket 32 =
1293 fmap EmbeddedSignaturePacket (parse_packet 2)
1294-- Represent unsupported packets as their tag and literal bytes
1295parse_signature_subpacket tag =
1296 fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
1297
1298-- | Find the keyid that issued a SignaturePacket
1299signature_issuer :: Packet -> Maybe String
1300signature_issuer (SignaturePacket {hashed_subpackets = hashed,
1301 unhashed_subpackets = unhashed}) =
1302 case issuers of
1303 IssuerPacket issuer : _ -> Just issuer
1304 _ -> Nothing
1305 where
1306 issuers = filter isIssuer hashed ++ filter isIssuer unhashed
1307 isIssuer (IssuerPacket {}) = True
1308 isIssuer _ = False
1309signature_issuer _ = Nothing
1310
1311-- | Find a key with the given Fingerprint/KeyID
1312find_key ::
1313 (Packet -> String) -- ^ Extract Fingerprint/KeyID from packet
1314 -> Message -- ^ List of packets (some of which are keys)
1315 -> String -- ^ Fingerprint/KeyID to search for
1316 -> Maybe Packet
1317find_key fpr (Message (x@(PublicKeyPacket {}):xs)) keyid =
1318 find_key' fpr x xs keyid
1319find_key fpr (Message (x@(SecretKeyPacket {}):xs)) keyid =
1320 find_key' fpr x xs keyid
1321find_key fpr (Message (_:xs)) keyid =
1322 find_key fpr (Message xs) keyid
1323find_key _ _ _ = Nothing
1324
1325find_key' :: (Packet -> String) -> Packet -> [Packet] -> String -> Maybe Packet
1326find_key' fpr x xs keyid
1327 | thisid == keyid = Just x
1328 | otherwise = find_key fpr (Message xs) keyid
1329 where
1330 thisid = takeFromEnd (length keyid) (fpr x)
1331
1332takeFromEnd :: Int -> String -> String
1333takeFromEnd l = reverse . take l . reverse
1334
1335-- | SignaturePacket smart constructor
1336--
1337-- <http://tools.ietf.org/html/rfc4880#section-5.2>
1338signaturePacket ::
1339 Word8 -- ^ Signature version (probably 4)
1340 -> Word8 -- ^ Signature type <http://tools.ietf.org/html/rfc4880#section-5.2.1>
1341 -> KeyAlgorithm
1342 -> HashAlgorithm
1343 -> [SignatureSubpacket] -- ^ Hashed subpackets (these get signed)
1344 -> [SignatureSubpacket] -- ^ Unhashed subpackets (these do not get signed)
1345 -> Word16 -- ^ Left 16 bits of the signed hash value
1346 -> [MPI] -- ^ The raw MPIs of the signature
1347 -> Packet
1348signaturePacket version signature_type key_algorithm hash_algorithm hashed_subpackets unhashed_subpackets hash_head signature =
1349 let p = SignaturePacket {
1350 version = version,
1351 signature_type = signature_type,
1352 key_algorithm = key_algorithm,
1353 hash_algorithm = hash_algorithm,
1354 hashed_subpackets = hashed_subpackets,
1355 unhashed_subpackets = unhashed_subpackets,
1356 hash_head = hash_head,
1357 signature = signature,
1358 trailer = undefined
1359 } in p { trailer = calculate_signature_trailer p }
1360
1361isSignaturePacket :: Packet -> Bool
1362isSignaturePacket (SignaturePacket {}) = True
1363isSignaturePacket _ = False
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 @@
1module Data.OpenPGP.Internal where
2
3import Data.Word
4import Data.Bits
5
6decode_s2k_count :: Word8 -> Word32
7decode_s2k_count c = (16 + (fromIntegral c .&. 15)) `shiftL`
8 ((fromIntegral c `shiftR` 4) + 6)
9
10encode_s2k_count :: Word32 -> Word8
11encode_s2k_count iterations
12 | iterations >= 65011712 = 255
13 | decode_s2k_count result < iterations = result+1
14 | otherwise = result
15 where
16 result = fromIntegral $ (fromIntegral c `shiftL` 4) .|. (count - 16)
17 (count, c) = encode_s2k_count' (iterations `shiftR` 6) (0::Word8)
18 encode_s2k_count' count c
19 | count < 32 = (count, c)
20 | otherwise = encode_s2k_count' (count `shiftR` 1) (c+1)
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..1311fcd
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,76 @@
1ifdef CEREAL
2GHCFLAGS=-Wall -O2 -DCEREAL -fno-warn-name-shadowing -XHaskell98
3else
4GHCFLAGS=-Wall -O2 -fno-warn-name-shadowing -XHaskell98
5endif
6
7ifdef TRAVIS
8GHCFLAGS+=-Werror
9endif
10
11HLINTFLAGS=-u -XHaskell98 -XCPP -i 'Use camelCase' -i 'Use String' -i 'Use string literal' -i 'Use list comprehension'
12VERSION=0.6.1
13
14.PHONY: all clean doc install debian test
15
16all: test report.html doc dist/build/libHSopenpgp-$(VERSION).a dist/openpgp-$(VERSION).tar.gz
17
18install: dist/build/libHSopenpgp-$(VERSION).a
19 cabal install
20
21debian: debian/control
22
23test: tests/suite
24 tests/suite
25
26tests/suite: tests/suite.hs Data/OpenPGP.hs Data/OpenPGP/Internal.hs Data/OpenPGP/Arbitrary.hs
27 ghc --make $(GHCFLAGS) -o $@ $^
28
29Data/OpenPGP/Arbitrary.hs: Data/OpenPGP.hs Arbitrary.patch
30 derive -d Arbitrary -m Data.OpenPGP.Arbitrary -iData.OpenPGP -iData.OpenPGP.Internal -iTest.QuickCheck -iTest.QuickCheck.Instances -iData.Word -o $@ Data/OpenPGP.hs
31 patch $@ Arbitrary.patch
32
33report.html: tests/suite.hs Data/OpenPGP.hs Data/OpenPGP/Internal.hs
34 -hlint $(HLINTFLAGS) --report $^
35
36doc: dist/doc/html/openpgp/index.html README
37
38README: openpgp.cabal
39 tail -n+$$(( `grep -n ^description: $^ | head -n1 | cut -d: -f1` + 1 )) $^ > .$@
40 head -n+$$(( `grep -n ^$$ .$@ | head -n1 | cut -d: -f1` - 1 )) .$@ > $@
41 -printf ',s/ //g\n,s/^.$$//g\nw\nq\n' | ed $@
42 $(RM) .$@
43
44# XXX: Is there a way to make this just pass through $(GHCFLAGS)
45ifdef CEREAL
46dist/doc/html/openpgp/index.html: dist/setup-config Data/OpenPGP.hs Data/OpenPGP/Internal.hs
47 cabal haddock --hyperlink-source --haddock-options="--optghc=-DCEREAL"
48else
49dist/doc/html/openpgp/index.html: dist/setup-config Data/OpenPGP.hs Data/OpenPGP/Internal.hs
50 cabal haddock --hyperlink-source
51endif
52
53ifdef CEREAL
54dist/setup-config: openpgp.cabal
55 -printf '1c\nname: openpgp-cereal\n.\n,s/binary >= 0.6.4.0,$$/cereal,/g\nw\nq\n' | ed openpgp.cabal
56 cabal configure --enable-tests
57else
58dist/setup-config: openpgp.cabal
59 cabal configure --enable-tests
60endif
61
62clean:
63 -printf '1c\nname: openpgp\n.\n,s/cereal,$$/binary >= 0.6.4.0,/g\nw\nq\n' | ed openpgp.cabal
64 find -name '*.o' -o -name '*.hi' | xargs $(RM)
65 $(RM) sign verify keygen tests/suite Data/OpenPGP/Arbitrary.hs
66 $(RM) -r dist dist-ghc
67
68debian/control: openpgp.cabal
69 cabal-debian --update-debianization
70
71dist/build/libHSopenpgp-$(VERSION).a: openpgp.cabal dist/setup-config Data/OpenPGP.hs Data/OpenPGP/Internal.hs
72 cabal build --ghc-options="$(GHCFLAGS)"
73
74dist/openpgp-$(VERSION).tar.gz: openpgp.cabal dist/setup-config README Data/OpenPGP.hs Data/OpenPGP/Internal.hs
75 cabal check
76 cabal sdist
diff --git a/README b/README
new file mode 100644
index 0000000..ddad150
--- /dev/null
+++ b/README
@@ -0,0 +1,19 @@
1This is an OpenPGP library inspired by my work on OpenPGP libraries in
2Ruby <https://github.com/singpolyma/openpgp>,
3PHP <http://github.com/singpolyma/openpgp-php>,
4and Python <https://github.com/singpolyma/OpenPGP-Python>.
5
6It defines types to represent OpenPGP messages as a series of packets
7and then defines instances of Data.Binary for each to facilitate
8encoding/decoding.
9
10For performing cryptography, see
11<http://hackage.haskell.org/package/openpgp-crypto-api> or
12<http://hackage.haskell.org/package/openpgp-Crypto>
13
14For dealing with ASCII armor, see
15<http://hackage.haskell.org/package/openpgp-asciiarmor>
16
17It is intended that you use qualified imports with this library.
18
19> import qualified Data.OpenPGP as OpenPGP
diff --git a/debian/changelog b/debian/changelog
deleted file mode 100644
index f4f6a5c..0000000
--- a/debian/changelog
+++ /dev/null
@@ -1,5 +0,0 @@
1haskell-openpgp-util (0.1) unstable; urgency=low
2
3 * Debianization generated by cabal-debian
4
5 -- Joe Crayne <joe@jerkface.net> Tue, 28 Jan 2014 00:08:36 -0500
diff --git a/debian/compat b/debian/compat
deleted file mode 100644
index ec63514..0000000
--- a/debian/compat
+++ /dev/null
@@ -1 +0,0 @@
19
diff --git a/debian/control b/debian/control
deleted file mode 100644
index a8eeed0..0000000
--- a/debian/control
+++ /dev/null
@@ -1,138 +0,0 @@
1Source: haskell-openpgp-util
2Maintainer: Joe Crayne <joe@jerkface.net>
3Priority: optional
4Section: haskell
5Build-Depends: debhelper (>= 7.0)
6 , haskell-devscripts (>= 0.8)
7 , cdbs
8 , ghc
9 , ghc-prof
10 , libghc-base-dev (>= 4) | ghc
11 , libghc-base-dev (<< 5) | ghc
12 , libghc-base-prof (>= 4) | ghc-prof
13 , libghc-base-prof (<< 5) | ghc-prof
14 , libghc-binary-dev (>= 0.5.1.0) | ghc
15 , libghc-binary-prof (>= 0.5.1.0) | ghc-prof
16 , libghc-byteable-dev
17 , libghc-byteable-prof
18 , libghc-bytestring-dev | ghc
19 , libghc-bytestring-prof | ghc-prof
20 , libghc-cipher-aes-dev (>= 0.2.5)
21 , libghc-cipher-aes-prof (>= 0.2.5)
22 , libghc-cipher-blowfish-dev
23 , libghc-cipher-blowfish-prof
24 , libghc-cipher-cast5-dev
25 , libghc-cipher-cast5-prof
26 , libghc-crypto-cipher-types-dev (>= 0.0.7)
27 , libghc-crypto-cipher-types-prof (>= 0.0.7)
28 , libghc-crypto-pubkey-dev (>= 0.2.3)
29 , libghc-crypto-pubkey-prof (>= 0.2.3)
30 , libghc-crypto-pubkey-types-dev (>= 0.4.1)
31 , libghc-crypto-pubkey-types-prof (>= 0.4.1)
32 , libghc-crypto-random-dev (>= 0.0.7)
33 , libghc-crypto-random-prof (>= 0.0.7)
34 , libghc-cryptohash-dev (>= 0.7.5)
35 , libghc-cryptohash-prof (>= 0.7.5)
36 , libghc-openpgp-dev (>= 0.4)
37 , libghc-openpgp-prof (>= 0.4)
38 , libghc-time-dev (>= 1.4) | ghc
39 , libghc-time-prof (>= 1.4) | ghc-prof
40 , libghc-transformers-dev
41 , libghc-transformers-prof
42Build-Depends-Indep: ghc-doc
43 , libghc-base-doc (>= 4) | ghc-doc
44 , libghc-base-doc (<< 5) | ghc-doc
45 , libghc-binary-doc (>= 0.5.1.0) | ghc-doc
46 , libghc-byteable-doc
47 , libghc-bytestring-doc | ghc-doc
48 , libghc-cipher-aes-doc (>= 0.2.5)
49 , libghc-cipher-blowfish-doc
50 , libghc-cipher-cast5-doc
51 , libghc-crypto-cipher-types-doc (>= 0.0.7)
52 , libghc-crypto-pubkey-doc (>= 0.2.3)
53 , libghc-crypto-pubkey-types-doc (>= 0.4.1)
54 , libghc-crypto-random-doc (>= 0.0.7)
55 , libghc-cryptohash-doc (>= 0.7.5)
56 , libghc-openpgp-doc (>= 0.4)
57 , libghc-time-doc (>= 1.4) | ghc-doc
58 , libghc-transformers-doc
59
60Package: libghc-openpgp-util-dev
61Architecture: any
62Depends: ${shlibs:Depends}
63 , ${haskell:Depends}
64 , ${misc:Depends}
65Recommends: ${haskell:Recommends}
66Suggests: ${haskell:Suggests}
67Conflicts: ${haskell:Conflicts}
68Provides: ${haskell:Provides}
69Replaces: ${haskell:Replaces}
70Description: Implement cryptography for OpenPGP using libraries compatible with Vincent Hanquez's Haskell Crypto Platform
71 Fingerprint generation, signature generation, signature verification,
72 and secret key decryption for OpenPGP Packets.
73 .
74 It is indended to be used with <http://hackage.haskell.org/package/openpgp>
75 .
76 It is intended that you use qualified imports with this library.
77 .
78 > import qualified Data.OpenPGP.Util as OpenPGP
79 .
80 Author: Stephen Paul Weber <singpolyma@singpolyma.net>
81 Upstream-Maintainer: Joe Crayne <joe@jerkface.net>
82 .
83 This package provides a library for the Haskell programming language.
84 See http:///www.haskell.org/ for more information on Haskell.
85
86Package: libghc-openpgp-util-prof
87Architecture: any
88Depends: ${shlibs:Depends}
89 , ${haskell:Depends}
90 , ${misc:Depends}
91Recommends: ${haskell:Recommends}
92Suggests: ${haskell:Suggests}
93Conflicts: ${haskell:Conflicts}
94Provides: ${haskell:Provides}
95Replaces: ${haskell:Replaces}
96Description: Implement cryptography for OpenPGP using libraries compatible with Vincent Hanquez's Haskell Crypto Platform
97 Fingerprint generation, signature generation, signature verification,
98 and secret key decryption for OpenPGP Packets.
99 .
100 It is indended to be used with <http://hackage.haskell.org/package/openpgp>
101 .
102 It is intended that you use qualified imports with this library.
103 .
104 > import qualified Data.OpenPGP.Util as OpenPGP
105 .
106 Author: Stephen Paul Weber <singpolyma@singpolyma.net>
107 Upstream-Maintainer: Joe Crayne <joe@jerkface.net>
108 .
109 This package provides a library for the Haskell programming language, compiled
110 for profiling. See http:///www.haskell.org/ for more information on Haskell.
111
112Package: libghc-openpgp-util-doc
113Architecture: all
114Section: doc
115Depends: ${shlibs:Depends}
116 , ${haskell:Depends}
117 , ${misc:Depends}
118Recommends: ${haskell:Recommends}
119Suggests: ${haskell:Suggests}
120Conflicts: ${haskell:Conflicts}
121Provides: ${haskell:Provides}
122Replaces: ${haskell:Replaces}
123Description: Implement cryptography for OpenPGP using libraries compatible with Vincent Hanquez's Haskell Crypto Platform
124 Fingerprint generation, signature generation, signature verification,
125 and secret key decryption for OpenPGP Packets.
126 .
127 It is indended to be used with <http://hackage.haskell.org/package/openpgp>
128 .
129 It is intended that you use qualified imports with this library.
130 .
131 > import qualified Data.OpenPGP.Util as OpenPGP
132 .
133 Author: Stephen Paul Weber <singpolyma@singpolyma.net>
134 Upstream-Maintainer: Joe Crayne <joe@jerkface.net>
135 .
136 This package provides the documentation for a library for the Haskell
137 programming language.
138 See http:///www.haskell.org/ for more information on Haskell.
diff --git a/debian/copyright b/debian/copyright
deleted file mode 100644
index d84afa6..0000000
--- a/debian/copyright
+++ /dev/null
@@ -1,31 +0,0 @@
1Copyright © 2013, Joseph Crayne <joe@jerkface.net>
2
3Permission to use, copy, modify, and/or distribute this software for any
4purpose with or without fee is hereby granted, provided that the above
5copyright notice and this permission notice appear in all copies.
6
7THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
8WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
9MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
10ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
11WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
12ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
13OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
14
15
16This software was derived from the OpenPGP-CryptoAPI library which was
17distributed with the following message:
18
19Copyright © 2012, Stephen Paul Weber <singpolyma.net>
20
21Permission to use, copy, modify, and/or distribute this software for any
22purpose with or without fee is hereby granted, provided that the above
23copyright notice and this permission notice appear in all copies.
24
25THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
26WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
27MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
28ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
29WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
30ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
31OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
diff --git a/debian/rules b/debian/rules
deleted file mode 100755
index 924ff72..0000000
--- a/debian/rules
+++ /dev/null
@@ -1,7 +0,0 @@
1#!/usr/bin/make -f
2
3DEB_CABAL_PACKAGE = openpgp-util
4
5include /usr/share/cdbs/1/rules/debhelper.mk
6include /usr/share/cdbs/1/class/hlibrary.mk
7
diff --git a/openpgp.cabal b/openpgp.cabal
new file mode 100644
index 0000000..c23e4ad
--- /dev/null
+++ b/openpgp.cabal
@@ -0,0 +1,168 @@
1name: openpgp
2version: 0.6.1.1
3cabal-version: >= 1.8
4license: OtherLicense
5license-file: COPYING
6category: Data
7copyright: © 2011-2012 Stephen Paul Weber
8author: Stephen Paul Weber <singpolyma@singpolyma.net>
9maintainer: Stephen Paul Weber <singpolyma@singpolyma.net>
10stability: experimental
11tested-with: GHC == 7.0.3
12synopsis: Implementation of the OpenPGP message format
13homepage: http://github.com/singpolyma/OpenPGP-Haskell
14bug-reports: http://github.com/singpolyma/OpenPGP-Haskell/issues
15build-type: Simple
16description:
17 This is an OpenPGP library inspired by my work on OpenPGP libraries in
18 Ruby <https://github.com/singpolyma/openpgp>,
19 PHP <http://github.com/singpolyma/openpgp-php>,
20 and Python <https://github.com/singpolyma/OpenPGP-Python>.
21 .
22 It defines types to represent OpenPGP messages as a series of packets
23 and then defines instances of Data.Binary for each to facilitate
24 encoding/decoding.
25 .
26 For performing cryptography, see
27 <http://hackage.haskell.org/package/openpgp-crypto-api> or
28 <http://hackage.haskell.org/package/openpgp-Crypto>
29 .
30 For dealing with ASCII armor, see
31 <http://hackage.haskell.org/package/openpgp-asciiarmor>
32 .
33 It is intended that you use qualified imports with this library.
34 .
35 > import qualified Data.OpenPGP as OpenPGP
36
37extra-source-files:
38 README,
39 tests/suite.hs,
40 tests/data/000001-006.public_key,
41 tests/data/000002-013.user_id,
42 tests/data/000003-002.sig,
43 tests/data/000004-012.ring_trust,
44 tests/data/000005-002.sig,
45 tests/data/000006-012.ring_trust,
46 tests/data/000007-002.sig,
47 tests/data/000008-012.ring_trust,
48 tests/data/000009-002.sig,
49 tests/data/000010-012.ring_trust,
50 tests/data/000011-002.sig,
51 tests/data/000012-012.ring_trust,
52 tests/data/000013-014.public_subkey,
53 tests/data/000014-002.sig,
54 tests/data/000015-012.ring_trust,
55 tests/data/000016-006.public_key,
56 tests/data/000017-002.sig,
57 tests/data/000018-012.ring_trust,
58 tests/data/000019-013.user_id,
59 tests/data/000020-002.sig,
60 tests/data/000021-012.ring_trust,
61 tests/data/000022-002.sig,
62 tests/data/000023-012.ring_trust,
63 tests/data/000024-014.public_subkey,
64 tests/data/000025-002.sig,
65 tests/data/000026-012.ring_trust,
66 tests/data/000027-006.public_key,
67 tests/data/000028-002.sig,
68 tests/data/000029-012.ring_trust,
69 tests/data/000030-013.user_id,
70 tests/data/000031-002.sig,
71 tests/data/000032-012.ring_trust,
72 tests/data/000033-002.sig,
73 tests/data/000034-012.ring_trust,
74 tests/data/000035-006.public_key,
75 tests/data/000036-013.user_id,
76 tests/data/000037-002.sig,
77 tests/data/000038-012.ring_trust,
78 tests/data/000039-002.sig,
79 tests/data/000040-012.ring_trust,
80 tests/data/000041-017.attribute,
81 tests/data/000042-002.sig,
82 tests/data/000043-012.ring_trust,
83 tests/data/000044-014.public_subkey,
84 tests/data/000045-002.sig,
85 tests/data/000046-012.ring_trust,
86 tests/data/000047-005.secret_key,
87 tests/data/000048-013.user_id,
88 tests/data/000049-002.sig,
89 tests/data/000050-012.ring_trust,
90 tests/data/000051-007.secret_subkey,
91 tests/data/000052-002.sig,
92 tests/data/000053-012.ring_trust,
93 tests/data/000054-005.secret_key,
94 tests/data/000055-002.sig,
95 tests/data/000056-012.ring_trust,
96 tests/data/000057-013.user_id,
97 tests/data/000058-002.sig,
98 tests/data/000059-012.ring_trust,
99 tests/data/000060-007.secret_subkey,
100 tests/data/000061-002.sig,
101 tests/data/000062-012.ring_trust,
102 tests/data/000063-005.secret_key,
103 tests/data/000064-002.sig,
104 tests/data/000065-012.ring_trust,
105 tests/data/000066-013.user_id,
106 tests/data/000067-002.sig,
107 tests/data/000068-012.ring_trust,
108 tests/data/000069-005.secret_key,
109 tests/data/000070-013.user_id,
110 tests/data/000071-002.sig,
111 tests/data/000072-012.ring_trust,
112 tests/data/000073-017.attribute,
113 tests/data/000074-002.sig,
114 tests/data/000075-012.ring_trust,
115 tests/data/000076-007.secret_subkey,
116 tests/data/000077-002.sig,
117 tests/data/000078-012.ring_trust,
118 tests/data/002182-002.sig,
119 tests/data/compressedsig-bzip2.gpg,
120 tests/data/compressedsig.gpg,
121 tests/data/compressedsig-zlib.gpg,
122 tests/data/onepass_sig,
123 tests/data/symmetrically_encrypted,
124 tests/data/pubring.gpg,
125 tests/data/secring.gpg,
126 tests/data/uncompressed-ops-dsa.gpg,
127 tests/data/uncompressed-ops-dsa-sha384.txt.gpg,
128 tests/data/uncompressed-ops-rsa.gpg
129
130library
131 exposed-modules:
132 Data.OpenPGP
133
134 other-modules:
135 Data.OpenPGP.Internal
136
137 build-depends:
138 base == 4.*,
139 bytestring,
140 utf8-string,
141 binary >= 0.5.1.0,
142 zlib,
143 bzlib
144
145test-suite tests
146 type: exitcode-stdio-1.0
147 main-is: tests/suite.hs
148
149 other-modules:
150 Data.OpenPGP.Arbitrary
151
152 build-depends:
153 base == 4.*,
154 bytestring,
155 utf8-string,
156 binary >= 0.6.4.0,
157 zlib,
158 bzlib,
159 HUnit,
160 QuickCheck >= 2.4.1.1,
161 quickcheck-instances,
162 test-framework,
163 test-framework-hunit,
164 test-framework-quickcheck2
165
166source-repository head
167 type: git
168 location: git://github.com/singpolyma/OpenPGP-Haskell.git
diff --git a/tests/data/000001-006.public_key b/tests/data/000001-006.public_key
new file mode 100644
index 0000000..7cbab17
--- /dev/null
+++ b/tests/data/000001-006.public_key
Binary files differ
diff --git a/tests/data/000002-013.user_id b/tests/data/000002-013.user_id
new file mode 100644
index 0000000..759449b
--- /dev/null
+++ b/tests/data/000002-013.user_id
@@ -0,0 +1 @@
´$Test Key (RSA) <testkey@example.org> \ No newline at end of file
diff --git a/tests/data/000003-002.sig b/tests/data/000003-002.sig
new file mode 100644
index 0000000..1e0656d
--- /dev/null
+++ b/tests/data/000003-002.sig
Binary files differ
diff --git a/tests/data/000004-012.ring_trust b/tests/data/000004-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000004-012.ring_trust
Binary files differ
diff --git a/tests/data/000005-002.sig b/tests/data/000005-002.sig
new file mode 100644
index 0000000..108b998
--- /dev/null
+++ b/tests/data/000005-002.sig
Binary files differ
diff --git a/tests/data/000006-012.ring_trust b/tests/data/000006-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000006-012.ring_trust
Binary files differ
diff --git a/tests/data/000007-002.sig b/tests/data/000007-002.sig
new file mode 100644
index 0000000..14276d0
--- /dev/null
+++ b/tests/data/000007-002.sig
Binary files differ
diff --git a/tests/data/000008-012.ring_trust b/tests/data/000008-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000008-012.ring_trust
Binary files differ
diff --git a/tests/data/000009-002.sig b/tests/data/000009-002.sig
new file mode 100644
index 0000000..4a282dd
--- /dev/null
+++ b/tests/data/000009-002.sig
Binary files differ
diff --git a/tests/data/000010-012.ring_trust b/tests/data/000010-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000010-012.ring_trust
Binary files differ
diff --git a/tests/data/000011-002.sig b/tests/data/000011-002.sig
new file mode 100644
index 0000000..cae1b73
--- /dev/null
+++ b/tests/data/000011-002.sig
Binary files differ
diff --git a/tests/data/000012-012.ring_trust b/tests/data/000012-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000012-012.ring_trust
Binary files differ
diff --git a/tests/data/000013-014.public_subkey b/tests/data/000013-014.public_subkey
new file mode 100644
index 0000000..08676d0
--- /dev/null
+++ b/tests/data/000013-014.public_subkey
Binary files differ
diff --git a/tests/data/000014-002.sig b/tests/data/000014-002.sig
new file mode 100644
index 0000000..dd60180
--- /dev/null
+++ b/tests/data/000014-002.sig
Binary files differ
diff --git a/tests/data/000015-012.ring_trust b/tests/data/000015-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000015-012.ring_trust
Binary files differ
diff --git a/tests/data/000016-006.public_key b/tests/data/000016-006.public_key
new file mode 100644
index 0000000..c9dccbf
--- /dev/null
+++ b/tests/data/000016-006.public_key
Binary files differ
diff --git a/tests/data/000017-002.sig b/tests/data/000017-002.sig
new file mode 100644
index 0000000..e734505
--- /dev/null
+++ b/tests/data/000017-002.sig
Binary files differ
diff --git a/tests/data/000018-012.ring_trust b/tests/data/000018-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000018-012.ring_trust
Binary files differ
diff --git a/tests/data/000019-013.user_id b/tests/data/000019-013.user_id
new file mode 100644
index 0000000..ab3f51d
--- /dev/null
+++ b/tests/data/000019-013.user_id
@@ -0,0 +1 @@
´$Test Key (DSA) <testkey@example.com> \ No newline at end of file
diff --git a/tests/data/000020-002.sig b/tests/data/000020-002.sig
new file mode 100644
index 0000000..8588489
--- /dev/null
+++ b/tests/data/000020-002.sig
Binary files differ
diff --git a/tests/data/000021-012.ring_trust b/tests/data/000021-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000021-012.ring_trust
Binary files differ
diff --git a/tests/data/000022-002.sig b/tests/data/000022-002.sig
new file mode 100644
index 0000000..fefcb5f
--- /dev/null
+++ b/tests/data/000022-002.sig
Binary files differ
diff --git a/tests/data/000023-012.ring_trust b/tests/data/000023-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000023-012.ring_trust
Binary files differ
diff --git a/tests/data/000024-014.public_subkey b/tests/data/000024-014.public_subkey
new file mode 100644
index 0000000..2e8deea
--- /dev/null
+++ b/tests/data/000024-014.public_subkey
Binary files differ
diff --git a/tests/data/000025-002.sig b/tests/data/000025-002.sig
new file mode 100644
index 0000000..a3eea0a
--- /dev/null
+++ b/tests/data/000025-002.sig
Binary files differ
diff --git a/tests/data/000026-012.ring_trust b/tests/data/000026-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000026-012.ring_trust
Binary files differ
diff --git a/tests/data/000027-006.public_key b/tests/data/000027-006.public_key
new file mode 100644
index 0000000..5817e00
--- /dev/null
+++ b/tests/data/000027-006.public_key
Binary files differ
diff --git a/tests/data/000028-002.sig b/tests/data/000028-002.sig
new file mode 100644
index 0000000..5194b78
--- /dev/null
+++ b/tests/data/000028-002.sig
Binary files differ
diff --git a/tests/data/000029-012.ring_trust b/tests/data/000029-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000029-012.ring_trust
Binary files differ
diff --git a/tests/data/000030-013.user_id b/tests/data/000030-013.user_id
new file mode 100644
index 0000000..fb3f49e
--- /dev/null
+++ b/tests/data/000030-013.user_id
@@ -0,0 +1 @@
´+Test Key (DSA sign-only) <test@example.net> \ No newline at end of file
diff --git a/tests/data/000031-002.sig b/tests/data/000031-002.sig
new file mode 100644
index 0000000..f69f687
--- /dev/null
+++ b/tests/data/000031-002.sig
Binary files differ
diff --git a/tests/data/000032-012.ring_trust b/tests/data/000032-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000032-012.ring_trust
Binary files differ
diff --git a/tests/data/000033-002.sig b/tests/data/000033-002.sig
new file mode 100644
index 0000000..2bb55d4
--- /dev/null
+++ b/tests/data/000033-002.sig
Binary files differ
diff --git a/tests/data/000034-012.ring_trust b/tests/data/000034-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000034-012.ring_trust
Binary files differ
diff --git a/tests/data/000035-006.public_key b/tests/data/000035-006.public_key
new file mode 100644
index 0000000..5980638
--- /dev/null
+++ b/tests/data/000035-006.public_key
Binary files differ
diff --git a/tests/data/000036-013.user_id b/tests/data/000036-013.user_id
new file mode 100644
index 0000000..5d0d46e
--- /dev/null
+++ b/tests/data/000036-013.user_id
@@ -0,0 +1 @@
´.Test Key (RSA sign-only) <testkey@example.net> \ No newline at end of file
diff --git a/tests/data/000037-002.sig b/tests/data/000037-002.sig
new file mode 100644
index 0000000..833b563
--- /dev/null
+++ b/tests/data/000037-002.sig
Binary files differ
diff --git a/tests/data/000038-012.ring_trust b/tests/data/000038-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000038-012.ring_trust
Binary files differ
diff --git a/tests/data/000039-002.sig b/tests/data/000039-002.sig
new file mode 100644
index 0000000..89c34fa
--- /dev/null
+++ b/tests/data/000039-002.sig
Binary files differ
diff --git a/tests/data/000040-012.ring_trust b/tests/data/000040-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000040-012.ring_trust
Binary files differ
diff --git a/tests/data/000041-017.attribute b/tests/data/000041-017.attribute
new file mode 100644
index 0000000..a21a82f
--- /dev/null
+++ b/tests/data/000041-017.attribute
Binary files differ
diff --git a/tests/data/000042-002.sig b/tests/data/000042-002.sig
new file mode 100644
index 0000000..fc6267f
--- /dev/null
+++ b/tests/data/000042-002.sig
Binary files differ
diff --git a/tests/data/000043-012.ring_trust b/tests/data/000043-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000043-012.ring_trust
Binary files differ
diff --git a/tests/data/000044-014.public_subkey b/tests/data/000044-014.public_subkey
new file mode 100644
index 0000000..06bf50e
--- /dev/null
+++ b/tests/data/000044-014.public_subkey
Binary files differ
diff --git a/tests/data/000045-002.sig b/tests/data/000045-002.sig
new file mode 100644
index 0000000..336eb0f
--- /dev/null
+++ b/tests/data/000045-002.sig
Binary files differ
diff --git a/tests/data/000046-012.ring_trust b/tests/data/000046-012.ring_trust
new file mode 100644
index 0000000..ffa57e5
--- /dev/null
+++ b/tests/data/000046-012.ring_trust
Binary files differ
diff --git a/tests/data/000047-005.secret_key b/tests/data/000047-005.secret_key
new file mode 100644
index 0000000..77b5d42
--- /dev/null
+++ b/tests/data/000047-005.secret_key
Binary files differ
diff --git a/tests/data/000048-013.user_id b/tests/data/000048-013.user_id
new file mode 100644
index 0000000..759449b
--- /dev/null
+++ b/tests/data/000048-013.user_id
@@ -0,0 +1 @@
´$Test Key (RSA) <testkey@example.org> \ No newline at end of file
diff --git a/tests/data/000049-002.sig b/tests/data/000049-002.sig
new file mode 100644
index 0000000..14276d0
--- /dev/null
+++ b/tests/data/000049-002.sig
Binary files differ
diff --git a/tests/data/000050-012.ring_trust b/tests/data/000050-012.ring_trust
new file mode 100644
index 0000000..b1eeabb
--- /dev/null
+++ b/tests/data/000050-012.ring_trust
Binary files differ
diff --git a/tests/data/000051-007.secret_subkey b/tests/data/000051-007.secret_subkey
new file mode 100644
index 0000000..b4e65c9
--- /dev/null
+++ b/tests/data/000051-007.secret_subkey
Binary files differ
diff --git a/tests/data/000052-002.sig b/tests/data/000052-002.sig
new file mode 100644
index 0000000..dd60180
--- /dev/null
+++ b/tests/data/000052-002.sig
Binary files differ
diff --git a/tests/data/000053-012.ring_trust b/tests/data/000053-012.ring_trust
new file mode 100644
index 0000000..b1eeabb
--- /dev/null
+++ b/tests/data/000053-012.ring_trust
Binary files differ
diff --git a/tests/data/000054-005.secret_key b/tests/data/000054-005.secret_key
new file mode 100644
index 0000000..f153e59
--- /dev/null
+++ b/tests/data/000054-005.secret_key
Binary files differ
diff --git a/tests/data/000055-002.sig b/tests/data/000055-002.sig
new file mode 100644
index 0000000..e734505
--- /dev/null
+++ b/tests/data/000055-002.sig
Binary files differ
diff --git a/tests/data/000056-012.ring_trust b/tests/data/000056-012.ring_trust
new file mode 100644
index 0000000..b1eeabb
--- /dev/null
+++ b/tests/data/000056-012.ring_trust
Binary files differ
diff --git a/tests/data/000057-013.user_id b/tests/data/000057-013.user_id
new file mode 100644
index 0000000..ab3f51d
--- /dev/null
+++ b/tests/data/000057-013.user_id
@@ -0,0 +1 @@
´$Test Key (DSA) <testkey@example.com> \ No newline at end of file
diff --git a/tests/data/000058-002.sig b/tests/data/000058-002.sig
new file mode 100644
index 0000000..8588489
--- /dev/null
+++ b/tests/data/000058-002.sig
Binary files differ
diff --git a/tests/data/000059-012.ring_trust b/tests/data/000059-012.ring_trust
new file mode 100644
index 0000000..b1eeabb
--- /dev/null
+++ b/tests/data/000059-012.ring_trust
Binary files differ
diff --git a/tests/data/000060-007.secret_subkey b/tests/data/000060-007.secret_subkey
new file mode 100644
index 0000000..9df45f3
--- /dev/null
+++ b/tests/data/000060-007.secret_subkey
Binary files differ
diff --git a/tests/data/000061-002.sig b/tests/data/000061-002.sig
new file mode 100644
index 0000000..6394942
--- /dev/null
+++ b/tests/data/000061-002.sig
Binary files differ
diff --git a/tests/data/000062-012.ring_trust b/tests/data/000062-012.ring_trust
new file mode 100644
index 0000000..b1eeabb
--- /dev/null
+++ b/tests/data/000062-012.ring_trust
Binary files differ
diff --git a/tests/data/000063-005.secret_key b/tests/data/000063-005.secret_key
new file mode 100644
index 0000000..2f4268e
--- /dev/null
+++ b/tests/data/000063-005.secret_key
Binary files differ
diff --git a/tests/data/000064-002.sig b/tests/data/000064-002.sig
new file mode 100644
index 0000000..5194b78
--- /dev/null
+++ b/tests/data/000064-002.sig
Binary files differ
diff --git a/tests/data/000065-012.ring_trust b/tests/data/000065-012.ring_trust
new file mode 100644
index 0000000..b1eeabb
--- /dev/null
+++ b/tests/data/000065-012.ring_trust
Binary files differ
diff --git a/tests/data/000066-013.user_id b/tests/data/000066-013.user_id
new file mode 100644
index 0000000..fb3f49e
--- /dev/null
+++ b/tests/data/000066-013.user_id
@@ -0,0 +1 @@
´+Test Key (DSA sign-only) <test@example.net> \ No newline at end of file
diff --git a/tests/data/000067-002.sig b/tests/data/000067-002.sig
new file mode 100644
index 0000000..d354e79
--- /dev/null
+++ b/tests/data/000067-002.sig
Binary files differ
diff --git a/tests/data/000068-012.ring_trust b/tests/data/000068-012.ring_trust
new file mode 100644
index 0000000..b1eeabb
--- /dev/null
+++ b/tests/data/000068-012.ring_trust
Binary files differ
diff --git a/tests/data/000069-005.secret_key b/tests/data/000069-005.secret_key
new file mode 100644
index 0000000..17a2c35
--- /dev/null
+++ b/tests/data/000069-005.secret_key
Binary files differ
diff --git a/tests/data/000070-013.user_id b/tests/data/000070-013.user_id
new file mode 100644
index 0000000..5d0d46e
--- /dev/null
+++ b/tests/data/000070-013.user_id
@@ -0,0 +1 @@
´.Test Key (RSA sign-only) <testkey@example.net> \ No newline at end of file
diff --git a/tests/data/000071-002.sig b/tests/data/000071-002.sig
new file mode 100644
index 0000000..833b563
--- /dev/null
+++ b/tests/data/000071-002.sig
Binary files differ
diff --git a/tests/data/000072-012.ring_trust b/tests/data/000072-012.ring_trust
new file mode 100644
index 0000000..b1eeabb
--- /dev/null
+++ b/tests/data/000072-012.ring_trust
Binary files differ
diff --git a/tests/data/000073-017.attribute b/tests/data/000073-017.attribute
new file mode 100644
index 0000000..a21a82f
--- /dev/null
+++ b/tests/data/000073-017.attribute
Binary files differ
diff --git a/tests/data/000074-002.sig b/tests/data/000074-002.sig
new file mode 100644
index 0000000..fc6267f
--- /dev/null
+++ b/tests/data/000074-002.sig
Binary files differ
diff --git a/tests/data/000075-012.ring_trust b/tests/data/000075-012.ring_trust
new file mode 100644
index 0000000..b1eeabb
--- /dev/null
+++ b/tests/data/000075-012.ring_trust
Binary files differ
diff --git a/tests/data/000076-007.secret_subkey b/tests/data/000076-007.secret_subkey
new file mode 100644
index 0000000..b380339
--- /dev/null
+++ b/tests/data/000076-007.secret_subkey
Binary files differ
diff --git a/tests/data/000077-002.sig b/tests/data/000077-002.sig
new file mode 100644
index 0000000..336eb0f
--- /dev/null
+++ b/tests/data/000077-002.sig
Binary files differ
diff --git a/tests/data/000078-012.ring_trust b/tests/data/000078-012.ring_trust
new file mode 100644
index 0000000..b1eeabb
--- /dev/null
+++ b/tests/data/000078-012.ring_trust
Binary files differ
diff --git a/tests/data/002182-002.sig b/tests/data/002182-002.sig
new file mode 100644
index 0000000..2bc6679
--- /dev/null
+++ b/tests/data/002182-002.sig
Binary files differ
diff --git a/tests/data/3F5BBA0B0694BEB6000005-002.sig b/tests/data/3F5BBA0B0694BEB6000005-002.sig
new file mode 100644
index 0000000..94055af
--- /dev/null
+++ b/tests/data/3F5BBA0B0694BEB6000005-002.sig
Binary files differ
diff --git a/tests/data/3F5BBA0B0694BEB6000017-002.sig b/tests/data/3F5BBA0B0694BEB6000017-002.sig
new file mode 100644
index 0000000..b22f23b
--- /dev/null
+++ b/tests/data/3F5BBA0B0694BEB6000017-002.sig
Binary files differ
diff --git a/tests/data/compressedsig-bzip2.gpg b/tests/data/compressedsig-bzip2.gpg
new file mode 100644
index 0000000..87539db
--- /dev/null
+++ b/tests/data/compressedsig-bzip2.gpg
Binary files differ
diff --git a/tests/data/compressedsig-zlib.gpg b/tests/data/compressedsig-zlib.gpg
new file mode 100644
index 0000000..4da4dfa
--- /dev/null
+++ b/tests/data/compressedsig-zlib.gpg
Binary files differ
diff --git a/tests/data/compressedsig.gpg b/tests/data/compressedsig.gpg
new file mode 100644
index 0000000..dd617de
--- /dev/null
+++ b/tests/data/compressedsig.gpg
Binary files differ
diff --git a/tests/data/onepass_sig b/tests/data/onepass_sig
new file mode 100644
index 0000000..87b2895
--- /dev/null
+++ b/tests/data/onepass_sig
Binary files differ
diff --git a/tests/data/pubring.gpg b/tests/data/pubring.gpg
new file mode 100644
index 0000000..a1519ee
--- /dev/null
+++ b/tests/data/pubring.gpg
Binary files differ
diff --git a/tests/data/secring.gpg b/tests/data/secring.gpg
new file mode 100644
index 0000000..1359875
--- /dev/null
+++ b/tests/data/secring.gpg
Binary files differ
diff --git a/tests/data/symmetrically_encrypted b/tests/data/symmetrically_encrypted
new file mode 100644
index 0000000..129155a
--- /dev/null
+++ b/tests/data/symmetrically_encrypted
Binary files differ
diff --git a/tests/data/uncompressed-ops-dsa-sha384.txt.gpg b/tests/data/uncompressed-ops-dsa-sha384.txt.gpg
new file mode 100644
index 0000000..39828fc
--- /dev/null
+++ b/tests/data/uncompressed-ops-dsa-sha384.txt.gpg
Binary files differ
diff --git a/tests/data/uncompressed-ops-dsa.gpg b/tests/data/uncompressed-ops-dsa.gpg
new file mode 100644
index 0000000..97e7a26
--- /dev/null
+++ b/tests/data/uncompressed-ops-dsa.gpg
Binary files differ
diff --git a/tests/data/uncompressed-ops-rsa.gpg b/tests/data/uncompressed-ops-rsa.gpg
new file mode 100644
index 0000000..7ae453d
--- /dev/null
+++ b/tests/data/uncompressed-ops-rsa.gpg
Binary files differ
diff --git a/tests/suite.hs b/tests/suite.hs
new file mode 100644
index 0000000..cb4f4aa
--- /dev/null
+++ b/tests/suite.hs
@@ -0,0 +1,160 @@
1{-# LANGUAGE CPP #-}
2import Test.Framework (defaultMain, testGroup, Test)
3import Test.Framework.Providers.HUnit
4import Test.Framework.Providers.QuickCheck2
5import Test.HUnit hiding (Test)
6
7import Data.Word
8import Data.OpenPGP.Arbitrary ()
9import qualified Data.OpenPGP as OpenPGP
10import qualified Data.OpenPGP.Internal as OpenPGP
11
12#ifdef CEREAL
13import Data.Serialize
14import qualified Data.ByteString as B
15
16decode' :: (Serialize a) => B.ByteString -> a
17decode' x = let Right v = decode x in v
18#else
19import Data.Binary
20import qualified Data.ByteString.Lazy as B
21
22decode' :: (Binary a) => B.ByteString -> a
23decode' = decode
24#endif
25
26testSerialization :: FilePath -> Assertion
27testSerialization fp = do
28 bs <- B.readFile $ "tests/data/" ++ fp
29 nullShield "First" (decode' bs) (\firstpass ->
30 nullShield "Second" (decode' $ encode firstpass) (
31 assertEqual ("for " ++ fp) firstpass
32 )
33 )
34 where
35 nullShield pass (OpenPGP.Message []) _ =
36 assertFailure $ pass ++ " pass of " ++ fp ++ " decoded to nothing."
37 nullShield _ m f = f m
38
39prop_s2k_count :: Word8 -> Bool
40prop_s2k_count c =
41 c == OpenPGP.encode_s2k_count (OpenPGP.decode_s2k_count c)
42
43prop_MPI_serialization_loop :: OpenPGP.MPI -> Bool
44prop_MPI_serialization_loop mpi =
45 mpi == decode' (encode mpi)
46
47prop_S2K_serialization_loop :: OpenPGP.S2K -> Bool
48prop_S2K_serialization_loop s2k =
49 s2k == decode' (encode s2k)
50
51prop_SignatureSubpacket_serialization_loop :: OpenPGP.SignatureSubpacket -> Bool
52prop_SignatureSubpacket_serialization_loop packet =
53 packet == decode' (encode packet)
54
55tests :: [Test]
56tests =
57 [
58 testGroup "Serialization" [
59 testCase "000001-006.public_key" (testSerialization "000001-006.public_key"),
60 testCase "000002-013.user_id" (testSerialization "000002-013.user_id"),
61 testCase "000003-002.sig" (testSerialization "000003-002.sig"),
62 testCase "000004-012.ring_trust" (testSerialization "000004-012.ring_trust"),
63 testCase "000005-002.sig" (testSerialization "000005-002.sig"),
64 testCase "000006-012.ring_trust" (testSerialization "000006-012.ring_trust"),
65 testCase "000007-002.sig" (testSerialization "000007-002.sig"),
66 testCase "000008-012.ring_trust" (testSerialization "000008-012.ring_trust"),
67 testCase "000009-002.sig" (testSerialization "000009-002.sig"),
68 testCase "000010-012.ring_trust" (testSerialization "000010-012.ring_trust"),
69 testCase "000011-002.sig" (testSerialization "000011-002.sig"),
70 testCase "000012-012.ring_trust" (testSerialization "000012-012.ring_trust"),
71 testCase "000013-014.public_subkey" (testSerialization "000013-014.public_subkey"),
72 testCase "000014-002.sig" (testSerialization "000014-002.sig"),
73 testCase "000015-012.ring_trust" (testSerialization "000015-012.ring_trust"),
74 testCase "000016-006.public_key" (testSerialization "000016-006.public_key"),
75 testCase "000017-002.sig" (testSerialization "000017-002.sig"),
76 testCase "000018-012.ring_trust" (testSerialization "000018-012.ring_trust"),
77 testCase "000019-013.user_id" (testSerialization "000019-013.user_id"),
78 testCase "000020-002.sig" (testSerialization "000020-002.sig"),
79 testCase "000021-012.ring_trust" (testSerialization "000021-012.ring_trust"),
80 testCase "000022-002.sig" (testSerialization "000022-002.sig"),
81 testCase "000023-012.ring_trust" (testSerialization "000023-012.ring_trust"),
82 testCase "000024-014.public_subkey" (testSerialization "000024-014.public_subkey"),
83 testCase "000025-002.sig" (testSerialization "000025-002.sig"),
84 testCase "000026-012.ring_trust" (testSerialization "000026-012.ring_trust"),
85 testCase "000027-006.public_key" (testSerialization "000027-006.public_key"),
86 testCase "000028-002.sig" (testSerialization "000028-002.sig"),
87 testCase "000029-012.ring_trust" (testSerialization "000029-012.ring_trust"),
88 testCase "000030-013.user_id" (testSerialization "000030-013.user_id"),
89 testCase "000031-002.sig" (testSerialization "000031-002.sig"),
90 testCase "000032-012.ring_trust" (testSerialization "000032-012.ring_trust"),
91 testCase "000033-002.sig" (testSerialization "000033-002.sig"),
92 testCase "000034-012.ring_trust" (testSerialization "000034-012.ring_trust"),
93 testCase "000035-006.public_key" (testSerialization "000035-006.public_key"),
94 testCase "000036-013.user_id" (testSerialization "000036-013.user_id"),
95 testCase "000037-002.sig" (testSerialization "000037-002.sig"),
96 testCase "000038-012.ring_trust" (testSerialization "000038-012.ring_trust"),
97 testCase "000039-002.sig" (testSerialization "000039-002.sig"),
98 testCase "000040-012.ring_trust" (testSerialization "000040-012.ring_trust"),
99 testCase "000041-017.attribute" (testSerialization "000041-017.attribute"),
100 testCase "000042-002.sig" (testSerialization "000042-002.sig"),
101 testCase "000043-012.ring_trust" (testSerialization "000043-012.ring_trust"),
102 testCase "000044-014.public_subkey" (testSerialization "000044-014.public_subkey"),
103 testCase "000045-002.sig" (testSerialization "000045-002.sig"),
104 testCase "000046-012.ring_trust" (testSerialization "000046-012.ring_trust"),
105 testCase "000047-005.secret_key" (testSerialization "000047-005.secret_key"),
106 testCase "000048-013.user_id" (testSerialization "000048-013.user_id"),
107 testCase "000049-002.sig" (testSerialization "000049-002.sig"),
108 testCase "000050-012.ring_trust" (testSerialization "000050-012.ring_trust"),
109 testCase "000051-007.secret_subkey" (testSerialization "000051-007.secret_subkey"),
110 testCase "000052-002.sig" (testSerialization "000052-002.sig"),
111 testCase "000053-012.ring_trust" (testSerialization "000053-012.ring_trust"),
112 testCase "000054-005.secret_key" (testSerialization "000054-005.secret_key"),
113 testCase "000055-002.sig" (testSerialization "000055-002.sig"),
114 testCase "000056-012.ring_trust" (testSerialization "000056-012.ring_trust"),
115 testCase "000057-013.user_id" (testSerialization "000057-013.user_id"),
116 testCase "000058-002.sig" (testSerialization "000058-002.sig"),
117 testCase "000059-012.ring_trust" (testSerialization "000059-012.ring_trust"),
118 testCase "000060-007.secret_subkey" (testSerialization "000060-007.secret_subkey"),
119 testCase "000061-002.sig" (testSerialization "000061-002.sig"),
120 testCase "000062-012.ring_trust" (testSerialization "000062-012.ring_trust"),
121 testCase "000063-005.secret_key" (testSerialization "000063-005.secret_key"),
122 testCase "000064-002.sig" (testSerialization "000064-002.sig"),
123 testCase "000065-012.ring_trust" (testSerialization "000065-012.ring_trust"),
124 testCase "000066-013.user_id" (testSerialization "000066-013.user_id"),
125 testCase "000067-002.sig" (testSerialization "000067-002.sig"),
126 testCase "000068-012.ring_trust" (testSerialization "000068-012.ring_trust"),
127 testCase "000069-005.secret_key" (testSerialization "000069-005.secret_key"),
128 testCase "000070-013.user_id" (testSerialization "000070-013.user_id"),
129 testCase "000071-002.sig" (testSerialization "000071-002.sig"),
130 testCase "000072-012.ring_trust" (testSerialization "000072-012.ring_trust"),
131 testCase "000073-017.attribute" (testSerialization "000073-017.attribute"),
132 testCase "000074-002.sig" (testSerialization "000074-002.sig"),
133 testCase "000075-012.ring_trust" (testSerialization "000075-012.ring_trust"),
134 testCase "000076-007.secret_subkey" (testSerialization "000076-007.secret_subkey"),
135 testCase "000077-002.sig" (testSerialization "000077-002.sig"),
136 testCase "000078-012.ring_trust" (testSerialization "000078-012.ring_trust"),
137 testCase "002182-002.sig" (testSerialization "002182-002.sig"),
138 testCase "pubring.gpg" (testSerialization "pubring.gpg"),
139 testCase "secring.gpg" (testSerialization "secring.gpg"),
140 testCase "compressedsig.gpg" (testSerialization "compressedsig.gpg"),
141 testCase "compressedsig-zlib.gpg" (testSerialization "compressedsig-zlib.gpg"),
142 testCase "compressedsig-bzip2.gpg" (testSerialization "compressedsig-bzip2.gpg"),
143 testCase "onepass_sig" (testSerialization "onepass_sig"),
144 testCase "symmetrically_encrypted" (testSerialization "symmetrically_encrypted"),
145 testCase "uncompressed-ops-dsa.gpg" (testSerialization "uncompressed-ops-dsa.gpg"),
146 testCase "uncompressed-ops-dsa-sha384.txt.gpg" (testSerialization "uncompressed-ops-dsa-sha384.txt.gpg"),
147 testCase "uncompressed-ops-rsa.gpg" (testSerialization "uncompressed-ops-rsa.gpg"),
148 testCase "3F5BBA0B0694BEB6000005-002.sig" (testSerialization "3F5BBA0B0694BEB6000005-002.sig"),
149 testCase "3F5BBA0B0694BEB6000017-002.sig" (testSerialization "3F5BBA0B0694BEB6000017-002.sig"),
150 testProperty "MPI encode/decode" prop_MPI_serialization_loop,
151 testProperty "S2K encode/decode" prop_S2K_serialization_loop,
152 testProperty "SignatureSubpacket encode/decode" prop_SignatureSubpacket_serialization_loop
153 ],
154 testGroup "S2K count" [
155 testProperty "S2K count encode reverses decode" prop_s2k_count
156 ]
157 ]
158
159main :: IO ()
160main = defaultMain tests
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-17 01:52:34 +0000