{-# 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 (EllipticCurve curve, Random (ScalarField curve)) => PedersonSetup [] (Point curve) where
    groupElements :: [Point curve]
groupElements =
        -- TODO: This is just for testing purposes! Not to be used in production
        let x :: ScalarField curve
x = (ScalarField curve, StdGen) -> ScalarField curve
forall a b. (a, b) -> a
fst ((ScalarField curve, StdGen) -> ScalarField curve)
-> (ScalarField curve, StdGen) -> ScalarField curve
forall a b. (a -> b) -> a -> b
$ StdGen -> (ScalarField curve, StdGen)
forall g. RandomGen g => g -> (ScalarField curve, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random (StdGen -> (ScalarField curve, StdGen))
-> StdGen -> (ScalarField curve, StdGen)
forall a b. (a -> b) -> a -> b
$ Int -> StdGen
mkStdGen Int
0 :: ScalarField curve
        in Natural -> [Point curve] -> [Point curve]
forall a. HasCallStack => Natural -> [a] -> [a]
take (forall (n :: Natural). KnownNat n => Natural
value @PedersonSetupMaxSize) ([Point curve] -> [Point curve]) -> [Point curve] -> [Point curve]
forall a b. (a -> b) -> a -> b
$ (Point curve -> Point curve) -> Point curve -> [Point curve]
forall a. (a -> a) -> a -> [a]
iterate (ScalarField curve -> Point curve -> Point curve
forall curve.
EllipticCurve curve =>
ScalarField curve -> Point curve -> Point curve
mul ScalarField curve
x) Point curve
forall curve. EllipticCurve curve => Point curve
pointGen

instance (KnownNat n, EllipticCurve curve, Random (ScalarField curve), n <= PedersonSetupMaxSize) => PedersonSetup (Vector n) (Point curve) where
    groupElements :: Vector n (Point curve)
groupElements =
        -- TODO: This is just for testing purposes! Not to be used in production
        [Point curve] -> Vector n (Point curve)
forall (size :: Natural) a. [a] -> Vector size a
unsafeToVector ([Point curve] -> Vector n (Point curve))
-> [Point curve] -> Vector n (Point curve)
forall a b. (a -> b) -> a -> b
$ Natural -> [Point curve] -> [Point curve]
forall a. HasCallStack => Natural -> [a] -> [a]
take (forall (n :: Natural). KnownNat n => Natural
value @n) ([Point curve] -> [Point curve]) -> [Point curve] -> [Point curve]
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 (Point curve), Functor s) => PedersonSetup s (Constant (Point curve) a) where
    groupElements :: s (Constant (Point curve) a)
groupElements = Point curve -> Constant (Point curve) a
forall {k} a (b :: k). a -> Constant a b
Constant (Point curve -> Constant (Point curve) a)
-> s (Point curve) -> s (Constant (Point curve) 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 c, Zip s, Foldable s, Scale f c, AdditiveGroup c) => HomomorphicCommit (s f) c where
    hcommit :: s f -> c
hcommit s f
v = s c -> c
forall (t :: Type -> Type) a.
(Foldable t, AdditiveMonoid a) =>
t a -> a
sum (s c -> c) -> s c -> c
forall a b. (a -> b) -> a -> b
$ (f -> c -> c) -> s f -> s c -> s c
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 -> c -> c
forall b a. Scale b a => b -> a -> a
scale s f
v s c
forall {k} (s :: k -> Type) (c :: k). PedersonSetup s c => s c
groupElements