diff options
Diffstat (limited to 'Codec/Encryption/OpenPGP/ASCIIArmor')
-rw-r--r-- | Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs | 46 | ||||
-rw-r--r-- | Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs | 10 | ||||
-rw-r--r-- | Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs | 16 |
3 files changed, 38 insertions, 34 deletions
diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs index e69087c..0376abc 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs | |||
@@ -26,17 +26,17 @@ import Data.Serialize.Put (runPut, putWord32be) | |||
26 | import Data.String (IsString, fromString) | 26 | import Data.String (IsString, fromString) |
27 | import Data.Word (Word32) | 27 | import Data.Word (Word32) |
28 | 28 | ||
29 | decode :: (Integral a, Read a, Show a, IsString e) => ByteString -> Either e ([Armor a]) | 29 | decode :: IsString e => ByteString -> Either e [Armor] |
30 | decode bs = go (parse parseArmors bs) | 30 | decode bs = go (parse parseArmors bs) |
31 | where | 31 | where |
32 | go (Fail t c e) = Left (fromString e) | 32 | go (Fail t c e) = Left (fromString e) |
33 | go (Partial cont) = go (cont B.empty) | 33 | go (Partial cont) = go (cont B.empty) |
34 | go (Done _ r) = Right r | 34 | go (Done _ r) = Right r |
35 | 35 | ||
36 | parseArmors :: (Integral a, Read a, Show a) => Parser ([Armor a]) | 36 | parseArmors :: Parser [Armor] |
37 | parseArmors = many parseArmor | 37 | parseArmors = many parseArmor |
38 | 38 | ||
39 | parseArmor :: (Integral a, Read a, Show a) => Parser (Armor a) | 39 | parseArmor :: Parser Armor |
40 | parseArmor = do | 40 | parseArmor = do |
41 | atype <- prefixed beginLine <?> "begin line" | 41 | atype <- prefixed beginLine <?> "begin line" |
42 | headers <- armorHeaders <?> "headers" | 42 | headers <- armorHeaders <?> "headers" |
@@ -45,23 +45,27 @@ parseArmor = do | |||
45 | endLine atype <?> "end line" | 45 | endLine atype <?> "end line" |
46 | return $ Armor atype headers payload | 46 | return $ Armor atype headers payload |
47 | 47 | ||
48 | beginLine :: (Integral a, Read a, Show a) => Parser (ArmorType a) | 48 | beginLine :: Parser ArmorType |
49 | beginLine = do | 49 | beginLine = do |
50 | string "-----BEGIN PGP " | 50 | string "-----BEGIN PGP " <?> "leading minus-hyphens" |
51 | atype <- message <|> pubkey <|> privkey<|> parts <|> signature | 51 | atype <- pubkey <|> privkey <|> parts <|> message <|> signature |
52 | string "-----" | 52 | string "-----" <?> "trailing minus-hyphens" |
53 | many (satisfy (inClass " \t")) | 53 | many (satisfy (inClass " \t")) <?> "whitespace" |
54 | lineEnding | 54 | lineEnding <?> "line ending" |
55 | return atype | 55 | return atype |
56 | where | 56 | where |
57 | message = string "MESSAGE" >> return ArmorMessage | 57 | message = string "MESSAGE" *> return ArmorMessage |
58 | pubkey = string "PUBLIC KEY BLOCK" >> return ArmorPublicKeyBlock | 58 | pubkey = string "PUBLIC KEY BLOCK" *> return ArmorPublicKeyBlock |
59 | privkey = string "PRIVATE KEY BLOCK" >> return ArmorPrivateKeyBlock | 59 | privkey = string "PRIVATE KEY BLOCK" *> return ArmorPrivateKeyBlock |
60 | signature = string "SIGNATURE" >> return ArmorSignature | 60 | signature = string "SIGNATURE" *> return ArmorSignature |
61 | parts = do | 61 | parts = string "MESSAGE, PART " *> (partsdef <|> partsindef) |
62 | string "MESSAGE, PART " | 62 | partsdef = do |
63 | firstnum <- read . BC8.unpack . B.pack <$> many1 (satisfy isDigit_w8) | 63 | firstnum <- num |
64 | return $ ArmorSplitMessageIndefinite firstnum | 64 | word8 (fromIntegral . fromEnum $ '/') |
65 | secondnum <- num | ||
66 | return $ ArmorSplitMessage (B.pack firstnum) (B.pack secondnum) | ||
67 | partsindef = ArmorSplitMessageIndefinite . B.pack <$> num | ||
68 | num = many1 (satisfy isDigit_w8) <?> "number" | ||
65 | 69 | ||
66 | lineEnding :: Parser ByteString | 70 | lineEnding :: Parser ByteString |
67 | lineEnding = string "\n" <|> string "\r\n" | 71 | lineEnding = string "\n" <|> string "\r\n" |
@@ -82,17 +86,17 @@ armorHeader = do | |||
82 | blankishLine :: Parser ByteString | 86 | blankishLine :: Parser ByteString |
83 | blankishLine = many (satisfy (inClass " \t")) >> lineEnding | 87 | blankishLine = many (satisfy (inClass " \t")) >> lineEnding |
84 | 88 | ||
85 | endLine :: (Integral a, Read a, Show a) => ArmorType a -> Parser ByteString | 89 | endLine :: ArmorType -> Parser ByteString |
86 | endLine atype = do | 90 | endLine atype = do |
87 | string $ "-----END PGP " `B.append` aType atype `B.append` "-----" | 91 | string $ "-----END PGP " `B.append` aType atype `B.append` "-----" |
88 | lineEnding | 92 | lineEnding |
89 | 93 | ||
90 | aType :: (Integral a, Read a, Show a) => ArmorType a -> ByteString | 94 | aType :: ArmorType -> ByteString |
91 | aType (ArmorMessage) = BC8.pack "MESSAGE" | 95 | aType (ArmorMessage) = BC8.pack "MESSAGE" |
92 | aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" | 96 | aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" |
93 | aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" | 97 | aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" |
94 | aType (ArmorSplitMessage x y) = BC8.pack $ "MESSAGE, PART " ++ show x ++ "/" ++ show y | 98 | aType (ArmorSplitMessage x y) = BC8.pack "MESSAGE, PART " `B.append` x `B.append` BC8.singleton '/' `B.append` y |
95 | aType (ArmorSplitMessageIndefinite x) = BC8.pack $ "MESSAGE, PART " ++ show x | 99 | aType (ArmorSplitMessageIndefinite x) = BC8.pack "MESSAGE, PART " `B.append` x |
96 | aType (ArmorSignature) = BC8.pack "SIGNATURE" | 100 | aType (ArmorSignature) = BC8.pack "SIGNATURE" |
97 | 101 | ||
98 | base64Data :: Parser ByteString | 102 | base64Data :: Parser ByteString |
diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs index 99d4d54..28bb3e6 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs | |||
@@ -17,22 +17,22 @@ import Data.Serialize (put) | |||
17 | import Data.Serialize.Put (runPut, putWord32be) | 17 | import Data.Serialize.Put (runPut, putWord32be) |
18 | import Data.String (IsString, fromString) | 18 | import Data.String (IsString, fromString) |
19 | 19 | ||
20 | encode :: (Integral a, Show a) => [Armor a] -> ByteString | 20 | encode :: [Armor] -> ByteString |
21 | encode = B.concat . map armor | 21 | encode = B.concat . map armor |
22 | 22 | ||
23 | armor :: (Integral a, Show a) => Armor a -> ByteString | 23 | armor :: Armor -> ByteString |
24 | armor (Armor atype ahs bs) = beginLine atype `B.append` armorHeaders ahs `B.append` blankLine `B.append` armorData bs `B.append` armorChecksum bs `B.append` endLine atype | 24 | armor (Armor atype ahs bs) = beginLine atype `B.append` armorHeaders ahs `B.append` blankLine `B.append` armorData bs `B.append` armorChecksum bs `B.append` endLine atype |
25 | 25 | ||
26 | blankLine :: ByteString | 26 | blankLine :: ByteString |
27 | blankLine = BC8.singleton '\n' | 27 | blankLine = BC8.singleton '\n' |
28 | 28 | ||
29 | beginLine :: (Integral a, Show a) => ArmorType a -> ByteString | 29 | beginLine :: ArmorType -> ByteString |
30 | beginLine atype = BC8.pack "-----BEGIN PGP " `B.append` aType atype `B.append` BC8.pack "-----\n" | 30 | beginLine atype = BC8.pack "-----BEGIN PGP " `B.append` aType atype `B.append` BC8.pack "-----\n" |
31 | 31 | ||
32 | endLine :: (Integral a, Show a) => ArmorType a -> ByteString | 32 | endLine :: ArmorType -> ByteString |
33 | endLine atype = BC8.pack "-----END PGP " `B.append` aType atype `B.append` BC8.pack "-----\n" | 33 | endLine atype = BC8.pack "-----END PGP " `B.append` aType atype `B.append` BC8.pack "-----\n" |
34 | 34 | ||
35 | aType :: (Integral a, Show a) => ArmorType a -> ByteString | 35 | aType :: ArmorType -> ByteString |
36 | aType (ArmorMessage) = BC8.pack "MESSAGE" | 36 | aType (ArmorMessage) = BC8.pack "MESSAGE" |
37 | aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" | 37 | aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" |
38 | aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" | 38 | aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" |
diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs index 8c7ef6f..46416c1 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs | |||
@@ -10,14 +10,14 @@ module Codec.Encryption.OpenPGP.ASCIIArmor.Types ( | |||
10 | 10 | ||
11 | import Data.ByteString (ByteString) | 11 | import Data.ByteString (ByteString) |
12 | 12 | ||
13 | data Armor a = Armor (ArmorType a) [(String, String)] ByteString | 13 | data Armor = Armor ArmorType [(String, String)] ByteString |
14 | | ClearSigned [(String, String)] String (Armor a) | 14 | | ClearSigned [(String, String)] String Armor |
15 | deriving (Show, Eq) | 15 | deriving (Show, Eq) |
16 | 16 | ||
17 | data ArmorType a = ArmorMessage | 17 | data ArmorType = ArmorMessage |
18 | | ArmorPublicKeyBlock | 18 | | ArmorPublicKeyBlock |
19 | | ArmorPrivateKeyBlock | 19 | | ArmorPrivateKeyBlock |
20 | | ArmorSplitMessage a a | 20 | | ArmorSplitMessage ByteString ByteString |
21 | | ArmorSplitMessageIndefinite a | 21 | | ArmorSplitMessageIndefinite ByteString |
22 | | ArmorSignature | 22 | | ArmorSignature |
23 | deriving (Show, Eq) | 23 | deriving (Show, Eq) |