diff options
Diffstat (limited to 'Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs')
-rw-r--r-- | Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs | 55 |
1 files changed, 30 insertions, 25 deletions
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 |