-- 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}