diff options
author | Clint Adams <clint@debian.org> | 2012-04-26 20:28:40 -0400 |
---|---|---|
committer | Clint Adams <clint@debian.org> | 2012-04-26 20:28:40 -0400 |
commit | 8c34729c62ba64c810fbfa73719ae7f7110c0fbe (patch) | |
tree | c510a323f4c4a49cfb19ca3ba3132e8a80dc48d1 /Codec | |
parent | 1ddca48c27cece9352e85ce6188f697eb9124750 (diff) |
More laziness.
Diffstat (limited to 'Codec')
-rw-r--r-- | Codec/Encryption/OpenPGP/ASCIIArmor.hs | 10 | ||||
-rw-r--r-- | Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs | 23 | ||||
-rw-r--r-- | Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs | 55 |
3 files changed, 52 insertions, 36 deletions
diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor.hs b/Codec/Encryption/OpenPGP/ASCIIArmor.hs index 6d0c172..fcb7337 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor.hs | |||
@@ -4,12 +4,14 @@ | |||
4 | -- (See the LICENSE file). | 4 | -- (See the LICENSE file). |
5 | 5 | ||
6 | module Codec.Encryption.OpenPGP.ASCIIArmor ( | 6 | module Codec.Encryption.OpenPGP.ASCIIArmor ( |
7 | encode | 7 | decode |
8 | , decode | 8 | , decodeLazy |
9 | , encode | ||
10 | , encodeLazy | ||
9 | , parseArmor | 11 | , parseArmor |
10 | , multipartMerge | 12 | , multipartMerge |
11 | ) where | 13 | ) where |
12 | 14 | ||
13 | import Codec.Encryption.OpenPGP.ASCIIArmor.Encode (encode) | 15 | import Codec.Encryption.OpenPGP.ASCIIArmor.Decode (decode, decodeLazy, parseArmor) |
14 | import Codec.Encryption.OpenPGP.ASCIIArmor.Decode (decode, parseArmor) | 16 | import Codec.Encryption.OpenPGP.ASCIIArmor.Encode (encode, encodeLazy) |
15 | import Codec.Encryption.OpenPGP.ASCIIArmor.Multipart (multipartMerge) | 17 | import Codec.Encryption.OpenPGP.ASCIIArmor.Multipart (multipartMerge) |
diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs index b89fbfa..bfaef39 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs | |||
@@ -7,12 +7,15 @@ | |||
7 | module Codec.Encryption.OpenPGP.ASCIIArmor.Decode ( | 7 | module Codec.Encryption.OpenPGP.ASCIIArmor.Decode ( |
8 | parseArmor | 8 | parseArmor |
9 | , decode | 9 | , decode |
10 | , decodeLazy | ||
10 | ) where | 11 | ) where |
11 | 12 | ||
12 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types | 13 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types |
13 | import Codec.Encryption.OpenPGP.ASCIIArmor.Utils | 14 | import Codec.Encryption.OpenPGP.ASCIIArmor.Utils |
14 | import Control.Applicative (many, (<|>), (<$>), Alternative, (<*), (<*>), (*>), optional) | 15 | import Control.Applicative (many, (<|>), (<$>), Alternative, (<*), (<*>), (*>), optional) |
15 | import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, (<?>), parse, IResult(..)) | 16 | import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, (<?>)) |
17 | import qualified Data.Attoparsec.ByteString as AS | ||
18 | import qualified Data.Attoparsec.ByteString.Lazy as AL | ||
16 | import Data.Attoparsec.ByteString.Char8 (isDigit_w8, anyChar) | 19 | import Data.Attoparsec.ByteString.Char8 (isDigit_w8, anyChar) |
17 | import Data.Attoparsec.Combinator (manyTill) | 20 | import Data.Attoparsec.Combinator (manyTill) |
18 | import Data.Bits (shiftL) | 21 | import Data.Bits (shiftL) |
@@ -29,11 +32,17 @@ import Data.String (IsString, fromString) | |||
29 | import Data.Word (Word32) | 32 | import Data.Word (Word32) |
30 | 33 | ||
31 | decode :: IsString e => ByteString -> Either e [Armor] | 34 | decode :: IsString e => ByteString -> Either e [Armor] |
32 | decode bs = go (parse parseArmors bs) | 35 | decode bs = go (AS.parse parseArmors bs) |
33 | where | 36 | where |
34 | go (Fail t c e) = Left (fromString e) | 37 | go (AS.Fail t c e) = Left (fromString e) |
35 | go (Partial cont) = go (cont B.empty) | 38 | go (AS.Partial cont) = go (cont B.empty) |
36 | go (Done _ r) = Right r | 39 | go (AS.Done _ r) = Right r |
40 | |||
41 | decodeLazy :: IsString e => BL.ByteString -> Either e [Armor] | ||
42 | decodeLazy bs = go (AL.parse parseArmors bs) | ||
43 | where | ||
44 | go (AL.Fail t c e) = Left (fromString e) | ||
45 | go (AL.Done _ r) = Right r | ||
37 | 46 | ||
38 | parseArmors :: Parser [Armor] | 47 | parseArmors :: Parser [Armor] |
39 | parseArmors = many parseArmor | 48 | parseArmors = many parseArmor |
@@ -110,8 +119,8 @@ aType :: ArmorType -> ByteString | |||
110 | aType (ArmorMessage) = BC8.pack "MESSAGE" | 119 | aType (ArmorMessage) = BC8.pack "MESSAGE" |
111 | aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" | 120 | aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" |
112 | aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" | 121 | aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" |
113 | aType (ArmorSplitMessage x y) = BC8.pack "MESSAGE, PART " `B.append` (l2s x) `B.append` BC8.singleton '/' `B.append` (l2s y) | 122 | aType (ArmorSplitMessage x y) = BC8.pack "MESSAGE, PART " `B.append` l2s x `B.append` BC8.singleton '/' `B.append` l2s y |
114 | aType (ArmorSplitMessageIndefinite x) = BC8.pack "MESSAGE, PART " `B.append` (l2s x) | 123 | aType (ArmorSplitMessageIndefinite x) = BC8.pack "MESSAGE, PART " `B.append` l2s x |
115 | aType (ArmorSignature) = BC8.pack "SIGNATURE" | 124 | aType (ArmorSignature) = BC8.pack "SIGNATURE" |
116 | 125 | ||
117 | l2s :: BL.ByteString -> ByteString | 126 | l2s :: BL.ByteString -> ByteString |
diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs index 06d7f1a..cb7eb3d 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs | |||
@@ -5,66 +5,71 @@ | |||
5 | 5 | ||
6 | module Codec.Encryption.OpenPGP.ASCIIArmor.Encode ( | 6 | module Codec.Encryption.OpenPGP.ASCIIArmor.Encode ( |
7 | encode | 7 | encode |
8 | , encodeLazy | ||
8 | ) where | 9 | ) where |
9 | 10 | ||
10 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types | 11 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types |
11 | import Data.ByteString (ByteString) | 12 | import Data.ByteString.Lazy (ByteString) |
12 | import qualified Data.ByteString as B | 13 | import qualified Data.ByteString as B |
13 | import qualified Data.ByteString.Lazy as BL | 14 | import qualified Data.ByteString.Lazy as BL |
14 | import qualified Data.ByteString.Char8 as BC8 | 15 | import qualified Data.ByteString.Char8 as BC8 |
16 | import qualified Data.ByteString.Lazy.Char8 as BLC8 | ||
15 | import qualified Data.ByteString.Base64 as Base64 | 17 | import qualified Data.ByteString.Base64 as Base64 |
16 | import Data.Digest.CRC24 (crc24) | 18 | import Data.Digest.CRC24 (crc24Lazy) |
17 | import Data.Serialize (put) | 19 | import Data.Serialize (put) |
18 | import Data.Serialize.Put (runPut, putWord32be) | 20 | import Data.Serialize.Put (runPutLazy, putWord32be) |
19 | import Data.String (IsString, fromString) | 21 | import Data.String (IsString, fromString) |
20 | 22 | ||
21 | encode :: [Armor] -> ByteString | 23 | encode :: [Armor] -> B.ByteString |
22 | encode = B.concat . map armor | 24 | encode = B.concat . BL.toChunks . encodeLazy |
25 | |||
26 | encodeLazy :: [Armor] -> ByteString | ||
27 | encodeLazy = BL.concat . map armor | ||
23 | 28 | ||
24 | armor :: Armor -> ByteString | 29 | armor :: Armor -> ByteString |
25 | armor (Armor atype ahs bs) = beginLine atype `B.append` armorHeaders ahs `B.append` blankLine `B.append` armorData (B.concat . BL.toChunks $ bs) `B.append` armorChecksum (B.concat . BL.toChunks $ bs) `B.append` endLine atype | 30 | armor (Armor atype ahs bs) = beginLine atype `BL.append` armorHeaders ahs `BL.append` blankLine `BL.append` armorData bs `BL.append` armorChecksum bs `BL.append` endLine atype |
26 | armor (ClearSigned chs ctxt csig) = BC8.pack "-----BEGIN PGP SIGNED MESSAGE-----\n" `B.append` armorHeaders chs `B.append` blankLine `B.append` dashEscape (B.concat . BL.toChunks $ ctxt) `B.append` armor csig | 31 | armor (ClearSigned chs ctxt csig) = BLC8.pack "-----BEGIN PGP SIGNED MESSAGE-----\n" `BL.append` armorHeaders chs `BL.append` blankLine `BL.append` dashEscape ctxt `BL.append` armor csig |
27 | 32 | ||
28 | blankLine :: ByteString | 33 | blankLine :: ByteString |
29 | blankLine = BC8.singleton '\n' | 34 | blankLine = BLC8.singleton '\n' |
30 | 35 | ||
31 | beginLine :: ArmorType -> ByteString | 36 | beginLine :: ArmorType -> ByteString |
32 | beginLine atype = BC8.pack "-----BEGIN PGP " `B.append` aType atype `B.append` BC8.pack "-----\n" | 37 | beginLine atype = BLC8.pack "-----BEGIN PGP " `BL.append` aType atype `BL.append` BLC8.pack "-----\n" |
33 | 38 | ||
34 | endLine :: ArmorType -> ByteString | 39 | endLine :: ArmorType -> ByteString |
35 | endLine atype = BC8.pack "-----END PGP " `B.append` aType atype `B.append` BC8.pack "-----\n" | 40 | endLine atype = BLC8.pack "-----END PGP " `BL.append` aType atype `BL.append` BLC8.pack "-----\n" |
36 | 41 | ||
37 | aType :: ArmorType -> ByteString | 42 | aType :: ArmorType -> ByteString |
38 | aType (ArmorMessage) = BC8.pack "MESSAGE" | 43 | aType (ArmorMessage) = BLC8.pack "MESSAGE" |
39 | aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" | 44 | aType (ArmorPublicKeyBlock) = BLC8.pack "PUBLIC KEY BLOCK" |
40 | aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" | 45 | aType (ArmorPrivateKeyBlock) = BLC8.pack "PRIVATE KEY BLOCK" |
41 | aType (ArmorSplitMessage x y) = BC8.pack $ "MESSAGE, PART " ++ show x ++ "/" ++ show y | 46 | aType (ArmorSplitMessage x y) = BLC8.pack $ "MESSAGE, PART " ++ show x ++ "/" ++ show y |
42 | aType (ArmorSplitMessageIndefinite x) = BC8.pack $ "MESSAGE, PART " ++ show x | 47 | aType (ArmorSplitMessageIndefinite x) = BLC8.pack $ "MESSAGE, PART " ++ show x |
43 | aType (ArmorSignature) = BC8.pack "SIGNATURE" | 48 | aType (ArmorSignature) = BLC8.pack "SIGNATURE" |
44 | 49 | ||
45 | armorHeaders :: [(String, String)] -> ByteString | 50 | armorHeaders :: [(String, String)] -> ByteString |
46 | armorHeaders ahs = BC8.unlines . map armorHeader $ ahs | 51 | armorHeaders ahs = BLC8.unlines . map armorHeader $ ahs |
47 | where | 52 | where |
48 | armorHeader :: (String, String) -> ByteString | 53 | armorHeader :: (String, String) -> ByteString |
49 | armorHeader (k, v) = BC8.pack k `B.append` BC8.pack ": " `B.append` BC8.pack v | 54 | armorHeader (k, v) = BLC8.pack k `BL.append` BLC8.pack ": " `BL.append` BLC8.pack v |
50 | 55 | ||
51 | armorData :: ByteString -> ByteString | 56 | armorData :: ByteString -> ByteString |
52 | armorData = BC8.unlines . wordWrap 64 . Base64.encode | 57 | armorData = BLC8.unlines . wordWrap 64 . BL.fromChunks . return . Base64.encode . B.concat . BL.toChunks |
53 | 58 | ||
54 | wordWrap :: Int -> ByteString -> [ByteString] | 59 | wordWrap :: Int -> ByteString -> [ByteString] |
55 | wordWrap lw bs | 60 | wordWrap lw bs |
56 | | B.null bs = [] | 61 | | BL.null bs = [] |
57 | | lw < 1 || lw > 76 = wordWrap 76 bs | 62 | | lw < 1 || lw > 76 = wordWrap 76 bs |
58 | | otherwise = B.take lw bs : wordWrap lw (B.drop lw bs) | 63 | | otherwise = BL.take (fromIntegral lw) bs : wordWrap lw (BL.drop (fromIntegral lw) bs) |
59 | 64 | ||
60 | armorChecksum :: ByteString -> ByteString | 65 | armorChecksum :: ByteString -> ByteString |
61 | armorChecksum = BC8.cons '=' . armorData . B.tail . runPut . putWord32be . crc24 | 66 | armorChecksum = BLC8.cons '=' . armorData . BL.tail . runPutLazy . putWord32be . crc24Lazy |
62 | 67 | ||
63 | dashEscape :: ByteString -> ByteString | 68 | dashEscape :: ByteString -> ByteString |
64 | dashEscape = BC8.unlines . map escapeLine . BC8.lines | 69 | dashEscape = BLC8.unlines . map escapeLine . BLC8.lines |
65 | where | 70 | where |
66 | escapeLine :: ByteString -> ByteString | 71 | escapeLine :: ByteString -> ByteString |
67 | escapeLine l | 72 | escapeLine l |
68 | | BC8.singleton '-' `B.isPrefixOf` l = BC8.pack "- " `B.append` l | 73 | | BLC8.singleton '-' `BL.isPrefixOf` l = BLC8.pack "- " `BL.append` l |
69 | | BC8.pack "From " `B.isPrefixOf` l = BC8.pack "- " `B.append` l | 74 | | BLC8.pack "From " `BL.isPrefixOf` l = BLC8.pack "- " `BL.append` l |
70 | | otherwise = l | 75 | | otherwise = l |