-- ASCIIArmor/Encode.hs: OpenPGP (RFC4880) ASCII armor implementation
-- Copyright Ⓒ 2012  Clint Adams
-- This software is released under the terms of the ISC license.
-- (See the LICENSE file).

module Codec.Encryption.OpenPGP.ASCIIArmor.Encode (
   encode
) where

import Codec.Encryption.OpenPGP.ASCIIArmor.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)
import Data.Serialize.Put (runPut, putWord32be)
import Data.String (IsString, fromString)

encode :: [Armor] -> ByteString
encode = B.concat . map armor

armor :: Armor -> ByteString
armor (Armor atype ahs bs) = beginLine atype `B.append` armorHeaders ahs `B.append` blankLine `B.append` armorData bs `B.append` armorChecksum bs `B.append` endLine atype
armor (ClearSigned chs ctxt csig) = BC8.pack "-----BEGIN PGP SIGNED MESSAGE-----\n" `B.append` armorHeaders chs `B.append` blankLine `B.append` dashEscape ctxt `B.append` armor csig

blankLine :: ByteString
blankLine = BC8.singleton '\n'

beginLine :: ArmorType -> ByteString
beginLine atype = BC8.pack "-----BEGIN PGP " `B.append` aType atype `B.append` BC8.pack "-----\n"

endLine :: ArmorType -> ByteString
endLine atype = BC8.pack "-----END PGP " `B.append` aType atype `B.append` BC8.pack "-----\n"

aType :: ArmorType -> 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 :: [(String, String)] -> ByteString
armorHeaders ahs = BC8.unlines . map armorHeader $ ahs
    where
        armorHeader :: (String, String) -> ByteString
        armorHeader (k, v) = BC8.pack k `B.append` BC8.pack ": " `B.append` BC8.pack v

armorData :: ByteString -> ByteString
armorData = BC8.unlines . wordWrap 64 . Base64.encode

wordWrap :: Int -> ByteString -> [ByteString]
wordWrap lw bs
    | B.null bs = []
    | lw < 1 || lw > 76 = wordWrap 76 bs
    | otherwise = B.take lw bs : wordWrap lw (B.drop lw bs)

armorChecksum :: ByteString -> ByteString
armorChecksum = BC8.cons '=' . armorData . B.tail . runPut . putWord32be . crc24

dashEscape :: ByteString -> ByteString
dashEscape = BC8.unlines . map escapeLine . BC8.lines
    where
        escapeLine :: ByteString -> ByteString
        escapeLine l
            | BC8.singleton '-' `B.isPrefixOf` l = BC8.pack "- " `B.append` l
            | BC8.pack "From " `B.isPrefixOf` l = BC8.pack "- " `B.append` l
            | otherwise = l