diff options
author | Stephen Paul Weber <singpolyma@singpolyma.net> | 2012-04-24 13:04:07 -0500 |
---|---|---|
committer | Stephen Paul Weber <singpolyma@singpolyma.net> | 2012-04-24 13:04:07 -0500 |
commit | 7d75d59b4c089f0a9ef2a3cccd099b3a3a847a7e (patch) | |
tree | d83c57feb5fa876cfa393280d83c7fb714173bd8 /Data/OpenPGP.hs | |
parent | 907855b59542682dce5181dd76441395e2e161d5 (diff) |
Unknown algorithms and Enum
Closes #6
Closes #7
Diffstat (limited to 'Data/OpenPGP.hs')
-rw-r--r-- | Data/OpenPGP.hs | 144 |
1 files changed, 81 insertions, 63 deletions
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs index affc940..e0361a7 100644 --- a/Data/OpenPGP.hs +++ b/Data/OpenPGP.hs | |||
@@ -241,11 +241,13 @@ put_packet (PublicKeyPacket { version = 4, timestamp = timestamp, | |||
241 | put_packet (CompressedDataPacket { compression_algorithm = algorithm, | 241 | put_packet (CompressedDataPacket { compression_algorithm = algorithm, |
242 | message = message }) = | 242 | message = message }) = |
243 | (LZ.append (encode algorithm) $ compress $ encode message, 8) | 243 | (LZ.append (encode algorithm) $ compress $ encode message, 8) |
244 | where compress = case algorithm of | 244 | where |
245 | compress = case algorithm of | ||
245 | Uncompressed -> id | 246 | Uncompressed -> id |
246 | ZIP -> Zip.compress | 247 | ZIP -> Zip.compress |
247 | ZLIB -> Zlib.compress | 248 | ZLIB -> Zlib.compress |
248 | BZip2 -> BZip2.compress | 249 | BZip2 -> BZip2.compress |
250 | x -> error ("No implementation for " ++ show x) | ||
249 | put_packet (LiteralDataPacket { format = format, filename = filename, | 251 | put_packet (LiteralDataPacket { format = format, filename = filename, |
250 | timestamp = timestamp, content = content | 252 | timestamp = timestamp, content = content |
251 | }) = | 253 | }) = |
@@ -365,9 +367,10 @@ parse_packet 8 = do | |||
365 | message <- getRemainingLazyByteString | 367 | message <- getRemainingLazyByteString |
366 | let decompress = case algorithm of | 368 | let decompress = case algorithm of |
367 | Uncompressed -> id | 369 | Uncompressed -> id |
368 | ZIP -> Zip.decompress | 370 | ZIP -> Zip.decompress |
369 | ZLIB -> Zlib.decompress | 371 | ZLIB -> Zlib.decompress |
370 | BZip2 -> BZip2.decompress | 372 | BZip2 -> BZip2.decompress |
373 | x -> error ("No implementation for " ++ show x) | ||
371 | return CompressedDataPacket { | 374 | return CompressedDataPacket { |
372 | compression_algorithm = algorithm, | 375 | compression_algorithm = algorithm, |
373 | message = runGet (get :: Get Message) (decompress message) | 376 | message = runGet (get :: Get Message) (decompress message) |
@@ -422,67 +425,82 @@ fingerprint_material p | version p `elem` [2, 3] = [n, e] | |||
422 | fingerprint_material _ = | 425 | fingerprint_material _ = |
423 | error "Unsupported Packet version or type in fingerprint_material." | 426 | error "Unsupported Packet version or type in fingerprint_material." |
424 | 427 | ||
425 | data HashAlgorithm = MD5 | SHA1 | RIPEMD160 | SHA256 | SHA384 | SHA512 | SHA224 | 428 | enum_to_word8 :: (Enum a) => a -> Word8 |
429 | enum_to_word8 = fromIntegral . fromEnum | ||
430 | |||
431 | enum_from_word8 :: (Enum a) => Word8 -> a | ||
432 | enum_from_word8 = toEnum . fromIntegral | ||
433 | |||
434 | data HashAlgorithm = MD5 | SHA1 | RIPEMD160 | SHA256 | SHA384 | SHA512 | SHA224 | HashAlgorithm Word8 | ||
426 | deriving (Show, Read, Eq) | 435 | deriving (Show, Read, Eq) |
436 | |||
437 | instance Enum HashAlgorithm where | ||
438 | toEnum 01 = MD5 | ||
439 | toEnum 02 = SHA1 | ||
440 | toEnum 03 = RIPEMD160 | ||
441 | toEnum 08 = SHA256 | ||
442 | toEnum 09 = SHA384 | ||
443 | toEnum 10 = SHA512 | ||
444 | toEnum 11 = SHA224 | ||
445 | toEnum x = HashAlgorithm $ fromIntegral x | ||
446 | fromEnum MD5 = 01 | ||
447 | fromEnum SHA1 = 02 | ||
448 | fromEnum RIPEMD160 = 03 | ||
449 | fromEnum SHA256 = 08 | ||
450 | fromEnum SHA384 = 09 | ||
451 | fromEnum SHA512 = 10 | ||
452 | fromEnum SHA224 = 11 | ||
453 | fromEnum (HashAlgorithm x) = fromIntegral x | ||
454 | |||
427 | instance Binary HashAlgorithm where | 455 | instance Binary HashAlgorithm where |
428 | put MD5 = put (01 :: Word8) | 456 | put = put . enum_to_word8 |
429 | put SHA1 = put (02 :: Word8) | 457 | get = fmap enum_from_word8 get |
430 | put RIPEMD160 = put (03 :: Word8) | 458 | |
431 | put SHA256 = put (08 :: Word8) | 459 | data KeyAlgorithm = RSA | RSA_E | RSA_S | ELGAMAL | DSA | ECC | ECDSA | DH | KeyAlgorithm Word8 |
432 | put SHA384 = put (09 :: Word8) | ||
433 | put SHA512 = put (10 :: Word8) | ||
434 | put SHA224 = put (11 :: Word8) | ||
435 | get = do | ||
436 | tag <- get :: Get Word8 | ||
437 | case tag of | ||
438 | 01 -> return MD5 | ||
439 | 02 -> return SHA1 | ||
440 | 03 -> return RIPEMD160 | ||
441 | 08 -> return SHA256 | ||
442 | 09 -> return SHA384 | ||
443 | 10 -> return SHA512 | ||
444 | 11 -> return SHA224 | ||
445 | x -> fail $ "Unknown HashAlgorithm " ++ show x ++ "." | ||
446 | |||
447 | data KeyAlgorithm = RSA | RSA_E | RSA_S | ELGAMAL | DSA | ECC | ECDSA | DH | ||
448 | deriving (Show, Read, Eq) | 460 | deriving (Show, Read, Eq) |
461 | |||
462 | instance Enum KeyAlgorithm where | ||
463 | toEnum 01 = RSA | ||
464 | toEnum 02 = RSA_E | ||
465 | toEnum 03 = RSA_S | ||
466 | toEnum 16 = ELGAMAL | ||
467 | toEnum 17 = DSA | ||
468 | toEnum 18 = ECC | ||
469 | toEnum 19 = ECDSA | ||
470 | toEnum 21 = DH | ||
471 | toEnum x = KeyAlgorithm $ fromIntegral x | ||
472 | fromEnum RSA = 01 | ||
473 | fromEnum RSA_E = 02 | ||
474 | fromEnum RSA_S = 03 | ||
475 | fromEnum ELGAMAL = 16 | ||
476 | fromEnum DSA = 17 | ||
477 | fromEnum ECC = 18 | ||
478 | fromEnum ECDSA = 19 | ||
479 | fromEnum DH = 21 | ||
480 | fromEnum (KeyAlgorithm x) = fromIntegral x | ||
481 | |||
449 | instance Binary KeyAlgorithm where | 482 | instance Binary KeyAlgorithm where |
450 | put RSA = put (01 :: Word8) | 483 | put = put . enum_to_word8 |
451 | put RSA_E = put (02 :: Word8) | 484 | get = fmap enum_from_word8 get |
452 | put RSA_S = put (03 :: Word8) | 485 | |
453 | put ELGAMAL = put (16 :: Word8) | 486 | data CompressionAlgorithm = Uncompressed | ZIP | ZLIB | BZip2 | CompressionAlgorithm Word8 |
454 | put DSA = put (17 :: Word8) | ||
455 | put ECC = put (18 :: Word8) | ||
456 | put ECDSA = put (19 :: Word8) | ||
457 | put DH = put (21 :: Word8) | ||
458 | get = do | ||
459 | tag <- get :: Get Word8 | ||
460 | case tag of | ||
461 | 01 -> return RSA | ||
462 | 02 -> return RSA_E | ||
463 | 03 -> return RSA_S | ||
464 | 16 -> return ELGAMAL | ||
465 | 17 -> return DSA | ||
466 | 18 -> return ECC | ||
467 | 19 -> return ECDSA | ||
468 | 21 -> return DH | ||
469 | x -> fail $ "Unknown KeyAlgorithm " ++ show x ++ "." | ||
470 | |||
471 | data CompressionAlgorithm = Uncompressed | ZIP | ZLIB | BZip2 | ||
472 | deriving (Show, Read, Eq) | 487 | deriving (Show, Read, Eq) |
488 | |||
489 | instance Enum CompressionAlgorithm where | ||
490 | toEnum 0 = Uncompressed | ||
491 | toEnum 1 = ZIP | ||
492 | toEnum 2 = ZLIB | ||
493 | toEnum 3 = BZip2 | ||
494 | toEnum x = CompressionAlgorithm $ fromIntegral x | ||
495 | fromEnum Uncompressed = 0 | ||
496 | fromEnum ZIP = 1 | ||
497 | fromEnum ZLIB = 2 | ||
498 | fromEnum BZip2 = 3 | ||
499 | fromEnum (CompressionAlgorithm x) = fromIntegral x | ||
500 | |||
473 | instance Binary CompressionAlgorithm where | 501 | instance Binary CompressionAlgorithm where |
474 | put Uncompressed = put (0 :: Word8) | 502 | put = put . enum_to_word8 |
475 | put ZIP = put (1 :: Word8) | 503 | get = fmap enum_from_word8 get |
476 | put ZLIB = put (2 :: Word8) | ||
477 | put BZip2 = put (3 :: Word8) | ||
478 | get = do | ||
479 | tag <- get :: Get Word8 | ||
480 | case tag of | ||
481 | 0 -> return Uncompressed | ||
482 | 1 -> return ZIP | ||
483 | 2 -> return ZLIB | ||
484 | 3 -> return BZip2 | ||
485 | x -> fail $ "Unknown CompressionAlgorithm " ++ show x ++ "." | ||
486 | 504 | ||
487 | -- A message is encoded as a list that takes the entire file | 505 | -- A message is encoded as a list that takes the entire file |
488 | newtype Message = Message [Packet] deriving (Show, Read, Eq) | 506 | newtype Message = Message [Packet] deriving (Show, Read, Eq) |
@@ -496,7 +514,7 @@ instance Binary Message where | |||
496 | if done then return (Message []) else do | 514 | if done then return (Message []) else do |
497 | next_packet <- get | 515 | next_packet <- get |
498 | (Message tail) <- get | 516 | (Message tail) <- get |
499 | return (Message (next_packet:tail)) | 517 | return $ Message (next_packet:tail) |
500 | 518 | ||
501 | -- | Extract all signature and data packets from a 'Message' | 519 | -- | Extract all signature and data packets from a 'Message' |
502 | signatures_and_data :: Message -> ([Packet], [Packet]) | 520 | signatures_and_data :: Message -> ([Packet], [Packet]) |