summaryrefslogtreecommitdiff
path: root/Codec
diff options
context:
space:
mode:
authorClint Adams <clint@debian.org>2012-04-26 20:28:40 -0400
committerClint Adams <clint@debian.org>2012-04-26 20:28:40 -0400
commit8c34729c62ba64c810fbfa73719ae7f7110c0fbe (patch)
treec510a323f4c4a49cfb19ca3ba3132e8a80dc48d1 /Codec
parent1ddca48c27cece9352e85ce6188f697eb9124750 (diff)
More laziness.
Diffstat (limited to 'Codec')
-rw-r--r--Codec/Encryption/OpenPGP/ASCIIArmor.hs10
-rw-r--r--Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs23
-rw-r--r--Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs55
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
6module Codec.Encryption.OpenPGP.ASCIIArmor ( 6module 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
13import Codec.Encryption.OpenPGP.ASCIIArmor.Encode (encode) 15import Codec.Encryption.OpenPGP.ASCIIArmor.Decode (decode, decodeLazy, parseArmor)
14import Codec.Encryption.OpenPGP.ASCIIArmor.Decode (decode, parseArmor) 16import Codec.Encryption.OpenPGP.ASCIIArmor.Encode (encode, encodeLazy)
15import Codec.Encryption.OpenPGP.ASCIIArmor.Multipart (multipartMerge) 17import 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 @@
7module Codec.Encryption.OpenPGP.ASCIIArmor.Decode ( 7module Codec.Encryption.OpenPGP.ASCIIArmor.Decode (
8 parseArmor 8 parseArmor
9 , decode 9 , decode
10 , decodeLazy
10) where 11) where
11 12
12import Codec.Encryption.OpenPGP.ASCIIArmor.Types 13import Codec.Encryption.OpenPGP.ASCIIArmor.Types
13import Codec.Encryption.OpenPGP.ASCIIArmor.Utils 14import Codec.Encryption.OpenPGP.ASCIIArmor.Utils
14import Control.Applicative (many, (<|>), (<$>), Alternative, (<*), (<*>), (*>), optional) 15import Control.Applicative (many, (<|>), (<$>), Alternative, (<*), (<*>), (*>), optional)
15import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, (<?>), parse, IResult(..)) 16import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, (<?>))
17import qualified Data.Attoparsec.ByteString as AS
18import qualified Data.Attoparsec.ByteString.Lazy as AL
16import Data.Attoparsec.ByteString.Char8 (isDigit_w8, anyChar) 19import Data.Attoparsec.ByteString.Char8 (isDigit_w8, anyChar)
17import Data.Attoparsec.Combinator (manyTill) 20import Data.Attoparsec.Combinator (manyTill)
18import Data.Bits (shiftL) 21import Data.Bits (shiftL)
@@ -29,11 +32,17 @@ import Data.String (IsString, fromString)
29import Data.Word (Word32) 32import Data.Word (Word32)
30 33
31decode :: IsString e => ByteString -> Either e [Armor] 34decode :: IsString e => ByteString -> Either e [Armor]
32decode bs = go (parse parseArmors bs) 35decode 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
41decodeLazy :: IsString e => BL.ByteString -> Either e [Armor]
42decodeLazy 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
38parseArmors :: Parser [Armor] 47parseArmors :: Parser [Armor]
39parseArmors = many parseArmor 48parseArmors = many parseArmor
@@ -110,8 +119,8 @@ aType :: ArmorType -> ByteString
110aType (ArmorMessage) = BC8.pack "MESSAGE" 119aType (ArmorMessage) = BC8.pack "MESSAGE"
111aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" 120aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK"
112aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" 121aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK"
113aType (ArmorSplitMessage x y) = BC8.pack "MESSAGE, PART " `B.append` (l2s x) `B.append` BC8.singleton '/' `B.append` (l2s y) 122aType (ArmorSplitMessage x y) = BC8.pack "MESSAGE, PART " `B.append` l2s x `B.append` BC8.singleton '/' `B.append` l2s y
114aType (ArmorSplitMessageIndefinite x) = BC8.pack "MESSAGE, PART " `B.append` (l2s x) 123aType (ArmorSplitMessageIndefinite x) = BC8.pack "MESSAGE, PART " `B.append` l2s x
115aType (ArmorSignature) = BC8.pack "SIGNATURE" 124aType (ArmorSignature) = BC8.pack "SIGNATURE"
116 125
117l2s :: BL.ByteString -> ByteString 126l2s :: 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
6module Codec.Encryption.OpenPGP.ASCIIArmor.Encode ( 6module Codec.Encryption.OpenPGP.ASCIIArmor.Encode (
7 encode 7 encode
8 , encodeLazy
8) where 9) where
9 10
10import Codec.Encryption.OpenPGP.ASCIIArmor.Types 11import Codec.Encryption.OpenPGP.ASCIIArmor.Types
11import Data.ByteString (ByteString) 12import Data.ByteString.Lazy (ByteString)
12import qualified Data.ByteString as B 13import qualified Data.ByteString as B
13import qualified Data.ByteString.Lazy as BL 14import qualified Data.ByteString.Lazy as BL
14import qualified Data.ByteString.Char8 as BC8 15import qualified Data.ByteString.Char8 as BC8
16import qualified Data.ByteString.Lazy.Char8 as BLC8
15import qualified Data.ByteString.Base64 as Base64 17import qualified Data.ByteString.Base64 as Base64
16import Data.Digest.CRC24 (crc24) 18import Data.Digest.CRC24 (crc24Lazy)
17import Data.Serialize (put) 19import Data.Serialize (put)
18import Data.Serialize.Put (runPut, putWord32be) 20import Data.Serialize.Put (runPutLazy, putWord32be)
19import Data.String (IsString, fromString) 21import Data.String (IsString, fromString)
20 22
21encode :: [Armor] -> ByteString 23encode :: [Armor] -> B.ByteString
22encode = B.concat . map armor 24encode = B.concat . BL.toChunks . encodeLazy
25
26encodeLazy :: [Armor] -> ByteString
27encodeLazy = BL.concat . map armor
23 28
24armor :: Armor -> ByteString 29armor :: Armor -> ByteString
25armor (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 30armor (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
26armor (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 31armor (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
28blankLine :: ByteString 33blankLine :: ByteString
29blankLine = BC8.singleton '\n' 34blankLine = BLC8.singleton '\n'
30 35
31beginLine :: ArmorType -> ByteString 36beginLine :: ArmorType -> ByteString
32beginLine atype = BC8.pack "-----BEGIN PGP " `B.append` aType atype `B.append` BC8.pack "-----\n" 37beginLine atype = BLC8.pack "-----BEGIN PGP " `BL.append` aType atype `BL.append` BLC8.pack "-----\n"
33 38
34endLine :: ArmorType -> ByteString 39endLine :: ArmorType -> ByteString
35endLine atype = BC8.pack "-----END PGP " `B.append` aType atype `B.append` BC8.pack "-----\n" 40endLine atype = BLC8.pack "-----END PGP " `BL.append` aType atype `BL.append` BLC8.pack "-----\n"
36 41
37aType :: ArmorType -> ByteString 42aType :: ArmorType -> ByteString
38aType (ArmorMessage) = BC8.pack "MESSAGE" 43aType (ArmorMessage) = BLC8.pack "MESSAGE"
39aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" 44aType (ArmorPublicKeyBlock) = BLC8.pack "PUBLIC KEY BLOCK"
40aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" 45aType (ArmorPrivateKeyBlock) = BLC8.pack "PRIVATE KEY BLOCK"
41aType (ArmorSplitMessage x y) = BC8.pack $ "MESSAGE, PART " ++ show x ++ "/" ++ show y 46aType (ArmorSplitMessage x y) = BLC8.pack $ "MESSAGE, PART " ++ show x ++ "/" ++ show y
42aType (ArmorSplitMessageIndefinite x) = BC8.pack $ "MESSAGE, PART " ++ show x 47aType (ArmorSplitMessageIndefinite x) = BLC8.pack $ "MESSAGE, PART " ++ show x
43aType (ArmorSignature) = BC8.pack "SIGNATURE" 48aType (ArmorSignature) = BLC8.pack "SIGNATURE"
44 49
45armorHeaders :: [(String, String)] -> ByteString 50armorHeaders :: [(String, String)] -> ByteString
46armorHeaders ahs = BC8.unlines . map armorHeader $ ahs 51armorHeaders 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
51armorData :: ByteString -> ByteString 56armorData :: ByteString -> ByteString
52armorData = BC8.unlines . wordWrap 64 . Base64.encode 57armorData = BLC8.unlines . wordWrap 64 . BL.fromChunks . return . Base64.encode . B.concat . BL.toChunks
53 58
54wordWrap :: Int -> ByteString -> [ByteString] 59wordWrap :: Int -> ByteString -> [ByteString]
55wordWrap lw bs 60wordWrap 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
60armorChecksum :: ByteString -> ByteString 65armorChecksum :: ByteString -> ByteString
61armorChecksum = BC8.cons '=' . armorData . B.tail . runPut . putWord32be . crc24 66armorChecksum = BLC8.cons '=' . armorData . BL.tail . runPutLazy . putWord32be . crc24Lazy
62 67
63dashEscape :: ByteString -> ByteString 68dashEscape :: ByteString -> ByteString
64dashEscape = BC8.unlines . map escapeLine . BC8.lines 69dashEscape = 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