{-# LANGUAGE RecordWildCards #-}

-- hot.hs: hOpenPGP Tool
-- Copyright © 2012-2013  Clint Adams
--
-- vim: softtabstop=4:shiftwidth=4:expandtab
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as
-- published by the Free Software Foundation, either version 3 of the
-- License, or (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

import Paths_hopenpgp_tools (version)
import qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA
import Codec.Encryption.OpenPGP.ASCIIArmor.Types (Armor(..), ArmorType(..))
import Codec.Encryption.OpenPGP.Serialize ()
import Codec.Encryption.OpenPGP.Types (Pkt)
import Control.Applicative ((<$>),(<*>), optional, pure)
import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Conduit (($=), ($$), Sink, runResourceT)
import Data.Conduit.Cereal (conduitGet)
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL
import Data.Serialize (get)
import Data.Serialize.Get (Get)

import Data.Version (showVersion)
import Data.Monoid ((<>))

import System.IO (stdin, stderr, hPutStrLn, hFlush, hSetBuffering, BufferMode(..))

import Options.Applicative.Builder (command, help, idm, info, long, metavar, nullOption, reader, progDesc, strOption, subparser, ParseError(..))
import Options.Applicative.Extra (execParser)
import Options.Applicative.Types (Parser)

data Command = DumpC | DeArmorC | ArmorC ArmoringOptions

data ArmoringOptions = ArmoringOptions {
    comment :: Maybe String
  , armortype :: ArmorType
}

doDump :: IO ()
doDump = do
    runResourceT $ CB.sourceHandle stdin $= conduitGet (get :: Get Pkt) $$ printer

-- Print every input value to standard output.
printer :: (Show a, MonadIO m) => Sink a m ()
printer = CL.mapM_ (liftIO . print)

doDeArmor :: IO ()
doDeArmor = do
    a <- runResourceT $ CB.sourceHandle stdin $$ CL.consume
    case AA.decode (B.concat a) of
        Left e -> hPutStrLn stderr $ "Failure to decode ASCII Armor:" ++ e
        Right msgs -> BL.putStr $ BL.concat (map (\(Armor _ _ bs) -> bs) msgs)

doArmor :: ArmoringOptions -> IO ()
doArmor ArmoringOptions{..} = do
    m <- runResourceT $ CB.sourceHandle stdin $$ CL.consume
    let a = Armor armortype ([("Version", "hot " ++ showVersion version)] ++ maybe [] (\x -> [("Comment", x)]) comment ) (BL.fromChunks m)
    BL.putStr $ AA.encodeLazy [a]

armorTypeReader :: String -> Either ParseError ArmorType
armorTypeReader "message" = Right ArmorMessage	 
armorTypeReader "pubkeyblock" = Right ArmorPublicKeyBlock	 
armorTypeReader "privkeyblock" = Right ArmorPrivateKeyBlock	 
armorTypeReader "signature" = Right ArmorSignature
armorTypeReader _ = Left (ErrorMsg "unknown armor type")

aoP :: Parser ArmoringOptions
aoP = ArmoringOptions
    <$> optional (strOption (long "comment" <> metavar "COMMENT" <> help "ASCII armor Comment field"))
    <*> nullOption (long "armor-type" <> reader armorTypeReader <> metavar "ARMORTYPE" <> help "ASCII armor type")

dispatch :: Command -> IO ()
dispatch DumpC = doDump
dispatch DeArmorC = doDeArmor
dispatch (ArmorC o) = doArmor o

main :: IO ()
main = do
    hSetBuffering stderr LineBuffering
    hPutStrLn stderr $ "hot version " ++ showVersion version ++ ", Copyright (C) 2012-2013  Clint Adams\n\
   \hot comes with ABSOLUTELY NO WARRANTY.\n\
   \This is free software, and you are welcome to redistribute it\n\
   \under certain conditions.\n"
    hFlush stderr

    execParser (info cmd idm) >>= dispatch

cmd :: Parser Command
cmd = subparser
  ( command "dump" (info ( pure DumpC ) ( progDesc "Dump OpenPGP packets from stdin" ))
 <> command "dearmor" (info ( pure DeArmorC ) ( progDesc "Dearmor stdin to stdout" ))
 <> command "armor" (info ( ArmorC <$> aoP ) ( progDesc "Armor stdin to stdout" ))
  )