{-# LANGUAGE OverloadedStrings #-}

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

module Main where

import Types
import Tunables
import qualified CmdLine
import UI
import Encryption
import Entropy
import ExpensiveHash
import Cost
import Shard
import Storage
import Storage.LocalFiles
import Data.Maybe
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as BU8
import System.Posix.User (userGecos, getUserEntryForID, getEffectiveUserID)

main :: IO ()
main = do
	cmdline <- CmdLine.get
	ui <- selectUI (CmdLine.gui cmdline)
	let keytype = CmdLine.keytype cmdline
	-- TODO determine gpg key id by examining secret key,
	-- or retrieving public key from keyserver and examining it.
	let keyid = KeyId keytype "dummy key id"
	let tunables = if CmdLine.testMode cmdline
		then testModeTunables
		else defaultTunables
	case CmdLine.mode cmdline of
		CmdLine.Backup -> storedemo ui keyid tunables
		CmdLine.Restore -> retrievedemo ui keyid
		CmdLine.Benchmark -> benchmarkTunables tunables

storedemo :: UI -> KeyId -> Tunables -> IO ()
storedemo ui keyid tunables = do
	username <- userName
	name <- fromMaybe (error "Aborting on no name") 
		<$> promptName ui "Enter a name"
			namedesc username validateName
	kek <- genKeyEncryptionKey tunables name password
	putStrLn "Very rough estimate of cost to brute-force the password:"
	print $ estimateAttack spotAWS $ estimateBruteforceOf kek
		(passwordEntropy password [])
	let esk = encrypt tunables kek secretkey
	let sis = shardIdents tunables name keyid
	shards <- genShards esk tunables
	print =<< mapM (uncurry (storeShard localFiles)) (zip (getIdents sis) shards)
	print =<< obscureShards localFiles
  where
	password = Password "correct horse battery staple"
	secretkey = SecretKey "this is a gpg private key"
	namedesc = unlines
		[ "To back up your key, you will need to enter a name and a password."
		, ""
		, "Make sure to pick a name you will remember at some point in the future,"
		, "perhaps years from now, when you will need to enter it with the same"
		, "spelling and capitalization in order to restore the key."
		, ""
		, "(Your own full name is a pretty good choice for the name to enter here.)"
		]

retrievedemo :: UI -> KeyId -> IO ()
retrievedemo ui keyid = do
	username <- userName
	name <- fromMaybe (error "Aborting on no name") 
		<$> promptName ui "Enter the name of the key to restore"
			namedesc username validateName
	let sis = shardIdents tunables name keyid
	-- we drop 1 to simulate not getting all shards from the servers
	let l = drop 1 $ zip [1..] (getIdents sis)
	shards <- map (\(RetrieveSuccess s) -> s)
		<$> mapM (uncurry (retrieveShard localFiles)) l
	_ <- obscureShards localFiles
	let esk = combineShards tunables shards
	go esk (candidateKeyEncryptionKeys tunables name password)
  where
	go _ [] = error "decryption failed"
	go esk (kek:rest) = case decrypt kek esk of
		Just (SecretKey sk) -> print sk
		Nothing -> go esk rest

	password = Password "correct horse battery staple"
	-- TODO: derive by probing to find objects
	tunables = testModeTunables -- defaultTunables
	namedesc = unlines
		[ "When you backed up the key, you entered a name and a password."
		, "Now it's time to remember what you entered back then."
		, ""
		, "(If you can't remember the name you used, your own full name is the best guess.)"
		]

validateName :: Name -> Maybe Problem
validateName (Name n)
	| B.length n < 6 = Just "The name should be at least 6 letters long."
	| otherwise = Nothing

userName :: IO Name
userName = do
	u <- getUserEntryForID =<< getEffectiveUserID
	return $ Name $ BU8.fromString $ takeWhile (/= ',') (userGecos u)