diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,11 @@ +0.2.0 +===== + +Initial release. + +* Typechecker and interpreter for Michelson. +* Morley extensions: + - syntax sugar + - let-blocks + - inline assertions +* EDSL for unit testing and integrational testing diff --git a/morley.cabal b/morley.cabal --- a/morley.cabal +++ b/morley.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: morley -version: 0.1.0.2 +version: 0.1.0.3 synopsis: Developer tools for the Michelson Language description: A library to make writing smart contracts in Michelson — the smart contract @@ -14,7 +14,8 @@ category: Language build-type: Simple bug-reports: https://issues.serokell.io/issues/TM -extra-doc-files: CONTRIBUTING.md +extra-doc-files: CHANGES.md + , CONTRIBUTING.md , README.md source-repository head @@ -22,7 +23,8 @@ location: git@gitlab.com:camlcase-dev/morley.git library - build-tool-depends: autoexporter:autoexporter +-- build-tool-depends: autoexporter:autoexporter + build-tools: autoexporter hs-source-dirs: src default-language: Haskell2010 @@ -224,7 +226,6 @@ , Test.Interpreter.CallSelf , Test.Interpreter.Compare , Test.Interpreter.Conditionals - , Test.Interpreter.EnvironmentSpec , Test.Interpreter.StringCaller , Test.Macro , Test.Ext diff --git a/src/Morley/Runtime.hs b/src/Morley/Runtime.hs --- a/src/Morley/Runtime.hs +++ b/src/Morley/Runtime.hs @@ -94,7 +94,7 @@ data InterpreterError = IEUnknownContract !Address -- ^ The interpreted contract hasn't been originated. - | IEInterpreterFailed !Address + | IEInterpreterFailed !(Contract Op) !(InterpretUntypedError MorleyLogs) -- ^ Interpretation of Michelson contract failed. | IEAlreadyOriginated !Address @@ -116,8 +116,7 @@ build = \case IEUnknownContract addr -> "The contract is not originated " +| addr |+ "" - IEInterpreterFailed addr err -> - "Michelson interpreter failed for contract " +| addr |+ ": " +| err |+ "" + IEInterpreterFailed _ err -> "Michelson interpreter failed: " +| err |+ "" IEAlreadyOriginated addr cs -> "The following contract is already originated: " +| addr |+ ", " +| cs |+ "" @@ -373,7 +372,7 @@ , iurNewStorage = newValue , iurNewState = InterpreterState printedLogs newRemainingSteps } - <- first (IEInterpreterFailed addr) $ + <- first (IEInterpreterFailed contract) $ interpretMorleyUntyped contract (tdParameter txData) (csStorage cs) contractEnv let diff --git a/src/Morley/Test/Integrational.hs b/src/Morley/Test/Integrational.hs --- a/src/Morley/Test/Integrational.hs +++ b/src/Morley/Test/Integrational.hs @@ -1,206 +1,142 @@ -- | Utilities for integrational testing. --- Example tests can be found in the 'morley-test' test suite. module Morley.Test.Integrational - ( - -- * Re-exports - TxData (..) - - -- * Testing engine - , TestOperation (..) - , IntegrationalValidator + ( IntegrationalValidator , SuccessValidator - , IntegrationalScenario , integrationalTestExpectation , integrationalTestProperty - , originate - , transfer - , validate - , setMaxSteps - , setNow + , simplerIntegrationalTestExpectation + , simplerIntegrationalTestProperty -- * Validators , composeValidators - , composeValidatorsList - , expectAnySuccess - , expectStorageUpdate - , expectStorageUpdateConst + , expectStorageValue + , expectStorageConstant , expectBalance - , expectStorageConst , expectGasExhaustion - , expectMichelsonFailed ) where -import Control.Lens (at, makeLenses, (.=), (<>=)) -import Control.Monad.Except (Except, runExcept, throwError) +import Control.Lens (at) import qualified Data.List as List import Fmt (blockListF, pretty, (+|), (|+)) import Test.Hspec (Expectation, expectationFailure) import Test.QuickCheck (Property) import Michelson.Interpret (InterpretUntypedError(..), MichelsonFailed(..), RemainingSteps) -import Michelson.Untyped (OriginationOperation(..), mkContractAddress) -import Morley.Aliases (UntypedContract, UntypedValue) +import Morley.Aliases (UntypedValue) import Morley.Runtime (InterpreterError(..), InterpreterOp(..), InterpreterRes(..), interpreterPure) import Morley.Runtime.GState -import Morley.Runtime.TxData import Morley.Test.Dummy import Morley.Test.Util (failedProp, succeededProp) import Tezos.Address (Address) import Tezos.Core (Mutez, Timestamp) ----------------------------------------------------------------------------- --- Some internals (they are here because TH makes our very existence much harder) ----------------------------------------------------------------------------- - -data InternalState = InternalState - { _isMaxSteps :: !RemainingSteps - , _isNow :: !Timestamp - , _isGState :: !GState - , _isOperations :: ![InterpreterOp] - -- ^ Operations to be interpreted when 'TOValidate' is encountered. - } - -makeLenses ''InternalState - ----------------------------------------------------------------------------- --- Interface ----------------------------------------------------------------------------- - --- | Operations supported by this testing engine. --- Each operation has a corresponding top-level function where its semantics is defined. --- Usually you shouldn't use this type directly. -data TestOperation - = TOInterpreterOp !InterpreterOp - | TOValidate !IntegrationalValidator - | TOSetMaxSteps !RemainingSteps - | TOSetNow !Timestamp - -- | Validator for integrational testing. -- If an error is expected, it should be 'Left' with validator for errors. -- Otherwise it should check final global state and its updates. type IntegrationalValidator = Either (InterpreterError -> Bool) SuccessValidator --- | Validator for integrational testing that expects successful execution. type SuccessValidator = (GState -> [GStateUpdate] -> Either Text ()) -type IntegrationalScenarioState = [TestOperation] - --- | A monad inside which integrational tests can be described using --- do-notation. -type IntegrationalScenarioM = State IntegrationalScenarioState - --- | A dummy data type that ensures that `validate` is called in the --- end of each scenario. It is intentionally not exported. -data Validated = Validated - -type IntegrationalScenario = IntegrationalScenarioM Validated - -- | Integrational test that executes given operations and validates -- them using given validator. It can fail using 'Expectation' -- capability. --- It starts with 'initGState' and some reasonable dummy values for --- gas limit and current timestamp. You can update blockchain state --- by performing some operations. -integrationalTestExpectation :: IntegrationalScenario -> Expectation +integrationalTestExpectation :: + Timestamp -> RemainingSteps -> [InterpreterOp] -> IntegrationalValidator -> Expectation integrationalTestExpectation = integrationalTest (maybe pass (expectationFailure . toString)) --- | Integrational test similar to 'integrationalTestExpectation'. --- It can fail using 'Property' capability. --- It can be used with QuickCheck's @forAll@ to make a +-- | Integrational test that executes given operations and validates +-- them using given validator. It can fail using 'Property' +-- capability. It can be used with QuickCheck's @forAll@ to make a -- property-based test with arbitrary data. -integrationalTestProperty :: IntegrationalScenario -> Property +integrationalTestProperty :: + Timestamp -> RemainingSteps -> [InterpreterOp] -> IntegrationalValidator -> Property integrationalTestProperty = integrationalTest (maybe succeededProp failedProp) --- | Originate a contract with given initial storage and balance. Its --- address is returned. -originate :: - UntypedContract -> UntypedValue -> Mutez -> IntegrationalScenarioM Address -originate contract value balance = - mkContractAddress origination <$ putOperation (TOInterpreterOp originateOp) - where - origination = (dummyOrigination value contract) {ooBalance = balance} - originateOp = OriginateOp origination - --- | Transfer tokens to given address. -transfer :: TxData -> Address -> IntegrationalScenarioM () -transfer txData destination = - putOperation (TOInterpreterOp $ TransferOp destination txData) - --- | Execute all operations that were added to the scenarion since --- last 'validate' call. If validator fails, the execution will be aborted. -validate :: IntegrationalValidator -> IntegrationalScenario -validate validator = Validated <$ putOperation (TOValidate validator) +-- | 'integrationalTestExpectation' which uses dummy now and max steps. +simplerIntegrationalTestExpectation :: [InterpreterOp] -> IntegrationalValidator -> Expectation +simplerIntegrationalTestExpectation = + integrationalTestExpectation dummyNow dummyMaxSteps --- | Make all further interpreter calls (which are triggered by the --- 'validate' function) use given timestamp as the current one. -setNow :: Timestamp -> IntegrationalScenarioM () -setNow = putOperation . TOSetNow +-- | 'integrationalTestProperty' which uses dummy now and max steps. +simplerIntegrationalTestProperty :: [InterpreterOp] -> IntegrationalValidator -> Property +simplerIntegrationalTestProperty = + integrationalTestProperty dummyNow dummyMaxSteps --- | Make all further interpreter calls (which are triggered by the --- 'validate' function) use given gas limit. -setMaxSteps :: RemainingSteps -> IntegrationalScenarioM () -setMaxSteps = putOperation . TOSetMaxSteps +integrationalTest :: + (Maybe Text -> res) + -> Timestamp + -> RemainingSteps + -> [InterpreterOp] + -> IntegrationalValidator + -> res +integrationalTest howToFail now maxSteps operations validator = + validateResult + howToFail + validator + (interpreterPure now maxSteps initGState operations) -putOperation :: TestOperation -> IntegrationalScenarioM () -putOperation op = id <>= one op +validateResult :: + (Maybe Text -> res) + -> IntegrationalValidator + -> Either InterpreterError InterpreterRes + -> res +validateResult howToFail validator result = + case (validator, result) of + (Left validateError, Left err) + | validateError err -> doNotFail + (_, Left err) -> + doFail $ "Unexpected interpreter error: " <> pretty err + (Left _, Right _) -> + doFail $ "Interpreter unexpectedly didn't fail" + (Right validateUpdates, Right ir) + | Left bad <- validateUpdates (_irGState ir) (_irUpdates ir) -> + doFail $ + "Updates are incorrect: " +| bad |+ ". Updates are: \n" +| + blockListF (_irUpdates ir) |+ "" + | otherwise -> doNotFail + where + doNotFail = howToFail Nothing + doFail = howToFail . Just ---------------------------------------------------------------------------- -- Validators to be used within 'IntegrationalValidator' ---------------------------------------------------------------------------- --- | 'SuccessValidator' that always passes. -expectAnySuccess :: SuccessValidator -expectAnySuccess _ _ = pass - -- | Check that storage value is updated for given address. Takes a -- predicate that is used to check the value. -- -- It works even if updates are not filtered (i. e. a value can be -- updated more than once). -expectStorageUpdate :: +expectStorageValue :: Address -> (UntypedValue -> Either Text ()) -> SuccessValidator -expectStorageUpdate addr predicate _ updates = +expectStorageValue addr predicate _ updates = case List.find checkAddr (reverse updates) of Nothing -> Left $ "Storage of " +| addr |+ " is not updated" Just (GSSetStorageValue _ val) -> first (("Storage of " +| addr |+ "is updated incorrectly: ") <>) $ predicate val -- 'checkAddr' ensures that only 'GSSetStorageValue' can be found - Just _ -> error "expectStorageUpdate: internal error" + Just _ -> error "expectStorageValue: internal error" where checkAddr (GSSetStorageValue addr' _) = addr' == addr checkAddr _ = False --- | Like 'expectStorageUpdate', but expects a constant. -expectStorageUpdateConst :: +-- | Like 'expectStorageValue', but expects a constant. +expectStorageConstant :: Address -> UntypedValue -> SuccessValidator -expectStorageUpdateConst addr expected = - expectStorageUpdate addr predicate +expectStorageConstant addr expected = + expectStorageValue addr predicate where predicate val | val == expected = pass | otherwise = Left $ "expected " +| expected |+ "" --- | Check that eventually address has some particular storage value. -expectStorageConst :: Address -> UntypedValue -> SuccessValidator -expectStorageConst addr expected gs _ = - case gsAddresses gs ^. at addr of - Just (ASContract cs) - | csStorage cs == expected -> pass - | otherwise -> - Left $ intro +| "its storage is " +| csStorage cs |+ "" - Just (ASSimple {}) -> - Left $ intro +| "it's a simple address" - Nothing -> Left $ intro +| "it's unknown" - where - intro = "Expected " +| addr |+ " to have storage " +| expected |+ ", but " - -- | Check that eventually address has some particular balance. expectBalance :: Address -> Mutez -> SuccessValidator expectBalance addr balance gs _ = @@ -221,7 +157,7 @@ -- For example: -- -- expectBalance bal addr `composeValidators` --- expectStorageUpdateConst addr2 ValueUnit +-- expectStorageConstant addr2 ValueUnit composeValidators :: SuccessValidator -> SuccessValidator @@ -229,81 +165,8 @@ composeValidators val1 val2 gState updates = val1 gState updates >> val2 gState updates --- | Compose a list of success validators. -composeValidatorsList :: [SuccessValidator] -> SuccessValidator -composeValidatorsList = foldl' composeValidators expectAnySuccess - --- | Check that interpreter failed due to gas exhaustion. expectGasExhaustion :: InterpreterError -> Bool expectGasExhaustion = \case IEInterpreterFailed _ (RuntimeFailure (MichelsonGasExhaustion, _)) -> True _ -> False - --- | Expect that interpretation of contract with given address ended --- with [FAILED]. -expectMichelsonFailed :: Address -> InterpreterError -> Bool -expectMichelsonFailed addr = - \case - IEInterpreterFailed failedAddr (RuntimeFailure {}) -> addr == failedAddr - _ -> False - ----------------------------------------------------------------------------- --- Implementation of the testing engine ----------------------------------------------------------------------------- - -initIS :: InternalState -initIS = InternalState - { _isNow = dummyNow - , _isMaxSteps = dummyMaxSteps - , _isGState = initGState - , _isOperations = mempty - } - -integrationalTest :: - (Maybe Text -> res) - -> IntegrationalScenario - -> res -integrationalTest howToFail scenario = - howToFail $ leftToMaybe $ runExcept (runStateT integrationalTestDo initIS) - where - operations = execState scenario [] - integrationalTestDo :: StateT InternalState (Except Text) () - integrationalTestDo = mapM_ integrationalTestStep operations - -integrationalTestStep :: TestOperation -> StateT InternalState (Except Text) () -integrationalTestStep = - \case - TOInterpreterOp intOp -> isOperations <>= one intOp - TOValidate validator -> do - now <- use isNow - maxSteps <- use isMaxSteps - gState <- use isGState - ops <- use isOperations - mUpdatedGState <- - lift $ validateResult validator $ interpreterPure now maxSteps gState ops - isOperations .= mempty - whenJust mUpdatedGState $ \newGState -> isGState .= newGState - TOSetNow newNow -> isNow .= newNow - TOSetMaxSteps newMaxSteps -> isMaxSteps .= newMaxSteps - -validateResult :: - IntegrationalValidator - -> Either InterpreterError InterpreterRes - -> Except Text (Maybe GState) -validateResult validator result = - case (validator, result) of - (Left validateError, Left err) - | validateError err -> pure Nothing - (_, Left err) -> - doFail $ "Unexpected interpreter error: " <> pretty err - (Left _, Right _) -> - doFail $ "Interpreter unexpectedly didn't fail" - (Right validateUpdates, Right ir) - | Left bad <- validateUpdates (_irGState ir) (_irUpdates ir) -> - doFail $ - "Updates are incorrect: " +| bad |+ ". Updates are: \n" +| - blockListF (_irUpdates ir) |+ "" - | otherwise -> pure $ Just $ _irGState ir - where - doFail = throwError diff --git a/src/Tezos/Address.hs b/src/Tezos/Address.hs --- a/src/Tezos/Address.hs +++ b/src/Tezos/Address.hs @@ -8,7 +8,6 @@ -- * Formatting , formatAddress , parseAddress - , unsafeParseAddress ) where import Data.Aeson (FromJSON(..), FromJSONKey, ToJSON(..), ToJSONKey) @@ -85,9 +84,6 @@ , ")" ] --- | Parse an address from its human-readable textual representation --- used by Tezos (e. g. "tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU"). Or --- fail if it's invalid. parseAddress :: Text -> Either ParseAddressError Address parseAddress addressText = case parseKeyHash addressText of @@ -95,11 +91,6 @@ Left keyAddrErr -> first (ParseAddressBothFailed keyAddrErr) $ parseContractAddress addressText Right keyHash -> Right (KeyAddress keyHash) - --- | Partial version of 'parseAddress' which assumes that the address --- is correct. Can be used in tests. -unsafeParseAddress :: HasCallStack => Text -> Address -unsafeParseAddress = either (error . pretty) id . parseAddress data ParseContractAddressError = ParseContractAddressWrongBase58Check diff --git a/test/Test/Interpreter.hs b/test/Test/Interpreter.hs --- a/test/Test/Interpreter.hs +++ b/test/Test/Interpreter.hs @@ -18,7 +18,6 @@ import Test.Interpreter.CallSelf (selfCallerSpec) import Test.Interpreter.Compare (compareSpec) import Test.Interpreter.Conditionals (conditionalsSpec) -import Test.Interpreter.EnvironmentSpec (environmentSpec) import Test.Interpreter.StringCaller (stringCallerSpec) spec :: Spec @@ -63,7 +62,6 @@ conditionalsSpec stringCallerSpec selfCallerSpec - environmentSpec specWithTypedContract "contracts/steps_to_quota_test1.tz" $ \contract -> do it "Amount of steps should reduce" $ do diff --git a/test/Test/Interpreter/CallSelf.hs b/test/Test/Interpreter/CallSelf.hs --- a/test/Test/Interpreter/CallSelf.hs +++ b/test/Test/Interpreter/CallSelf.hs @@ -10,14 +10,14 @@ import Michelson.Interpret (ContractEnv(..), InterpreterState(..), RemainingSteps(..)) import Michelson.Typed +import Michelson.Untyped (OriginationOperation(..), mkContractAddress) import qualified Michelson.Untyped as Untyped import Morley.Aliases (UntypedContract) +import Morley.Runtime (InterpreterOp(..), TxData(..)) import Morley.Runtime.GState import Morley.Test (ContractPropValidator, contractProp, specWithContract) import Morley.Test.Dummy import Morley.Test.Integrational -import Tezos.Address (Address) -import Tezos.Core (unsafeMkMutez) selfCallerSpec :: Spec selfCallerSpec = @@ -69,7 +69,8 @@ prop propertyDescription $ forAll genFixture $ \fixture -> - integrationalTestProperty (integrationalScenario uSelfCaller fixture) + integrationalTestProperty dummyNow (fMaxSteps fixture) + (operations fixture) (integValidator fixture) where -- Environment for unit test unitContractEnv = dummyContractEnv @@ -84,24 +85,26 @@ "it fails due to gas limit if the number is large, otherwise the " <> "storage is updated to the number of calls" -integrationalScenario :: UntypedContract -> Fixture -> IntegrationalScenario -integrationalScenario uSelfCaller fixture = do - setMaxSteps (fMaxSteps fixture) - address <- originate uSelfCaller (Untyped.ValueInt 0) (unsafeMkMutez 1) - let - txData :: TxData - txData = TxData + operations :: Fixture -> [InterpreterOp] + operations fixture = [originateOp, transferOp fixture] + + origination :: OriginationOperation + origination = dummyOrigination (Untyped.ValueInt 0) uSelfCaller + address = mkContractAddress origination + originateOp = OriginateOp origination + + txData :: Fixture -> TxData + txData fixture = TxData { tdSenderAddress = genesisAddress , tdParameter = Untyped.ValueInt (fromIntegral $ fParameter fixture) , tdAmount = minBound } - transfer txData address - validate (validator address) - where - validator :: Address -> IntegrationalValidator - validator address + transferOp fixture = TransferOp address (txData fixture) + + integValidator :: Fixture -> IntegrationalValidator + integValidator fixture | fExpectSuccess fixture = let expectedStorage = Untyped.ValueInt (fromIntegral $ fParameter fixture) - in Right $ expectStorageUpdateConst address expectedStorage + in Right $ expectStorageConstant address expectedStorage | otherwise = Left expectGasExhaustion diff --git a/test/Test/Interpreter/EnvironmentSpec.hs b/test/Test/Interpreter/EnvironmentSpec.hs deleted file mode 100644 --- a/test/Test/Interpreter/EnvironmentSpec.hs +++ /dev/null @@ -1,104 +0,0 @@ --- | Tests for the 'environment.tz' contract - -module Test.Interpreter.EnvironmentSpec - ( environmentSpec - ) where - -import Test.Hspec (Spec) -import Test.Hspec.QuickCheck (modifyMaxSuccess, prop) -import Test.QuickCheck (Arbitrary(..), choose) -import Test.QuickCheck.Instances.Text () - -import Michelson.Interpret (RemainingSteps(..)) -import Michelson.Typed -import qualified Michelson.Untyped as Untyped -import Morley.Aliases (UntypedContract, UntypedValue) -import Morley.Runtime.GState -import Morley.Test (specWithContract) -import Morley.Test.Integrational -import Tezos.Address -import Tezos.Core - -environmentSpec :: Spec -environmentSpec = - specWithContract "contracts/environment.tz" specImpl - -data Fixture = Fixture - { fNow :: !Timestamp - , fMaxSteps :: !RemainingSteps - , fPassOriginatedAddress :: !Bool - , fBalance :: !Mutez - , fAmount :: !Mutez - } deriving (Show) - -instance Arbitrary Fixture where - arbitrary = do - fNow <- timestampFromSeconds @Int <$> choose (100000, 111111) - fMaxSteps <- RemainingSteps <$> choose (1000, 1200) - fPassOriginatedAddress <- arbitrary - fBalance <- unsafeMkMutez <$> choose (1, 1234) - fAmount <- unsafeMkMutez <$> choose (1, 42) - return Fixture {..} - -shouldExpectFailed :: Fixture -> Bool -shouldExpectFailed fixture = - or - [ fBalance fixture > unsafeMkMutez 1000 - , fNow fixture < timestampFromSeconds @Int 100500 - , fPassOriginatedAddress fixture - , fAmount fixture < unsafeMkMutez 15 - ] - -shouldReturn :: Fixture -> UntypedValue -shouldReturn fixture - | fMaxSteps fixture - consumedGas > 1000 = Untyped.ValueTrue - | otherwise = Untyped.ValueFalse - where - consumedGas = 24 - -specImpl :: - (UntypedContract, Contract ('Tc 'CAddress) ('Tc 'CBool)) - -> Spec -specImpl (uEnvironment, _environment) = do - let scenario = integrationalScenario uEnvironment - modifyMaxSuccess (min 12) $ - prop description $ - integrationalTestExpectation . scenario - where - description = - "This contract fails under conditions described in a comment at the " <> - "beginning of this contract and returns whether remaining gas is " <> - "greater than 1000" - -integrationalScenario :: UntypedContract -> Fixture -> IntegrationalScenario -integrationalScenario contract fixture = do - -- First of all let's set desired gas limit and NOW - setNow $ fNow fixture - setMaxSteps $ fMaxSteps fixture - - -- Then let's originated the 'environment.tz' contract - environmentAddress <- - originate contract Untyped.ValueFalse (fBalance fixture) - - -- And transfer tokens to it - let - param - | fPassOriginatedAddress fixture = environmentAddress - | otherwise = genesisAddress - txData = TxData - { tdSenderAddress = genesisAddress - , tdParameter = Untyped.ValueString (formatAddress param) - , tdAmount = fAmount fixture - } - transfer txData environmentAddress - - -- Execute operations and check that interpreter fails when one of - -- failure conditions is met or updates environment's storage - -- approriately - let - validator - | shouldExpectFailed fixture = - Left $ expectMichelsonFailed environmentAddress - | otherwise = - Right $ expectStorageConst environmentAddress $ shouldReturn fixture - validate validator diff --git a/test/Test/Interpreter/StringCaller.hs b/test/Test/Interpreter/StringCaller.hs --- a/test/Test/Interpreter/StringCaller.hs +++ b/test/Test/Interpreter/StringCaller.hs @@ -1,6 +1,4 @@ --- | Tests for the 'stringCaller.tz' contract and its interaction with --- the 'idString.tz' contract. Both of them have comments describing --- their behavior. +-- | Tests for the 'stringCaller.tz' contract. module Test.Interpreter.StringCaller ( stringCallerSpec @@ -11,12 +9,15 @@ import Test.QuickCheck.Instances.Text () import Michelson.Typed +import Michelson.Untyped (OriginationOperation(..), mkContractAddress) import qualified Michelson.Untyped as Untyped -import Morley.Aliases (UntypedContract) +import Morley.Aliases (UntypedContract, UntypedValue) +import Morley.Runtime (InterpreterOp(..), TxData(..)) import Morley.Runtime.GState import Morley.Test (specWithContract) +import Morley.Test.Dummy import Morley.Test.Integrational -import Tezos.Address +import Tezos.Address (formatAddress) import Tezos.Core stringCallerSpec :: Spec @@ -31,111 +32,53 @@ -> (UntypedContract, Contract ('Tc 'CString) ('Tc 'CString)) -> Spec specImpl (uStringCaller, _stringCaller) (uIdString, _idString) = do - let scenario = integrationalScenario uStringCaller uIdString - let suffix = - " and properly updates balances. But fails if idString's balance is ≥ \ - \1000 and NOW is ≥ 500" - it ("stringCaller calls idString and updates its storage with a constant" - <> suffix) $ - integrationalTestExpectation (scenario constStr) + it "stringCaller calls idString and updates its storage with a constant" $ + simplerIntegrationalTestExpectation + (operations newValueConstant) + (Right (updatesValidator newValueConstant)) -- The test is trivial, so it's kinda useless to run it many times modifyMaxSuccess (const 2) $ - prop ("stringCaller calls idString and updates its storage with an arbitrary value" - <> suffix) $ - \str -> integrationalTestProperty (scenario str) + prop "stringCaller calls idString and updates its storage with an arbitrary value" $ + \(Untyped.ValueString -> newValue) -> simplerIntegrationalTestProperty + (operations newValue) + (Right (updatesValidator newValue)) where - constStr = "caller" - -integrationalScenario :: UntypedContract -> UntypedContract -> Text -> IntegrationalScenario -integrationalScenario stringCaller idString str = do - let - initIdStringBalace = unsafeMkMutez 900 - initStringCallerBalance = unsafeMkMutez 500 + newValueConstant = Untyped.ValueString "caller" - -- Originate both contracts - idStringAddress <- - originate idString (Untyped.ValueString "hello") initIdStringBalace - stringCallerAddress <- - originate stringCaller (Untyped.ValueString $ formatAddress idStringAddress) - initStringCallerBalance + idStringOrigination :: OriginationOperation + idStringOrigination = + dummyOrigination (Untyped.ValueString "hello") uIdString + originateIdString = OriginateOp idStringOrigination + idStringAddress = mkContractAddress idStringOrigination - -- NOW = 500, so stringCaller shouldn't fail - setNow (timestampFromSeconds @Int 500) + stringCallerOrigination :: OriginationOperation + stringCallerOrigination = + dummyOrigination (Untyped.ValueString $ formatAddress idStringAddress) + uStringCaller + originateStringCaller = OriginateOp stringCallerOrigination + stringCallerAddress = mkContractAddress stringCallerOrigination - -- Transfer 100 tokens to stringCaller, it should transfer 300 tokens - -- to idString - let - newValue = Untyped.ValueString str - txData = TxData + txData :: UntypedValue -> TxData + txData newValue = TxData { tdSenderAddress = genesisAddress , tdParameter = newValue - , tdAmount = unsafeMkMutez 100 - } - transferToStringCaller = transfer txData stringCallerAddress - transferToStringCaller - - -- Execute operations and check balances and storage of 'idString' - do - let - -- `stringCaller.tz` transfers 300 mutez. - -- 'idString.tz' transfers 5 tokens. - -- Also 100 tokens are transferred from the genesis address. - expectedStringCallerBalance = unsafeMkMutez (500 - 300 + 100) - expectedIdStringBalance = unsafeMkMutez (900 + 300 - 5) - expectedConstAddrBalance = unsafeMkMutez 5 - - updatesValidator :: SuccessValidator - updatesValidator = composeValidatorsList - [ expectStorageUpdateConst idStringAddress newValue - , expectBalance idStringAddress expectedIdStringBalance - , expectBalance stringCallerAddress expectedStringCallerBalance - , expectBalance constAddr expectedConstAddrBalance - ] - validate (Right updatesValidator) - - -- Now let's transfer 100 tokens to stringCaller again. - transferToStringCaller - - -- This time execution should fail, because idString should fail - -- because its balance is greater than 1000. - void $ validate (Left $ expectMichelsonFailed idStringAddress) - - -- We can also send tokens from idString to tz1 address directly - let - txDataToConst = TxData - { tdSenderAddress = idStringAddress - , tdParameter = Untyped.ValueUnit - , tdAmount = unsafeMkMutez 200 + , tdAmount = minBound } - transfer txDataToConst constAddr - - -- Let's check balance of idString and tz1 address - do - let - expectedIdStringBalance = unsafeMkMutez (900 + 300 - 5 - 200) - expectedConstAddrBalance = unsafeMkMutez (5 + 200) - - updatesValidator :: SuccessValidator - updatesValidator = composeValidatorsList - [ expectBalance idStringAddress expectedIdStringBalance - , expectBalance constAddr expectedConstAddrBalance - ] - - void $ validate (Right updatesValidator) - - -- Now we can transfer to stringCaller again and it should succeed - -- this time, because the balance of idString decreased - transferToStringCaller + transferToStringCaller newValue = + TransferOp stringCallerAddress (txData newValue) - -- Let's simply assert that it should succeed to keep the scenario shorter - void $ validate (Right expectAnySuccess) + operations newValue = + [ originateIdString + , originateStringCaller + , transferToStringCaller newValue + ] - -- Now let's set NOW to 600 and expect stringCaller to fail - setNow (timestampFromSeconds @Int 600) - transferToStringCaller - validate (Left $ expectMichelsonFailed stringCallerAddress) + -- `stringCaller.tz` transfers 2 mutez. + expectedIdStringBalance = + ooBalance idStringOrigination `unsafeAddMutez` unsafeMkMutez 2 --- Address hardcoded in 'idString.tz'. -constAddr :: Address -constAddr = unsafeParseAddress "tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU" + updatesValidator :: UntypedValue -> SuccessValidator + updatesValidator newValue = + expectStorageConstant idStringAddress newValue `composeValidators` + expectBalance idStringAddress expectedIdStringBalance