openpgp 0.5 → 0.6
raw patch · 6 files changed
+303/−118 lines, 6 filesdep ~basebinary-added
Dependency ranges changed: base
Files
- Data/OpenPGP.hs +230/−99
- Data/OpenPGP/Arbitrary.hs +59/−18
- README +3/−0
- openpgp.cabal +5/−1
- tests/data/symmetrically_encrypted binary
- tests/suite.hs +6/−0
Data/OpenPGP.hs view
@@ -8,6 +8,7 @@ Packet( AsymmetricSessionKeyPacket, OnePassSignaturePacket,+ SymmetricSessionKeyPacket, PublicKeyPacket, SecretKeyPacket, CompressedDataPacket,@@ -33,15 +34,11 @@ key_id, message, nested,- private_hash,- s2k_count,- s2k_hash_algorithm,- s2k_salt,- s2k_type, s2k_useage,+ s2k, signature, signature_type,- symmetric_type,+ symmetric_algorithm, timestamp, trailer, unhashed_subpackets,@@ -51,6 +48,8 @@ signaturePacket, Message(..), SignatureSubpacket(..),+ S2K(..),+ string2key, HashAlgorithm(..), KeyAlgorithm(..), SymmetricAlgorithm(..),@@ -59,29 +58,33 @@ MPI(..), find_key, fingerprint_material,- signatures_and_data,- signature_issuer+ SignatureOver(..),+ signatures,+ signature_issuer,+ public_key_fields,+ secret_key_fields ) where import Numeric import Control.Monad import Control.Arrow import Control.Applicative+import Data.Monoid import Data.Bits import Data.Word import Data.Char-import Data.Maybe import Data.List import Data.OpenPGP.Internal+import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LZ #ifdef CEREAL-import Data.Serialize+import Data.Serialize hiding (decode) import qualified Data.ByteString as B import qualified Data.ByteString.UTF8 as B (toString, fromString) #define BINARY_CLASS Serialize #else-import Data.Binary+import Data.Binary hiding (decode) import Data.Binary.Get import Data.Binary.Put import qualified Data.ByteString.Lazy as B@@ -119,6 +122,9 @@ toLazyBS :: B.ByteString -> LZ.ByteString toLazyBS = LZ.fromChunks . (:[])++lazyEncode :: (Serialize a) => a -> LZ.ByteString+lazyEncode = toLazyBS . encode #else getRemainingByteString :: Get B.ByteString getRemainingByteString = getRemainingLazyByteString@@ -141,6 +147,9 @@ decompress :: CompressionAlgorithm -> B.ByteString -> B.ByteString decompress = lazyDecompress++lazyEncode :: (Binary a) => a -> LZ.ByteString+lazyEncode = encode #endif lazyCompress :: CompressionAlgorithm -> LZ.ByteString -> LZ.ByteString@@ -168,6 +177,10 @@ padBS :: Int -> B.ByteString -> B.ByteString padBS l s = B.replicate (fromIntegral l - B.length s) 0 `B.append` s +checksum :: B.ByteString -> Word16+checksum = fromIntegral .+ B.foldl (\c i -> (c + fromIntegral i) `mod` 65536) (0::Integer)+ data Packet = AsymmetricSessionKeyPacket { version::Word8,@@ -175,6 +188,7 @@ key_algorithm::KeyAlgorithm, encrypted_data::B.ByteString } |+ -- ^ <http://tools.ietf.org/html/rfc4880#section-5.1> SignaturePacket { version::Word8, signature_type::Word8,@@ -186,6 +200,14 @@ signature::[MPI], trailer::B.ByteString } |+ -- ^ <http://tools.ietf.org/html/rfc4880#section-5.2>+ SymmetricSessionKeyPacket {+ version::Word8,+ symmetric_algorithm::SymmetricAlgorithm,+ s2k::S2K,+ encrypted_data::B.ByteString+ } |+ -- ^ <http://tools.ietf.org/html/rfc4880#section-5.3> OnePassSignaturePacket { version::Word8, signature_type::Word8,@@ -194,6 +216,7 @@ key_id::String, nested::Word8 } |+ -- ^ <http://tools.ietf.org/html/rfc4880#section-5.4> PublicKeyPacket { version::Word8, timestamp::Word32,@@ -202,39 +225,41 @@ is_subkey::Bool, v3_days_of_validity::Maybe Word16 } |+ -- ^ <http://tools.ietf.org/html/rfc4880#section-5.5.1.1> (also subkey) SecretKeyPacket { version::Word8, timestamp::Word32, key_algorithm::KeyAlgorithm, key::[(Char,MPI)],- s2k_useage::Word8, -- determines if the Maybes are Just or Nothing- symmetric_type::Maybe Word8,- s2k_type::Maybe Word8,- s2k_hash_algorithm::Maybe HashAlgorithm,- s2k_salt::Maybe Word64,- s2k_count::Maybe Word32,+ s2k_useage::Word8,+ s2k::S2K, -- ^ This is meaningless if symmetric_algorithm == Unencrypted+ symmetric_algorithm::SymmetricAlgorithm, encrypted_data::B.ByteString,- private_hash::Maybe B.ByteString, -- the hash may be in the encrypted data is_subkey::Bool } |+ -- ^ <http://tools.ietf.org/html/rfc4880#section-5.5.1.3> (also subkey) CompressedDataPacket { compression_algorithm::CompressionAlgorithm, message::Message } |- MarkerPacket |+ -- ^ <http://tools.ietf.org/html/rfc4880#section-5.6>+ MarkerPacket | -- ^ <http://tools.ietf.org/html/rfc4880#section-5.8> LiteralDataPacket { format::Char, filename::String, timestamp::Word32, content::B.ByteString } |- TrustPacket B.ByteString |- UserIDPacket String |+ -- ^ <http://tools.ietf.org/html/rfc4880#section-5.9>+ TrustPacket B.ByteString | -- ^ <http://tools.ietf.org/html/rfc4880#section-5.10>+ UserIDPacket String | -- ^ <http://tools.ietf.org/html/rfc4880#section-5.11> EncryptedDataPacket {- version::Word8, -- 0 for old-skool no-MDC (tag 9)+ version::Word8, encrypted_data::B.ByteString } |- ModificationDetectionCodePacket B.ByteString |+ -- ^ <http://tools.ietf.org/html/rfc4880#section-5.13>+ -- or <http://tools.ietf.org/html/rfc4880#section-5.7> when version is 0+ ModificationDetectionCodePacket B.ByteString | -- ^ <http://tools.ietf.org/html/rfc4880#section-5.14> UnsupportedPacket Word8 B.ByteString deriving (Show, Read, Eq) @@ -248,32 +273,31 @@ -- Use 5-octet lengths put (255 :: Word8) put (blen :: Word32)- putSomeByteString body+ putSomeByteString body where blen :: (Num a) => a blen = fromIntegral $ B.length body (body, tag) = put_packet p get = do- (t, packet) <- get_packet_bytes+ tag <- get+ let (t, l) =+ if (tag .&. 64) /= 0 then+ (tag .&. 63, parse_new_length)+ else+ ((tag `shiftR` 2) .&. 15, (,) <$> parse_old_length tag <*> pure False)+ packet <- uncurry get_packet_bytes =<< l localGet (parse_packet t) (B.concat packet) -get_packet_bytes :: Get (Word8, [B.ByteString])-get_packet_bytes = do- tag <- get- let (t, l) =- if (tag .&. 64) /= 0 then- (tag .&. 63, fmap (first Just) parse_new_length)- else- ((tag `shiftR` 2) .&. 15, (,) <$> parse_old_length tag <*> pure False)- (len, partial) <- l+get_packet_bytes :: Maybe Word32 -> Bool -> Get [B.ByteString]+get_packet_bytes len partial = do -- This forces the whole packet to be consumed packet <- maybe getRemainingByteString (getSomeByteString . fromIntegral) len- if not partial then return (t, [packet]) else- (,) t <$> ((packet:) . snd) <$> get_packet_bytes+ if not partial then return [packet] else+ (packet:) <$> (uncurry get_packet_bytes =<< parse_new_length) -- http://tools.ietf.org/html/rfc4880#section-4.2.2-parse_new_length :: Get (Word32, Bool)-parse_new_length = do+parse_new_length :: Get (Maybe Word32, Bool)+parse_new_length = fmap (first Just) $ do len <- fmap fromIntegral (get :: Get Word8) case len of -- One octet length@@ -323,7 +347,7 @@ secret_key_fields _ = undefined -- Nothing in the spec. Maybe empty (!) :: (Eq k) => [(k,v)] -> k -> v-(!) xs = fromJust . (`lookup` xs)+(!) xs k = let Just x = lookup k xs in x -- Need this seperate for trailer calculation signature_packet_start :: Packet -> B.ByteString@@ -375,7 +399,7 @@ put_packet (AsymmetricSessionKeyPacket version key_id key_algorithm dta) = (B.concat [ encode version,- encode (fst $ head $ readHex key_id :: Word64),+ encode (fst $ head $ readHex $ takeFromEnd 16 key_id :: Word64), encode key_algorithm, dta ], 1)@@ -397,10 +421,12 @@ encode hash_head ] ++ map encode signature, 2) where- keyid = fst $ head $ readHex keyidS :: Word64+ keyid = fst $ head $ readHex $ takeFromEnd 16 keyidS :: Word64 Just (IssuerPacket keyidS) = find isIssuer unhashed_subpackets isIssuer (IssuerPacket {}) = True isIssuer _ = False+put_packet (SymmetricSessionKeyPacket version salgo s2k encd) =+ (B.concat [encode version, encode salgo, encode s2k, encd], 3) put_packet (SignaturePacket { version = 4, unhashed_subpackets = unhashed_subpackets, hash_head = hash_head,@@ -423,40 +449,29 @@ (B.concat [ encode version, encode signature_type, encode hash_algorithm, encode key_algorithm,- encode (fst $ head $ readHex key_id :: Word64),+ encode (fst $ head $ readHex $ takeFromEnd 16 key_id :: Word64), encode nested ], 4) put_packet (SecretKeyPacket { version = version, timestamp = timestamp, key_algorithm = algorithm, key = key,- s2k_useage = s2k_useage,- symmetric_type = symmetric_type,- s2k_type = s2k_type,- s2k_hash_algorithm = s2k_hash_algo,- s2k_salt = s2k_salt,- s2k_count = s2k_count,+ s2k_useage = s2k_useage, s2k = s2k,+ symmetric_algorithm = symmetric_algorithm, encrypted_data = encrypted_data, is_subkey = is_subkey }) =- (B.concat $ [p, encode s2k_useage] ++- (if s2k_useage `elem` [255, 254] then- [encode $ fromJust symmetric_type, encode s2k_t,- encode $ fromJust s2k_hash_algo] ++- (if s2k_t `elem` [1,3] then [encode $ fromJust s2k_salt] else []) ++- if s2k_t == 3 then- [encode $ encode_s2k_count $ fromJust s2k_count] else []- else []) ++- (if s2k_useage > 0 then+ (B.concat $ p :+ (if s2k_useage `elem` [254,255] then+ [encode s2k_useage, encode symmetric_algorithm, encode s2k]+ else+ [encode symmetric_algorithm]+ ) +++ (if symmetric_algorithm /= Unencrypted then+ -- For V3 keys, the "encrypted data" has an unencrypted checksum+ -- of the unencrypted MPIs on the end [encrypted_data] else s ++- -- XXX: Checksum is part of encrypted_data for V4 ONLY- if s2k_useage == 254 then- [B.replicate 20 0] -- TODO SHA1 Checksum- else- [encode (fromIntegral $- B.foldl (\c i -> (c + fromIntegral i) `mod` 65536)- (0::Integer) (B.concat s) :: Word16)]),+ [encode $ checksum $ B.concat s]), if is_subkey then 7 else 5) where- (Just s2k_t) = s2k_type p = fst (put_packet $ PublicKeyPacket version timestamp algorithm key False Nothing) s = map (encode . (key !)) (secret_key_fields algorithm)@@ -466,7 +481,7 @@ | v == 3 = final (B.concat $ [ B.singleton 3, encode timestamp,- encode (fromJust $ v3_days_of_validity p),+ encode v3_days, encode algorithm ] ++ material) | v == 4 =@@ -474,6 +489,7 @@ B.singleton 4, encode timestamp, encode algorithm ] ++ material) where+ Just v3_days = v3_days_of_validity p final x = (x, if is_subkey then 14 else 6) material = map (encode . (key !)) (public_key_fields algorithm) put_packet (CompressedDataPacket { compression_algorithm = algorithm,@@ -557,6 +573,12 @@ trailer = B.concat [encode version, encode signature_type, encode key_algorithm, encode hash_algorithm, encode (fromIntegral hashed_size :: Word16), hashed_data, B.pack [4, 0xff], encode ((6 + fromIntegral hashed_size) :: Word32)] } x -> fail $ "Unknown SignaturePacket version " ++ show x ++ "."+-- SymmetricSessionKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.3+parse_packet 3 = SymmetricSessionKeyPacket+ <$> (assertProp (==4) =<< get)+ <*> get+ <*> get+ <*> getRemainingByteString -- OnePassSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.4 parse_packet 4 = do version <- get@@ -584,31 +606,24 @@ }) <- parse_packet 6 s2k_useage <- get :: Get Word8 let k = SecretKeyPacket version timestamp algorithm key s2k_useage- k' <- case s2k_useage of- _ | s2k_useage `elem` [255, 254] -> do- symmetric_type <- get- s2k_type <- get- s2k_hash_algorithm <- get- s2k_salt <- if s2k_type `elem` [1, 3] then get- else return undefined- s2k_count <- if s2k_type == 3 then fmap decode_s2k_count get else- return undefined- return (k (Just symmetric_type) (Just s2k_type)- (Just s2k_hash_algorithm) (Just s2k_salt) (Just s2k_count))+ (symmetric_algorithm, s2k) <- case () of+ _ | s2k_useage `elem` [255, 254] -> (,) <$> get <*> get _ | s2k_useage > 0 -> -- s2k_useage is symmetric_type in this case- return (k (Just s2k_useage) Nothing Nothing Nothing Nothing)+ (,) <$> localGet get (encode s2k_useage) <*> pure (SimpleS2K MD5) _ ->- return (k Nothing Nothing Nothing Nothing Nothing)- if s2k_useage > 0 then do {+ return (Unencrypted, S2K 100 B.empty)+ if symmetric_algorithm /= Unencrypted then do { encrypted <- getRemainingByteString;- return (k' encrypted Nothing False)+ return (k s2k symmetric_algorithm encrypted False) } else do- key <- foldM (\m f -> do+ skey <- foldM (\m f -> do mpi <- get :: Get MPI- return $ (f,mpi):m) key (secret_key_fields algorithm)- private_hash <- getRemainingByteString- return ((k' B.empty (Just private_hash) False) {key = key})+ return $ (f,mpi):m) [] (secret_key_fields algorithm)+ chk <- get+ when (checksum (B.concat $ map (encode . snd) skey) /= chk) $+ fail "Checksum verification failed for unencrypted secret key"+ return ((k s2k symmetric_algorithm B.empty False) {key = key ++ skey}) -- PublicKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.2 parse_packet 6 = do version <- get :: Get Word8@@ -710,6 +725,48 @@ enum_from_word8 :: (Enum a) => Word8 -> a enum_from_word8 = toEnum . fromIntegral +data S2K =+ SimpleS2K HashAlgorithm |+ SaltedS2K HashAlgorithm Word64 |+ IteratedSaltedS2K HashAlgorithm Word64 Word32 |+ S2K Word8 B.ByteString+ deriving (Show, Read, Eq)++instance BINARY_CLASS S2K where+ put (SimpleS2K halgo) = put (0::Word8) >> put halgo+ put (SaltedS2K halgo salt) = put (1::Word8) >> put halgo >> put salt+ put (IteratedSaltedS2K halgo salt count) = put (3::Word8) >> put halgo+ >> put salt >> put (encode_s2k_count count)+ put (S2K t body) = put t >> putSomeByteString body++ get = do+ t <- get :: Get Word8+ case t of+ 0 -> SimpleS2K <$> get+ 1 -> SaltedS2K <$> get <*> get+ 3 -> IteratedSaltedS2K <$> get <*> get <*> (decode_s2k_count <$> get)+ _ -> S2K t <$> getRemainingByteString++-- | Take a hash function and an 'S2K' value and generate the bytes+-- needed for creating a symmetric key.+--+-- Return value is always infinite length.+-- Take the first n bytes you need for your keysize.+string2key :: (HashAlgorithm -> LZ.ByteString -> BS.ByteString) -> S2K -> LZ.ByteString -> LZ.ByteString+string2key hsh (SimpleS2K halgo) s = infiniHashes (hsh halgo) s+string2key hsh (SaltedS2K halgo salt) s =+ infiniHashes (hsh halgo) (lazyEncode salt `LZ.append` s)+string2key hsh (IteratedSaltedS2K halgo salt count) s =+ infiniHashes (hsh halgo) $+ LZ.take (max (fromIntegral count) (LZ.length s))+ (LZ.cycle $ lazyEncode salt `LZ.append` s)+string2key _ s2k _ = error $ "Unsupported S2K specifier: " ++ show s2k++infiniHashes :: (LZ.ByteString -> BS.ByteString) -> LZ.ByteString -> LZ.ByteString+infiniHashes hsh s = LZ.fromChunks (hs 0)+ where+ hs c = hsh (LZ.replicate c 0 `LZ.append` s) : hs (c+1)+ data HashAlgorithm = MD5 | SHA1 | RIPEMD160 | SHA256 | SHA384 | SHA512 | SHA224 | HashAlgorithm Word8 deriving (Show, Read, Eq) @@ -830,22 +887,77 @@ put = put . enum_to_word8 get = fmap enum_from_word8 get --- A message is encoded as a list that takes the entire file+-- | A message is encoded as a list that takes the entire file newtype Message = Message [Packet] deriving (Show, Read, Eq) instance BINARY_CLASS Message where put (Message xs) = mapM_ put xs get = fmap Message listUntilEnd --- | Extract all signature and data packets from a 'Message'-signatures_and_data :: Message -> ([Packet], [Packet])-signatures_and_data (Message ((CompressedDataPacket {message = m}):_)) =- signatures_and_data m-signatures_and_data (Message lst) =- (filter isSignaturePacket lst, filter isDta lst)+instance Monoid Message where+ mempty = Message []+ mappend (Message a) (Message b) = Message (a ++ b)++-- | Data needed to verify a signature+data SignatureOver =+ DataSignature {literal::Packet, signatures_over::[Packet]} |+ KeySignature {topkey::Packet, signatures_over::[Packet]} |+ SubkeySignature {topkey::Packet, subkey::Packet, signatures_over::[Packet]} |+ CertificationSignature {topkey::Packet, user_id::Packet, signatures_over::[Packet]}+ deriving (Show, Read, Eq)++-- To get the signed-over bytes+instance BINARY_CLASS SignatureOver where+ put (DataSignature (LiteralDataPacket {content = c}) _) =+ putSomeByteString c+ put (KeySignature k _) = mapM_ putSomeByteString (fingerprint_material k)+ put (SubkeySignature k s _) = mapM_ (mapM_ putSomeByteString)+ [fingerprint_material k, fingerprint_material s]+ put (CertificationSignature k (UserIDPacket s) _) =+ mapM_ (mapM_ putSomeByteString) [fingerprint_material k, [+ B.singleton 0xB4,+ encode ((fromIntegral $ B.length bs) :: Word32),+ bs+ ]]+ where+ bs = B.fromString s+ put x = fail $ "Malformed signature: " ++ show x+ get = fail "Cannot meaningfully parse bytes to be signed over."++-- | Extract signed objects from a well-formatted message+--+-- Recurses into CompressedDataPacket+--+-- <http://tools.ietf.org/html/rfc4880#section-11>+signatures :: Message -> [SignatureOver]+signatures (Message [CompressedDataPacket _ m]) = signatures m+signatures (Message ps) =+ maybe (paired_sigs Nothing ps) (\p -> [DataSignature p sigs]) (find isDta ps) where+ sigs = filter isSignaturePacket ps isDta (LiteralDataPacket {}) = True isDta _ = False +-- TODO: UserAttribute+paired_sigs :: Maybe Packet -> [Packet] -> [SignatureOver]+paired_sigs _ [] = []+paired_sigs _ (p@(PublicKeyPacket {is_subkey = False}):ps) =+ KeySignature p (takeWhile isSignaturePacket ps) :+ paired_sigs (Just p) (dropWhile isSignaturePacket ps)+paired_sigs _ (p@(SecretKeyPacket {is_subkey = False}):ps) =+ KeySignature p (takeWhile isSignaturePacket ps) :+ paired_sigs (Just p) (dropWhile isSignaturePacket ps)+paired_sigs (Just k) (p@(PublicKeyPacket {is_subkey = True}):ps) =+ SubkeySignature k p (takeWhile isSignaturePacket ps) :+ paired_sigs (Just p) (dropWhile isSignaturePacket ps)+paired_sigs (Just k) (p@(SecretKeyPacket {is_subkey = True}):ps) =+ SubkeySignature k p (takeWhile isSignaturePacket ps) :+ paired_sigs (Just p) (dropWhile isSignaturePacket ps)+paired_sigs (Just k) (p@(UserIDPacket {}):ps) =+ CertificationSignature k p (takeWhile isSignaturePacket ps) :+ paired_sigs (Just p) (dropWhile isSignaturePacket ps)+paired_sigs k (_:ps) = paired_sigs k ps++-- | <http://tools.ietf.org/html/rfc4880#section-3.2> newtype MPI = MPI Integer deriving (Show, Read, Eq, Ord) instance BINARY_CLASS MPI where put (MPI i)@@ -879,15 +991,15 @@ rest <- listUntilEnd return (next:rest) --- http://tools.ietf.org/html/rfc4880#section-5.2.3.1+-- | <http://tools.ietf.org/html/rfc4880#section-5.2.3.1> data SignatureSubpacket = SignatureCreationTimePacket Word32 |- SignatureExpirationTimePacket Word32 | -- seconds after CreationTime+ SignatureExpirationTimePacket Word32 | -- ^ seconds after CreationTime ExportableCertificationPacket Bool | TrustSignaturePacket {depth::Word8, trust::Word8} | RegularExpressionPacket String | RevocablePacket Bool |- KeyExpirationTimePacket Word32 | -- seconds after key CreationTime+ KeyExpirationTimePacket Word32 | -- ^ seconds after key CreationTime PreferredSymmetricAlgorithmsPacket [SymmetricAlgorithm] | RevocationKeyPacket { sensitive::Bool,@@ -979,7 +1091,7 @@ fprb = padBS 20 $ B.drop 2 $ encode (MPI fpri) fpri = fst $ head $ readHex fpr put_signature_subpacket (IssuerPacket keyid) =- (encode (fst $ head $ readHex keyid :: Word64), 16)+ (encode (fst $ head $ readHex $ takeFromEnd 16 keyid :: Word64), 16) put_signature_subpacket (NotationDataPacket human_readable name value) = (B.concat [ B.pack [flag1,0,0,0],@@ -1160,7 +1272,12 @@ isIssuer _ = False signature_issuer _ = Nothing -find_key :: (Packet -> String) -> Message -> String -> Maybe Packet+-- | Find a key with the given Fingerprint/KeyID+find_key ::+ (Packet -> String) -- ^ Extract Fingerprint/KeyID from packet+ -> Message -- ^ List of packets (some of which are keys)+ -> String -- ^ Fingerprint/KeyID to search for+ -> Maybe Packet find_key fpr (Message (x@(PublicKeyPacket {}):xs)) keyid = find_key' fpr x xs keyid find_key fpr (Message (x@(SecretKeyPacket {}):xs)) keyid =@@ -1174,10 +1291,24 @@ | thisid == keyid = Just x | otherwise = find_key fpr (Message xs) keyid where- thisid = reverse $ take (length keyid) (reverse (fpr x))+ thisid = takeFromEnd (length keyid) (fpr x) +takeFromEnd :: Int -> String -> String+takeFromEnd l = reverse . take l . reverse+ -- | SignaturePacket smart constructor-signaturePacket :: Word8 -> Word8 -> KeyAlgorithm -> HashAlgorithm -> [SignatureSubpacket] -> [SignatureSubpacket] -> Word16 -> [MPI] -> Packet+--+-- <http://tools.ietf.org/html/rfc4880#section-5.2>+signaturePacket ::+ Word8 -- ^ Signature version (probably 4)+ -> Word8 -- ^ Signature type <http://tools.ietf.org/html/rfc4880#section-5.2.1>+ -> KeyAlgorithm+ -> HashAlgorithm+ -> [SignatureSubpacket] -- ^ Hashed subpackets (these get signed)+ -> [SignatureSubpacket] -- ^ Unhashed subpackets (these do not get signed)+ -> Word16 -- ^ Left 16 bits of the signed hash value+ -> [MPI] -- ^ The raw MPIs of the signature+ -> Packet signaturePacket version signature_type key_algorithm hash_algorithm hashed_subpackets unhashed_subpackets hash_head signature = let p = SignaturePacket { version = version,
Data/OpenPGP/Arbitrary.hs view
@@ -1,15 +1,15 @@+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-imports #-} module Data.OpenPGP.Arbitrary where import Data.OpenPGP+import Data.OpenPGP.Internal import Test.QuickCheck import Test.QuickCheck.Instances-import Numeric-import Data.Char import Data.Word instance Arbitrary Packet where arbitrary- = do x <- choose (0 :: Int, 12)+ = do x <- choose (0 :: Int, 13) case x of 0 -> do x1 <- arbitrary x2 <- arbitrary@@ -35,17 +35,22 @@ x2 <- arbitrary x3 <- arbitrary x4 <- arbitrary+ return (SymmetricSessionKeyPacket x1 x2 x3 x4)+ 3 -> do x1 <- arbitrary+ x2 <- arbitrary+ x3 <- arbitrary+ x4 <- arbitrary x5 <- arbitrary x6 <- arbitrary return (OnePassSignaturePacket x1 x2 x3 x4 x5 x6)- 3 -> do x1 <- arbitrary+ 4 -> do x1 <- arbitrary x2 <- arbitrary x3 <- arbitrary x4 <- arbitrary x5 <- arbitrary x6 <- arbitrary return (PublicKeyPacket x1 x2 x3 x4 x5 x6)- 4 -> do x1 <- arbitrary+ 5 -> do x1 <- arbitrary x2 <- arbitrary x3 <- arbitrary x4 <- arbitrary@@ -54,35 +59,50 @@ x7 <- arbitrary x8 <- arbitrary x9 <- arbitrary- x10 <- arbitrary- x11 <- arbitrary- x12 <- arbitrary- x13 <- arbitrary- return (SecretKeyPacket x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13)- 5 -> do x1 <- arbitrary+ return (SecretKeyPacket x1 x2 x3 x4 x5 x6 x7 x8 x9)+ 6 -> do x1 <- arbitrary x2 <- arbitrary return (CompressedDataPacket x1 x2)- 6 -> return MarkerPacket- 7 -> do x1 <- arbitrary+ 7 -> return MarkerPacket+ 8 -> do x1 <- arbitrary x2 <- arbitrary x3 <- arbitrary x4 <- arbitrary return (LiteralDataPacket x1 x2 x3 x4)- 8 -> do x1 <- arbitrary- return (TrustPacket x1) 9 -> do x1 <- arbitrary- return (UserIDPacket x1)+ return (TrustPacket x1) 10 -> do x1 <- arbitrary+ return (UserIDPacket x1)+ 11 -> do x1 <- arbitrary x2 <- arbitrary return (EncryptedDataPacket x1 x2)- 11 -> do x1 <- arbitrary- return (ModificationDetectionCodePacket x1) 12 -> do x1 <- arbitrary+ return (ModificationDetectionCodePacket x1)+ 13 -> do x1 <- arbitrary x2 <- arbitrary return (UnsupportedPacket x1 x2) _ -> error "FATAL ERROR: Arbitrary instance, logic bug" +instance Arbitrary S2K where+ arbitrary+ = do x <- choose (0 :: Int, 3)+ case x of+ 0 -> do x1 <- arbitrary+ return (SimpleS2K x1)+ 1 -> do x1 <- arbitrary+ x2 <- arbitrary+ return (SaltedS2K x1 x2)+ 2 -> do x1 <- arbitrary+ x2 <- arbitrary+ x3 <- fmap decode_s2k_count arbitrary+ return (IteratedSaltedS2K x1 x2 x3)+ 3 -> do x1 <- suchThat arbitrary (`notElem` [0,1,3])+ x2 <- arbitrary+ return (S2K x1 x2)+ _ -> error "FATAL ERROR: Arbitrary instance, logic bug"++ instance Arbitrary HashAlgorithm where arbitrary = do x <- choose (0 :: Int, 7)@@ -165,6 +185,27 @@ arbitrary = do x1 <- arbitrary return (Message x1)++ +instance Arbitrary SignatureOver where+ arbitrary+ = do x <- choose (0 :: Int, 3)+ case x of+ 0 -> do x1 <- arbitrary+ x2 <- arbitrary+ return (DataSignature x1 x2)+ 1 -> do x1 <- arbitrary+ x2 <- arbitrary+ return (KeySignature x1 x2)+ 2 -> do x1 <- arbitrary+ x2 <- arbitrary+ x3 <- arbitrary+ return (SubkeySignature x1 x2 x3)+ 3 -> do x1 <- arbitrary+ x2 <- arbitrary+ x3 <- arbitrary+ return (CertificationSignature x1 x2 x3)+ _ -> error "FATAL ERROR: Arbitrary instance, logic bug" instance Arbitrary MPI where
README view
@@ -11,6 +11,9 @@ <http://hackage.haskell.org/package/openpgp-crypto-api> or <http://hackage.haskell.org/package/openpgp-Crypto> +For dealing with ASCII armor, see+<http://hackage.haskell.org/package/openpgp-asciiarmor>+ It is intended that you use qualified imports with this library. > import qualified Data.OpenPGP as OpenPGP
openpgp.cabal view
@@ -1,5 +1,5 @@ name: openpgp-version: 0.5+version: 0.6 cabal-version: >= 1.8 license: OtherLicense license-file: COPYING@@ -27,6 +27,9 @@ <http://hackage.haskell.org/package/openpgp-crypto-api> or <http://hackage.haskell.org/package/openpgp-Crypto> .+ For dealing with ASCII armor, see+ <http://hackage.haskell.org/package/openpgp-asciiarmor>+ . It is intended that you use qualified imports with this library. . > import qualified Data.OpenPGP as OpenPGP@@ -117,6 +120,7 @@ tests/data/compressedsig.gpg, tests/data/compressedsig-zlib.gpg, tests/data/onepass_sig,+ tests/data/symmetrically_encrypted, tests/data/pubring.gpg, tests/data/secring.gpg, tests/data/uncompressed-ops-dsa.gpg,
+ tests/data/symmetrically_encrypted view
binary file changed (absent → 528 bytes)
tests/suite.hs view
@@ -44,6 +44,10 @@ prop_MPI_serialization_loop mpi = mpi == decode' (encode mpi) +prop_S2K_serialization_loop :: OpenPGP.S2K -> Bool+prop_S2K_serialization_loop s2k =+ s2k == decode' (encode s2k)+ prop_SignatureSubpacket_serialization_loop :: OpenPGP.SignatureSubpacket -> Bool prop_SignatureSubpacket_serialization_loop packet = packet == decode' (encode packet)@@ -137,10 +141,12 @@ testCase "compressedsig-zlib.gpg" (testSerialization "compressedsig-zlib.gpg"), testCase "compressedsig-bzip2.gpg" (testSerialization "compressedsig-bzip2.gpg"), testCase "onepass_sig" (testSerialization "onepass_sig"),+ testCase "symmetrically_encrypted" (testSerialization "symmetrically_encrypted"), testCase "uncompressed-ops-dsa.gpg" (testSerialization "uncompressed-ops-dsa.gpg"), testCase "uncompressed-ops-dsa-sha384.txt.gpg" (testSerialization "uncompressed-ops-dsa-sha384.txt.gpg"), testCase "uncompressed-ops-rsa.gpg" (testSerialization "uncompressed-ops-rsa.gpg"), testProperty "MPI encode/decode" prop_MPI_serialization_loop,+ testProperty "S2K encode/decode" prop_S2K_serialization_loop, testProperty "SignatureSubpacket encode/decode" prop_SignatureSubpacket_serialization_loop ], testGroup "S2K count" [