Expr.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Tests for Indigo Expr

module Test.Code.Expr
  ( MyUStore
  , MyTemplate (..)
  , SignatureData (..)
  , sampleSignature
  , partialParse

  , exprNullary
  , exprUnary
  , exprBinary
  , exprAbs
  , exprDivEq
  , exprModNeq
  , exprLe3
  , exprLt3OrGt10
  , exprGe3AndNotGe10
  , exprGe4OrNeq5AndEq6
  , exprNot
  , exprIsNat
  , exprSome
  , exprNone
  , exprFst
  , exprSnd
  , exprPack
  , exprUnpack
  , exprSet
  , exprSize
  , exprEmptySet
  , exprCons
  , exprConcat
  , exprSlice
  , exprBigMapLookup
  , exprBigMapDelete
  , exprBigMapInsert
  , exprUStore
  , exprCheckSignature
  , exprCrypto
  , exprHashKey
  , exprNonZero
  ) where

import Fmt (Buildable, pretty)

import Indigo
import Test.Util
import qualified Tezos.Crypto as C

partialParse :: Buildable b => (a -> Either b c) -> a -> c
partialParse f = either (error . pretty) id . f

data MyTemplate = MyTemplate
  { ints :: Integer |~> ()
  , bool :: UStoreField Bool
  } deriving stock (Eq, Show, Generic)

type MyUStore = UStore MyTemplate

----------------------------------------------------------------------------
-- Sample data
----------------------------------------------------------------------------

data SignatureData = SignatureData
  { sdPublicKey :: Text
  , sdBytes :: ByteString
  , sdSignature :: Text
  }

sampleSignature :: SignatureData
sampleSignature = SignatureData
    { sdPublicKey = "edpkuwTWKgQNnhR5v17H2DYHbfcxYepARyrPGbf1tbMoGQAj8Ljr3V"
    , sdBytes = "\0"
    , sdSignature = "edsigtrs8bK7vNfiR4Kd9dWasVa1bAWaQSu2ipnmLGZuwQa8ktCEMYVKqbWsbJ7zTS8dgYT9tiSUKorWCPFHosL5zPsiDwBQ6vb"
    }

----------------------------------------------------------------------------
-- Indigo Expr code
----------------------------------------------------------------------------

exprNullary
  :: forall s. IsObject s => Expr s -> '[(), s] :-> '[(), s]
exprNullary expr = compileIndigo @2 $ \st _param -> st =: expr

exprUnary
  :: forall s. IsObject s => (Var s -> Expr s) -> '[s, s] :-> '[s, s]
exprUnary expr = compileIndigo @2 $ \st param -> st =: expr param

exprBinary
  :: forall s. IsObject s => (Var s -> Var s -> Expr s) -> '[s, s] :-> '[s, s]
exprBinary expr = compileIndigo @2 $ \st param -> st =: expr param st

exprAbs :: '[Integer, Natural] :-> '[Integer, Natural]
exprAbs = compileIndigo @2 $ \st param -> st =: abs param

exprDivEq :: '[Integer, Integer] :-> '[Integer, Integer]
exprDivEq = compileIndigo @2 $ \st param -> st =: st / param

exprModNeq :: '[Integer, Integer] :-> '[Integer, Integer]
exprModNeq = compileIndigo @2 $ \st param -> do
  if st % param /= 0 nat then st =: 0 int else st =: 1 int

exprLe3 :: '[Integer, Bool] :-> '[Integer, Bool]
exprLe3 = compileIndigo @2 $ \st param ->
  st =: param <= 3 int

exprLt3OrGt10 :: '[Integer, Bool] :-> '[Integer, Bool]
exprLt3OrGt10 = compileIndigo @2 $ \st param ->
  st =: param < 3 int || param > 10 int

