Runtime.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Tests for "Morley.Michelson.Runtime".

module Test.Michelson.Runtime
  ( test_executorPure
  ) where

import Control.Lens (at)
import Data.Default (def)
import Fmt (pretty)
import Test.HUnit (Assertion, assertFailure, (@?), (@?=))
import Test.Hspec.Expectations (Expectation, expectationFailure)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

import Morley.Michelson.Interpret
  (ContractEnv(..), InterpretResult(..), handleContractReturn, interpret)
import Morley.Michelson.Runtime hiding (transfer)
import Morley.Michelson.Runtime.Dummy
  (dummyBigMapCounter, dummyContractEnv, dummyGlobalCounter, dummyLevel, dummyMaxSteps, dummyNow,
  dummyOrigination)
import Morley.Michelson.Runtime.GState (BigMapCounter, GState(..), initGState)
import Morley.Michelson.Text (MText)
import Morley.Michelson.Typed
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.Operation (OriginationOperation(..), TransferOperation(..))
import Morley.Tezos.Address
import Test.Cleveland.Instances ()

test_executorPure :: IO [TestTree]
test_executorPure = do
  pure
    [ testGroup "Updates storage value of executed contract" $
      [ testCase "contract1" $ updatesStorageValue contractAux1
      , testCase "contract2" $ updatesStorageValue contractAux2
      ]
    , testCase "Succeeds to originate the same contract twice, with different addresses"
        succeedsToOriginateTwice
    , testCase "Transfer of 0tz from unknown address is allowed" transferFromUnknown
    ]

----------------------------------------------------------------------------
-- Test code
----------------------------------------------------------------------------

-- | Data type, that containts contract and its auxiliary data.
data ContractAux cp st = ContractAux
  { caContract :: T.Contract cp st
  , caBigMapCounter :: BigMapCounter
  , caEnv :: ContractEnv
  , caStorage :: T.Value st
  , caParameter :: T.Value cp
  }

updatesStorageValue
  :: (ParameterScope cp, StorageScope st)
  => ContractAux cp st -> Assertion
updatesStorageValue ca = either (assertFailure . pretty) handleResult $ do
  let
    ce = caEnv ca
    origination = contractAuxToOrigination ca
    txData = TxData
      { tdSenderAddress = ceSender ce
      , tdParameter = TxTypedParam $ caParameter ca
      , tdEntrypoint = DefEpName
      , tdAmount = 100
      }

  runExecutorM dummyNow dummyLevel dummyMaxSteps initGState $ do
    addr <- executeGlobalOrigination origination
    executeGlobalOperations def [TransferOp $ TransferOperation addr txData 1]
    return addr
  where
    toNewStorage :: InterpretResult -> SomeValue
    toNewStorage InterpretResult {..} = SomeValue $ iurNewStorage

    handleResult :: (ExecutorRes, Address) -> Assertion
    handleResult (ir, addr) = do
      expectedValue <-
        either (assertFailure . pretty) (pure . toNewStorage) $
        handleContractReturn $
        interpret
          (caContract ca)
          unsafeEpcCallRoot
          (caParameter ca)
          (caStorage ca)
          dummyGlobalCounter
          (caBigMapCounter ca)
          (caEnv ca)
      case gsAddresses (_erGState ir) ^. at addr of
        Nothing -> expectationFailure $ "Address not found: " <> pretty addr
        Just (ASContract ContractState{..}) -> SomeValue csStorage @?= expectedValue
        Just _ -> expectationFailure $ "Address has unexpected state " <> pretty addr

succeedsToOriginateTwice :: Expectation
succeedsToOriginateTwice = either (assertFailure . pretty) handleResult $ do
  runExecutorM dummyNow dummyLevel dummyMaxSteps initGState $ do
    addr1 <- executeGlobalOrigination origination1
    addr2 <- executeGlobalOrigination origination2
    return (addr1, addr2)
  where
    contract = caContract contractAux1
    origination1 = dummyOrigination (caStorage contractAux1) contract 0
    origination2 = dummyOrigination (caStorage contractAux1) contract 1

    handleResult :: (ExecutorRes, (Address, Address)) -> Assertion
    handleResult (_, (addr1, addr2)) =
      addr1 /= addr2 @? "Two originated addresses are not different"

transferFromUnknown :: Assertion
transferFromUnknown = do
  let
    res = runExecutorM dummyNow dummyLevel dummyMaxSteps initGState $ do
      addr <- executeGlobalOrigination origination
      executeGlobalOperations def [TransferOp $ TransferOperation addr txData 1]

  whenLeft res $
    assertFailure . pretty
  where
    ca = contractAux1
    origination = contractAuxToOrigination ca
    txData =
      TxData
        { tdSenderAddress = detGenKeyAddress "transferFromUnknown"
        , tdParameter = TxTypedParam $ caParameter ca
        , tdEntrypoint = DefEpName
        , tdAmount = 0
        }

----------------------------------------------------------------------------
-- Data
----------------------------------------------------------------------------

contractAux1 :: ContractAux 'TString 'TBool
contractAux1 = ContractAux
  { caContract = contract
  , caBigMapCounter = dummyBigMapCounter
  , caEnv = dummyContractEnv
  , caStorage = toVal True
  , caParameter = toVal ("aaa" :: MText)
  }
  where
    contract :: Contract 'TString 'TBool
    contract = Contract
      { cParamNotes = starParamNotes
      , cStoreNotes = starNotes
      , cCode =
          CDR `Seq` NIL `Seq` PAIR
      , cEntriesOrder = def
      , cViews = def
      }

contractAux2 :: ContractAux 'TString 'TBool
contractAux2 = contractAux1
  { caContract = (caContract contractAux1)
    { cCode =
        CDR `Seq` NOT `Seq` NIL `Seq` PAIR
    }
  }

contractAuxToOrigination
  :: (ParameterScope cp , StorageScope st)
  => ContractAux cp st -> OriginationOperation
contractAuxToOrigination ca =
  let contract = caContract ca
      ce = caEnv ca
      originationOp = dummyOrigination (caStorage ca) contract dummyGlobalCounter
   in originationOp {ooBalance = ceBalance ce}