diff options
Diffstat (limited to 'Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs')
-rw-r--r-- | Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs | 58 |
1 files changed, 58 insertions, 0 deletions
diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs new file mode 100644 index 0000000..d08c3c1 --- /dev/null +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs | |||
@@ -0,0 +1,58 @@ | |||
1 | -- ASCIIArmor/Encode.hs: OpenPGP (RFC4880) ASCII armor implementation | ||
2 | -- Copyright Ⓒ 2012 Clint Adams | ||
3 | -- This software is released under the terms of the Expat (MIT) license. | ||
4 | -- (See the LICENSE file). | ||
5 | |||
6 | module Codec.Encryption.OpenPGP.ASCIIArmor.Encode ( | ||
7 | armor | ||
8 | ) where | ||
9 | |||
10 | import Codec.Encryption.OpenPGP.Serialize (putPackets) | ||
11 | import Codec.Encryption.OpenPGP.Types | ||
12 | import Data.ByteString (ByteString) | ||
13 | import qualified Data.ByteString as B | ||
14 | import qualified Data.ByteString.Char8 as BC8 | ||
15 | import qualified Data.ByteString.Base64 as Base64 | ||
16 | import Data.Digest.CRC24 (crc24) | ||
17 | import Data.Serialize.Put (runPut, putWord32be) | ||
18 | import Data.String (IsString, fromString) | ||
19 | |||
20 | armor :: (Integral a, Show a) => Armor a -> ByteString | ||
21 | armor (Armor atype ahs ps) = beginLine atype `B.append` armorHeaders ahs `B.append` blankLine `B.append` armorData (opgpStream ps) `B.append` armorChecksum (opgpStream ps) `B.append` endLine atype | ||
22 | |||
23 | blankLine :: ByteString | ||
24 | blankLine = BC8.singleton '\n' | ||
25 | |||
26 | beginLine :: (Integral a, Show a) => ArmorType a -> ByteString | ||
27 | beginLine atype = BC8.pack "-----BEGIN PGP " `B.append` aType atype `B.append` BC8.pack "-----\n" | ||
28 | |||
29 | endLine :: (Integral a, Show a) => ArmorType a -> ByteString | ||
30 | endLine atype = BC8.pack "-----END PGP " `B.append` aType atype `B.append` BC8.pack "-----\n" | ||
31 | |||
32 | aType :: (Integral a, Show a) => ArmorType a -> ByteString | ||
33 | aType (ArmorMessage) = BC8.pack "MESSAGE" | ||
34 | aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" | ||
35 | aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" | ||
36 | aType (ArmorSplitMessage x y) = BC8.pack $ "MESSAGE, PART " ++ show x ++ "/" ++ show y | ||
37 | aType (ArmorSplitMessageIndefinite x) = BC8.pack $ "MESSAGE, PART " ++ show x | ||
38 | aType (ArmorSignature) = BC8.pack "SIGNATURE" | ||
39 | |||
40 | armorHeaders :: [ArmorHeader] -> ByteString | ||
41 | armorHeaders ahs = BC8.unlines . map armorHeader $ ahs | ||
42 | where | ||
43 | armorHeader :: ArmorHeader -> ByteString | ||
44 | armorHeader (k, v) = k `B.append` BC8.pack ": " `B.append` v | ||
45 | |||
46 | opgpStream :: [Packet] -> ByteString | ||
47 | opgpStream = runPut . putPackets | ||
48 | |||
49 | armorData :: ByteString -> ByteString | ||
50 | armorData = BC8.unlines . wrap76 . Base64.encode | ||
51 | |||
52 | wrap76 :: ByteString -> [ByteString] | ||
53 | wrap76 bs | ||
54 | | B.null bs = [] | ||
55 | | otherwise = B.take 76 bs : wrap76 (B.drop 76 bs) | ||
56 | |||
57 | armorChecksum :: ByteString -> ByteString | ||
58 | armorChecksum = BC8.cons '=' . armorData . B.tail . runPut . putWord32be . crc24 | ||