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

    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 ArmorType
    atype [(String, String)]
    ahs 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 [(String, String)]
    chs ByteString
    ctxt Armor
    csig) = String -> ByteString
    BLC8.pack String
    "-----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 Char
    '\n'

    beginLine :: ArmorType -> ByteString
    beginLine :: ArmorType -> ByteString
    beginLine ArmorType
    atype = String -> ByteString
    BLC8.pack String
    "-----BEGIN PGP " ByteString -> ByteString -> ByteString
    `BL.append` ArmorType -> ByteString
    aType ArmorType
    atype ByteString -> ByteString -> ByteString
    `BL.append` String -> ByteString
    BLC8.pack String
    "-----\n"

    endLine :: ArmorType -> ByteString
    endLine :: ArmorType -> ByteString
    endLine ArmorType
    atype = String -> ByteString
    BLC8.pack String
    "-----END PGP " ByteString -> ByteString -> ByteString
    `BL.append` ArmorType -> ByteString
    aType ArmorType
    atype ByteString -> ByteString -> ByteString
    `BL.append` String -> ByteString
    BLC8.pack String
    "-----\n"

    aType :: ArmorType -> ByteString
    aType :: ArmorType -> ByteString
    aType ArmorType
    ArmorMessage = String -> ByteString
    BLC8.pack String
    "MESSAGE"
    aType ArmorType
    ArmorPublicKeyBlock = String -> ByteString
    BLC8.pack String
    "PUBLIC KEY BLOCK"
    aType ArmorType
    ArmorPrivateKeyBlock = String -> ByteString
    BLC8.pack String
    "PRIVATE KEY BLOCK"
    aType (ArmorSplitMessage ByteString
    x ByteString
    y) = String -> ByteString
    BLC8.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ String
    "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 -> String
    forall a. [a] -> [a] -> [a]
    ++ ByteString -> String
    forall a. Show a => a -> String
    show ByteString
    y
    aType (ArmorSplitMessageIndefinite ByteString
    x) = String -> ByteString
    BLC8.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ String
    "MESSAGE, PART " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ByteString -> String
    forall a. Show a => a -> String
    show ByteString
    x
    aType ArmorType
    ArmorSignature = String -> ByteString
    BLC8.pack String
    "SIGNATURE"

    armorHeaders :: [(String, String)] -> ByteString
    armorHeaders :: [(String, String)] -> ByteString
    armorHeaders = [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 (String
    k, String
    v) = String -> ByteString
    BLC8.pack String
    k ByteString -> ByteString -> ByteString
    `BL.append` String -> ByteString
    BLC8.pack String
    ": " 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 Int
    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 a. a -> [a]
    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 Int
    lw ByteString
    bs
        | ByteString -> Bool
    BL.null ByteString
    bs = []
        | Int
    lw Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    1 Bool -> Bool -> Bool
    || Int
    lw Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    76 = Int -> ByteString -> [ByteString]
    wordWrap Int
    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 Char
    '=' (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
    . HasCallStack => ByteString -> ByteString
    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 ByteString
    l
                | Char -> ByteString
    BLC8.singleton Char
    '-' ByteString -> ByteString -> Bool
    `BL.isPrefixOf` ByteString
    l = String -> ByteString
    BLC8.pack String
    "- " ByteString -> ByteString -> ByteString
    `BL.append` ByteString
    l
                | String -> ByteString
    BLC8.pack String
    "From " ByteString -> ByteString -> Bool
    `BL.isPrefixOf` ByteString
    l = String -> ByteString
    BLC8.pack String
    "- " ByteString -> ByteString -> ByteString
    `BL.append` ByteString
    l
                | Bool
    otherwise = ByteString
    l