morley 0.1.0.2 → 0.1.0.3
raw patch · 9 files changed
+145/−440 lines, 9 files
Files
- CHANGES.md +11/−0
- morley.cabal +5/−4
- src/Morley/Runtime.hs +3/−4
- src/Morley/Test/Integrational.hs +64/−201
- src/Tezos/Address.hs +0/−9
- test/Test/Interpreter.hs +0/−2
- test/Test/Interpreter/CallSelf.hs +19/−16
- test/Test/Interpreter/EnvironmentSpec.hs +0/−104
- test/Test/Interpreter/StringCaller.hs +43/−100
+ CHANGES.md view
@@ -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
morley.cabal view
@@ -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
src/Morley/Runtime.hs view
@@ -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
src/Morley/Test/Integrational.hs view
@@ -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
src/Tezos/Address.hs view
@@ -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
test/Test/Interpreter.hs view
@@ -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
test/Test/Interpreter/CallSelf.hs view
@@ -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
− test/Test/Interpreter/EnvironmentSpec.hs
@@ -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
test/Test/Interpreter/StringCaller.hs view
@@ -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