diff options
Diffstat (limited to 'Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs')
-rw-r--r-- | Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs | 32 |
1 files changed, 28 insertions, 4 deletions
diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs index 0376abc..b0033a8 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs | |||
@@ -10,7 +10,8 @@ module Codec.Encryption.OpenPGP.ASCIIArmor.Decode ( | |||
10 | ) where | 10 | ) where |
11 | 11 | ||
12 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types | 12 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types |
13 | import Control.Applicative (many, (<|>), (<$>), Alternative, (*>)) | 13 | import Codec.Encryption.OpenPGP.ASCIIArmor.Utils |
14 | import Control.Applicative (many, (<|>), (<$>), Alternative, (<*), (<*>), (*>), optional) | ||
14 | import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, (<?>), parse, IResult(..)) | 15 | import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, (<?>), parse, IResult(..)) |
15 | import Data.Attoparsec.ByteString.Char8 (isDigit_w8, anyChar) | 16 | import Data.Attoparsec.ByteString.Char8 (isDigit_w8, anyChar) |
16 | import Data.Attoparsec.Combinator (manyTill) | 17 | import Data.Attoparsec.Combinator (manyTill) |
@@ -37,8 +38,21 @@ parseArmors :: Parser [Armor] | |||
37 | parseArmors = many parseArmor | 38 | parseArmors = many parseArmor |
38 | 39 | ||
39 | parseArmor :: Parser Armor | 40 | parseArmor :: Parser Armor |
40 | parseArmor = do | 41 | parseArmor = prefixed (clearsigned <|> armor) <?> "armor" |
41 | atype <- prefixed beginLine <?> "begin line" | 42 | |
43 | clearsigned :: Parser Armor | ||
44 | clearsigned = do | ||
45 | string "-----BEGIN PGP SIGNED MESSAGE-----" <?> "clearsign header" | ||
46 | lineEnding <?> "line ending" | ||
47 | headers <- armorHeaders <?> "clearsign headers" | ||
48 | blankishLine <?> "blank line" | ||
49 | cleartext <- dashEscapedCleartext | ||
50 | sig <- armor | ||
51 | return $ ClearSigned headers cleartext sig | ||
52 | |||
53 | armor :: Parser Armor | ||
54 | armor = do | ||
55 | atype <- beginLine <?> "begin line" | ||
42 | headers <- armorHeaders <?> "headers" | 56 | headers <- armorHeaders <?> "headers" |
43 | blankishLine <?> "blank line" | 57 | blankishLine <?> "blank line" |
44 | payload <- base64Data <?> "base64 data" | 58 | payload <- base64Data <?> "base64 data" |
@@ -84,7 +98,7 @@ armorHeader = do | |||
84 | w8sToString = BC8.unpack . B.pack | 98 | w8sToString = BC8.unpack . B.pack |
85 | 99 | ||
86 | blankishLine :: Parser ByteString | 100 | blankishLine :: Parser ByteString |
87 | blankishLine = many (satisfy (inClass " \t")) >> lineEnding | 101 | blankishLine = many (satisfy (inClass " \t")) *> lineEnding |
88 | 102 | ||
89 | endLine :: ArmorType -> Parser ByteString | 103 | endLine :: ArmorType -> Parser ByteString |
90 | endLine atype = do | 104 | endLine atype = do |
@@ -138,3 +152,13 @@ d24 = do | |||
138 | 152 | ||
139 | prefixed :: Parser a -> Parser a | 153 | prefixed :: Parser a -> Parser a |
140 | prefixed end = end <|> anyChar *> prefixed end | 154 | prefixed end = end <|> anyChar *> prefixed end |
155 | |||
156 | dashEscapedCleartext :: Parser ByteString | ||
157 | dashEscapedCleartext = do | ||
158 | ls <- many1 ((deLine <|> unescapedLine) <* lineEnding) | ||
159 | return $ crlfUnlines ls | ||
160 | where | ||
161 | deLine :: Parser ByteString | ||
162 | deLine = B.pack <$> (string "- " *> many (satisfy (notInClass "\n\r"))) | ||
163 | unescapedLine :: Parser ByteString | ||
164 | unescapedLine = maybe B.empty B.pack <$> optional ((:) <$> satisfy (notInClass "-\n\r") <*> many (satisfy (notInClass "\n\r"))) | ||