{-# LANGUAGE UndecidableInstances #-} module ZkFold.Base.Protocol.Plonkup.Input where import Prelude hiding (Num (..), drop, length, sum, take, (!!), (/), (^)) import Test.QuickCheck (Arbitrary (..)) import ZkFold.Base.Algebra.Basic.Class import ZkFold.Base.Algebra.Basic.Number import ZkFold.Base.Algebra.EllipticCurve.Class (EllipticCurve (..)) import ZkFold.Base.Data.Vector (Vector (..), unsafeToVector) import ZkFold.Prelude (take) import ZkFold.Symbolic.Compiler () newtype PlonkupInput l c = PlonkupInput { forall {k} (l :: Natural) (c :: k). PlonkupInput l c -> Vector l (ScalarField c) unPlonkupInput :: Vector l (ScalarField c) } instance Show (ScalarField c) => Show (PlonkupInput l c) where show :: PlonkupInput l c -> String show (PlonkupInput Vector l (ScalarField c) v) = String "Plonkup Input: " String -> ShowS forall a. [a] -> [a] -> [a] ++ Vector l (ScalarField c) -> String forall a. Show a => a -> String show Vector l (ScalarField c) v instance (KnownNat l, Arbitrary (ScalarField c)) => Arbitrary (PlonkupInput l c) where arbitrary :: Gen (PlonkupInput l c) arbitrary = do Vector l (ScalarField c) -> PlonkupInput l c forall {k} (l :: Natural) (c :: k). Vector l (ScalarField c) -> PlonkupInput l c PlonkupInput (Vector l (ScalarField c) -> PlonkupInput l c) -> ([ScalarField c] -> Vector l (ScalarField c)) -> [ScalarField c] -> PlonkupInput l c forall b c a. (b -> c) -> (a -> b) -> a -> c . [ScalarField c] -> Vector l (ScalarField c) forall (size :: Natural) a. [a] -> Vector size a unsafeToVector ([ScalarField c] -> Vector l (ScalarField c)) -> ([ScalarField c] -> [ScalarField c]) -> [ScalarField c] -> Vector l (ScalarField c) forall b c a. (b -> c) -> (a -> b) -> a -> c . Natural -> [ScalarField c] -> [ScalarField c] forall a. HasCallStack => Natural -> [a] -> [a] take (forall (n :: Natural). KnownNat n => Natural value @l) ([ScalarField c] -> PlonkupInput l c) -> Gen [ScalarField c] -> Gen (PlonkupInput l c) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b <$> Gen [ScalarField c] forall a. Arbitrary a => Gen a arbitrary plonkupVerifierInput :: Field (ScalarField c) => Vector l (ScalarField c) -> PlonkupInput l c plonkupVerifierInput :: forall {k} (c :: k) (l :: Natural). Field (ScalarField c) => Vector l (ScalarField c) -> PlonkupInput l c plonkupVerifierInput Vector l (ScalarField c) input = Vector l (ScalarField c) -> PlonkupInput l c forall {k} (l :: Natural) (c :: k). Vector l (ScalarField c) -> PlonkupInput l c PlonkupInput (Vector l (ScalarField c) -> PlonkupInput l c) -> Vector l (ScalarField c) -> PlonkupInput l c forall a b. (a -> b) -> a -> b $ (ScalarField c -> ScalarField c) -> Vector l (ScalarField c) -> Vector l (ScalarField c) forall a b. (a -> b) -> Vector l a -> Vector l b forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap ScalarField c -> ScalarField c forall a. AdditiveGroup a => a -> a negate Vector l (ScalarField c) input