Merge pull request #260 from zkFold/TurtlePU/drop-bs-orphans

Drop bs-aeson-orphans; use our combinators
zkFold · Sep 16, 2024 · ee813ba · ee813ba
2 parents a1cfea0 + e057018
commit ee813ba
Show file tree

Hide file tree

Showing 7 changed files with 45 additions and 28 deletions.
diff --git a/src/ZkFold/Base/Data/ByteString.hs b/src/ZkFold/Base/Data/ByteString.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE DerivingStrategies #-}
 
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 module ZkFold.Base.Data.ByteString
   ( Binary (..)
   , toByteString
@@ -11,16 +13,32 @@ module ZkFold.Base.Data.ByteString
   , BigEndian (..)
   ) where
 
-import           Control.Applicative  (many)
+import           Control.Applicative    (many)
+import qualified Data.Aeson             as Aeson
 import           Data.Binary
 import           Data.Binary.Get
 import           Data.Binary.Put
-import qualified Data.ByteString      as Strict
-import qualified Data.ByteString.Lazy as Lazy
-import           Data.Foldable        (foldl')
-import           Numeric.Natural      (Natural)
+import qualified Data.ByteString        as Strict
+import qualified Data.ByteString.Base64 as Base64
+import qualified Data.ByteString.Lazy   as Lazy
+import           Data.Foldable          (foldl')
+import qualified Data.Text.Encoding     as Text
+import           Numeric.Natural        (Natural)
 import           Prelude
-import           Test.QuickCheck      (Arbitrary (..))
+import           Test.QuickCheck        (Arbitrary (..))
+
+instance Aeson.FromJSON Strict.ByteString where
+  parseJSON o =
+    either fail return
+    . Base64.decode
+    . Text.encodeUtf8
+    =<< Aeson.parseJSON o
+
+instance Aeson.ToJSON Strict.ByteString where
+  toJSON = Aeson.toJSON . Text.decodeUtf8 . Base64.encode
+
+instance Aeson.FromJSONKey Strict.ByteString
+instance Aeson.ToJSONKey Strict.ByteString
 
 toByteString :: Binary a => a -> Strict.ByteString
 toByteString = Lazy.toStrict . runPut . put

diff --git a/src/ZkFold/Base/Protocol/Plonkup/LookupConstraint.hs b/src/ZkFold/Base/Protocol/Plonkup/LookupConstraint.hs
@@ -1,19 +1,20 @@
 module ZkFold.Base.Protocol.Plonkup.LookupConstraint where
 
-import           Data.Binary                                         (Binary, encode)
-import           Data.ByteString                                     (ByteString, toStrict)
+import           Data.Binary                                         (Binary)
+import           Data.ByteString                                     (ByteString)
 import           Prelude                                             hiding (Num (..), drop, length, sum, take, (!!),
                                                                       (/), (^))
 import           Test.QuickCheck                                     (Arbitrary (..))
 
+import           ZkFold.Base.Data.ByteString                         (toByteString)
 import           ZkFold.Base.Data.Vector                             (Vector)
 import           ZkFold.Symbolic.Compiler.ArithmeticCircuit.Internal
 
 newtype LookupConstraint i a = LookupConstraint { lkVar :: Var (Vector i) }
     deriving (Show, Eq)
 
 instance (Arbitrary a, Binary a) => Arbitrary (LookupConstraint i a) where
-    arbitrary = LookupConstraint . NewVar . toStrict . encode @a <$> arbitrary
+    arbitrary = LookupConstraint . NewVar . toByteString @a <$> arbitrary
 
 toLookupConstraint :: forall a i . ByteString -> LookupConstraint i a
 toLookupConstraint = LookupConstraint . NewVar
diff --git a/src/ZkFold/Base/Protocol/Plonkup/PlonkConstraint.hs b/src/ZkFold/Base/Protocol/Plonkup/PlonkConstraint.hs
@@ -4,8 +4,7 @@
 module ZkFold.Base.Protocol.Plonkup.PlonkConstraint where
 
 import           Control.Monad                                       (guard, return)
-import           Data.Binary                                         (Binary, encode)
-import           Data.ByteString                                     (toStrict)
+import           Data.Binary                                         (Binary)
 import           Data.Containers.ListUtils                           (nubOrd)
 import           Data.Eq                                             (Eq (..))
 import           Data.Function                                       (($), (.))
@@ -24,6 +23,7 @@ import           Text.Show                                           (Show)
 import           ZkFold.Base.Algebra.Basic.Class
 import           ZkFold.Base.Algebra.Polynomials.Multivariate        (Poly, evalMonomial, evalPolynomial, polynomial,
                                                                       var, variables)
+import           ZkFold.Base.Data.ByteString                         (toByteString)
 import           ZkFold.Base.Data.Vector                             (Vector)
 import           ZkFold.Prelude                                      (length, replicate, replicateA, take)
 import           ZkFold.Symbolic.Compiler.ArithmeticCircuit.Internal
@@ -48,7 +48,7 @@ instance (Arbitrary a, Binary a, KnownNat i) => Arbitrary (PlonkConstraint i a)
         qo <- arbitrary
         qc <- arbitrary
         k <- elements [1, 2, 3]
-        xs0 <- sort <$> replicateA k (Just . NewVar . toStrict . encode @a <$> arbitrary)
+        xs0 <- sort <$> replicateA k (Just . NewVar . toByteString @a <$> arbitrary)
         let (x, y, z) = case replicate (3 -! k) Nothing ++ xs0 of
               [x', y', z'] -> (x', y', z')
               _            -> error "impossible"

diff --git a/src/ZkFold/Base/Protocol/Protostar.hs b/src/ZkFold/Base/Protocol/Protostar.hs
@@ -4,17 +4,17 @@ module ZkFold.Base.Protocol.Protostar where
 
 
 import           Control.DeepSeq                                     (NFData)
-import           Data.Binary                                         (decode)
-import           Data.ByteString                                     (fromStrict)
 import           Data.Map.Strict                                     (Map)
 import qualified Data.Map.Strict                                     as M
+import           Data.Maybe                                          (fromJust)
 import           GHC.Generics                                        (Generic)
 import           Prelude                                             (($), (==))
 import qualified Prelude                                             as P
 
 import           ZkFold.Base.Algebra.Basic.Class
 import           ZkFold.Base.Algebra.Basic.Number
 import           ZkFold.Base.Algebra.Polynomials.Multivariate        (evalMonomial, evalPolynomial, var)
+import           ZkFold.Base.Data.ByteString                         (fromByteString)
 import           ZkFold.Base.Data.Vector                             (Vector)
 import           ZkFold.Base.Protocol.Protostar.SpecialSound
 import           ZkFold.Symbolic.Compiler.ArithmeticCircuit.Internal
@@ -68,7 +68,7 @@ instance (Arithmetic a, KnownNat n) => SpecialSoundProtocol a (RecursiveCircuit
     --
     algebraicMap rc _ _ _ =
         let
-            varF (NewVar ix) = var (toConstant (decode @VarField $ fromStrict ix) P.+ value @n)
+            varF (NewVar ix) = var (toConstant (fromJust $ fromByteString @VarField ix) P.+ value @n)
             varF (InVar ix)  = var (toConstant ix)
         in
             [ evalPolynomial evalMonomial varF poly

diff --git a/src/ZkFold/Symbolic/Compiler/ArithmeticCircuit/Internal.hs b/src/ZkFold/Symbolic/Compiler/ArithmeticCircuit/Internal.hs
@@ -22,16 +22,15 @@ module ZkFold.Symbolic.Compiler.ArithmeticCircuit.Internal (
         apply,
     ) where
 
-import           ByteString.Aeson.Orphans                     ()
 import           Control.DeepSeq                              (NFData, force)
 import           Control.Monad.State                          (MonadState (..), State, modify, runState)
-import           Data.Aeson                                   hiding (decode)
-import           Data.Binary                                  (decode)
-import           Data.ByteString                              (ByteString, fromStrict, toStrict)
+import           Data.Aeson
+import           Data.ByteString                              (ByteString)
 import           Data.Foldable                                (fold, toList)
 import           Data.Functor.Rep
 import           Data.Map.Strict                              hiding (drop, foldl, foldr, map, null, splitAt, take,
                                                                toList)
+import           Data.Maybe                                   (fromJust)
 import           Data.Semialign                               (unzipDefault)
 import qualified Data.Set                                     as S
 import           GHC.Generics                                 (Generic, Par1 (..), U1 (..), (:*:) (..))
@@ -48,6 +47,7 @@ import           ZkFold.Base.Algebra.Basic.Sources
 import           ZkFold.Base.Algebra.EllipticCurve.BLS12_381  (BLS12_381_Scalar)
 import           ZkFold.Base.Algebra.Polynomials.Multivariate (Poly, evalMonomial, evalPolynomial, mapCoeffs, var)
 import           ZkFold.Base.Control.HApplicative
+import           ZkFold.Base.Data.ByteString                  (fromByteString, toByteString)
 import           ZkFold.Base.Data.HFunctor
 import           ZkFold.Base.Data.Package
 import           ZkFold.Symbolic.Class
@@ -157,11 +157,11 @@ unconstrained ::
   Witness (Var i) a -> NewConstraint (Var i) a ->
   State (ArithmeticCircuit a i U1) ByteString
 unconstrained witness con = do
-  raw <- encode @VarField . fromConstant . fst <$> do
+  raw <- toByteString @VarField . fromConstant . fst <$> do
     zoom #acRNG (get >>= traverse put . uniformR (0, order @VarField -! 1))
   let sources = runSources . ($ Sources @a . S.singleton)
       srcs = sources witness `S.difference` sources (`con` NewVar mempty)
-      v = toVar @a @i (S.toList srcs) . con var $ NewVar (toStrict raw)
+      v = toVar @a @i (S.toList srcs) $ con var (NewVar raw)
   -- TODO: forbid reassignment of variables
   zoom #acWitness . modify $ insert v $ \i w -> witness $ \case
     InVar inV -> index i inV
@@ -173,12 +173,12 @@ toVar ::
   forall a i.
   (Arithmetic a, ToConstant (Rep i), Const (Rep i) ~ Natural) =>
   (Representable i, Foldable i) => [Var i] -> Constraint a i -> ByteString
-toVar srcs c = force $ toStrict (encode ex)
+toVar srcs c = force (toByteString ex)
     where
         l  = Haskell.fromIntegral (Haskell.length @i acInput)
         r  = toZp 903489679376934896793395274328947923579382759823 :: VarField
         g  = toZp 89175291725091202781479751781509570912743212325 :: VarField
-        varF (NewVar w)  = toConstant (decode @VarField $ fromStrict w) + l
+        varF (NewVar w)  = toConstant (fromJust $ fromByteString @VarField w) + l
         varF (InVar inV) = toConstant inV
         v  = (+ r) . fromConstant . varF
         x  = g ^ fromZp (evalPolynomial evalMonomial v $ mapCoeffs toConstant c)

diff --git a/src/ZkFold/Symbolic/Compiler/ArithmeticCircuit/Map.hs b/src/ZkFold/Symbolic/Compiler/ArithmeticCircuit/Map.hs
@@ -6,8 +6,6 @@ module ZkFold.Symbolic.Compiler.ArithmeticCircuit.Map (
         ArithmeticCircuitTest(..)
     ) where
 
-import           Data.Binary                                         (encode)
-import           Data.ByteString                                     (toStrict)
 import           Data.Functor.Rep                                    (Representable (..))
 import           Data.Map                                            hiding (drop, foldl, foldr, fromList, map, null,
                                                                       splitAt, take, toList)
@@ -20,6 +18,7 @@ import           Test.QuickCheck                                     (Arbitrary
 
 import           ZkFold.Base.Algebra.Basic.Class
 import           ZkFold.Base.Algebra.Polynomials.Multivariate
+import           ZkFold.Base.Data.ByteString                         (toByteString)
 import           ZkFold.Symbolic.Compiler.ArithmeticCircuit.Internal (Arithmetic, ArithmeticCircuit (..), Var (..),
                                                                       VarField, getAllVars)
 
@@ -47,8 +46,8 @@ instance (Arithmetic a, Arbitrary (i a), Arbitrary (ArithmeticCircuit a i f), Re
 mapVarArithmeticCircuit :: (Field a, Eq a, Functor o, Ord (Rep i), Representable i, Foldable i) => ArithmeticCircuitTest a i o -> ArithmeticCircuitTest a i o
 mapVarArithmeticCircuit (ArithmeticCircuitTest ac wi) =
     let vars = [v | NewVar v <- getAllVars ac]
-        asc = [ toStrict (encode @VarField (fromConstant @Natural x)) | x <- [0..] ]
-        forward = Map.fromList $ zip vars asc
+        asc = [ toByteString @VarField (fromConstant @Natural x) | x <- [0..] ]
+        forward = Map.fromAscList $ zip vars asc
         backward = Map.fromAscList $ zip asc vars
         varF (InVar v)  = InVar v
         varF (NewVar v) = NewVar (forward ! v)

diff --git a/zkfold-base.cabal b/zkfold-base.cabal
@@ -233,7 +233,6 @@ library
       -- TODO: remove `blake2` after refactoring of ZK protocols
       blake2                                < 0.4,
       bytestring                           < 0.12,
-      bytestring-aeson-orphans                   ,
       containers                            < 0.7,
       cryptohash-sha256                    < 0.12,
       deepseq                          <= 1.5.0.0,