{-# ANN exprGe3AndNotGe10 ("HLint: ignore Use <" :: Text) #-}
exprGe3AndNotGe10 :: '[Integer, Bool] :-> '[Integer, Bool]
exprGe3AndNotGe10 = compileIndigo @2 $ \st param ->
  st =: param >= 3 int && not (param >= 10 int)

exprGe4OrNeq5AndEq6 :: '[Integer, Bool] :-> '[Integer, Bool]
exprGe4OrNeq5AndEq6 = compileIndigo @2 $ \st param ->
  st =: param >= 4 int || param /= 5 int && param == 6 int

exprNot :: '[Bool, Bool] :-> '[Bool, Bool]
exprNot = compileIndigo @2 $ \st param ->
  st =: not param

exprIsNat :: '[Integer, Maybe Natural] :-> '[Integer, Maybe Natural]
exprIsNat = compileIndigo @2 $ \st param ->
  st =: isNat param

exprSome :: KnownValue a => '[a, Maybe a] :-> '[a, Maybe a]
exprSome = compileIndigo @2 $ \st param ->
  st =: some param

exprNone :: KnownValue a => '[a, Maybe a] :-> '[a, Maybe a]
exprNone = compileIndigo @2 $ \st _ ->
  st =: none

exprFst :: '[(Integer, Integer), Integer] :-> '[(Integer, Integer), Integer]
exprFst = compileIndigo @2 $ \st param -> st =: fst param

exprSnd :: '[(Integer, Integer), Integer] :-> '[(Integer, Integer), Integer]
exprSnd = compileIndigo @2 $ \st param -> st =: snd param

exprPack :: '[Signature, ByteString] :-> '[Signature, ByteString]
exprPack = compileIndigo @2 $ \st param -> st =: pack param

exprUnpack :: '[ByteString, Maybe Signature] :-> '[ByteString, Maybe Signature]
exprUnpack= compileIndigo @2 $ \st param -> st =: unpack param

exprSet :: '[(Set Integer), Integer] :-> '[(Set Integer), Integer]
exprSet = compileIndigo @2 $ \st param -> do
  z <- new$ 0 int
  if_ (mem z param) -- Same, but also checks `mem` expression
    (param =: param -: z)
    (param =: param +: 1 int)
  if_ (size param == 1 nat)
    (st =: z)
    (st =: 1 int)

exprSize :: '[[Integer], Natural] :-> '[[Integer], Natural]
exprSize = compileIndigo @2 $ \st param -> do
  st =: size param

exprEmptySet :: '[(), Set Integer] :-> '[(), Set Integer]
exprEmptySet = compileIndigo @2 $ \st _param -> st =: emptySet

exprCons :: '[Integer, List Integer] :-> '[Integer, List Integer]
exprCons = compileIndigo @2 $ \st param -> do
  st =: param .: st

exprConcat :: '[MText, MText] :-> '[MText, MText]
exprConcat = compileIndigo @2 $ \st param -> do
  st =: param <> st

exprSlice :: '[Natural, Maybe MText] :-> '[Natural, Maybe MText]
exprSlice = compileIndigo @2 $ \st' param -> do
  ifSome st'
    (\st -> do
      ifSome (slice (0 nat, param) st)
        (\r -> do
          st =: r
          st' =: some st
        )
        (return ()))
    (return ())

exprBigMapLookup :: '[BigMap Integer Integer, Maybe Integer] :-> '[BigMap Integer Integer, Maybe Integer]
exprBigMapLookup = compileIndigo @2 $ \st param -> do
  st =: param #: 2 int

exprBigMapDelete :: '[Integer, BigMap Integer Integer] :-> '[Integer, BigMap Integer Integer]
exprBigMapDelete = compileIndigo @2 $ \st param -> do
  st =: st -: param

exprBigMapInsert :: '[Integer, BigMap Integer Integer] :-> '[Integer, BigMap Integer Integer]
exprBigMapInsert = compileIndigo @2 $ \st param -> do
  st =: st +: (param, param)

exprUStore
  :: '[Integer, MyUStore]
  :-> '[Integer, MyUStore]
exprUStore = compileIndigo @2 $ \st param -> do
  st1 <- new$ st +@ (#ints, param, ())
  st2 <- new$ st1 ++@ (#ints, notNewKeyM, 0 int, ())
  ifSome (st2 #@ (#ints, -1 int))
    (\_v -> st =: st)
    (st =: st2)

exprCheckSignature :: '[Bool, Bool] :-> '[Bool, Bool]
exprCheckSignature = compileIndigo @2 (phi sampleSignature)
  where
    phi SignatureData{..} st _param = do
      st =: checkSignature
        (constExpr $ partialParse C.parsePublicKey sdPublicKey)
        (constExpr $ partialParse C.parseSignature sdSignature)
        (constExpr sdBytes)

exprCrypto
  :: '[ByteString, ByteString]
  :-> '[ByteString, ByteString]
exprCrypto = compileIndigo @2 $ \st param -> do
  _sha256var <- new$ sha256 param
  st =: blake2b param
  param =: sha512 param

exprHashKey :: '[PublicKey, KeyHash] :-> '[PublicKey, KeyHash]
exprHashKey = compileIndigo @2 $ \st param -> do
  st =: hashKey param

exprNonZero :: '[Integer, Maybe Integer] :-> '[Integer, Maybe Integer]
exprNonZero = compileIndigo @2 $ \st param ->
  st =: nonZero param