{-# LANGUAGE DeriveAnyClass #-}

module ZkFold.Symbolic.Compiler.ArithmeticCircuit.MerkleHash where

import           Crypto.Hash.SHA256              (hash)
import           Data.Binary                     (Binary (..))
import           Data.ByteString                 (ByteString)
import           Data.Function                   ((.))
import           Data.Maybe                      (Maybe (..))
import           GHC.Generics                    (Generic)
import           Numeric.Natural                 (Natural)
import           Prelude                         (Integer, error)

import           ZkFold.Base.Algebra.Basic.Class
import           ZkFold.Base.Algebra.Basic.Field (Zp)
import           ZkFold.Base.Data.ByteString     (toByteString)

newtype MerkleHash (n :: Maybe Natural) = M { forall (n :: Maybe Natural). MerkleHash n -> ByteString
runHash :: ByteString }

data Prec = Add | Mul | Div | Mod | Exp | Const deriving ((forall x. Prec -> Rep Prec x)
-> (forall x. Rep Prec x -> Prec) -> Generic Prec
forall x. Rep Prec x -> Prec
forall x. Prec -> Rep Prec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Prec -> Rep Prec x
from :: forall x. Prec -> Rep Prec x
$cto :: forall x. Rep Prec x -> Prec
to :: forall x. Rep Prec x -> Prec
Generic, Get Prec
[Prec] -> Put
Prec -> Put
(Prec -> Put) -> Get Prec -> ([Prec] -> Put) -> Binary Prec
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: Prec -> Put
put :: Prec -> Put
$cget :: Get Prec
get :: Get Prec
$cputList :: [Prec] -> Put
putList :: [Prec] -> Put
Binary)

merkleHash :: Binary a => a -> MerkleHash n
merkleHash :: forall a (n :: Maybe Natural). Binary a => a -> MerkleHash n
merkleHash = ByteString -> MerkleHash n
forall (n :: Maybe Natural). ByteString -> MerkleHash n
M (ByteString -> MerkleHash n)
-> (a -> ByteString) -> a -> MerkleHash n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
hash (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Binary a => a -> ByteString
toByteString

instance Binary (MerkleHash n) where
  get :: Get (MerkleHash n)
get = [Char] -> Get (MerkleHash n)
forall a. HasCallStack => [Char] -> a
error [Char]
"undefined"
  put :: MerkleHash n -> Put
put = ByteString -> Put
forall t. Binary t => t -> Put
put (ByteString -> Put)
-> (MerkleHash n -> ByteString) -> MerkleHash n -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MerkleHash n -> ByteString
forall (n :: Maybe Natural). MerkleHash n -> ByteString
runHash

instance Finite (Zp n) => Finite (MerkleHash (Just n)) where
  type Order (MerkleHash (Just n)) = n

instance {-# OVERLAPPING #-} FromConstant (MerkleHash n) (MerkleHash n)

instance {-# OVERLAPPING #-} Scale (MerkleHash n) (MerkleHash n)

instance Binary a => FromConstant a (MerkleHash n) where
  fromConstant :: a -> MerkleHash n
fromConstant a
x = (Prec, a) -> MerkleHash n
forall a (n :: Maybe Natural). Binary a => a -> MerkleHash n
merkleHash (Prec
Const, a
x)

instance Binary a => Scale a (MerkleHash n)

instance Exponent (MerkleHash n) Natural where
  M ByteString
h ^ :: MerkleHash n -> Natural -> MerkleHash n
^ Natural
p = (Prec, ByteString, ByteString) -> MerkleHash n
forall a (n :: Maybe Natural). Binary a => a -> MerkleHash n
merkleHash (Prec
Exp, ByteString
h, ByteString -> ByteString
hash (Natural -> ByteString
forall a. Binary a => a -> ByteString
toByteString Natural
p))

instance MultiplicativeSemigroup (MerkleHash n) where
  M ByteString
x * :: MerkleHash n -> MerkleHash n -> MerkleHash n
* M ByteString
y = (Prec, ByteString, ByteString) -> MerkleHash n
forall a (n :: Maybe Natural). Binary a => a -> MerkleHash n
merkleHash (Prec
Mul, ByteString
x, ByteString
y)

instance MultiplicativeMonoid (MerkleHash n) where
  one :: MerkleHash n
one = Natural -> MerkleHash n
forall a b. FromConstant a b => a -> b
fromConstant (Natural
forall a. MultiplicativeMonoid a => a
one :: Natural)

instance AdditiveSemigroup (MerkleHash n) where
  M ByteString
x + :: MerkleHash n -> MerkleHash n -> MerkleHash n
+ M ByteString
y = (Prec, ByteString, ByteString) -> MerkleHash n
forall a (n :: Maybe Natural). Binary a => a -> MerkleHash n
merkleHash (Prec
Add, ByteString
x, ByteString
y)

instance AdditiveMonoid (MerkleHash n) where
  zero :: MerkleHash n
zero = Natural -> MerkleHash n
forall a b. FromConstant a b => a -> b
fromConstant (Natural
forall a. AdditiveMonoid a => a
zero :: Natural)

instance Semiring (MerkleHash n)

instance AdditiveGroup (MerkleHash (Just n)) where
  negate :: MerkleHash ('Just n) -> MerkleHash ('Just n)
negate (M ByteString
x) = (Prec, ByteString) -> MerkleHash ('Just n)
forall a (n :: Maybe Natural). Binary a => a -> MerkleHash n
merkleHash (Prec
Add, ByteString
x)

instance Ring (MerkleHash (Just n))

instance Exponent (MerkleHash n) Integer where
  M ByteString
h ^ :: MerkleHash n -> Integer -> MerkleHash n
^ Integer
p = (Prec, ByteString, ByteString) -> MerkleHash n
forall a (n :: Maybe Natural). Binary a => a -> MerkleHash n
merkleHash (Prec
Exp, ByteString
h, ByteString -> ByteString
hash (Integer -> ByteString
forall a. Binary a => a -> ByteString
toByteString Integer
p))

instance Field (MerkleHash (Just n)) where
  finv :: MerkleHash ('Just n) -> MerkleHash ('Just n)
finv (M ByteString
x) = (Prec, ByteString) -> MerkleHash ('Just n)
forall a (n :: Maybe Natural). Binary a => a -> MerkleHash n
merkleHash (Prec
Mul, ByteString
x)

instance ToConstant (MerkleHash (Just n)) where
  type Const (MerkleHash (Just n)) = MerkleHash Nothing
  toConstant :: MerkleHash ('Just n) -> Const (MerkleHash ('Just n))
toConstant = MerkleHash ('Just n) -> Const (MerkleHash ('Just n))
MerkleHash ('Just n) -> MerkleHash 'Nothing
forall a (n :: Maybe Natural). Binary a => a -> MerkleHash n
merkleHash

instance SemiEuclidean (MerkleHash Nothing) where
  div :: MerkleHash 'Nothing -> MerkleHash 'Nothing -> MerkleHash 'Nothing
div (M ByteString
x) (M ByteString
y) = (Prec, ByteString, ByteString) -> MerkleHash 'Nothing
forall a (n :: Maybe Natural). Binary a => a -> MerkleHash n
merkleHash (Prec
Div, ByteString
x, ByteString
y)
  mod :: MerkleHash 'Nothing -> MerkleHash 'Nothing -> MerkleHash 'Nothing
mod (M ByteString
x) (M ByteString
y) = (Prec, ByteString, ByteString) -> MerkleHash 'Nothing
forall a (n :: Maybe Natural). Binary a => a -> MerkleHash n
merkleHash (Prec
Mod, ByteString
x, ByteString
y)