module Codec.Encryption.OpenPGP.ASCIIArmor.Encode (
encode
, encodeLazy
) where
import Codec.Encryption.OpenPGP.ASCIIArmor.Types
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BLC8
import qualified Data.ByteString.Base64 as Base64
import Data.Digest.CRC24 (crc24Lazy)
import Data.Binary.Put (runPut, putWord32be)
encode :: [Armor] -> B.ByteString
encode :: [Armor] -> ByteString
encode = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> ([Armor] -> [ByteString]) -> [Armor] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks (ByteString -> [ByteString])
-> ([Armor] -> ByteString) -> [Armor] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Armor] -> ByteString
encodeLazy
encodeLazy :: [Armor] -> ByteString
encodeLazy :: [Armor] -> ByteString
encodeLazy = [ByteString] -> ByteString
BL.concat ([ByteString] -> ByteString)
-> ([Armor] -> [ByteString]) -> [Armor] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Armor -> ByteString) -> [Armor] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Armor -> ByteString
armor
armor :: Armor -> ByteString
armor :: Armor -> ByteString
armor (Armor atype :: ArmorType
atype ahs :: [(String, String)]
ahs bs :: ByteString
bs) = ArmorType -> ByteString
beginLine ArmorType
atype ByteString -> ByteString -> ByteString
`BL.append` [(String, String)] -> ByteString
armorHeaders [(String, String)]
ahs ByteString -> ByteString -> ByteString
`BL.append` ByteString
blankLine ByteString -> ByteString -> ByteString
`BL.append` ByteString -> ByteString
armorData ByteString
bs ByteString -> ByteString -> ByteString
`BL.append` ByteString -> ByteString
armorChecksum ByteString
bs ByteString -> ByteString -> ByteString
`BL.append` ArmorType -> ByteString
endLine ArmorType
atype
armor (ClearSigned chs :: [(String, String)]
chs ctxt :: ByteString
ctxt csig :: Armor
csig) = String -> ByteString
BLC8.pack "-----BEGIN PGP SIGNED MESSAGE-----\n" ByteString -> ByteString -> ByteString
`BL.append` [(String, String)] -> ByteString
armorHeaders [(String, String)]
chs ByteString -> ByteString -> ByteString
`BL.append` ByteString
blankLine ByteString -> ByteString -> ByteString
`BL.append` ByteString -> ByteString
dashEscape ByteString
ctxt ByteString -> ByteString -> ByteString
`BL.append` Armor -> ByteString
armor Armor
csig
blankLine :: ByteString
blankLine :: ByteString
blankLine = Char -> ByteString
BLC8.singleton '\n'
beginLine :: ArmorType -> ByteString
beginLine :: ArmorType -> ByteString
beginLine atype :: ArmorType
atype = String -> ByteString
BLC8.pack "-----BEGIN PGP " ByteString -> ByteString -> ByteString
`BL.append` ArmorType -> ByteString
aType ArmorType
atype ByteString -> ByteString -> ByteString
`BL.append` String -> ByteString
BLC8.pack "-----\n"
endLine :: ArmorType -> ByteString
endLine :: ArmorType -> ByteString
endLine atype :: ArmorType
atype = String -> ByteString
BLC8.pack "-----END PGP " ByteString -> ByteString -> ByteString
`BL.append` ArmorType -> ByteString
aType ArmorType
atype ByteString -> ByteString -> ByteString
`BL.append` String -> ByteString
BLC8.pack "-----\n"
aType :: ArmorType -> ByteString
aType :: ArmorType -> ByteString
aType ArmorMessage = String -> ByteString
BLC8.pack "MESSAGE"
aType ArmorPublicKeyBlock = String -> ByteString
BLC8.pack "PUBLIC KEY BLOCK"
aType ArmorPrivateKeyBlock = String -> ByteString
BLC8.pack "PRIVATE KEY BLOCK"
aType (ArmorSplitMessage x :: ByteString
x y :: ByteString
y) = String -> ByteString
BLC8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ "MESSAGE, PART " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
y
aType (ArmorSplitMessageIndefinite x :: ByteString
x) = String -> ByteString
BLC8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ "MESSAGE, PART " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
x
aType ArmorSignature = String -> ByteString
BLC8.pack "SIGNATURE"
armorHeaders :: [(String, String)] -> ByteString
= [ByteString] -> ByteString
BLC8.unlines ([ByteString] -> ByteString)
-> ([(String, String)] -> [ByteString])
-> [(String, String)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> ByteString)
-> [(String, String)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> ByteString
armorHeader
where
armorHeader :: (String, String) -> ByteString
armorHeader :: (String, String) -> ByteString
armorHeader (k :: String
k, v :: String
v) = String -> ByteString
BLC8.pack String
k ByteString -> ByteString -> ByteString
`BL.append` String -> ByteString
BLC8.pack ": " ByteString -> ByteString -> ByteString
`BL.append` String -> ByteString
BLC8.pack String
v
armorData :: ByteString -> ByteString
armorData :: ByteString -> ByteString
armorData = [ByteString] -> ByteString
BLC8.unlines ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> [ByteString]
wordWrap 64 (ByteString -> [ByteString])
-> (ByteString -> ByteString) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BL.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> [ByteString])
-> (ByteString -> ByteString) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks
wordWrap :: Int -> ByteString -> [ByteString]
wordWrap :: Int -> ByteString -> [ByteString]
wordWrap lw :: Int
lw bs :: ByteString
bs
| ByteString -> Bool
BL.null ByteString
bs = []
| Int
lw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 Bool -> Bool -> Bool
|| Int
lw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 76 = Int -> ByteString -> [ByteString]
wordWrap 76 ByteString
bs
| Bool
otherwise = Int64 -> ByteString -> ByteString
BL.take (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lw) ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int -> ByteString -> [ByteString]
wordWrap Int
lw (Int64 -> ByteString -> ByteString
BL.drop (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lw) ByteString
bs)
armorChecksum :: ByteString -> ByteString
armorChecksum :: ByteString -> ByteString
armorChecksum = Char -> ByteString -> ByteString
BLC8.cons '=' (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
armorData (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.tail (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString)
-> (ByteString -> Put) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Put
putWord32be (Word32 -> Put) -> (ByteString -> Word32) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word32
crc24Lazy
dashEscape :: ByteString -> ByteString
dashEscape :: ByteString -> ByteString
dashEscape = [ByteString] -> ByteString
BLC8.unlines ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
escapeLine ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BLC8.lines
where
escapeLine :: ByteString -> ByteString
escapeLine :: ByteString -> ByteString
escapeLine l :: ByteString
l
| Char -> ByteString
BLC8.singleton '-' ByteString -> ByteString -> Bool
`BL.isPrefixOf` ByteString
l = String -> ByteString
BLC8.pack "- " ByteString -> ByteString -> ByteString
`BL.append` ByteString
l
| String -> ByteString
BLC8.pack "From " ByteString -> ByteString -> Bool
`BL.isPrefixOf` ByteString
l = String -> ByteString
BLC8.pack "- " ByteString -> ByteString -> ByteString
`BL.append` ByteString
l
| Bool
otherwise = ByteString
l