diff options
Diffstat (limited to 'Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs')
-rw-r--r-- | Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs | 38 |
1 files changed, 19 insertions, 19 deletions
diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs index 98934a0..08a951b 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs | |||
@@ -1,6 +1,6 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | 1 | {-# LANGUAGE OverloadedStrings #-} |
2 | -- ASCIIArmor/Decode.hs: OpenPGP (RFC4880) ASCII armor implementation | 2 | -- ASCIIArmor/Decode.hs: OpenPGP (RFC4880) ASCII armor implementation |
3 | -- Copyright © 2012 Clint Adams | 3 | -- Copyright © 2012-2018 Clint Adams |
4 | -- This software is released under the terms of the ISC license. | 4 | -- This software is released under the terms of the ISC license. |
5 | -- (See the LICENSE file). | 5 | -- (See the LICENSE file). |
6 | 6 | ||
@@ -18,17 +18,17 @@ import qualified Data.Attoparsec.ByteString as AS | |||
18 | import qualified Data.Attoparsec.ByteString.Lazy as AL | 18 | import qualified Data.Attoparsec.ByteString.Lazy as AL |
19 | import Data.Attoparsec.ByteString.Char8 (isDigit_w8, anyChar) | 19 | import Data.Attoparsec.ByteString.Char8 (isDigit_w8, anyChar) |
20 | import Data.Bits (shiftL) | 20 | import Data.Bits (shiftL) |
21 | import Data.ByteString (ByteString) | 21 | import Data.ByteString.Lazy (ByteString) |
22 | import qualified Data.ByteString as B | 22 | import qualified Data.ByteString as B |
23 | import qualified Data.ByteString.Lazy as BL | 23 | import qualified Data.ByteString.Lazy as BL |
24 | import qualified Data.ByteString.Char8 as BC8 | 24 | import qualified Data.ByteString.Char8 as BC8 |
25 | import qualified Data.ByteString.Base64 as Base64 | 25 | import qualified Data.ByteString.Base64 as Base64 |
26 | import Data.Digest.CRC24 (crc24) | 26 | import Data.Digest.CRC24 (crc24) |
27 | import Data.Serialize.Get (Get, runGet, getWord8) | 27 | import Data.Binary.Get (Get, runGetOrFail, getWord8) |
28 | import Data.String (IsString, fromString) | 28 | import Data.String (IsString, fromString) |
29 | import Data.Word (Word32) | 29 | import Data.Word (Word32) |
30 | 30 | ||
31 | decode :: IsString e => ByteString -> Either e [Armor] | 31 | decode :: IsString e => B.ByteString -> Either e [Armor] |
32 | decode bs = go (AS.parse parseArmors bs) | 32 | decode bs = go (AS.parse parseArmors bs) |
33 | where | 33 | where |
34 | go (AS.Fail _ _ e) = Left (fromString e) | 34 | go (AS.Fail _ _ e) = Left (fromString e) |
@@ -55,7 +55,7 @@ clearsigned = do | |||
55 | _ <- blankishLine <?> "blank line" | 55 | _ <- blankishLine <?> "blank line" |
56 | cleartext <- dashEscapedCleartext | 56 | cleartext <- dashEscapedCleartext |
57 | sig <- armor | 57 | sig <- armor |
58 | return $ ClearSigned headers (BL.fromChunks [cleartext]) sig | 58 | return $ ClearSigned headers cleartext sig |
59 | 59 | ||
60 | armor :: Parser Armor | 60 | armor :: Parser Armor |
61 | armor = do | 61 | armor = do |
@@ -64,7 +64,7 @@ armor = do | |||
64 | _ <- blankishLine <?> "blank line" | 64 | _ <- blankishLine <?> "blank line" |
65 | payload <- base64Data <?> "base64 data" | 65 | payload <- base64Data <?> "base64 data" |
66 | _ <- endLine atype <?> "end line" | 66 | _ <- endLine atype <?> "end line" |
67 | return $ Armor atype headers (BL.fromChunks [payload]) | 67 | return $ Armor atype headers payload |
68 | 68 | ||
69 | beginLine :: Parser ArmorType | 69 | beginLine :: Parser ArmorType |
70 | beginLine = do | 70 | beginLine = do |
@@ -88,7 +88,7 @@ beginLine = do | |||
88 | partsindef = ArmorSplitMessageIndefinite . BL.pack <$> num | 88 | partsindef = ArmorSplitMessageIndefinite . BL.pack <$> num |
89 | num = many1 (satisfy isDigit_w8) <?> "number" | 89 | num = many1 (satisfy isDigit_w8) <?> "number" |
90 | 90 | ||
91 | lineEnding :: Parser ByteString | 91 | lineEnding :: Parser B.ByteString |
92 | lineEnding = string "\n" <|> string "\r\n" | 92 | lineEnding = string "\n" <|> string "\r\n" |
93 | 93 | ||
94 | armorHeaders :: Parser [(String, String)] | 94 | armorHeaders :: Parser [(String, String)] |
@@ -104,15 +104,15 @@ armorHeader = do | |||
104 | where | 104 | where |
105 | w8sToString = BC8.unpack . B.pack | 105 | w8sToString = BC8.unpack . B.pack |
106 | 106 | ||
107 | blankishLine :: Parser ByteString | 107 | blankishLine :: Parser B.ByteString |
108 | blankishLine = many (satisfy (inClass " \t")) *> lineEnding | 108 | blankishLine = many (satisfy (inClass " \t")) *> lineEnding |
109 | 109 | ||
110 | endLine :: ArmorType -> Parser ByteString | 110 | endLine :: ArmorType -> Parser B.ByteString |
111 | endLine atype = do | 111 | endLine atype = do |
112 | _ <- string $ "-----END PGP " `B.append` aType atype `B.append` "-----" | 112 | _ <- string $ "-----END PGP " `B.append` aType atype `B.append` "-----" |
113 | lineEnding | 113 | lineEnding |
114 | 114 | ||
115 | aType :: ArmorType -> ByteString | 115 | aType :: ArmorType -> B.ByteString |
116 | aType (ArmorMessage) = BC8.pack "MESSAGE" | 116 | aType (ArmorMessage) = BC8.pack "MESSAGE" |
117 | aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" | 117 | aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" |
118 | aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" | 118 | aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" |
@@ -120,7 +120,7 @@ aType (ArmorSplitMessage x y) = BC8.pack "MESSAGE, PART " `B.append` l2s x `B.ap | |||
120 | aType (ArmorSplitMessageIndefinite x) = BC8.pack "MESSAGE, PART " `B.append` l2s x | 120 | aType (ArmorSplitMessageIndefinite x) = BC8.pack "MESSAGE, PART " `B.append` l2s x |
121 | aType (ArmorSignature) = BC8.pack "SIGNATURE" | 121 | aType (ArmorSignature) = BC8.pack "SIGNATURE" |
122 | 122 | ||
123 | l2s :: BL.ByteString -> ByteString | 123 | l2s :: BL.ByteString -> B.ByteString |
124 | l2s = B.concat . BL.toChunks | 124 | l2s = B.concat . BL.toChunks |
125 | 125 | ||
126 | base64Data :: Parser ByteString | 126 | base64Data :: Parser ByteString |
@@ -129,11 +129,11 @@ base64Data = do | |||
129 | cksum <- checksumLine | 129 | cksum <- checksumLine |
130 | let payload = B.concat ls | 130 | let payload = B.concat ls |
131 | let ourcksum = crc24 payload | 131 | let ourcksum = crc24 payload |
132 | case runGet d24 cksum of | 132 | case runGetOrFail d24 (BL.fromStrict cksum) of |
133 | Left err -> fail err | 133 | Left (_,_,err) -> fail err |
134 | Right theircksum -> if theircksum == ourcksum then return payload else fail ("CRC24 mismatch: " ++ show (B.unpack cksum) ++ "/" ++ show theircksum ++ " vs. " ++ show ourcksum) | 134 | Right (_,_,theircksum) -> if theircksum == ourcksum then return (BL.fromStrict payload) else fail ("CRC24 mismatch: " ++ show (B.unpack cksum) ++ "/" ++ show theircksum ++ " vs. " ++ show ourcksum) |
135 | where | 135 | where |
136 | base64Line :: Parser ByteString | 136 | base64Line :: Parser B.ByteString |
137 | base64Line = do | 137 | base64Line = do |
138 | b64 <- many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")) | 138 | b64 <- many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")) |
139 | pad <- many (word8 (fromIntegral . fromEnum $ '=')) | 139 | pad <- many (word8 (fromIntegral . fromEnum $ '=')) |
@@ -142,7 +142,7 @@ base64Data = do | |||
142 | case Base64.decode line of | 142 | case Base64.decode line of |
143 | Left err -> fail err | 143 | Left err -> fail err |
144 | Right bs -> return bs | 144 | Right bs -> return bs |
145 | checksumLine :: Parser ByteString | 145 | checksumLine :: Parser B.ByteString |
146 | checksumLine = do | 146 | checksumLine = do |
147 | _ <- word8 (fromIntegral . fromEnum $ '=') | 147 | _ <- word8 (fromIntegral . fromEnum $ '=') |
148 | b64 <- many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")) | 148 | b64 <- many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")) |
@@ -166,9 +166,9 @@ prefixed end = end <|> anyChar *> prefixed end | |||
166 | dashEscapedCleartext :: Parser ByteString | 166 | dashEscapedCleartext :: Parser ByteString |
167 | dashEscapedCleartext = do | 167 | dashEscapedCleartext = do |
168 | ls <- many1 ((deLine <|> unescapedLine) <* lineEnding) | 168 | ls <- many1 ((deLine <|> unescapedLine) <* lineEnding) |
169 | return $ crlfUnlines ls | 169 | return . BL.fromStrict $ crlfUnlines ls |
170 | where | 170 | where |
171 | deLine :: Parser ByteString | 171 | deLine :: Parser B.ByteString |
172 | deLine = B.pack <$> (string "- " *> many (satisfy (notInClass "\n\r"))) | 172 | deLine = B.pack <$> (string "- " *> many (satisfy (notInClass "\n\r"))) |
173 | unescapedLine :: Parser ByteString | 173 | unescapedLine :: Parser B.ByteString |
174 | unescapedLine = maybe B.empty B.pack <$> optional ((:) <$> satisfy (notInClass "-\n\r") <*> many (satisfy (notInClass "\n\r"))) | 174 | unescapedLine = maybe B.empty B.pack <$> optional ((:) <$> satisfy (notInClass "-\n\r") <*> many (satisfy (notInClass "\n\r"))) |