module Protocol.Election where

import Control.Monad (Monad(..))
import Data.Bool
import Data.Eq (Eq(..))
import Data.Functor (Functor, (<$>))
import Data.Maybe (Maybe(..))
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Int (Int)
import Data.Semigroup (Semigroup(..))
import Prelude (Integral, undefined)
import Text.Show (Show(..))
import qualified Control.Monad.Trans.State.Strict as S
import qualified Data.List as List

import Protocol.Arith

-- * Type 'CipherText'
data CipherText q = CipherText
 { alpha :: G q -- ^ Random nonce: @(g'^'r)@
 , beta  :: G q -- ^ Encrypted message: @(g'^'msg '*' (g'^'secKey)'^'r)@
 } deriving (Show)

-- | Additive homomorphism.
-- Using the fact that: @g^x * g^y == g^(x+y)@.
instance SubGroup q => Semigroup (CipherText q) where
	x<>y = CipherText (alpha x * alpha y) (beta x * beta y)
instance SubGroup q => Monoid (CipherText q) where
	mempty = CipherText one one
	mappend = (<>)

type PublicKey = G
type SecretKey = E
type Random = E

encrypt ::
 PrimeField (P q) =>
 SubGroup q =>
 Integral msg =>
 PublicKey q -> Random q -> msg -> CipherText q
encrypt pk r msg =
	CipherText
	 { alpha = groupGen^r
	 , beta  = groupGen^inE msg * pk^r
	 -- NOTE: pk == groupGen ^ sk
	 -- NOTE: msg is put as exponent in order
	 -- to make an additive homomorphism
	 -- instead of a multiplicative homomorphism.
	 }

-- * Type 'Proof'
data Proof q = Proof
 { challenge :: E q
 , response  :: E q
 } deriving (Eq,Show)

proofFiatShamir ::
 Monad m =>
 RandomGen r =>
 SubGroup q =>
 Functor f =>
 f (G q) -> E q -> (f (G q) -> E q) -> S.StateT r m (Proof q)
proofFiatShamir gs msg oracle = do
	r <- random
	let commitments = (^ r) <$> gs
	let challenge = oracle commitments
	return Proof
	 { challenge
	 , response = r + msg * challenge
	 }

-- | Prove that alpha = g^r and beta = y^r/d!!i
-- the size of d is the number of disjuncts
elgamalDisjProve ::
 PublicKey q -> [G q] -> Text -> Int -> Random q -> CipherText q -> Proof q
elgamalDisjProve y d zkp i r CipherText{..} =
	undefined

{-
type Randomness
type Message
type Answer


-}
{-
  (** ZKPs for disjunctions *)

  let eg_disj_prove y d zkp x r {alpha; beta} =
    (* prove that alpha = g^r and beta = y^r/d_x *)
    (* the size of d is the number of disjuncts *)
    let n = Array.length d in
    assert (0 <= x && x < n);
    let proofs = Array.make n dummy_proof
    and commitments = Array.make (2*n) g
    and total_challenges = ref Z.zero in
    (* compute fake proofs *)
    let f i =
      let challenge = random q
      and response = random q in
      challenge >>= fun challenge ->
        response >>= fun response ->
          proofs.(i)          <- {challenge; response};
          commitments.(2*i)   <- g **~ response / alpha **~ challenge;
          commitments.(2*i+1) <- y **~ response / (beta *~ d.(i)) **~ challenge;
          total_challenges := Z.(!total_challenges + challenge);
          return ()
    in
		-- Apply f to all elements of d except the xth
    let rec loop i =
      if i < x then f i >>= fun () -> loop (succ i)
      else if i = x then loop (succ i)
      else if i < n then f i >>= fun () -> loop (succ i)
      else return ()
    in loop 0 >>= fun () ->
      total_challenges := Z.(q - !total_challenges mod q);
      (* compute genuine proof *)
      fs_prove [| g; y |] r (fun commitx ->
        Array.blit commitx 0 commitments (2*x) 2;
        let prefix = Printf.sprintf "prove|%s|%s,%s|"
          zkp (G.to_string alpha) (G.to_string beta)
        in
        Z.((G.hash prefix commitments + !total_challenges) mod q)
      ) >>= fun p ->
        proofs.(x) <- p;
        return proofs
-}