{-# LANGUAGE AllowAmbiguousTypes  #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}

module ZkFold.Base.Protocol.IVC.Commit (Commit (..), HomomorphicCommit (..), PedersonSetup (..)) where

import           Data.Functor.Constant                   (Constant (..))
import           Data.Zip                                (Zip (..))
import           Prelude                                 hiding (Num (..), sum, take, zipWith)
import           System.Random                           (Random (..), mkStdGen)

import           ZkFold.Base.Algebra.Basic.Class
import           ZkFold.Base.Algebra.Basic.Number
import           ZkFold.Base.Algebra.EllipticCurve.Class
import           ZkFold.Base.Data.Vector                 (Vector, unsafeToVector)
import           ZkFold.Base.Protocol.IVC.Oracle
import           ZkFold.Prelude                          (take)

-- | Commit to the object @a@ with commitment key @ck@ and results of type @f@
--
class Commit algo a f where
    commit :: a -> f

instance RandomOracle algo a x => Commit algo a x where
    commit :: a -> x
commit = forall (algo :: k) a x. RandomOracle algo a x => a -> x
forall k (algo :: k) a x. RandomOracle algo a x => a -> x
oracle @algo

-- | Homomorphic commitment scheme, i.e. (hcommit x) * (hcommit y) == hcommit (x + y)
--
class AdditiveGroup c => HomomorphicCommit a c where
    hcommit :: a -> c

class PedersonSetup s c where
    groupElements :: s c

type PedersonSetupMaxSize = 100

instance
  ( CyclicGroup (Weierstrass curve (Point field))
  , Random (ScalarFieldOf (Weierstrass curve (Point field)))
  ) => PedersonSetup [] (Weierstrass curve (Point field)) where
    groupElements :: [Weierstrass curve (Point field)]
groupElements =
        -- TODO: This is just for testing purposes! Not to be used in production
        let x :: ScalarFieldOf (Weierstrass curve (Point field))
x = (ScalarFieldOf (Weierstrass curve (Point field)), StdGen)
-> ScalarFieldOf (Weierstrass curve (Point field))
forall a b. (a, b) -> a
fst ((ScalarFieldOf (Weierstrass curve (Point field)), StdGen)
 -> ScalarFieldOf (Weierstrass curve (Point field)))
-> (ScalarFieldOf (Weierstrass curve (Point field)), StdGen)
-> ScalarFieldOf (Weierstrass curve (Point field))
forall a b. (a -> b) -> a -> b
$ StdGen -> (ScalarFieldOf (Weierstrass curve (Point field)), StdGen)
forall g.
RandomGen g =>
g -> (ScalarFieldOf (Weierstrass curve (Point field)), g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random (StdGen
 -> (ScalarFieldOf (Weierstrass curve (Point field)), StdGen))
-> StdGen
-> (ScalarFieldOf (Weierstrass curve (Point field)), StdGen)
forall a b. (a -> b) -> a -> b
$ Int -> StdGen
mkStdGen Int
0 :: ScalarFieldOf (Weierstrass curve (Point field))
        in Natural
-> [Weierstrass curve (Point field)]
-> [Weierstrass curve (Point field)]
forall a. HasCallStack => Natural -> [a] -> [a]
take (forall (n :: Natural). KnownNat n => Natural
value @PedersonSetupMaxSize) ([Weierstrass curve (Point field)]
 -> [Weierstrass curve (Point field)])
-> [Weierstrass curve (Point field)]
-> [Weierstrass curve (Point field)]
forall a b. (a -> b) -> a -> b
$ (Weierstrass curve (Point field)
 -> Weierstrass curve (Point field))
-> Weierstrass curve (Point field)
-> [Weierstrass curve (Point field)]
forall a. (a -> a) -> a -> [a]
iterate (ScalarFieldOf (Weierstrass curve (Point field))
-> Weierstrass curve (Point field)
-> Weierstrass curve (Point field)
forall b a. Scale b a => b -> a -> a
scale ScalarFieldOf (Weierstrass curve (Point field))
x) Weierstrass curve (Point field)
forall g. CyclicGroup g => g
pointGen

instance
  ( KnownNat n
  , CyclicGroup (Weierstrass curve (Point field))
  , Random (ScalarFieldOf (Weierstrass curve (Point field)))
  , n <= PedersonSetupMaxSize
  ) => PedersonSetup (Vector n) (Weierstrass curve (Point field)) where
    groupElements :: Vector n (Weierstrass curve (Point field))
groupElements =
        -- TODO: This is just for testing purposes! Not to be used in production
        [Weierstrass curve (Point field)]
-> Vector n (Weierstrass curve (Point field))
forall (size :: Natural) a. [a] -> Vector size a
unsafeToVector ([Weierstrass curve (Point field)]
 -> Vector n (Weierstrass curve (Point field)))
-> [Weierstrass curve (Point field)]
-> Vector n (Weierstrass curve (Point field))
forall a b. (a -> b) -> a -> b
$ Natural
-> [Weierstrass curve (Point field)]
-> [Weierstrass curve (Point field)]
forall a. HasCallStack => Natural -> [a] -> [a]
take (forall (n :: Natural). KnownNat n => Natural
value @n) ([Weierstrass curve (Point field)]
 -> [Weierstrass curve (Point field)])
-> [Weierstrass curve (Point field)]
-> [Weierstrass curve (Point field)]
forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k -> Type) (c :: k). PedersonSetup s c => s c
forall (s :: Type -> Type) c. PedersonSetup s c => s c
groupElements @[]

instance (PedersonSetup s g, Functor s) => PedersonSetup s (Constant g a) where
    groupElements :: s (Constant g a)
groupElements = g -> Constant g a
forall {k} a (b :: k). a -> Constant a b
Constant (g -> Constant g a) -> s g -> s (Constant g a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (s :: k -> Type) (c :: k). PedersonSetup s c => s c
forall (s :: Type -> Type) c. PedersonSetup s c => s c
groupElements @s

instance
  ( PedersonSetup s g
  , Zip s
  , Foldable s
  , Scale f g
  , AdditiveGroup g
  ) => HomomorphicCommit (s f) g where
    hcommit :: s f -> g
hcommit s f
v = s g -> g
forall (t :: Type -> Type) a.
(Foldable t, AdditiveMonoid a) =>
t a -> a
sum (s g -> g) -> s g -> g
forall a b. (a -> b) -> a -> b
$ (f -> g -> g) -> s f -> s g -> s g
forall a b c. (a -> b -> c) -> s a -> s b -> s c
forall (f :: Type -> Type) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith f -> g -> g
forall b a. Scale b a => b -> a -> a
scale s f
v s g
forall {k} (s :: k -> Type) (c :: k). PedersonSetup s c => s c
groupElements