-- hkt.hs: hOpenPGP key tool
-- Copyright © 2013-2014  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 Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID)
import Codec.Encryption.OpenPGP.KeyInfo (keySize, pkalgoAbbrev)
import Codec.Encryption.OpenPGP.Types
import Control.Applicative ((<$>),(<*>), optional)
import Control.Lens ((^.))
import Control.Monad.Trans.Writer.Lazy (execWriter, tell)
import Data.Conduit (($=),($$), runResourceT)
import qualified Data.Conduit.Binary as CB
import Data.Conduit.Cereal (conduitGet)
import Data.Conduit.OpenPGP.Keyring (conduitToTKsDropping, sinkKeyringMap)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Data.IxSet ((@=))
import qualified Data.IxSet as IxSet
import Data.Serialize (get)
import Data.Version (showVersion)
import System.Directory (getHomeDirectory)

import Options.Applicative.Builder (argument, command, help, idm, info, long, metavar, prefs, progDesc, showHelpOnError, str, strOption, subparser)
import Options.Applicative.Extra (customExecParser, helper)
import Options.Applicative.Types (Parser)

import System.IO (hPutStrLn, stderr)

grabMatchingKeys :: FilePath -> String -> IO [TK]
grabMatchingKeys fp eok = do
    kr <- runResourceT $ CB.sourceFile fp $= conduitGet get $= conduitToTKsDropping $$ sinkKeyringMap
    return $! IxSet.toList (kr @= (read eok :: EightOctetKeyId))

showKey :: TK -> IO ()
showKey key = putStrLn . unlines . execWriter $ do
    tell [ "pub   " ++ show (keySize (key^.tkPKP^.pubkey)) ++ pkalgoAbbrev (key^.tkPKP^.pkalgo) ++ "/0x" ++ (show . eightOctetKeyID $ key^.tkPKP ) ]
    tell $ map (\(x,_) -> "uid                            " ++ x) (key^.tkUIDs)
    tell $ map (\(PublicSubkeyPkt x,_,_) -> "sub   " ++ show (keySize (x^.pubkey)) ++ pkalgoAbbrev (x^.pkalgo) ++ "/0x" ++ (show . eightOctetKeyID $ x)) (key^.tkSubs)

data Options = Options {
    keyring :: String
  , target :: String
}

data Command = List Options

listO :: String -> Parser Options
listO homedir = Options
    <$> (fromMaybe (homedir ++ "/.gnupg/pubring.gpg") <$> optional (strOption
        ( long "keyring"
       <> metavar "FILE"
       <> help "file containing keyring" )))
    <*> argument str ( metavar "TARGET" )

dispatch :: Command -> IO ()
dispatch (List o) = doList o

main :: IO ()
main = do
    homedir <- getHomeDirectory
    hPutStrLn stderr $ "hkt version " ++ showVersion version ++ ", Copyright (C) 2013-2014  Clint Adams\n\
     \hkt comes with ABSOLUTELY NO WARRANTY.\n\
     \This is free software, and you are welcome to redistribute it\n\
     \under certain conditions.\n"
    customExecParser (prefs showHelpOnError) (info (helper <*> cmd homedir) idm) >>= dispatch

cmd :: String -> Parser Command
cmd homedir = subparser
    ( command "list" (info ( List <$> listO homedir) ( progDesc "list matching keys" )))

doList :: Options -> IO ()
doList o = do
    keys <- grabMatchingKeys (keyring o) (target o)
    mapM_ showKey keys