{- Copyright 2016 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

{-# LANGUAGE OverloadedStrings, BangPatterns #-}

module Gpg where

import Types
import UI
import System.Process
import Data.List.Split
import System.IO
import System.Exit
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as BU8
import qualified Data.Text as T

-- | Pick gpg secret key to back up.
--
-- If there is only one gpg secret key,
-- the choice is obvious. Otherwise prompt the user with a list.
getKeyToBackup :: UI -> IO SecretKeySource
getKeyToBackup ui = go =<< listSecretKeys
  where
	go [] = do
		showError ui "You have no gpg secret keys to back up."
		error "Aborting on no gpg secret keys."
	go [(_, kid)] = selected kid
	go l = maybe (error "Canceled") selected
		=<< promptKeyId ui "Pick gpg secret key"
			"Pick gpg secret key to back up:" l
	selected = return . GpgKey

listSecretKeys :: IO [(Name, KeyId)]
listSecretKeys = map mk . parse . lines <$> readProcess "gpg"
	["--batch", "--with-colons", "--list-secret-keys", "--fixed-list-mode"] ""
  where
	parse = extract [] Nothing . map (splitOn ":")
	extract c (Just keyid) (("uid":_:_:_:_:_:_:_:_:userid:_):rest) =
		extract ((userid, keyid):c) Nothing rest
	extract c (Just keyid) rest@(("sec":_):_) =
		extract (("", keyid):c) Nothing rest
	extract c (Just keyid) (_:rest) =
		extract c (Just keyid) rest
	extract c _ [] = c
	extract c _ (("sec":_:_:_:keyid:_):rest) =
		extract c (Just keyid) rest
	extract c k (_:rest) =
		extract c k rest
	mk (userid, keyid) = (Name (BU8.fromString userid), KeyId (T.pack keyid))

getSecretKey :: KeyId -> IO SecretKey
getSecretKey (KeyId kid) = do
	(_, Just hout, _, ph) <- createProcess (proc "gpg" ps)
		{ std_out = CreatePipe }
	secretkey <- SecretKey <$> B.hGetContents hout
	exitcode <- waitForProcess ph
	case exitcode of
		ExitSuccess -> return secretkey
		_ -> error "gpg --export-secret-key failed"
  where
	ps = ["--batch", "--export-secret-key", T.unpack kid]

writeSecretKey :: SecretKey -> IO ()
writeSecretKey (SecretKey b) = do
	(Just hin, _, _, ph) <- createProcess (proc "gpg" ps)
		{ std_in = CreatePipe }
	B.hPut hin b
	hClose hin
	exitcode <- waitForProcess ph
	case exitcode of
		ExitSuccess -> return ()
		_ -> error "gpg --import failed"
  where
	ps = ["--batch", "--import"]