{- 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 Data.Maybe
import System.Exit
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as BU8

-- | 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 SecretKey
getKeyToBackup ui = go =<< Gpg.listSecretKeys
  where
	go [] = do
		showError ui "You have no gpg secret keys to back up."
		error "Aborting on no gpg secret keys."
	go [(_, kid)] = Gpg.getSecretKey kid
	go l = maybe (error "Canceled") Gpg.getSecretKey
		=<< promptKeyId ui "Pick gpg secret key"
			"Pick gpg secret key to back up:" l

-- | Use when the gpg keyid will not be known at restore time.
anyKey :: SecretKeySource
anyKey = GpgKey (KeyId "")

listSecretKeys :: IO [(Name, KeyId)]
listSecretKeys = mapMaybe parse . lines <$> readProcess "gpg"
	["--batch", "--with-colons", "--list-secret-keys"] ""
  where
	parse l = case splitOn ":" l of
		("sec":_:_:_:kid:_:_:_:_:n:_) -> Just 
			(Name (BU8.fromString n), KeyId (BU8.fromString kid))
		_ -> Nothing

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", BU8.toString kid]

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