module ZkFold.Symbolic.Algorithms.Hash.MiMC (mimcHash) where

import           Data.List.NonEmpty              (NonEmpty ((:|)), nonEmpty)
import           Numeric.Natural                 (Natural)
import           Prelude                         hiding (Eq (..), Num (..), any, length, not, (!!), (/), (^), (||))

import           ZkFold.Base.Algebra.Basic.Class
import           ZkFold.Symbolic.Types           (Symbolic)

-- | MiMC-2n/n (Feistel) hash function.
-- See https://eprint.iacr.org/2016/492.pdf, page 5
mimcHash :: forall a . Symbolic a => [a] -> a -> a -> a -> a
mimcHash :: forall a. Symbolic a => [a] -> a -> a -> a -> a
mimcHash [a]
xs a
k = case [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs) of
    Just NonEmpty a
cs -> NonEmpty a -> a -> a -> a
go NonEmpty a
cs
    Maybe (NonEmpty a)
Nothing -> [Char] -> a -> a -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"mimcHash: empty list"
    where
        go :: NonEmpty a -> a -> a -> a
go (a
c :| [a]
cs) a
xL a
xR =
          let t5 :: a
t5 = (a
xL a -> a -> a
forall a. AdditiveSemigroup a => a -> a -> a
+ a
k a -> a -> a
forall a. AdditiveSemigroup a => a -> a -> a
+ a
c) a -> Natural -> a
forall a b. Exponent a b => a -> b -> a
^ (Natural
5 :: Natural)
           in case [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [a]
cs of
              Just NonEmpty a
cs' -> NonEmpty a -> a -> a -> a
go NonEmpty a
cs' (a
xR a -> a -> a
forall a. AdditiveSemigroup a => a -> a -> a
+ a
t5) a
xL
              Maybe (NonEmpty a)
Nothing  -> a
xR a -> a -> a
forall a. AdditiveSemigroup a => a -> a -> a
+ a
t5