module Codec.Encryption.OpenPGP.ASCIIArmor.Encode (
armor
) where
import Codec.Encryption.OpenPGP.Serialize (putPackets)
import Codec.Encryption.OpenPGP.Types
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC8
import qualified Data.ByteString.Base64 as Base64
import Data.Digest.CRC24 (crc24)
import Data.Serialize.Put (runPut, putWord32be)
import Data.String (IsString, fromString)
armor :: (Integral a, Show a) => Armor a -> ByteString
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
blankLine :: ByteString
blankLine = BC8.singleton '\n'
beginLine :: (Integral a, Show a) => ArmorType a -> ByteString
beginLine atype = BC8.pack "-----BEGIN PGP " `B.append` aType atype `B.append` BC8.pack "-----\n"
endLine :: (Integral a, Show a) => ArmorType a -> ByteString
endLine atype = BC8.pack "-----END PGP " `B.append` aType atype `B.append` BC8.pack "-----\n"
aType :: (Integral a, Show a) => ArmorType a -> ByteString
aType (ArmorMessage) = BC8.pack "MESSAGE"
aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK"
aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK"
aType (ArmorSplitMessage x y) = BC8.pack $ "MESSAGE, PART " ++ show x ++ "/" ++ show y
aType (ArmorSplitMessageIndefinite x) = BC8.pack $ "MESSAGE, PART " ++ show x
aType (ArmorSignature) = BC8.pack "SIGNATURE"
armorHeaders :: [ArmorHeader] -> ByteString
armorHeaders ahs = BC8.unlines . map armorHeader $ ahs
where
armorHeader :: ArmorHeader -> ByteString
armorHeader (k, v) = k `B.append` BC8.pack ": " `B.append` v
opgpStream :: [Packet] -> ByteString
opgpStream = runPut . putPackets
armorData :: ByteString -> ByteString
armorData = BC8.unlines . wrap76 . Base64.encode
wrap76 :: ByteString -> [ByteString]
wrap76 bs
| B.null bs = []
| otherwise = B.take 76 bs : wrap76 (B.drop 76 bs)
armorChecksum :: ByteString -> ByteString
armorChecksum = BC8.cons '=' . armorData . B.tail . runPut . putWord32be . crc24