{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
module Hjugement.CLI.Administrator where

import Control.Applicative (Applicative(..))
import Control.Monad (Monad(..), forM, forM_, join, void)
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Maybe (MaybeT(..))
import Control.Monad.Trans.State.Strict (runState, runStateT)
import Data.Bits (setBit)
import Data.Bool
import Data.ByteString (ByteString)
import Data.Either (Either(..))
import Data.Eq (Eq(..))
import Data.Foldable (Foldable, foldMap, length, null)
import Data.Function (($), (.), id, flip)
import Data.Functor ((<$>), (<$))
import Data.Int (Int)
import Data.Maybe (Maybe(..), maybe, fromMaybe, fromJust)
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Proxy (Proxy(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import Data.Text (Text)
import GHC.Natural (minusNatural, minusNaturalMaybe)
import GHC.Prim (coerce)
import Numeric.Natural (Natural)
import Pipes ((>->))
import Prelude (logBase, ceiling, Num(..), (/), (^), fromIntegral, Double)
import Symantic.CLI as CLI
import System.IO (IO, FilePath)
import Text.Show (Show(..))
import qualified Crypto.Hash as Crypto
import qualified Data.Aeson as JSON
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BSL
import qualified Data.List as List
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import qualified Data.Text.Lazy.Builder.Int as TLB
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Text.Lazy.IO as TL
import qualified Data.Time as Time
import qualified Lens.Family as Lens
import qualified Lens.Family.State.Strict as Lens
import qualified Pipes as Pip
import qualified Pipes.ByteString as PipBS
import qualified Pipes.Group as Pip
import qualified Pipes.Prelude as Pip
import qualified Pipes.Aeson as PipJSON (DecodingError(..))
import qualified Pipes.Aeson.Unchecked as PipJSON
import qualified Pipes.Safe as Pip
import qualified Pipes.Safe.Prelude as Pip
import qualified Pipes.Text as PipText
import qualified Pipes.Text.Encoding as PipText
import qualified Pipes.Text.IO as PipText
import qualified Symantic.Document as Doc
import qualified System.FilePath as FP
import qualified System.IO as IO
import qualified System.Posix as Posix
import qualified System.Random as Rand
import qualified Voting.Protocol as VP

import Hjugement.CLI.Utils

-- * administrator
data Administrator_Params = Administrator_Params
 {
 } deriving (Show)

api_administrator =
	"Commands for an administrator."
	`helps`
	command "administrator" $
		api_administrator_election
		<!> api_help False
run_administrator globParams =
	run_administrator_election globParams
	:!: run_help api_administrator

-- ** election
data AdministratorElection_Params = AdministratorElection_Params
 {   administratorElection_crypto       :: VP.FFC
 ,   administratorElection_name         :: Text
 ,   administratorElection_description  :: Text
 ,   administratorElection_uuid         :: Maybe Text
 ,   administratorElection_grades       :: [Text]
 ,   administratorElection_defaultGrade :: Maybe Text
 } deriving (Show)

api_administrator_election =
	"This command reads and checks the trustees' public keys in "<>fileRef"public_keys.jsons"<>".\
 \ From which it computes the global election public key\
 \ put it into an "<>fileRef"election.json"<>" file \
 \ with the infos of the vote given here."
	`helps`
	command "election" $
		rule "PARAMS"
		 (AdministratorElection_Params
			 <$> api_param_crypto
			 <*> api_param_name
			 <*> api_param_description
			 <*> api_option_uuid
			 <*> api_param_grades
			 <*> api_param_defaultGrade
		 )
		<?> api_quests
		<.> response @(Maybe ())
	where
	api_param_name =
		"Name of the election."
		`help`
		long "name" (var "STRING")
	api_param_description =
		"Description of the election."
		`help`
		longOpt "description" "" (var "STRING")
	api_option_uuid =
		"UUID of the election."
		`help`
		longOpt "uuid" Nothing $
			dimap Just fromJust $ var "UUID"
	api_quests =
		"Some questions."
		`help`
		many1 (var @Text "STRING")
	api_param_grades = toPermutation {-Default []-} $
		many1 $
			"The grades to evaluate the choices, from the lowest to the highest."
			`helps`
			tagged (TagLong "grade") $
				var @Text "STRING"
	api_param_defaultGrade = toPermDefault Nothing $
		"The grade used when no grade is given by a voter.\n"<>
		"Defaults to the lowest grade."
		`helps`
		tagged (TagLong "default-grade") $
			dimap Just fromJust $
				var @Text "STRING"

run_administrator_election
 Global_Params{..}
 o@AdministratorElection_Params{..}
 quests =
	VP.reify administratorElection_crypto $ \(crypto::Proxy c) -> runMaybeT $ do
		election_uuid <-
			case administratorElection_uuid of
			 Nothing -> Pip.liftIO $ Rand.getStdRandom $ runState $ VP.randomUUID
			 Just u ->
				case VP.readUUID u of
				 Left err -> outputError $ Doc.from (show err)
				 Right uuid -> return uuid
		let trusteeKeysPath = global_dir FP.</> "public_keys.jsons"
		trusteeKeys :: [VP.TrusteePublicKey c] <- runPipeWithError $
			Pip.toListM' $ readJSON trusteeKeysPath
		-- TODO: check grades are distincts.
		-- TODO: check default-grade is a grade.
		saveJSON (global_dir FP.</> "election.json") $
			VP.hashElection VP.Election
			 { VP.election_name        = administratorElection_name
			 , VP.election_description = administratorElection_description
			 , VP.election_crypto      = VP.ElectionCrypto_FFC
				 { electionCrypto_FFC_params    = administratorElection_crypto
				 , electionCrypto_FFC_PublicKey = VP.combineIndispensableTrusteePublicKeys trusteeKeys
				 }
			 , VP.election_questions = (<$> quests) $ \quest -> VP.Question
				 { question_text    = quest
				 , question_choices = administratorElection_grades
				 , question_mini    = 1
				 , question_maxi    = 1
				 }
			 , VP.election_uuid
			 , VP.election_hash = VP.hashJSON JSON.Null
			 }
		outputInfo $ "Created election with "<>Doc.from (show election_uuid)