cleveland 0.1.2 → 0.2.0

raw patch · 41 files changed

+588/−684 lines, 41 filesdep +singletons-basedep −hspecPVP ok

version bump matches the API change (PVP)

Dependencies added: singletons-base

Dependencies removed: hspec

API changes (from Hackage documentation)

Files

• CHANGES.md +26/−0
• cleveland.cabal +4/−7
• src/Hedgehog/Gen/Michelson.hs +4/−16
• src/Hedgehog/Gen/Michelson/Typed.hs +22/−3
• src/Hedgehog/Gen/Michelson/Untyped.hs +2/−13
• src/Hedgehog/Gen/Morley/Micheline.hs +83/−19
• src/Hedgehog/Gen/SizedList.hs +1/−2
• src/Hedgehog/Gen/Tezos/Address.hs +3/−2
• src/Hedgehog/Gen/Tezos/Crypto.hs +3/−3
• src/Hedgehog/Range/Defaults.hs +2/−2
• src/Lorentz/Test/DupableScan.hs +1/−1
• src/Test/Cleveland.hs +6/−2
• src/Test/Cleveland/Instances.hs +34/−30
• src/Test/Cleveland/Internal/Abstract.hs +29/−24
• src/Test/Cleveland/Internal/Actions.hs +54/−28
• src/Test/Cleveland/Internal/Client.hs +49/−34
• src/Test/Cleveland/Internal/Pure.hs +41/−35
• src/Test/Cleveland/Internal/Scenario.hs +19/−2
• src/Test/Cleveland/Lorentz.hs +1/−17
• src/Test/Cleveland/Lorentz/Import.hs +10/−29
• src/Test/Cleveland/Michelson.hs +1/−18
• src/Test/Cleveland/Michelson/Dummy.hs +0/−19
• src/Test/Cleveland/Michelson/Import.hs +4/−80
• src/Test/Cleveland/Michelson/Unit.hs +0/−108
• src/Test/Cleveland/Tasty.hs +0/−1
• src/Test/Cleveland/Tasty/Internal.hs +29/−18
• src/Test/Cleveland/Tasty/Internal/Options.hs +4/−17
• test/TestSuite/Cleveland/CallStack.hs +49/−35
• test/TestSuite/Cleveland/EmptyImplicitAddress.hs +32/−0
• test/TestSuite/Cleveland/ExpectFailure.hs +1/−1
• test/TestSuite/Cleveland/InitialState.hs +9/−1
• test/TestSuite/Cleveland/Lorentz/Contracts/ContractAllocator.hs +2/−2
• test/TestSuite/Cleveland/Lorentz/Entrypoints.hs +13/−20
• test/TestSuite/Cleveland/NewAddressCheck.hs +4/−3
• test/TestSuite/Cleveland/PrefixNetworkScenario.hs +0/−67
• test/TestSuite/Cleveland/PrettyFailWith.hs +1/−0
• test/TestSuite/Cleveland/PublicKeyToAddress.hs +6/−6
• test/TestSuite/Cleveland/RunCode.hs +24/−4
• test/TestSuite/Cleveland/StorageWithBigMaps.hs +5/−5
• test/TestSuite/Cleveland/TransferCheck.hs +7/−7
• test/TestSuite/Cleveland/VotingPower.hs +3/−3

@@ -1,6 +1,32 @@ <!-- Unreleased: append new entries here -->  +0.2.0+=====+* [!1172](https://gitlab.com/morley-framework/morley/-/merge_requests/1172)+  Add `withChainId` and `withMinBlockTime` functions to set emulator constants.+* [!1123](https://gitlab.com/morley-framework/morley/-/merge_requests/1123)+  Remove deprecated exports+* [!1161](https://gitlab.com/morley-framework/morley/-/merge_requests/1161)+  Remove support for `AliasHint`+* [!1169](https://gitlab.com/morley-framework/morley/-/merge_requests/1169)+  Support MIN_BLOCK_TIME instruction+  + Add `getMinBlockTime` utility to get minimal block delay in seconds as+    `Natural`+* [!1164](https://gitlab.com/morley-framework/morley/-/merge_requests/1164)+  Add `now` and `level` params to the `/run_code`+* [!1162](https://gitlab.com/morley-framework/morley/-/merge_requests/1162)+  Implement instruction to batch-create accounts+* [!1114](https://gitlab.com/morley-framework/morley/-/merge_requests/1114)+  Update to ghc-9.0.2+* [!1108](https://gitlab.com/morley-framework/morley/-/merge_requests/1108)+  Remove support for the deprecated morley extensions+* [!1127](https://gitlab.com/morley-framework/morley/-/merge_requests/1127)+  Create tempdir in Cleveland if datadir is unspecified+  + Instead of mangling user's default tezos-client data directory, when+    a Cleveland test-suite invocation doesn't specify a datadir, use a+    new temporary directory by default.+ 0.1.2 ===== * [!1050](https://gitlab.com/morley-framework/morley/-/merge_requests/1050)

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           cleveland-version:        0.1.2+version:        0.2.0 synopsis:       Testing framework for Morley. description:    This package provides an eDSL for testing contracts written in Michelson, Morley or Lorentz. These tests can be run on an emulated environment or on a real network. category:       Blockchain@@ -72,11 +72,9 @@       Test.Cleveland.Lorentz.Ticketer       Test.Cleveland.Lorentz.Types       Test.Cleveland.Michelson-      Test.Cleveland.Michelson.Dummy       Test.Cleveland.Michelson.Entrypoints       Test.Cleveland.Michelson.Import       Test.Cleveland.Michelson.Internal.Entrypoints-      Test.Cleveland.Michelson.Unit       Test.Cleveland.Tasty       Test.Cleveland.Tasty.Internal       Test.Cleveland.Tasty.Internal.Options@@ -157,8 +155,6 @@     , fmt     , hedgehog >=1.0.3     , hex-text-    , hspec-    , hspec-expectations     , lens     , lorentz     , morley@@ -171,6 +167,7 @@     , safe-exceptions     , servant-client-core     , singletons+    , singletons-base     , statistics     , tagged     , tasty >=1.4@@ -178,6 +175,7 @@     , tasty-hedgehog     , tasty-hunit-compat     , template-haskell+    , temporary     , text     , time     , with-utf8@@ -198,6 +196,7 @@       TestSuite.Cleveland.ChainIdGet       TestSuite.Cleveland.ContractAllocation       TestSuite.Cleveland.DFS+      TestSuite.Cleveland.EmptyImplicitAddress       TestSuite.Cleveland.Emulated       TestSuite.Cleveland.Entrypoints       TestSuite.Cleveland.ExpectFailure@@ -210,7 +209,6 @@       TestSuite.Cleveland.MismatchError       TestSuite.Cleveland.NewAddressCheck       TestSuite.Cleveland.OperationReplay-      TestSuite.Cleveland.PrefixNetworkScenario       TestSuite.Cleveland.PrettyFailWith       TestSuite.Cleveland.PublicKeyToAddress       TestSuite.Cleveland.RefillableAddress@@ -305,7 +303,6 @@     , tasty     , tasty-hedgehog     , tasty-hunit-compat-    , temporary     , text     , time   default-language: Haskell2010

@@ -2,8 +2,7 @@ -- SPDX-License-Identifier: LicenseRef-MIT-OA  module Hedgehog.Gen.Michelson-  ( genInstrCallStack-  , genLetName+  ( genErrorSrcPos   , genSrcPos   , genPos   , genMText@@ -11,26 +10,15 @@  import Hedgehog (MonadGen) import Hedgehog.Gen qualified as Gen-import Hedgehog.Range (Range) import Hedgehog.Range qualified as Range -import Morley.Michelson.ErrorPos (InstrCallStack(..), LetName(..), Pos(..), SrcPos(..))+import Morley.Michelson.ErrorPos (ErrorSrcPos(..), Pos(..), SrcPos(..)) import Morley.Michelson.Text (MText, maxBoundMChar, minBoundMChar, mkMText)  import Hedgehog.Range.Defaults -genInstrCallStack :: MonadGen m => m InstrCallStack-genInstrCallStack = InstrCallStack <$> genLetCallStack <*> genSrcPos-  where-    genLetCallStack = Gen.frequency-      [ (80, pure [])-      , (18, Gen.list (Range.singleton 1) $ genLetName def)-      , (2, Gen.list (Range.singleton 2) $ genLetName def)-      ]--genLetName :: MonadGen m => Range TinyLength -> m LetName-genLetName lenRange =-  LetName <$> Gen.text (unTinyLength <$> lenRange) Gen.unicodeAll+genErrorSrcPos :: MonadGen m => m ErrorSrcPos+genErrorSrcPos = ErrorSrcPos <$> genSrcPos  genSrcPos :: MonadGen m => m SrcPos genSrcPos = SrcPos <$> genPos def <*> genPos def

@@ -40,12 +40,14 @@ import Hedgehog.Gen.Tezos.Crypto.BLS12381 (genBls12381Fr, genBls12381G1, genBls12381G2) import Morley.Michelson.Text (mkMText) import Morley.Michelson.Typed-  (Instr(DROP, FAILWITH, PUSH, SWAP, Seq, UNIT), SingT(..), T(..), Value'(..), toVal)+  (Instr(DROP, FAILWITH, PUSH, SWAP, Seq, UNIT), SingT(..), T(..), Value'(..), mkVLam, toVal) import Morley.Michelson.Typed.Entrypoints (EpAddress(..), unsafeSepcCallRoot) import Morley.Michelson.Typed.Haskell.Value (BigMap(..), BigMapId(..), ToT, WellTypedToT) import Morley.Michelson.Typed.Scope import Morley.Michelson.Typed.Value (RemFail(..))+import Morley.Tezos.Address (TxRollupL2Address(..)) import Morley.Tezos.Core (Mutez, Timestamp)+import Morley.Tezos.Crypto (parseHash) import Morley.Tezos.Crypto.BLS12381 qualified as BLS  import Hedgehog.Gen.Tezos.Crypto.Timelock (genChestAndKey)@@ -182,7 +184,7 @@     ]   -- It's quite hard to generate proper lambda of given type, so it always returns FAILWITH.   -- Such implementation is sufficient for now.-  STLambda{} -> pure $ VLam $ RfAlwaysFails $ Seq UNIT FAILWITH+  STLambda{} -> pure $ mkVLam $ RfAlwaysFails $ Seq UNIT FAILWITH   STMap k v -> genValueMap def (genNoOpValue k) (genNoOpValue v)   STBigMap k v -> genValueBigMap def (genNoOpValue k) (genNoOpValue v)   STInt -> genValueInt def@@ -191,6 +193,23 @@   STBytes -> genValueBytes def   STMutez -> genValueMutez def   STKeyHash -> genValueKeyHash+  STTxRollupL2Address ->+    VTxRollupL2Address . TxRollupL2Address+    . unsafe . parseHash <$> Gen.element+      -- TODO [#839]: implement BLS public key generation+      [ "tz4UJqedFMBS7FjAqvZojJMPNd59MLm2hkuc"+      , "tz4Y7kRVfDH2XGQtjc19ppJqejL4CBVmxHED"+      , "tz4LVHYD4P4T5NHCuwJbxQvwVURF62seE3Qa"+      , "tz4MwL5iRbyHvVxH9N69GCeDmYCqbQtewr7R"+      , "tz4AZhg8GuahEs2Uo7dFZxVZwEgNKirtYMhY"+      , "tz4D77UuwdqbmDd7Xh9VNbFRjDiqWbBeWqud"+      , "tz4SYR9zvak9GohAEENUjPk7zAQo46wo6vNE"+      , "tz4UWDSphLswG5xtBwGnodCGL7FBzN21EKSQ"+      , "tz49e42Nbrc15PuT7RgkGqC6Xi3w5jEzEzH1"+      , "tz4F1Nd91Fc3BUCxTCnFaccjnn2hH4W3Bd8X"+      , "tz4MVuy2j5GCjPZQg7cxadPiNWq2nsRA392Y"+      , "tz4StvWhTeDnVpGspXKbfuhuVXhZ1jkAp7Yq"+      ]   STBls12381Fr -> VBls12381Fr <$> genBls12381Fr   STBls12381G1 -> VBls12381G1 <$> genBls12381G1   STBls12381G2 -> VBls12381G2 <$> genBls12381G2@@ -202,7 +221,7 @@   STChestKey -> VChestKey . snd <$> genChestAndKey   STNever -> Gen.discard   STSaplingState _ -> error "genValue': Cannot generate `sapling_state` value."-  STSaplingTransaction _ -> error "genValue': Cannot generate `sapling_instruction` value."+  STSaplingTransaction _ -> error "genValue': Cannot generate `sapling_transaction` value."   where     genNoOpValue       :: (MonadGen m, GenBase m ~ Identity, WellTyped t')

@@ -1,9 +1,6 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA --- TODO [#712]: Remove this next major release-{-# OPTIONS_GHC -Wno-deprecations #-}- module Hedgehog.Gen.Michelson.Untyped   ( genInternalByteString   , genVar@@ -13,7 +10,6 @@   , genPrintComment   , genStackRef   , genTestAssert-  , genStackFn   , genStackTypePattern   , genInstrAbstract   , genContract@@ -38,7 +34,7 @@  import Morley.Michelson.Untyped -import Hedgehog.Gen.Michelson (genInstrCallStack, genMText)+import Hedgehog.Gen.Michelson (genErrorSrcPos, genMText) import Hedgehog.Range.Defaults  genInternalByteString :: MonadGen m => Range Length -> m InternalByteString@@ -61,13 +57,12 @@   -- recursive constructors   [ PrimEx <$> genInstrAbstract genExpandedOp   , SeqEx <$> genSmallList genExpandedOp-  , Gen.subtermM genExpandedOp $ \expandedOp -> WithSrcEx <$> genInstrCallStack <*> pure expandedOp+  , Gen.subtermM genExpandedOp $ \expandedOp -> WithSrcEx <$> genErrorSrcPos <*> pure expandedOp   ]  genExtInstrAbstract :: (MonadGen m, GenBase m ~ Identity) => m op -> m (ExtInstrAbstract op) genExtInstrAbstract genOp = Gen.choice   [ STACKTYPE <$> genStackTypePattern-  , FN <$> genSmallText <*> genStackFn <*> genSmallList genOp   , UTEST_ASSERT <$> genTestAssert genOp   , UPRINT <$> genPrintComment def   , UCOMMENT <$> genSmallText@@ -83,12 +78,6 @@  genTestAssert :: MonadGen m => m op -> m (TestAssert op) genTestAssert genOp = TestAssert <$> genSmallText <*> genPrintComment def <*> genSmallList genOp--genStackFn :: (MonadGen m, GenBase m ~ Identity) => m StackFn-genStackFn = StackFn-  <$> Gen.maybe (Gen.set smallCollectionRange genVar)-  <*> genStackTypePattern-  <*> genStackTypePattern  genStackTypePattern :: (MonadGen m, GenBase m ~ Identity) => m StackTypePattern genStackTypePattern = Gen.recursive Gen.choice

@@ -2,12 +2,21 @@ -- SPDX-License-Identifier: LicenseRef-MIT-OA  module Hedgehog.Gen.Morley.Micheline-  ( genExpression+  ( -- * 'Expression' generators+    genExpression   , genExpressionInt   , genExpressionString   , genExpressionBytes   , genExpressionSeq   , genExpressionPrim++    -- * Generic 'Exp' generators+  , genExp+  , genExpInt+  , genExpString+  , genExpBytes+  , genExpSeq+  , genExpPrim   , genMichelinePrimAp   , genExprAnnotation   ) where@@ -17,36 +26,91 @@ import Hedgehog.Range (Range)  import Hedgehog.Gen.Michelson.Untyped (genAnnotation)+import Hedgehog.Range.Defaults import Morley.Micheline.Expression -import Hedgehog.Range.Defaults+----------------------------------------------------------------------------+-- Expression generators+----------------------------------------------------------------------------  genExpression :: forall m. (MonadGen m, GenBase m ~ Identity) => m Expression-genExpression = Gen.recursive @m Gen.choice-  [genExpressionInt def, genExpressionString def, genExpressionBytes def]-  [genExpressionSeq def, genExpressionPrim]+genExpression = genExp Nothing Nothing (mkUniformExpExtras Gen.enumBounded) -genExpressionInt :: MonadGen f => Range ExpressionInt -> f Expression-genExpressionInt range = ExpressionInt <$> Gen.integral (unExpressionInt <$> range)+genExpressionInt :: MonadGen m => Range ExpressionInt -> m Expression+genExpressionInt = genExpInt (pure ()) -genExpressionString :: MonadGen f => Range SmallLength -> f Expression-genExpressionString rangeLen =-  ExpressionString <$> (Gen.text (unSmallLength <$> rangeLen) Gen.unicodeAll)+genExpressionString :: MonadGen m => Range SmallLength -> m Expression+genExpressionString = genExpString (pure ()) -genExpressionBytes :: MonadGen f => Range Length -> f Expression-genExpressionBytes rangeLen = ExpressionBytes <$> Gen.bytes (unLength <$> rangeLen)+genExpressionBytes :: MonadGen m => Range Length -> m Expression+genExpressionBytes = genExpBytes (pure ())  genExpressionSeq :: (MonadGen m, GenBase m ~ Identity) => Range SmallLength -> m Expression-genExpressionSeq = fmap ExpressionSeq . genSeq--genSeq :: (MonadGen m, GenBase m ~ Identity) => Range SmallLength -> m [Expression]-genSeq rangeLen = Gen.list (unSmallLength <$> rangeLen) genExpression+genExpressionSeq = genExpSeq genExpression (pure ())  genExpressionPrim :: (MonadGen m, GenBase m ~ Identity) => m Expression-genExpressionPrim = ExpressionPrim <$> genMichelinePrimAp+genExpressionPrim = genExpPrim genExpression (pure ()) -genMichelinePrimAp :: (MonadGen m, GenBase m ~ Identity) => m MichelinePrimAp-genMichelinePrimAp = MichelinePrimAp <$> genMichelinePrimitive <*> genSeq def <*> genAnnots+----------------------------------------------------------------------------+-- Generic Exp generators+----------------------------------------------------------------------------++-- | Generate extended expression given the generators for all the extension+-- points.+--+-- In case your expression has no extra constructors, avoid supplying+-- @Just 'Gen.discard'@ as that would cause the generator to give up+-- periodically (supply 'Nothing' instead).+genExp+  :: forall x m. (MonadGen m, GenBase m ~ Identity)+  => Maybe (m (XExp x))+     -- ^ Non-recursive extra constructors+  -> Maybe (m (XExp x))+     -- ^ Recursive extra constructors (that can generate @Exp@ inside)+  -> ExpExtras m x+  -> m (Exp x)+genExp mGenXCon mGenXConRec xGens = Gen.recursive Gen.choice+  ( maybe id (:) (ExpX <<$>> mGenXCon)+    [ genExpInt (eeInt xGens) def+    , genExpString (eeString xGens) def+    , genExpBytes (eeBytes xGens) def+    ]+  )+  ( maybe id (:) (ExpX <<$>> mGenXConRec)+    [genExpSeq runRec (eeSeq xGens) def, genExpPrim runRec (eePrim xGens)]+  )+  where+    runRec = Gen.subterm (genExp mGenXCon mGenXConRec xGens) id++genExpInt :: MonadGen m => m (XExpInt x) -> Range ExpressionInt -> m (Exp x)+genExpInt genX range =+  ExpInt <$> genX <*> Gen.integral (unExpressionInt <$> range)++genExpString :: MonadGen m => m (XExpString x) -> Range SmallLength -> m (Exp x)+genExpString genX rangeLen =+  ExpString <$> genX <*> (Gen.text (unSmallLength <$> rangeLen) Gen.unicodeAll)++genExpBytes :: MonadGen m => m (XExpBytes x) -> Range Length -> m (Exp x)+genExpBytes genX rangeLen =+  ExpBytes <$> genX <*> Gen.bytes (unLength <$> rangeLen)++genExpSeq+  :: MonadGen m+  => m (Exp x) -> m (XExpSeq x) -> Range SmallLength -> m (Exp x)+genExpSeq doGenExp genX rangeLen =+  ExpSeq <$> genX <*> Gen.list (unSmallLength <$> rangeLen) doGenExp++genExpPrim+  :: (MonadGen m, GenBase m ~ Identity)+  => m (Exp x) -> m (XExpPrim x) -> m (Exp x)+genExpPrim doGenExp genX = ExpPrim <$> genX <*> genMichelinePrimAp doGenExp++genMichelinePrimAp :: forall x m. (MonadGen m, GenBase m ~ Identity) => m (Exp x) -> m (MichelinePrimAp x)+genMichelinePrimAp doGenExp =+  MichelinePrimAp+    <$> genMichelinePrimitive+    <*> Gen.list (unSmallLength <$> def) doGenExp+    <*> genAnnots   where     genMichelinePrimitive = MichelinePrimitive <$> (Gen.element $ toList michelsonPrimitive)     genAnnots = Gen.list (unSmallLength <$> def) genExprAnnotation

@@ -11,7 +11,6 @@ import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range -import Morley.Util.SizedList qualified as SL import Morley.Util.SizedList.Types  genSizedList@@ -22,4 +21,4 @@ genSomeSizedList   :: forall m a. (MonadGen m)   => Range.Range Int -> m a -> m (SomeSizedList a)-genSomeSizedList len el = SL.fromList <$> Gen.list len el+genSomeSizedList len el = fromList <$> Gen.list len el

@@ -14,7 +14,8 @@ import Hedgehog.Range qualified as Range  import Hedgehog.Gen.Tezos.Crypto (genKeyHash)-import Morley.Tezos.Address (Address(..), ContractHash(..))+import Morley.Tezos.Address (Address(..))+import Morley.Tezos.Crypto  genAddress :: MonadGen m => m Address genAddress = Gen.choice [genKeyAddress, genContractAddress]@@ -23,4 +24,4 @@ genKeyAddress = KeyAddress <$> genKeyHash  genContractAddress :: MonadGen m => m Address-genContractAddress = ContractAddress . ContractHash <$> Gen.bytes (Range.singleton 20)+genContractAddress = ContractAddress . Hash HashContract <$> Gen.bytes (Range.singleton 20)

@@ -14,8 +14,8 @@ import Hedgehog.Range qualified as Range  import Morley.Tezos.Crypto-  (KeyHash, KeyHashTag, PublicKey, SecretKey(..), Signature(..), hashKey, signatureLengthBytes,-  toPublic)+  (KeyHash, KeyHashTag, PublicKey, SecretKey(..), Signature(..), allHashTags, hashKey,+  signatureLengthBytes, toPublic)  import Hedgehog.Gen.Tezos.Crypto.Ed25519 qualified as Ed25519 import Hedgehog.Gen.Tezos.Crypto.P256 qualified as P256@@ -40,7 +40,7 @@   ]  genKeyHashTag :: MonadGen m => m KeyHashTag-genKeyHashTag = Gen.enumBounded+genKeyHashTag = Gen.element $ toList allHashTags  genKeyHash :: MonadGen m => m KeyHash genKeyHash = hashKey <$> genPublicKey

@@ -48,7 +48,7 @@  -- | Newtype for the range of @ValueInt@ constructor of untyped @Value'@. newtype ValueInt = MkValueInt { unValueInt :: Integer }-  deriving newtype (Eq, Ord, Enum, Integral, Real, Num)+  deriving newtype (Eq, Ord, Enum, Real, Num)  instance Default (Range ValueInt) where   def = MkValueInt <$>@@ -58,7 +58,7 @@  -- | Newtype for the range of @ExpressionInt@ constructor of @Expression@. newtype ExpressionInt = MkExpressionInt { unExpressionInt :: Integer }-  deriving newtype (Eq, Ord, Enum, Integral, Real, Num)+  deriving newtype (Eq, Ord, Enum, Real, Num)  instance Default (Range ExpressionInt) where   def = MkExpressionInt <$> Range.linearFrom 0 -1000 1000

@@ -11,10 +11,10 @@   , BadElement (..)   ) where -import Data.Singletons.Prelude (demote) import Data.Typeable (TypeRep, typeRep) import Fmt (Buildable(..), pretty, (+|), (|+)) import GHC.Generics qualified as G+import Prelude.Singletons (demote) import Test.HUnit (assertFailure) import Test.Tasty (TestTree) import Test.Tasty.HUnit (testCase)

@@ -6,7 +6,7 @@ -- See the [documentation](https://gitlab.com/morley-framework/morley/-/blob/master/code/cleveland/testingEDSL.md) -- for usage instructions. module Test.Cleveland-  ( AliasHint+  ( Alias   , ContractHandle (..)   , OriginateData (..)   , UntypedOriginateData (..)@@ -27,6 +27,8 @@   , scenarioEmulated   , withInitialNow   , withInitialLevel+  , withMinBlockTime+  , withChainId   , collectLogs   , logsForAddress @@ -42,8 +44,9 @@   , resolveAddress   , refillable   , newAddress+  , newAddresses   , newFreshAddress-  , enumAliasHints+  , enumAliases   , signBytes   , signBinary   , originate@@ -84,6 +87,7 @@   , getNow   , getLevel   , getApproximateBlockInterval+  , getMinBlockTime   , RunCode(..)   , AsRPC.MaybeRPC(..)   , runCode

@@ -4,7 +4,7 @@ {-# OPTIONS_GHC -Wno-orphans #-}  module Test.Cleveland.Instances-  ( HasInstrCallStack (..)+  ( HasErrorSrcPos (..)   ) where  import Fmt (Buildable(..), eitherF, hexF, tupleF, (+|), (|+))@@ -16,6 +16,7 @@ import Morley.Michelson.Typed.Haskell.Value (BigMap(..)) import Morley.Michelson.Untyped qualified as U import Morley.Michelson.Untyped.Annotation (Annotation(..), mkAnnotation)+import Morley.Tezos.Address.Alias (Alias(..)) import Morley.Tezos.Core (Mutez(..), mkMutez, unsafeAddMutez, unsafeMulMutez, unsafeSubMutez)  instance IsString (Annotation tag) where@@ -93,41 +94,41 @@ instance Buildable ByteString where build bs = "0x" <> hexF bs instance Buildable LByteString where build bs = "0x" <> hexF bs --- | Class of types with t'Morley.Michelson.ErrorPos.InstrCallStack' allowing to remove it.--- Can be used in tests when we want to compare only values without callstack.-class HasInstrCallStack a where-  withoutIcs :: a -> a+-- | Class of types with t'Morley.Michelson.ErrorPos.ErrorSrcPos' allowing to remove it.+-- Can be used in tests when we want to compare only values without source positions.+class HasErrorSrcPos a where+  withoutEsp :: a -> a -withoutIcs' :: (Functor f, HasInstrCallStack a) =>  f a -> f a-withoutIcs' = fmap withoutIcs+withoutEsp' :: (Functor f, HasErrorSrcPos a) =>  f a -> f a+withoutEsp' = fmap withoutEsp -instance HasInstrCallStack U.ExpandedOp where-  withoutIcs = \case-    U.SeqEx ops'     -> U.SeqEx $ withoutIcs' ops'-    U.WithSrcEx _ op -> withoutIcs op-    U.PrimEx instr   -> U.PrimEx $ withoutIcs instr+instance HasErrorSrcPos U.ExpandedOp where+  withoutEsp = \case+    U.SeqEx ops'     -> U.SeqEx $ withoutEsp' ops'+    U.WithSrcEx _ op -> withoutEsp op+    U.PrimEx instr   -> U.PrimEx $ withoutEsp instr -instance HasInstrCallStack U.ExpandedInstr where-  withoutIcs = \case-    U.PUSH va ty v              -> U.PUSH va ty $ withoutIcs v-    U.IF_NONE ops1 ops2         -> U.IF_NONE (withoutIcs' ops1) (withoutIcs' ops2)-    U.IF_LEFT ops1 ops2         -> U.IF_LEFT (withoutIcs' ops1) (withoutIcs' ops2)-    U.IF_CONS ops1 ops2         -> U.IF_CONS (withoutIcs' ops1) (withoutIcs' ops2)-    U.MAP va ops                -> U.MAP va (withoutIcs' ops)-    U.ITER ops                  -> U.ITER $ withoutIcs' ops-    U.IF ops1 ops2              -> U.IF (withoutIcs' ops1) (withoutIcs' ops2)-    U.LOOP ops                  -> U.LOOP $ withoutIcs' ops-    U.LOOP_LEFT ops             -> U.LOOP_LEFT $ withoutIcs' ops-    U.LAMBDA va ty1 ty2 ops     -> U.LAMBDA va ty1 ty2 (withoutIcs' ops)-    U.DIP ops                   -> U.DIP $ withoutIcs' ops-    U.DIPN n ops -> U.DIPN n (withoutIcs' ops)+instance HasErrorSrcPos U.ExpandedInstr where+  withoutEsp = \case+    U.PUSH va ty v              -> U.PUSH va ty $ withoutEsp v+    U.IF_NONE ops1 ops2         -> U.IF_NONE (withoutEsp' ops1) (withoutEsp' ops2)+    U.IF_LEFT ops1 ops2         -> U.IF_LEFT (withoutEsp' ops1) (withoutEsp' ops2)+    U.IF_CONS ops1 ops2         -> U.IF_CONS (withoutEsp' ops1) (withoutEsp' ops2)+    U.MAP va ops                -> U.MAP va (withoutEsp' ops)+    U.ITER ops                  -> U.ITER $ withoutEsp' ops+    U.IF ops1 ops2              -> U.IF (withoutEsp' ops1) (withoutEsp' ops2)+    U.LOOP ops                  -> U.LOOP $ withoutEsp' ops+    U.LOOP_LEFT ops             -> U.LOOP_LEFT $ withoutEsp' ops+    U.LAMBDA va ty1 ty2 ops     -> U.LAMBDA va ty1 ty2 (withoutEsp' ops)+    U.DIP ops                   -> U.DIP $ withoutEsp' ops+    U.DIPN n ops -> U.DIPN n (withoutEsp' ops)     U.CREATE_CONTRACT va1 va2 c ->-      U.CREATE_CONTRACT va1 va2 (U.mapContractCode withoutIcs c)+      U.CREATE_CONTRACT va1 va2 (U.mapContractCode withoutEsp c)     i                           -> i -instance HasInstrCallStack U.Value where-  withoutIcs = \case-    U.ValueLambda ops -> U.ValueLambda $ withoutIcs' ops+instance HasErrorSrcPos U.Value where+  withoutEsp = \case+    U.ValueLambda ops -> U.ValueLambda $ withoutEsp' ops     v                 -> v  -- We don't want to depend on o-clock in morley-prelude, hence we're defining@@ -143,3 +144,6 @@  instance (Buildable a, Buildable b) => Buildable (Either a b) where   build = eitherF++instance IsString Alias where+  fromString = Alias . fromString

@@ -39,7 +39,7 @@   , ClevelandInput    , DefaultAliasCounter (..)-  , SpecificOrDefaultAliasHint (..)+  , SpecificOrDefaultAlias (..)    -- * Actions   , ClevelandOpsImpl (..)@@ -71,7 +71,7 @@   , mkDefaultAlias    -- * Morley client re-exports-  , AliasHint+  , Alias    -- * Capability records   , ClevelandCaps(..)@@ -110,10 +110,10 @@ import Lorentz (Contract(..)) import Lorentz.Constraints import Morley.AsRPC (HasRPCRepr(AsRPC), MaybeRPC)-import Morley.Client (AliasHint, Result)+import Morley.Client (Result) import Morley.Client.Types import Morley.Micheline (Expression, fromExpression)-import Morley.Michelson.ErrorPos (InstrCallStack)+import Morley.Michelson.ErrorPos (ErrorSrcPos) import Morley.Michelson.Interpret (MorleyLogs(..)) import Morley.Michelson.Runtime (VotingPowers) import Morley.Michelson.Typed (BigMapId)@@ -123,6 +123,7 @@ import Morley.Michelson.Typed.Scope (ConstantScope) import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address+import Morley.Tezos.Address.Alias (Alias(..)) import Morley.Tezos.Core (ChainId, Mutez, Timestamp) import Morley.Tezos.Crypto import Morley.Tezos.Crypto qualified as Crypto@@ -134,7 +135,7 @@  data OriginateData param st vd =   OriginateData-  { odName :: AliasHint+  { odName :: Alias   -- ^ Alias for the originated contract.   , odBalance :: Mutez   -- ^ Initial balance.@@ -151,7 +152,7 @@ -- | Untyped version of OriginateData. It can be used for interaction with raw -- Michelson contracts data UntypedOriginateData = UntypedOriginateData-  { uodName :: AliasHint+  { uodName :: Alias   -- ^ Alias for the originated contract.   , uodBalance :: Mutez   -- ^ Initial balance.@@ -213,30 +214,30 @@ -- undesired and unexpected to the user. newtype Moneybag = Moneybag { unMoneybag :: Address } --- | An alias hint with default value that can be used to define unique alias+-- | An alias with default value that can be used to define unique alias -- automatically.-data SpecificOrDefaultAliasHint-  = SpecificAliasHint AliasHint-  | DefaultAliasHint+data SpecificOrDefaultAlias+  = SpecificAlias Alias+  | DefaultAlias   deriving stock (Show) -instance IsString SpecificOrDefaultAliasHint where-  fromString = SpecificAliasHint . fromString+instance IsString SpecificOrDefaultAlias where+  fromString = SpecificAlias . Alias . fromString -instance Default SpecificOrDefaultAliasHint where-  def = DefaultAliasHint+instance Default SpecificOrDefaultAlias where+  def = DefaultAlias -mkDefaultAlias :: Natural -> AliasHint+mkDefaultAlias :: Natural -> Alias mkDefaultAlias counter =-  fromString $ ("default_cleveland_alias" <> show counter)+  Alias . fromString $ ("default_cleveland_alias" <> show counter)  -- | Helper to use automatically determined unique alias.-auto :: SpecificOrDefaultAliasHint+auto :: SpecificOrDefaultAlias auto = def  -- | Counter which is used to provide different default aliases. newtype DefaultAliasCounter = DefaultAliasCounter {unDefaultAliasCounter :: Natural}-  deriving stock Show+  deriving stock (Eq, Show)  -- | A record data type with operations creating primitives. data ClevelandOpsImpl m = ClevelandOpsImpl@@ -249,13 +250,13 @@ data ClevelandMiscImpl m = ClevelandMiscImpl   { cmiRunIO :: forall res. HasCallStack => IO res -> m res   -- ^ Runs an 'IO' action.-  , cmiResolveAddress :: HasCallStack => AliasHint -> m Address+  , cmiResolveAddress :: HasCallStack => Alias -> m Address   -- ^ Get the address of the implicit account / contract associated with the given alias.-  , cmiGenKey :: HasCallStack => SpecificOrDefaultAliasHint -> m Address+  , cmiGenKey :: HasCallStack => SpecificOrDefaultAlias -> m Address   -- ^ Generate a secret key and store it with given alias.   -- If a key with this alias already exists, the corresponding address   -- will be returned and no state will be changed.-  , cmiGenFreshKey :: HasCallStack => SpecificOrDefaultAliasHint -> m Address+  , cmiGenFreshKey :: HasCallStack => SpecificOrDefaultAlias -> m Address   -- ^ Generate a secret key and store it with given alias.   -- Unlike 'cmiGenKey' this function overwrites the existing key when   -- given alias is already stored.@@ -336,6 +337,10 @@   , rcParameter :: MaybeRPC cp   , rcAmount :: Mutez   -- ^ The value that will be returned by the @AMOUNT@ instruction.+  , rcLevel :: Maybe Natural+  -- ^ The value that will be returned by the @LEVEL@ instruction.+  , rcNow :: Maybe Timestamp+  -- ^ The value that will be returned by the @NOW@ instruction.   , rcBalance :: Mutez   -- ^ The balance that will be returned by the @BALANCE@ instruction.   , rcSource :: Maybe Address@@ -524,7 +529,7 @@   } deriving stock (Show, Eq)  data TransferFailureReason-  = FailedWith ExpressionOrTypedValue (Maybe InstrCallStack)+  = FailedWith ExpressionOrTypedValue (Maybe ErrorSrcPos)   -- ^ Expect that interpretation of contract with the given address ended   -- with @FAILWITH@.   | EmptyTransaction@@ -636,8 +641,8 @@     { cmiRunIO = \action -> f $ cmiRunIO action     , cmiResolveAddress = \address -> f $ cmiResolveAddress address     , cmiSignBytes = \bs alias -> f $ cmiSignBytes bs alias-    , cmiGenKey = \aliasHint -> f $ cmiGenKey aliasHint-    , cmiGenFreshKey = \aliasHint -> f $ cmiGenFreshKey aliasHint+    , cmiGenKey = \alias -> f $ cmiGenKey alias+    , cmiGenFreshKey = \alias -> f $ cmiGenFreshKey alias     , cmiOriginateLargeUntyped = \sender uodata -> f $ cmiOriginateLargeUntyped sender uodata     , cmiComment = \t -> f $ cmiComment t     , cmiGetBalance = \addr -> f $ cmiGetBalance addr

@@ -10,8 +10,9 @@   , resolveAddress   , refillable   , newAddress+  , newAddresses   , newFreshAddress-  , enumAliasHints+  , enumAliases   , signBytes   , signBinary   , originate@@ -51,6 +52,7 @@   , getNow   , getLevel   , getApproximateBlockInterval+  , getMinBlockTime   , runCode   , branchout   , offshoot@@ -110,7 +112,7 @@ import Data.List.NonEmpty qualified as NE import Data.Singletons (demote) import Fmt (Buildable, Builder, build, indentF, nameF, pretty, unlinesF, (+|), (|+))-import Time (KnownDivRat, Second, Time)+import Time (KnownDivRat, Second, Time, toNum) import Unsafe qualified (fromIntegral)  import Lorentz@@ -122,7 +124,7 @@ import Lorentz.Constraints import Morley.AsRPC (HasRPCRepr(..)) import Morley.Client (OperationInfo(..))-import Morley.Micheline (Expression, FromExpression(..), toExpression)+import Morley.Micheline (Expression, fromExpression, toExpression) import Morley.Michelson.Printer.Util (buildRenderDoc) import Morley.Michelson.Runtime (VotingPowers) import Morley.Michelson.Runtime.Import qualified as Runtime@@ -132,6 +134,7 @@ import Morley.Michelson.Typed.AnnotatedValue (castTo, getT, value) import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address (Address)+import Morley.Tezos.Address.Alias (Alias(..)) import Morley.Tezos.Core (ChainId, Mutez, Timestamp) import Morley.Tezos.Crypto (KeyHash, PublicKey, Signature) import Morley.Util.SizedList qualified as SL@@ -195,10 +198,10 @@ runIO io = do   withCap getMiscCap \cap -> cmiRunIO cap io --- | Get the address of the implicit account / contract associated with the given alias hint.+-- | Get the address of the implicit account / contract associated with the given alias. resolveAddress   :: (HasCallStack, MonadCleveland caps m)-  => AliasHint -> m Address+  => Alias -> m Address resolveAddress alias = do   withCap getMiscCap \cap -> cmiResolveAddress cap alias @@ -224,25 +227,40 @@ -- * By default, the XTZ is transferred from the account associated with the @moneybag@ alias. --   This can be overriden with the @--cleveland-moneybag-alias@ command line option, the --   @TASTY_CLEVELAND_MONEYBAG_ALIAS@ env var, or 'withMoneybag'.--- * Beware that if an "alias prefix" is set, it'll be prepended to the given alias hint.---   An "alias prefix" can be set using the @--cleveland-alias-prefix@ command line option, the---   @TASTY_CLEVELAND_ALIAS_PREFIX@ env var, or with 'Test.Cleveland.Tasty.setAliasPrefix'. --     > do --     >   addr1 <- newAddress "alias" --     >   addr2 <- resolveAddress $ mkAlias "prefix.alias" --     >   addr1 @== addr2-newAddress :: (HasCallStack, MonadCleveland caps m) => SpecificOrDefaultAliasHint -> m Address+newAddress :: (HasCallStack, MonadCleveland caps m) => SpecificOrDefaultAlias -> m Address newAddress alias = do-  addr <- withCap getMiscCap \cap -> cmiGenKey cap alias+  addrs <- newAddresses $ alias :< Nil+  case addrs of+    addr :< Nil -> pure addr++-- | Batched version of `newAddress`+newAddresses+  :: forall n n' caps m.+    (HasCallStack, MonadCleveland caps m, IsoNatPeano n n')+  => SizedList n SpecificOrDefaultAlias+  -> m (SizedList n Address)+newAddresses aliases = do+  addrs <- withCap getMiscCap \cap -> traverse (cmiGenKey cap) aliases   Moneybag moneybag <- view moneybagL -  -- The address may exist from previous scenarios runs and have sufficient+  -- Addresses may exist from previous scenarios runs and have sufficient   -- balance for the sake of testing; if so, we can save some time-  balance <- getBalance addr+  balances <- traverse getBalance addrs+  withSender moneybag do+    inBatch do+      sequenceA_ $+        SL.zipWith refillIfLowBalance addrs balances++  pure addrs++refillIfLowBalance :: (HasCallStack, Applicative m, MonadOps m) => Address -> Mutez -> m ()+refillIfLowBalance addr balance =   when (balance < 0.5_e6) do  -- < 0.5 XTZ-    withSender moneybag do-      transferMoney addr 0.9_e6 -- 0.9 XTZ-  pure addr+    transferMoney addr 0.9_e6 -- 0.9 XTZ  -- | Generate a new secret key and record it with given alias. If the -- alias is already known, the key will be overwritten. The address is@@ -257,26 +275,26 @@ --     >   addr1 <- newFreshAddress "alias" --     >   addr2 <- resolveAddress $ mkAlias "prefix.alias" --     >   addr1 @== addr2-newFreshAddress :: (HasCallStack, MonadCleveland caps m) => SpecificOrDefaultAliasHint -> m Address-newFreshAddress aliasHint = do-  withCap getMiscCap \cap -> cmiGenFreshKey cap aliasHint+newFreshAddress :: (HasCallStack, MonadCleveland caps m) => SpecificOrDefaultAlias -> m Address+newFreshAddress alias = do+  withCap getMiscCap \cap -> cmiGenFreshKey cap alias  -- | Get the signature of the preapplied operation. signBytes :: (HasCallStack, MonadCleveland caps m) => ByteString -> Address -> m Signature signBytes bytes signer = do   withCap getMiscCap \cap -> cmiSignBytes cap bytes signer --- | Create a list of similarly named 'SpecificAliasHint's.+-- | Create a list of similarly named 'SpecificAlias'es. -- -- For example, ----- >>> enumAliasHints @2 "operator" `isEquivalentTo` "operator-0" :< "operator-1" :< Nil+-- >>> enumAliases @2 "operator" `isEquivalentTo` "operator-0" :< "operator-1" :< Nil -- True-enumAliasHints+enumAliases   :: forall n n'.      (SingIPeano n, IsoNatPeano n n')-  => AliasHint -> SizedList n SpecificOrDefaultAliasHint-enumAliasHints pfx = SpecificAliasHint <$> SL.generate @n (\n -> pfx <> "-" <> show n)+  => Alias -> SizedList n SpecificOrDefaultAlias+enumAliases (Alias pfx) = SpecificAlias <$> SL.generate @n (\n -> Alias $ pfx <> "-" <> show n)  -- | Type-safer version of 'signBytes'. signBinary :: (HasCallStack, BytesLike bs, MonadCleveland caps m) => bs -> Address -> m (TSignature bs)@@ -292,7 +310,7 @@ -- | A simplified version of the originateUntyped command. -- The contract will have 0 balance. originateUntypedSimple-  :: (HasCallStack, MonadOps m) => AliasHint -> U.Value -> U.Contract -> m Address+  :: (HasCallStack, MonadOps m) => Alias -> U.Value -> U.Contract -> m Address originateUntypedSimple uodName uodStorage uodContract = do   let uodBalance = zeroMutez   originateUntyped UntypedOriginateData{..}@@ -317,7 +335,7 @@      ( HasCallStack      , MonadOps m      )-  => AliasHint+  => Alias   -> st   -> Contract cp st vd   -> m (ContractHandle cp st vd)@@ -333,7 +351,7 @@      , MonadOps m      , NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd      )-  => AliasHint -> st -> T.Contract (T.ToT cp) (T.ToT st) -> m (ContractHandle cp st vd)+  => Alias -> st -> T.Contract (T.ToT cp) (T.ToT st) -> m (ContractHandle cp st vd) originateTypedSimple name storage contract@T.Contract{} = do   addr <- originateUntypedSimple name (untypeHelper storage) (convertContract contract)   pure $ ContractHandle (pretty name) addr@@ -352,7 +370,7 @@ -- The contract will have 0 balance. originateLargeUntypedSimple   :: (HasCallStack, MonadCleveland caps m)-  => AliasHint -> U.Value -> U.Contract -> m Address+  => Alias -> U.Value -> U.Contract -> m Address originateLargeUntypedSimple uodName uodStorage uodContract = do   let uodBalance = zeroMutez   originateLargeUntyped UntypedOriginateData{..}@@ -373,7 +391,7 @@      ( HasCallStack      , MonadCleveland caps m      )-  => AliasHint+  => Alias   -> st   -> Contract param st vd   -> m (ContractHandle param st vd)@@ -674,6 +692,14 @@ getApproximateBlockInterval :: (HasCallStack, MonadCleveland caps m) => m (Time Second) getApproximateBlockInterval = do   withCap getMiscCap \cap -> cmiGetApproximateBlockInterval cap++-- | Get minimal block delay in seconds. This is essentially the same as+-- 'getApproximateBlockInterval', but returns a 'Natural' instead of @Time+-- Second@.+--+-- Can be useful when testing code using @MIN_BLOCK_TIME@ instruction.+getMinBlockTime :: (HasCallStack, MonadCleveland caps m) => m Natural+getMinBlockTime = toNum @Second <$> getApproximateBlockInterval  -- | Execute a contract's code without originating it. -- The chain's state will not be modified.

@@ -27,6 +27,7 @@   , neMorleyClientEnvL   , neSecretKeyL   , neMoneybagAliasL+  , neExplicitDataDirL    -- * Error types   , InternalNetworkScenarioError(..)@@ -48,9 +49,7 @@ import Lorentz qualified as L import Lorentz.Constraints.Scopes (NiceUnpackedValue, niceParameterEvi) import Morley.AsRPC (AsRPC, HasRPCRepr(..), MaybeRPC(..), TAsRPC, notesAsRPC, rpcSingIEvi)-import Morley.Client-  (AddressOrAlias(..), Alias, MorleyClientEnv, OperationInfo(..), disableAlphanetWarning,-  runMorleyClientM)+import Morley.Client (MorleyClientEnv, OperationInfo(..), disableAlphanetWarning, runMorleyClientM) import Morley.Client qualified as Client import Morley.Client.Action (Result) import Morley.Client.Action.Reveal qualified as RevealRPC@@ -61,16 +60,17 @@   (AppliedResult(..), BlockConstants(bcHeader), BlockHeaderNoHash(bhnhLevel, bhnhTimestamp),   BlockId(..), OperationHash, OriginationScript(..),   ProtocolParameters(ProtocolParameters, ppCostPerByte, ppMinimalBlockDelay, ppOriginationSize))-import Morley.Client.TezosClient.Impl qualified as Client (prefixNameM)+import Morley.Client.TezosClient.Types (tceMbTezosClientDataDirL) import Morley.Client.Util qualified as Client import Morley.Micheline-  (Expression, FromExpression(fromExpression), MichelinePrimitive(..), StringEncode(..), TezosInt64,-  TezosMutez(..), _ExpressionPrim, _ExpressionSeq, mpaArgsL, mpaPrimL)+  (Expression, MichelinePrimitive(..), StringEncode(..), TezosInt64, TezosMutez(..),+  _ExpressionPrim, _ExpressionSeq, fromExpression, mpaArgsL, mpaPrimL) import Morley.Michelson.TypeCheck (typeCheckContractAndStorage, typeCheckingWith) import Morley.Michelson.Typed (BigMapId, SomeAnnotatedValue(..), SomeContractAndStorage(..), toVal) import Morley.Michelson.Typed qualified as T import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address (Address, mkKeyAddress)+import Morley.Tezos.Address.Alias (AddressOrAlias(..)) import Morley.Tezos.Core as Tezos   (Mutez, Timestamp(..), addMutez, subMutez, timestampFromUTCTime, unsafeAddMutez, unsafeMulMutez,   unsafeSubMutez)@@ -87,6 +87,7 @@   { neMorleyClientEnv :: MorleyClientEnv   , neSecretKey :: Maybe Crypto.SecretKey   , neMoneybagAlias :: Alias+  , neExplicitDataDir :: Bool   }  makeLensesWith postfixLFields ''NetworkEnv@@ -183,17 +184,32 @@  -- | Initialize @moneybag@ address by given 'NetworkEnv' setupMoneybagAddress :: NetworkEnv -> IO Moneybag-setupMoneybagAddress (NetworkEnv env envKey envAlias) = do-  storageAddress <- runMorleyClientM env $-    Client.resolveAddressMaybe (AddressAlias envAlias)-  Moneybag <$> case (envKey, storageAddress) of-    (Nothing, Just addr) -> pure addr-    (Nothing, Nothing) -> throwM $ NoMoneybagAddress envAlias+setupMoneybagAddress NetworkEnv{..} = do+  let setupEnv = neMorleyClientEnv &+        if neExplicitDataDir+        then id+        else Client.mceTezosClientL . tceMbTezosClientDataDirL .~ Nothing+  storageAddress <- runMorleyClientM setupEnv $+    Client.resolveAddressMaybe (AddressAlias neMoneybagAlias)+  Moneybag <$> case (neSecretKey, storageAddress) of+    (Nothing, Just addr) -> do+      unless neExplicitDataDir do+        ek <- runMorleyClientM setupEnv $+          Client.getSecretKey (AddressAlias neMoneybagAlias)+        void $ runMorleyClientM neMorleyClientEnv $+          Client.importKey False neMoneybagAlias ek+      pure addr+    (Nothing, Nothing) -> throwM $ NoMoneybagAddress neMoneybagAlias     (Just ek, Just sa)-      | mkKeyAddress (toPublic ek) == sa -> pure sa-      | otherwise -> throwM $ TwoMoneybagKeys envAlias ek sa+      | mkKeyAddress (toPublic ek) == sa -> do+          unless neExplicitDataDir $ void $+            runMorleyClientM neMorleyClientEnv $+              Client.importKey False neMoneybagAlias ek+          pure sa+      | otherwise -> throwM $ TwoMoneybagKeys neMoneybagAlias ek sa     (Just ek, Nothing) -> do-      runMorleyClientM env (Client.importKey False (Client.AnAlias envAlias) ek)+      runMorleyClientM neMorleyClientEnv $+        Client.importKey False neMoneybagAlias ek       return $ mkKeyAddress (toPublic ek)  -- | Implementation that works with real network and uses @tezos-node@@@ -222,13 +238,13 @@         -- We don't use password protected accounts in cleveland tests         Client.signBytes (AddressResolved signer) Nothing hash -    , cmiGenKey = \alias -> do-        aliasHint <- resolveSpecificOrDefaultAliasHint alias-        liftIO $ runMorleyClientM env . Client.genKey $ Client.AnAliasHint aliasHint+    , cmiGenKey = \sodAlias -> do+        alias <- resolveSpecificOrDefaultAlias sodAlias+        liftIO $ runMorleyClientM env $ Client.genKey alias -    , cmiGenFreshKey = \alias -> do-        aliasHint <- resolveSpecificOrDefaultAliasHint alias-        liftIO $ runMorleyClientM env . Client.genFreshKey $ Client.AnAliasHint aliasHint+    , cmiGenFreshKey = \sodAlias -> do+        alias <- resolveSpecificOrDefaultAlias sodAlias+        liftIO $ runMorleyClientM env $ Client.genFreshKey alias      , cmiGetBalance = getBalanceHelper     , cmiGetChainId = liftIO $ runMorleyClientM env Client.getChainId@@ -236,8 +252,8 @@     , cmiThrow = throwM     , cmiMarkAddressRefillable = setAddressRefillable     , cmiRegisterDelegate = \addr -> liftIO $ runMorleyClientM env $ do-        alias <- Client.getAlias (Client.AddressResolved addr)-        Client.registerDelegate (Client.AnAlias alias) Nothing+        alias <- Client.getAlias (AddressResolved addr)+        Client.registerDelegate alias Nothing     , cmiComment = comment     , cmiEmulatedImpl = pure Nothing     , ..@@ -300,10 +316,8 @@                 , indentF 2 $ build err                 ] -    cmiResolveAddress :: Client.AliasHint -> ClientM Address-    cmiResolveAddress = liftIO . runMorleyClientM env .-      (Client.resolveAddress . AddressAlias <=< Client.prefixNameM) .-      Client.AnAliasHint+    cmiResolveAddress :: Alias -> ClientM Address+    cmiResolveAddress = liftIO . runMorleyClientM env . Client.resolveAddress . AddressAlias      cmiGetPublicKey :: Address -> ClientM PublicKey     cmiGetPublicKey = liftIO . runMorleyClientM env . Client.getPublicKey . AddressResolved@@ -372,7 +386,7 @@     cmiRunCode       :: forall cp st vd. (HasRPCRepr st, T.IsoValue (AsRPC st))       => Sender -> RunCode cp st vd -> ClientM (AsRPC st)-    cmiRunCode (Sender sender) (RunCode rcContract rcStorage rcParameter rcAmount rcBalance rcSource) =+    cmiRunCode (Sender sender) (RunCode rcContract rcStorage rcParameter rcAmount rcLevel rcNow rcBalance rcSource) =       liftIO $ runMorleyClientM env do         -- Pattern match on the contract constructor to reveal         -- a proof of `NiceParameter cp` and `NiceStorage st`@@ -390,6 +404,8 @@           , rcpAmount = rcAmount           , rcpBalance = rcBalance           , rcpSource = rcSource+          , rcpLevel = rcLevel+          , rcpNow = rcNow           , rcpSender = Just sender           }           \\ L.niceParameterEvi @cp@@ -569,7 +585,7 @@   :: MorleyClientEnv   -> Sender   -> (  Bool-      -> AliasHint+      -> Alias       -> AddressOrAlias       -> Mutez       -> U.Contract@@ -590,14 +606,13 @@     revealKeyUnlessRevealed env sender     runMorleyClientM env originationScenario -resolveSpecificOrDefaultAliasHint :: SpecificOrDefaultAliasHint -> ClientM AliasHint-resolveSpecificOrDefaultAliasHint (SpecificAliasHint aliasHint) =-  return aliasHint-resolveSpecificOrDefaultAliasHint (DefaultAliasHint) = do+resolveSpecificOrDefaultAlias :: SpecificOrDefaultAlias -> ClientM Alias+resolveSpecificOrDefaultAlias (SpecificAlias alias) = pure alias+resolveSpecificOrDefaultAlias (DefaultAlias) = do   stateRef <- ask   ist@ClientState{csDefaultAliasCounter=DefaultAliasCounter counter} <- readIORef stateRef   writeIORef stateRef ist{ csDefaultAliasCounter = DefaultAliasCounter $ counter + 1 }-  return $ mkDefaultAlias counter+  pure $ mkDefaultAlias counter  setAddressRefillable :: Address -> ClientM () setAddressRefillable addr = do

@@ -28,17 +28,20 @@   , psRefillableAddresses   , psNow   , psLevel+  , psMinBlockTime   , psGState   , psContractsNames   ) where  import Control.Lens (assign, at, makeLenses, modifying, to, (%=), (.=))+import Control.Lens.Unsound (lensProduct) import Control.Monad.Catch.Pure (CatchT, runCatchT) import Control.Monad.Writer (MonadWriter, WriterT, listen, runWriterT, tell) import Data.Constraint (Dict(..), withDict, (\\)) import Data.Default (def) import Data.Map qualified as Map import Data.Monoid (Ap(..))+import Data.Ratio ((%)) import Data.Set qualified as Set import Data.Singletons (sing) import Data.Type.Equality (type (:~:)(Refl))@@ -50,13 +53,13 @@ import Lorentz.Entrypoints (HasEntrypointArg, TrustEpName(..), useHasEntrypointArg) import Morley.AsRPC   (HasRPCRepr(AsRPC), MaybeRPC(..), notesAsRPC, replaceBigMapIds, rpcStorageScopeEvi, valueAsRPC)-import Morley.Client (Alias, OperationInfo(..), mkAlias)-import Morley.Client.TezosClient.Types (unsafeCoerceAliasHintToAlias, unsafeGetAliasHintText)+import Morley.Client (OperationInfo(..)) import Morley.Michelson.Interpret   (InterpretError(..), InterpretResult(..), MichelsonFailed(..), MichelsonFailureWithStack(..)) import Morley.Michelson.Runtime hiding (ExecutorOp(..), transfer) import Morley.Michelson.Runtime qualified as Runtime (ExecutorOp(..))-import Morley.Michelson.Runtime.Dummy (dummyLevel, dummyMaxSteps, dummyNow, dummyOrigination)+import Morley.Michelson.Runtime.Dummy+  (dummyLevel, dummyMaxSteps, dummyMinBlockTime, dummyNow, dummyOrigination) import Morley.Michelson.Runtime.GState   (GState(..), asBalance, genesisAddress, genesisSecretKey, gsAddressesL, gsChainIdL, gsCounterL,   gsVotingPowersL, initGState)@@ -68,6 +71,7 @@ import Morley.Michelson.Typed.Operation (OriginationOperation(..), TransferOperation(..)) import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address (Address, detGenKeyAddress)+import Morley.Tezos.Address.Alias (Alias(..)) import Morley.Tezos.Core (Timestamp, timestampPlusSeconds, unsafeSubMutez, zeroMutez) import Morley.Tezos.Crypto (SecretKey(..), detSecretKey, sign, toPublic) import Morley.Util.MismatchError@@ -84,11 +88,12 @@   , _psRefillableAddresses :: Set Address   , _psNow :: Timestamp   , _psLevel :: Natural+  , _psMinBlockTime :: Natural   , _psGState :: GState   , _psContractsNames :: Map Address Text   -- ^ Map from contracts addresses to human-readable names.   }-  deriving stock Show+  deriving stock (Eq, Show)  instance MonadState PureState PureM where   get = ask >>= readIORef@@ -110,7 +115,7 @@   { adAddress :: Address   , adMbSecretKey :: Maybe SecretKey   }-  deriving stock Show+  deriving stock (Eq, Show)  data TestError   = UnexpectedTypeCheckError TCError@@ -140,13 +145,8 @@ instance Exception TestError where   displayException = pretty --- In this implementation we do not prefix aliases, so 'Alias' and 'AliasHint'--- are identical and conversions between them are safe.-hintToAlias :: AliasHint -> Alias-hintToAlias = unsafeCoerceAliasHintToAlias- moneybagAlias :: Alias-moneybagAlias = mkAlias "moneybag"+moneybagAlias = Alias "moneybag"  runEmulatedT :: Alias -> EmulatedT PureM a -> IO a runEmulatedT moneybagAlias' scenario =@@ -235,16 +235,16 @@             "Given address doesn't have known associated secret key: " <> build alias           Just sk -> liftIO $ sign sk bs -    , cmiGenKey = \alias -> do-      aliasHint <- resolveSpecificOrDefaultAliasHint alias-      smartGenKey Nothing aliasHint+    , cmiGenKey = \sodAlias -> do+      alias <- resolveSpecificOrDefaultAlias sodAlias+      smartGenKey Nothing alias      , cmiGenFreshKey =-        \alias -> do-          aliasHint <- resolveSpecificOrDefaultAliasHint alias+        \sodAlias -> do+          alias <- resolveSpecificOrDefaultAlias sodAlias           aliases <- use psAliases-          let mbSk = Map.lookup (hintToAlias aliasHint) aliases-          smartGenKey (adAddress <$> mbSk) aliasHint+          let mbSk = Map.lookup alias aliases+          smartGenKey (adAddress <$> mbSk) alias      , cmiOriginateLargeUntyped = originateUntyped @@ -274,7 +274,7 @@      , cmiGetNow = use psNow     , cmiGetLevel = use psLevel-    , cmiGetApproximateBlockInterval = pure $ sec 1+    , cmiGetApproximateBlockInterval = sec . (% 1) <$> use psMinBlockTime     , cmiAttempt = try     , cmiThrow = throwM     , cmiMarkAddressRefillable = setAddressRefillable@@ -358,8 +358,8 @@         (\v -> case v of             VBigMap (Just bigMapId') (_ :: Map (Value k') (Value v'))               | bigMapId == bigMapId' -> do-                  Refl <- requireEq @k' @k (Ap . Left ... UnexpectedBigMapKeyType)-                  Refl <- requireEq @v' @v (Ap . Left ... UnexpectedBigMapValueType)+                  Refl <- requireEq @k' @k (Ap . Left . UnexpectedBigMapKeyType)+                  Refl <- requireEq @v' @v (Ap . Left . UnexpectedBigMapValueType)                   pure [v]             _ -> Ap $ Right []         )@@ -393,17 +393,17 @@     -- Generate a fresh address which was never generated for given alias.     -- If the address is not saved, we use the alias as its seed.     -- Otherwise we concatenate the alias with the saved address.-    smartGenKey :: Maybe Address -> AliasHint -> PureM Address-    smartGenKey existingAddr aliasHint@(unsafeGetAliasHintText -> aliasTxt) =+    smartGenKey :: Maybe Address -> Alias -> PureM Address+    smartGenKey existingAddr alias@(Alias aliasTxt) =       let         seed = maybe aliasTxt (mappend aliasTxt . pretty) existingAddr         sk = detSecretKey (encodeUtf8 seed)         addr = detGenKeyAddress (encodeUtf8 seed)-       in saveAlias aliasHint addr $ Just sk+       in saveAlias alias addr $ Just sk -    resolveSpecificOrDefaultAliasHint (SpecificAliasHint aliasHint) =-      return aliasHint-    resolveSpecificOrDefaultAliasHint (DefaultAliasHint) = do+    resolveSpecificOrDefaultAlias (SpecificAlias alias) =+      return alias+    resolveSpecificOrDefaultAlias DefaultAlias = do       DefaultAliasCounter counter <- use psDefaultAliasesCounter       psDefaultAliasesCounter %= \(DefaultAliasCounter i) -> DefaultAliasCounter $ i + 1       return $ mkDefaultAlias counter@@ -411,13 +411,15 @@     cmiRunCode       :: forall cp st vd. (HasRPCRepr st, T.IsoValue (AsRPC st))       => Sender -> RunCode cp st vd -> PureM (AsRPC st)-    cmiRunCode (Sender sender) (RunCode rcContract rcStorage rcParameter rcAmount rcBalance rcSource) = do+    cmiRunCode (Sender sender) (RunCode rcContract rcStorage rcParameter rcAmount rcLevel rcNow rcBalance rcSource) = do       -- Pattern match on the contract constructor to reveal       -- a proof of `NiceParameter cp` and `NiceStorage st`       L.Contract{} <- pure rcContract       param <- maybeRPCToVal rcParameter       storage <- maybeRPCToVal rcStorage-+      (now, level) <- use $ psNow `lensProduct` psLevel+      psNow %= maybe id const rcNow+      psLevel %= maybe id const rcLevel       res <- interpret do         counter0 <- use $ esGState . gsCounterL         contractAddr <-@@ -441,6 +443,8 @@               }             }         pure contractAddr+      psNow .= now+      psLevel .= level       case res of         Left executorError -> throwEE executorError         Right (executorRes, contractAddr) -> do@@ -467,9 +471,9 @@   GState{..} <- use psGState   return $ maybe zeroMutez asBalance $ Map.lookup addr gsAddresses -saveAlias :: AliasHint -> Address -> Maybe SecretKey -> PureM Address+saveAlias :: Alias -> Address -> Maybe SecretKey -> PureM Address saveAlias name addr mbSk = do-  psAliases %= Map.insert (hintToAlias name) (AliasData addr mbSk)+  psAliases %= Map.insert name (AliasData addr mbSk)   pure addr  exceptionHandler :: PureM a -> PureM a@@ -484,7 +488,7 @@       EEUnexpectedParameterType addr _ -> return $ TransferFailure (addrNameToAddr addr) BadParameter       EEInterpreterFailed addr (InterpretError (MichelsonFailureWithStack{..}, _)) ->         case mfwsFailed of-          MichelsonFailedWith val -> return $ TransferFailure (addrNameToAddr addr) $ FailedWith (EOTVTypedValue val) (Just mfwsInstrCallStack)+          MichelsonFailedWith val -> return $ TransferFailure (addrNameToAddr addr) $ FailedWith (EOTVTypedValue val) (Just mfwsErrorSrcPos)           MichelsonArithError (T.ShiftArithError{}) -> return $ TransferFailure (addrNameToAddr addr) ShiftOverflow           MichelsonArithError (T.MutezArithError errType _ _) -> return $ TransferFailure (addrNameToAddr addr) $ MutezArithError errType           MichelsonGasExhaustion -> return $ TransferFailure (addrNameToAddr addr) GasExhaustion@@ -516,8 +520,8 @@       "Expected address to be contract with storage, but it's a simple address: " <> pretty addr     Nothing -> unknownAddress addr -resolve :: AliasHint -> PureM Address-resolve (hintToAlias -> name) = do+resolve :: Alias -> PureM Address+resolve name = do   aliases <- use psAliases   let maybeAddress = Map.lookup name aliases   maybe (unknownAlias name) (pure . adAddress) maybeAddress@@ -560,6 +564,7 @@   , _psNow = dummyNow   , _psLevel = dummyLevel   , _psGState = initGState+  , _psMinBlockTime = dummyMinBlockTime   , _psContractsNames = Map.empty   } @@ -645,7 +650,8 @@   now <- use psNow   level <- use psLevel   gState <- use psGState-  pure $ runExecutorM now level dummyMaxSteps gState action+  minBlockTime <- use psMinBlockTime+  pure $ runExecutorM now level minBlockTime dummyMaxSteps gState action  addrToAddrName :: Address -> PureState -> AddressName addrToAddrName addr iState =

@@ -7,8 +7,11 @@   , scenarioEmulated   , withInitialNow   , withInitialLevel+  , withMinBlockTime+  , withChainId   ) where +import Morley.Michelson.Runtime.GState (gsChainIdL) import Morley.Tezos.Core qualified as TC import Test.Cleveland.Internal.Abstract import Test.Cleveland.Internal.Pure@@ -39,8 +42,8 @@ -- | Use with an emulated 'Scenario' to configure the initial @now@ value in tests. -- -- Example :--- > withInitialNow (Timestamp 10000000) $ testScenarioOnEmulator "Testname" $ scenarioEmulated $ tests--- > withInitialNow (Timestamp 10000000) $ testScenarioOnEmulator "Testname" $ scenario $ tests+-- > testScenarioOnEmulator "Testname" $ withInitialNow (Timestamp 10000000) $ scenarioEmulated $ tests+-- > testScenarioOnEmulator "Testname" $ withInitialNow (Timestamp 10000000) $ scenario $ tests withInitialNow   :: TC.Timestamp   -> Scenario PureM@@ -53,3 +56,17 @@   -> Scenario PureM   -> Scenario PureM withInitialLevel = withModifiedState . set psLevel++-- | Similar to 'withInitialNow' but for the @MINIMAL_BLOCK_DELAY@ protocol constant.+withMinBlockTime+  :: Natural+  -> Scenario PureM+  -> Scenario PureM+withMinBlockTime = withModifiedState . set psMinBlockTime++-- | Similar to 'withInitialNow' but for the chain id+withChainId+  :: TC.ChainId+  -> Scenario PureM+  -> Scenario PureM+withChainId = withModifiedState . set (psGState . gsChainIdL)

@@ -1,14 +1,9 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA -{-# OPTIONS_GHC -Wno-deprecations #-}- module Test.Cleveland.Lorentz   ( -- * Importing a contract-    specWithContract-  , specWithTypedContract-  , specWithUntypedContract-  , importContract+    importContract   , embedContract   , embedContractM @@ -18,10 +13,6 @@   , embedValueM    -- * Unit testing-  , Michelson.ContractReturn-  , Michelson.ContractPropValidator-  , Michelson.contractProp-  , Michelson.contractPropVal   , testContractCoversEntrypointsT   , testContractMatchesEntrypointsT   , testContractCoversEntrypoints@@ -56,9 +47,6 @@   -- 'meanTimeUpperBoundProp' and 'meanTimeUpperBoundPropNF'.   , mcs, ms, sec, minute -  -- * Dummy values-  , dummyContractEnv-   -- * Special contracts for testing   , contractConsumer   ) where@@ -68,8 +56,4 @@ import Test.Cleveland.Lorentz.Entrypoints import Test.Cleveland.Lorentz.Import import Test.Cleveland.Lorentz.Types-import Test.Cleveland.Michelson.Dummy-import Test.Cleveland.Michelson.Import-  (specWithContract, specWithTypedContract, specWithUntypedContract)-import Test.Cleveland.Michelson.Unit qualified as Michelson import Test.Cleveland.Util

@@ -1,14 +1,10 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA --- TODO [#712]: Remove this next major release-{-# OPTIONS_GHC -Wno-deprecations #-}- -- | Functions to import contracts to be used in tests. module Test.Cleveland.Lorentz.Import   ( -- * Read, parse, typecheck contracts     importContract-  , importContractExt   , embedContract   , embedContractM   , M.ContractReadError (..)@@ -31,7 +27,6 @@ import Lorentz.Constraints import Lorentz.ViewBase import Morley.Michelson.Parser.Types (MichelsonSource(..))-import Morley.Michelson.Runtime.Import qualified as MR import Morley.Michelson.Typed qualified as T import Morley.Util.Markdown import Test.Cleveland.Michelson.Import qualified as M@@ -43,7 +38,7 @@   -> T.Contract (T.ToT cp) (T.ToT st)   -> Either L.ViewInterfaceMatchError (Contract cp st vd) mkImportedContract path cMichelsonContract = verifyingViews Contract-  { cDocumentedCode =+  { cDocumentedCode = L.ContractCode $       L.fakeCoercing $         L.docGroup "Imported contract" $           L.doc $ L.DDescription $ "Read from " <> mdTicked (build path)@@ -67,21 +62,6 @@ importContract file =   either throwM pure . mkImportedContract file =<< M.importContract file --- | Import contract from a given 'FilePath', with deprecated Morley extensions.------ In this and similar functions, parameter and storage types must exactly match--- the ones in the contract, while for views this is not necessary. Only--- make sure that all views beyond @vd@ type are present in the contract; @()@--- always works as views descriptor of the contract.-importContractExt-  :: forall cp st vd.-     (NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd, DemoteViewsDescriptor vd)-  => FilePath -> IO (Contract cp st vd)-importContractExt file =-  either throwM pure . mkImportedContract file =<< MR.importUsing MR.readContractExt file--{-# DEPRECATED importContractExt "Morley extensions are deprecated" #-}- {- | Import a contract at compile time assuming its expected type is known.  Use it like:@@ -98,7 +78,7 @@ embedContract   :: forall cp st vd.     (NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd, DemoteViewsDescriptor vd)-  => FilePath -> TH.TExpQ (Contract cp st vd)+  => FilePath -> TH.Code TH.Q (Contract cp st vd) embedContract path = embedContractM (pure path)  -- | Version of 'embedContract' that accepts a filepath constructor in IO.@@ -110,8 +90,8 @@ embedContractM   :: forall cp st vd.     (NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd, DemoteViewsDescriptor vd)-  => IO FilePath -> TH.TExpQ (Contract cp st vd)-embedContractM pathM = do+  => IO FilePath -> TH.Code TH.Q (Contract cp st vd)+embedContractM pathM = TH.Code do   path <- TH.runIO pathM   contract <- M.embedTextFile path   case M.readContract @(T.ToT cp) @(T.ToT st) (MSFile path) contract of@@ -123,7 +103,8 @@         -- Emit a compiler error if there are issues with constructing contract         fail (pretty e)       -- Emit a haskell expression that reads the contract.-      Right _ -> [||+      Right _ -> TH.examineCode+        [||           -- Note: it's ok to use `unsafe` here, because we just proved that the contract           -- can be parsed+typechecked.           contract@@ -144,7 +125,7 @@  See also the note in "Test.Cleveland.Lorentz.Import#embedDepends" -}-embedValue :: forall a . T.IsoValue a => FilePath -> TH.TExpQ a+embedValue :: forall a . T.IsoValue a => FilePath -> TH.Code TH.Q a embedValue = embedValueM . pure  -- | A variant of 'embedValue' that accepts 'FilePath' in 'IO'.@@ -152,13 +133,13 @@ -- Can be useful when 'FilePath' depends on the environment. -- -- See also the note in "Test.Cleveland.Lorentz.Import#embedDepends"-embedValueM :: forall a . T.IsoValue a => IO FilePath -> TH.TExpQ a-embedValueM pathM = do+embedValueM :: forall a . T.IsoValue a => IO FilePath -> TH.Code TH.Q a+embedValueM pathM = TH.Code do   path <- TH.runIO pathM   rawValue <- M.embedTextFile path   case M.readValue @(T.ToT a) (MSFile path) rawValue of     Left e -> fail (pretty e)-    Right _ ->+    Right _ -> TH.examineCode           [||             -- Note: it's ok to use `error` here, because we just proved that the value             -- can be parsed+typechecked.

@@ -1,8 +1,6 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA -{-# OPTIONS_GHC -Wno-deprecations #-}- -- | Module containing some utilities for testing Michelson contracts using -- Haskell testing frameworks. -- It's Morley testing EDSL.@@ -13,10 +11,7 @@  module Test.Cleveland.Michelson   ( -- * Importing a contract-    specWithContract-  , specWithTypedContract-  , specWithUntypedContract-  , testTreesWithContract+    testTreesWithContract   , testTreesWithUntypedContract   , testTreesWithTypedContract   , concatTestTrees@@ -25,13 +20,6 @@   , importUntypedContract    -- * Unit testing-  , ContractReturn-  , ContractPropValidator-  , contractProp-  , contractPropVal-  , validateSuccess-  , validateStorageIs-  , validateMichelsonFailsWith   , testContractCoversEntrypoints   , testContractMatchesEntrypoints @@ -53,14 +41,9 @@   , runDocTests   , testDocBasic   , excludeDocTests--  -- * Dummy values-  , dummyContractEnv   ) where  import Test.Cleveland.Doc.Michelson-import Test.Cleveland.Michelson.Dummy import Test.Cleveland.Michelson.Entrypoints import Test.Cleveland.Michelson.Import-import Test.Cleveland.Michelson.Unit import Test.Cleveland.Util

@@ -1,19 +0,0 @@--- SPDX-FileCopyrightText: 2021 Oxhead Alpha--- SPDX-License-Identifier: LicenseRef-MIT-OA---- | Dummy data to be used in tests where it's not essential.--module Test.Cleveland.Michelson.Dummy-  {-# DEPRECATED "Use Morley.Michelson.Runtime.Dummy or Morley.Tezos.Core directly instead" #-}-  ( dummyNow-  , dummyLevel-  , dummyMaxSteps-  , dummyBigMapCounter-  , dummyContractEnv-  , dummyGlobalCounter-  , dummyOrigination-  , dummyChainId-  ) where--import Morley.Michelson.Runtime.Dummy-import Morley.Tezos.Core

@@ -1,9 +1,6 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA --- TODO [#712]: Remove this next major release-{-# OPTIONS_GHC -Wno-deprecations #-}- -- | Functions to import contracts to be used in tests.  module Test.Cleveland.Michelson.Import@@ -30,15 +27,8 @@   , testTreesWithContract   , testTreesWithTypedContract   , testTreesWithUntypedContract-  , testTreesWithUntypedContractExt-  , testTreesWithTypedContractExt   , concatTestTrees -    -- * HSpec helpers-  , specWithContract-  , specWithTypedContract-  , specWithUntypedContract-     -- * Helpers   , embedTextFile   ) where@@ -50,7 +40,6 @@ import Language.Haskell.TH qualified as TH import Language.Haskell.TH.Syntax (qAddDependentFile) import Test.HUnit (assertFailure)-import Test.Hspec (Spec, describe, expectationFailure, it, runIO) import Test.Tasty (TestTree) import Test.Tasty.HUnit (testCase) @@ -58,21 +47,6 @@ import Morley.Michelson.Typed (Contract, SingI) import Morley.Michelson.Untyped qualified as U -{-# DEPRECATED-    specWithContract-  , specWithTypedContract-  , specWithUntypedContract--  "Use testTreesWithContract &c. instead"-  #-}--{-# DEPRECATED-    testTreesWithUntypedContractExt-  , testTreesWithTypedContractExt--  "Morley extensions are deprecated"-  #-}- ---------------------------------------------------------------------------- -- tasty helpers ----------------------------------------------------------------------------@@ -95,14 +69,6 @@ testTreesWithUntypedContract =   testTreesWithContractImpl importUntypedContract --- | Like 'testTreesWithContract' but supplies only untyped contract--- with Morley extensions (deprecated).-testTreesWithUntypedContractExt-  :: HasCallStack-  => FilePath -> (U.Contract -> IO [TestTree]) -> IO [TestTree]-testTreesWithUntypedContractExt =-  testTreesWithContractImpl (importUsing readUntypedContractExt)- -- | Like 'testTreesWithContract' but supplies only typed contract. testTreesWithTypedContract   :: (Each '[SingI] [cp, st], HasCallStack)@@ -110,14 +76,6 @@ testTreesWithTypedContract =   testTreesWithContractImpl importContract --- | Like 'testTreesWithContract' but supplies only typed contract--- with Morley extensions (deprecated).-testTreesWithTypedContractExt-  :: (Each '[SingI] [cp, st], HasCallStack)-  => FilePath -> (Contract cp st -> IO [TestTree]) -> IO [TestTree]-testTreesWithTypedContractExt =-  testTreesWithContractImpl (importUsing readContractExt)- testTreesWithContractImpl   :: HasCallStack   => (FilePath -> IO contract)@@ -136,40 +94,6 @@ concatTestTrees = fmap concat . sequence  ------------------------------------------------------------------------------- hspec helpers--------------------------------------------------------------------------------- | Import contract and use it in the spec. Both versions of contract are--- passed to the callback function (untyped and typed).------ If contract's import fails, a spec with single failing expectation--- will be generated (so tests will likely run unexceptionally, but a failing--- result will notify about problem).-specWithContract-  :: (Each '[SingI] [cp, st], HasCallStack)-  => FilePath -> (Contract cp st -> Spec) -> Spec-specWithContract = specWithContractImpl importContract---- | A version of 'specWithContract' which passes only the typed--- representation of the contract.-specWithTypedContract-  :: (Each '[SingI] [cp, st], HasCallStack)-  => FilePath -> (Contract cp st -> Spec) -> Spec-specWithTypedContract = specWithContractImpl importContract--specWithUntypedContract :: FilePath -> (U.Contract -> Spec) -> Spec-specWithUntypedContract = specWithContractImpl importUntypedContract--specWithContractImpl-  :: HasCallStack-  => (FilePath -> IO contract) -> FilePath -> (contract -> Spec) -> Spec-specWithContractImpl doImport file execSpec =-  either errorSpec (describe ("Test contract " <> file) . execSpec)-    =<< runIO (saferImport doImport file)-  where-    errorSpec = it ("Import contract " <> file) . expectationFailure------------------------------------------------------------------------------ -- Helpers ---------------------------------------------------------------------------- @@ -208,7 +132,7 @@ -} embedContract   :: forall cp st. (SingI cp, SingI st)-  => FilePath -> TH.TExpQ (Contract cp st)+  => FilePath -> TH.Code TH.Q (Contract cp st) embedContract path = embedContractM (pure path)  -- | Version of 'embedContract' that accepts a filepath constructor in IO.@@ -217,15 +141,15 @@ -- user input. embedContractM   :: forall cp st. (SingI cp, SingI st)-  => IO FilePath -> TH.TExpQ (Contract cp st)-embedContractM pathM = do+  => IO FilePath -> TH.Code TH.Q (Contract cp st)+embedContractM pathM = TH.Code do   path <- TH.runIO pathM   contract <- embedTextFile path   case readContract @cp @st (MSFile path) contract of     Left e ->       -- Emit a compiler error if the contract cannot be read.       fail (pretty e)-    Right _ ->+    Right _ -> TH.examineCode       -- Emit a haskell expression that reads the contract.       [||         -- Note: it's ok to use `unsafe` here, because we just proved that the contrPact

@@ -1,108 +0,0 @@--- SPDX-FileCopyrightText: 2021 Oxhead Alpha--- SPDX-License-Identifier: LicenseRef-MIT-OA--{-# OPTIONS_GHC -Wno-deprecations #-}---- | Utility functions for unit testing.--module Test.Cleveland.Michelson.Unit-  {-# DEPRECATED "Use the new Test.Cleveland interface instead. Entrypoint utilities\-  \ are moved to Test.Cleveland.Michelson.Entrypoints" #-}-  ( ContractReturn-  , ContractPropValidator-  , EPMismatch-  , contractProp-  , contractPropVal-  , validateSuccess-  , validateStorageIs-  , validateMichelsonFailsWith-  ) where--import Data.Constraint ((\\))-import Fmt ((+|), (|+))-import Test.HUnit (Assertion, assertFailure, (@?=))-import Test.Hspec.Expectations (Expectation, shouldBe, shouldSatisfy)--import Lorentz.Constraints.Scopes (NiceConstant, niceConstantEvi)-import Morley.Michelson.Interpret-  (ContractEnv, ContractReturn, MichelsonFailed(..), MichelsonFailureWithStack(..), interpret)-import Morley.Michelson.Typed (Contract, IsoValue(..), ToT)-import Morley.Michelson.Typed qualified as T-import Test.Cleveland.Michelson.Dummy (dummyBigMapCounter, dummyGlobalCounter)-import Test.Cleveland.Michelson.Internal.Entrypoints---- | Type for contract execution validation.------ It's a function which is supplied with contract execution output--- (failure or new storage with operation list).------ Function returns a property which type is designated by type variable @prop@--- and might be @Test.QuickCheck.Property@ or 'Expectation'--- or anything else relevant.-type ContractPropValidator st prop = ContractReturn st -> prop---- | ContractCode's property tester against given input.--- Takes contract environment, initial storage and parameter,--- interprets contract on this input and invokes validation function.-contractProp-  :: ( IsoValue param, IsoValue storage-     , ToT param ~ cp, ToT storage ~ st-     , T.ParameterScope cp-     )-  => Contract cp st-  -> ContractPropValidator st prop-  -> ContractEnv-  -> param-  -> storage-  -> prop-contractProp instr check env param initSt =-  contractPropVal instr check env (toVal param) (toVal initSt)---- | Version of 'contractProp' which takes 'T.Value' as arguments instead--- of regular Haskell values.------ This function assumes that contract has no explicit default entrypoints--- and you always have to construct parameter manually; if you need to test--- contract calling specific entrypoints, use integrational testing defined--- by "Test.Cleveland.Michelson.Integrational" module.-contractPropVal-  :: (T.ParameterScope cp)-  => Contract cp st-  -> ContractPropValidator st prop-  -> ContractEnv-  -> T.Value cp-  -> T.Value st-  -> prop-contractPropVal instr check env param initSt =-  check $ interpret instr T.unsafeEpcCallRoot param initSt dummyGlobalCounter dummyBigMapCounter env--------------------------------------------------------------------------------- Validators--------------------------------------------------------------------------------- | 'ContractPropValidator' that expects a successful termination.-validateSuccess :: HasCallStack => ContractPropValidator st Expectation-validateSuccess (res, _) = res `shouldSatisfy` isRight---- | 'ContractPropValidator' that expects contract execution to--- succeed and update storage to a particular constant value.-validateStorageIs-  :: IsoValue st-  => st -> ContractPropValidator (ToT st) Assertion-validateStorageIs expected (res, _) =-  case res of-    Left err ->-      assertFailure $ "Unexpected interpretation failure: " +| err |+ ""-    Right (_ops, got) ->-      got @?= toVal expected---- | 'ContractPropValidator' that expects a given failure.-validateMichelsonFailsWith-  :: forall v st. NiceConstant v-  => v -> ContractPropValidator st Expectation-validateMichelsonFailsWith v (res, _) = case res of-  Right _ -> assertFailure $-    "contract was expected to fail with " +| expected |+ " but didn't."-  Left MichelsonFailureWithStack{..} -> mfwsFailed `shouldBe` expected-  where-    expected = MichelsonFailedWith (toVal v) \\ niceConstantEvi @v

@@ -57,7 +57,6 @@    -- * Reading/setting options   , modifyNetworkEnv-  , setAliasPrefix   ) where  import Test.Cleveland.Tasty.Internal

@@ -20,7 +20,6 @@    -- * Reading/setting options   , modifyNetworkEnv-  , setAliasPrefix    -- * Internals   , RunOnNetwork(..)@@ -39,11 +38,13 @@ import Data.Char qualified as C import Data.Tagged (Tagged(Tagged)) import Fmt (pretty)+import System.Directory (removeDirectoryRecursive) import System.Environment (lookupEnv)+import System.IO.Temp (createTempDirectory, getCanonicalTemporaryDirectory) import System.IO.Unsafe qualified as Unsafe import Test.Tasty   (TestName, adjustOption, askOption, defaultIngredients, defaultMainWithIngredients,-  includingOptions, localOption, testGroup)+  includingOptions, localOption, testGroup, withResource) import Test.Tasty.Ingredients (Ingredient) import Test.Tasty.Options (IsOption(..), OptionSet, lookupOption) import Test.Tasty.Patterns.Types as Tasty (Expr(..))@@ -51,15 +52,15 @@ import Test.Tasty.Runners (Result(..), TestPattern(..), TestTree(AskOptions))  import Morley.Client (MorleyClientConfig(..), mceTezosClientL, mkMorleyClientEnv)-import Morley.Client.TezosClient.Types (tceAliasPrefixL)+import Morley.Client.TezosClient.Types (tceMbTezosClientDataDirL) import Test.Cleveland.Internal.Client as Client   (ClientM, NetworkEnv(..), neMorleyClientEnvL, runClevelandT) import Test.Cleveland.Internal.Exceptions (WithCallStack(WithCallStack)) import Test.Cleveland.Internal.Pure as Pure (PureM, runClevelandT, runEmulatedT) import Test.Cleveland.Internal.Scenario import Test.Cleveland.Tasty.Internal.Options-  (AliasPrefixOpt(..), ContextLinesOpt(..), DataDirOpt(..), EndpointOpt(..), MoneybagAliasOpt(..),-  PathOpt(..), RunModeOpt(..), SecretKeyOpt(..), VerboseOpt(..), clevelandOptions)+  (ContextLinesOpt(..), DataDirOpt(..), EndpointOpt(..), MoneybagAliasOpt(..), PathOpt(..),+  RunModeOpt(..), SecretKeyOpt(..), VerboseOpt(..), clevelandOptions) import Test.Cleveland.Tasty.Internal.Report (formatError)  -- | A name that we use to tag all tests that run on the network.@@ -163,7 +164,8 @@ -- registers the necessary command line options/environment variables to configure -- "Test.Cleveland". clevelandMain :: TestTree -> IO ()-clevelandMain = clevelandMainWithIngredients defaultIngredients . loadTastyEnv+clevelandMain =+  clevelandMainWithIngredients defaultIngredients . loadTastyEnv  -- | Similar to 'defaultMainWithIngredients', but also preloads 'TastyEnv' and -- registers the necessary command line options/environment variables to configure@@ -173,7 +175,7 @@   ciSwitch <- withinCI   defaultMainWithIngredients     (clevelandIngredients <> ingredients)-    (loadOptionSwitcher ciSwitch . loadTastyEnv $ tree)+    (loadOptionSwitcher ciSwitch . setupTempDatadirIfNeeded . loadTastyEnv $ tree)  -- | A list with all the ingredients necessary to configure "Test.Cleveland". --@@ -196,7 +198,6 @@ tastyEnvFromOpts :: OptionSet -> TastyEnv tastyEnvFromOpts optionSet =   let-    AliasPrefixOpt aliasPrefix = lookupOption optionSet     EndpointOpt endpoint = lookupOption optionSet     PathOpt path = lookupOption optionSet     DataDirOpt dataDir = lookupOption optionSet@@ -210,8 +211,7 @@       -- Otherwise, load it.       TastyEnvOpt Nothing -> mkTastyEnv $ do         morleyClientEnv <- mkMorleyClientEnv MorleyClientConfig-          { mccAliasPrefix = aliasPrefix-          , mccEndpointUrl = endpoint+          { mccEndpointUrl = endpoint           , mccTezosClientPath = path           , mccMbTezosClientDataDir = dataDir           , mccVerbosity = verbosity@@ -221,6 +221,7 @@             { neMorleyClientEnv = morleyClientEnv             , neSecretKey = sk             , neMoneybagAlias = origAlias+            , neExplicitDataDir = isJust dataDir             }  -- | Heuristics to check whether we are running within CI.@@ -262,13 +263,6 @@     in localOption (TastyEnvOpt $ Just (mapTastyEnv f tastyEnv)) $          tree --- | Overrides the alias prefix (parsed from @--cleveland-alias-prefix@ or @TASTY_CLEVELAND_ALIAS_PREFIX@)--- for all the tests in the given test tree.-setAliasPrefix :: Text -> TestTree -> TestTree-setAliasPrefix aliasPrefix tree =-  modifyNetworkEnv (neMorleyClientEnvL.mceTezosClientL.tceAliasPrefixL .~ Just aliasPrefix) $-    tree- ---------------------------------------------------------------------------- -- Preload TastyEnv ----------------------------------------------------------------------------@@ -334,7 +328,7 @@ mkTastyEnv mkEnv =   TastyEnv     { useNetworkEnv = \cont ->-        withMVar lock $ \() -> do+        withMVar lock $ const do           env <- memoMkEnv           cont env     }@@ -345,6 +339,23 @@     --     -- We're only using it here to initialize an 'MVar', so it /should/ be safe 🤞     memoMkEnv = Unsafe.unsafePerformIO $ memoize mkEnv++setupTempDatadirIfNeeded :: TestTree -> TestTree+setupTempDatadirIfNeeded tree = askOption \case+    DataDirOpt Just{} -> tree+    DataDirOpt Nothing ->+      -- NB: 'withResource' memoizes the resource, so it's pretty safe to+      -- 'unsafePerformIO' it -- it won't be created twice at least, and+      -- will be freed after the test tree is done running.+      withResource initTempDir removeDirectoryRecursive \iodir ->+        modifyNetworkEnv (neMbTezosClientDataDirL .~ Just (Unsafe.unsafePerformIO iodir)) tree+  where+    initTempDir = do+      tmpdir <- getCanonicalTemporaryDirectory+      createTempDirectory tmpdir "cleveland"+    neMbTezosClientDataDirL :: Lens' NetworkEnv (Maybe FilePath)+    neMbTezosClientDataDirL =+      neMorleyClientEnvL . mceTezosClientL . tceMbTezosClientDataDirL  mapTastyEnv :: (NetworkEnv -> NetworkEnv) -> (TastyEnv -> TastyEnv) mapTastyEnv g (TastyEnv f) =

@@ -7,7 +7,6 @@ -- They're used to configure "Test.Cleveland". module Test.Cleveland.Tasty.Internal.Options   ( clevelandOptions-  , AliasPrefixOpt(..)   , MoneybagAliasOpt(..)   , EndpointOpt(..)   , PathOpt(..)@@ -25,8 +24,8 @@ import Servant.Client.Core (BaseUrl(..)) import Test.Tasty.Options as Tasty (IsOption(..), OptionDescription(Option), safeRead) -import Morley.Client (Alias, mkAlias) import Morley.Client.Parser (baseUrlReader)+import Morley.Tezos.Address.Alias (Alias(..)) import Morley.Tezos.Crypto qualified as Crypto import Morley.Util.CLI (HasCLReader(getMetavar, getReader)) @@ -49,8 +48,7 @@ -- | A list with all the options needed to configure "Test.Cleveland". clevelandOptions :: [OptionDescription] clevelandOptions =-  [ Tasty.Option (Proxy @AliasPrefixOpt)-  , Tasty.Option (Proxy @EndpointOpt)+  [ Tasty.Option (Proxy @EndpointOpt)   , Tasty.Option (Proxy @PathOpt)   , Tasty.Option (Proxy @DataDirOpt)   , Tasty.Option (Proxy @VerboseOpt)@@ -64,17 +62,6 @@ -- Morley Client options ---------------------------------------------------------------------------- -newtype AliasPrefixOpt = AliasPrefixOpt (Maybe Text)-  deriving stock (Show, Eq)--instance IsOption AliasPrefixOpt where-  defaultValue = AliasPrefixOpt Nothing-  optionName = "cleveland-alias-prefix"-  optionHelp = "[Test.Cleveland] A prefix to prepend to every alias created " <>-               "with 'newAddress' or 'newFreshAddress'."-  parseValue = mkParseValue (AliasPrefixOpt . Just)-  optionCLParser = mkOptionParser (AliasPrefixOpt . Just) Nothing- -- | Morley Client option specifying endpoint URL of the Tezos node. newtype EndpointOpt = EndpointOpt (Maybe BaseUrl)   deriving stock (Show, Eq)@@ -152,11 +139,11 @@   instance IsOption MoneybagAliasOpt where-  defaultValue = MoneybagAliasOpt $ mkAlias "moneybag"+  defaultValue = MoneybagAliasOpt $ Alias "moneybag"   optionName = "cleveland-moneybag-alias"   optionHelp = "[Test.Cleveland] Alias of the account to be used to execute all transfers/originations " <>                "(unless overriden with `withSender`) and fund new accounts (unless overriden with `withMoneybag`)."-  parseValue = Just . MoneybagAliasOpt . mkAlias . fromString+  parseValue = Just . MoneybagAliasOpt . Alias . fromString  data RunModeOpt   = RunAllMode

@@ -32,6 +32,7 @@ import Morley.Michelson.Typed (convertContract, untypeValue) import Morley.Tezos.Address (ta) import Morley.Util.Interpolate (lit)+import Morley.Util.SizedList.Types import Test.Cleveland import Test.Cleveland.Internal.Client (neMorleyClientEnvL) import Test.Cleveland.Internal.Pure (TestError(CustomTestError))@@ -67,13 +68,13 @@   , testFailureIncludesCallStack "clarifyErrors properly works for equality tests"           [lit|                 i @== 1-                ^^^^^^^-                | For i=2:-                |   Failed comparison-                |   ━━ Expected (rhs) ━━-                |   1-                |   ━━ Got (lhs) ━━-                |   2+                  ^^^+                  | For i=2:+                  |   Failed comparison+                  |   ━━ Expected (rhs) ━━+                  |   1+                  |   ━━ Got (lhs) ━━+                  |   2           |]           do             for_ ([1..10] :: [Int]) \i ->@@ -82,14 +83,14 @@   , testFailureIncludesCallStack "clarifyErrors nests well"           [lit|                     i @== j-                    ^^^^^^^-                    | For i=1:-                    |   For j=2:-                    |     Failed comparison-                    |     ━━ Expected (rhs) ━━-                    |     2-                    |     ━━ Got (lhs) ━━-                    |     1+                      ^^^+                      | For i=1:+                      |   For j=2:+                      |     Failed comparison+                      |     ━━ Expected (rhs) ━━+                      |     2+                      |     ━━ Got (lhs) ━━+                      |     1           |]           do             for_ ([1..10] :: [Int]) \i ->@@ -131,6 +132,17 @@           withMoneybag addr $             void $ newAddress "b" +    , testFailureIncludesCallStack "callstack points to newAddresses"+        [lit|+            void $ newAddresses $ "b" :< Nil+                   ^^^^^^^^^^^^+        |]+        do+          addr <- newFreshAddress "a"+          -- force a failure by using an address without money as the donator+          withMoneybag addr $+            void $ newAddresses $ "b" :< Nil+     , testFailureIncludesCallStack "callstack points to signBytes"         [lit|           void $ signBytes "" invalidAddr@@ -239,10 +251,7 @@     , testFailureIncludesCallStack "callstack points to inBatch for batched transfers"         [lit|           inBatch $ do-            call (TAddress @() invalidAddr) CallDefault ()-            call (TAddress @() invalidAddr) CallDefault ()-            return ()-          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^+          ^^^^^^^         |]         do           -- force a failure by transfering to an unknown address@@ -263,7 +272,8 @@       [ testFailureIncludesCallStack "when action throws an unexpected exception, callstack points to action"           [lit|                 runIO $ throwM DummyException-                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^+                ^^^^^+                | DummyException           |]           do             void $@@ -499,6 +509,8 @@             , rcAmount = 0             , rcBalance = 0             , rcSource = Nothing+            , rcNow = Nothing+            , rcLevel = Nothing             }             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^         |]@@ -511,6 +523,8 @@             , rcAmount = 0             , rcBalance = 0             , rcSource = Nothing+            , rcNow = Nothing+            , rcLevel = Nothing             }     , testFailureIncludesCallStackOnEmulator         "when a branchout branch throws, the callstack points to the function inside the branch"@@ -530,7 +544,7 @@         "when a branchout branch throws ANY exception, the exception raised is printed in a right way"         [lit|                 runIO $ throwM DummyException-                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^+                ^^^^^                 | In 'a' branch:                 | DummyException @@ -574,7 +588,7 @@     , testFailureIncludesCallStack "callstack points to @=="         [lit|           1 @== (2 :: Int)-          ^^^^^^^^^^^^^^^^+            ^^^         |]         do           1 @== (2 :: Int)@@ -582,7 +596,7 @@     , testFailureIncludesCallStack "callstack points to @/="         [lit|           1 @/= (1 :: Int)-          ^^^^^^^^^^^^^^^^+            ^^^         |]         do           1 @/= (1 :: Int)@@ -590,7 +604,7 @@     , testFailureIncludesCallStack "callstack points to @@=="         [lit|           pure 1 @@== (2 :: Int)-          ^^^^^^^^^^^^^^^^^^^^^^+                 ^^^^         |]         do           pure 1 @@== (2 :: Int)@@ -598,7 +612,7 @@     , testFailureIncludesCallStack "callstack points to @@/="         [lit|           pure 1 @@/= (1 :: Int)-          ^^^^^^^^^^^^^^^^^^^^^^+                 ^^^^         |]         do           pure 1 @@/= (1 :: Int)@@ -693,17 +707,17 @@     ^^^^^^^^^^^^^^^         |]         dummyProp-    , testFailureIncludesCallStackProperty "callstack points to the line where the pure error was thrown"-        [lit|-  error "Pure error" @== (1 :: Int)-  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^-        |]+    , testFailureIncludesCallStackProperty "callstack does not point to internals when a pure error is thrown"+        -- TODO [#818]: include the actual error message+        -- NB: a single quote with two of these lines unindented causes tasty to output a different error message+        (List.unlines+          [ [lit|dummyPropWithPureError = property $ testScenarioProps $ scenario do|]+          , [lit|^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^|]])         dummyPropWithPureError-    , testFailureIncludesCallStackProperty "callstack points to the line where the nested pure error was thrown"-        [lit|-  (10 - 11 :: Mutez) @== 0-  ^^^^^^^^^^^^^^^^^^^^^^^^-        |]+    , testFailureIncludesCallStackProperty "callstack does not point to internals when a nested pure error is thrown"+        (List.unlines+          [ [lit|dummyPropWithNestedPureError = property $ testScenarioProps $ scenario do|]+          , [lit|^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^|]])         dummyPropWithNestedPureError     ] 

@@ -0,0 +1,32 @@+-- SPDX-FileCopyrightText: 2022 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA++-- | Calls from empty implicit addresses are disallowed+module TestSuite.Cleveland.EmptyImplicitAddress+  ( test_EmptyImplicitAddressCalls+  , test_EmptyImplicitAddressTransfers+  ) where++import Test.Tasty (TestTree)++import Test.Cleveland++import TestSuite.Util++test_EmptyImplicitAddressCalls :: TestTree+test_EmptyImplicitAddressCalls =+  testScenario "Calling a contract with empty implicit address fails" $ scenario do+    addr <- newFreshAddress auto+    contract <- originateSimple "contract" () $ idContract @() @()+    call contract CallDefault ()+      & withSender addr+      & shouldFailWithMessage "Empty implicit contract"++test_EmptyImplicitAddressTransfers :: TestTree+test_EmptyImplicitAddressTransfers =+  testScenario "Transferring from empty implicit address fails" $ scenario do+    addr <- newFreshAddress auto+    recvr <- newAddress auto+    transferMoney recvr 0+      & withSender addr+      & shouldFailWithMessage "Empty implicit contract"

@@ -193,7 +193,7 @@  -- | A contract that triggers a variety of error scenarios -- depending on the argument it's given.-testContractCode :: ContractCode Parameter ()+testContractCode :: '[(Parameter, ())] :-> '[(List Operation, ())] testContractCode =   car #   entryCaseSimple @Parameter

@@ -11,7 +11,7 @@ import Test.Tasty (TestTree) import Test.Tasty.Hedgehog (testProperty) -import Morley.Tezos.Core (Timestamp(..))+import Morley.Tezos.Core (ChainId(..), Timestamp(..)) import Test.Cleveland  test_init :: IO [TestTree]@@ -39,4 +39,12 @@         $ scenarioEmulated $ do             getLevel @@== expectedLevel             getNow @@== expectedNow++    , testScenarioOnEmulator "Sets MINIMAL_BLOCK_DELAY"+        $ withMinBlockTime 123+        $ scenarioEmulated $ getMinBlockTime @@== 123++    , testScenarioOnEmulator "Sets CHAIN_ID"+        $ withChainId (UnsafeChainId "\01\02\03\04")+        $ scenarioEmulated $ getChainId @@== UnsafeChainId "\01\02\03\04"     ]

@@ -10,12 +10,12 @@ import Test.Cleveland.Instances ()  allocatorContract :: Contract [Address] Storage ()-allocatorContract = defaultContract allocatorContractLorentz+allocatorContract = mkContract allocatorContractLorentz  type Storage = ("storage" :! [Address])  allocatorContractLorentz :: ContractCode [Address] Storage-allocatorContractLorentz =+allocatorContractLorentz = mkContractCode $   unpair #   dip (nil @Operation) #   iter (

@@ -12,8 +12,6 @@   , expectFailure   ) where -import Lorentz qualified as L- import Data.List (isInfixOf) import Data.Text (strip) import Test.Tasty (testGroup)@@ -22,14 +20,13 @@ import Test.Tasty.Runners (FailureReason(..), Outcome(..), Result(..), TestTree(..))  import Lorentz.Annotation-import Lorentz.Constraints import Lorentz.Entrypoints-import Lorentz.Run import Lorentz.Value import Morley.Michelson.Untyped qualified as U import Morley.Util.Interpolate  import Test.Cleveland.Lorentz.Entrypoints+import TestSuite.Util  data MyEntrypoints1   = Do1 Integer@@ -58,10 +55,6 @@ instance ParameterHasEntrypoints MyEntrypoints2 where   type ParameterEntrypointsDerivation MyEntrypoints2 = EpdPlain -dummyContract :: NiceParameterFull param => Contract param () ()-dummyContract = L.defaultContract $-  L.drop L.# L.unit L.# L.nil L.# L.pair- epSpecPartial :: Map EpName U.Ty epSpecPartial =   [ ( U.UnsafeEpName "do1", U.Ty (U.TInt) def )@@ -107,14 +100,14 @@ test_ContractCoversEntrypoints =   [ testContractCoversEntrypoints       "testContractCoversEntrypoints works as expected"-        (dummyContract @MyEntrypoints1) epSpecPartial+        (idContract @MyEntrypoints1 @()) epSpecPartial   , testContractCoversEntrypoints       "testContractCoversEntrypoints fails on wrong type"-        (dummyContract @MyEntrypoints1) [ ( U.UnsafeEpName "do1", U.Ty (U.TNat) def ) ]+        (idContract @MyEntrypoints1 @()) [ ( U.UnsafeEpName "do1", U.Ty (U.TNat) def ) ]       & expectFailure "Expected: nat\nActual:   int"   , testContractCoversEntrypoints       "testContractCoversEntrypoints fails on missing entrypoints"-        (dummyContract @MyEntrypoints1) [ ( U.UnsafeEpName "do123", U.Ty (U.TInt) def ) ]+        (idContract @MyEntrypoints1 @()) [ ( U.UnsafeEpName "do123", U.Ty (U.TInt) def ) ]       & expectFailure "Entrypoints do not match specification: \           \Missing entrypoints in the contract: do123: int"   ]@@ -133,14 +126,14 @@ test_ContractMatchEntrypoints :: [TestTree] test_ContractMatchEntrypoints =   [ testContractMatchesEntrypoints-      "testContractMatchesEntrypoints works as expected" (dummyContract @MyEntrypoints1) epSpecFull+      "testContractMatchesEntrypoints works as expected" (idContract @MyEntrypoints1 @()) epSpecFull   , testContractMatchesEntrypoints       "testContractMatchesEntrypoints fails on wrong type"-        (dummyContract @MyEntrypoints1) [ ( U.UnsafeEpName "do1", U.Ty (U.TNat) def ) ]+        (idContract @MyEntrypoints1 @()) [ ( U.UnsafeEpName "do1", U.Ty (U.TNat) def ) ]       & expectFailure  "Expected: nat\nActual:   int"   , testContractMatchesEntrypoints       "testContractMatchesEntrypoints fails on wrong nested type"-        (dummyContract @MyEntrypoints1) [( U.UnsafeEpName "do4", genBigPair 6)]+        (idContract @MyEntrypoints1 @()) [( U.UnsafeEpName "do4", genBigPair 6)]       & expectFailure [it|             pair (unit %param1)           -      (pair %param2 (unit %param1)@@ -154,11 +147,11 @@           |]   , testContractMatchesEntrypoints       "testContractMatchesEntrypoints fails on missing entrypoints"-        (dummyContract @MyEntrypoints1) [ ( U.UnsafeEpName "do123", U.Ty (U.TInt) def ) ]+        (idContract @MyEntrypoints1 @()) [ ( U.UnsafeEpName "do123", U.Ty (U.TInt) def ) ]       & expectFailure "Missing entrypoints in the contract: do123: int"   , testContractMatchesEntrypoints       "testContractMatchesEntrypoints fails on extraneous entrypoints"-        (dummyContract @MyEntrypoints1) epSpecPartial+        (idContract @MyEntrypoints1 @()) epSpecPartial       & expectFailure "Entrypoints do not match specification:\           \ Extraneous entrypoints in the contract: do4: pair (unit %param1) (bytes %param2)"   ]@@ -166,9 +159,9 @@ test_ContractMatchEntrypointsT :: [TestTree] test_ContractMatchEntrypointsT =   [ testContractMatchesEntrypointsT @MyEntrypoints1-      "testContractMatchesEntrypointsT works as expected" (dummyContract @MyEntrypoints1)+      "testContractMatchesEntrypointsT works as expected" (idContract @MyEntrypoints1 @())   , testContractMatchesEntrypointsT @MyEntrypoints2-      "testContractMatchesEntrypointsT fails on extra entrypoints" (dummyContract @MyEntrypoints1)+      "testContractMatchesEntrypointsT fails on extra entrypoints" (idContract @MyEntrypoints1 @())       & expectFailure [it|           Extraneous entrypoints in the contract:             do1: int@@ -180,7 +173,7 @@ test_ContractCoverEntrypointsT :: [TestTree] test_ContractCoverEntrypointsT =   [ testContractCoversEntrypointsT @MyEntrypoints2-      "testContractCoversEntrypointsT works on partial spec" (dummyContract @MyEntrypoints1)+      "testContractCoversEntrypointsT works on partial spec" (idContract @MyEntrypoints1 @())   , testContractCoversEntrypointsT @MyEntrypoints1-      "testContractCoversEntrypointsT works on full spec" (dummyContract @MyEntrypoints1)+      "testContractCoversEntrypointsT works on full spec" (idContract @MyEntrypoints1 @())   ]

@@ -20,14 +20,15 @@   -- If probability of generating the same address twice is low, then   -- we better always blindly transfer some money to new addresses.   testScenario "Address generation is deterministic" $ scenario do-    addr1 ::< addr2 ::< Nil' <- traverse newAddress $ SL.replicateT "test"+    addr1 ::< addr2 ::< Nil' <- newAddresses $ SL.replicateT "test"      addr1 @== addr2  test_NewAddressCheck :: [TestTree] test_NewAddressCheck =   [ testScenario "Newly created address gets money if it had low balance" $ scenario do-      test :< test2 :< Nil <- traverse newAddress $ "test" :< "test2" :< Nil+      let hints = enumAliases "test"+      test ::< test2 ::< Nil' <- newAddresses hints        balance <- getBalance test       let@@ -43,7 +44,7 @@         "Sanity check failed. Something went wrong, is test broken?"        -- creating the same address to check how balance replenishes-      _ <- newAddress "test"+      _ <- newAddress $ SL.head hints        balance3 <- getBalance test       checkCompares balance3 (>) toRemain

@@ -1,67 +0,0 @@--- SPDX-FileCopyrightText: 2021 Oxhead Alpha--- SPDX-License-Identifier: LicenseRef-MIT-OA--module TestSuite.Cleveland.PrefixNetworkScenario-  ( test_PrefixNetworkScenario-  , test_newAddress_with_prefix-  ) where--import Data.Fixed (Nano)-import Data.Text (takeEnd)-import Data.Time.Clock.POSIX (getPOSIXTime)-import System.IO.Temp (withSystemTempDirectory)-import Test.Tasty (TestTree)-import Test.Tasty.HUnit (testCase, (@=?))--import Morley.Client qualified as Client-import Morley.Client.TezosClient.Types (tceAliasPrefixL, tceMbTezosClientDataDirL)-import Morley.Tezos.Crypto (SecretKey, detSecretKey)-import Test.Cleveland-import Test.Cleveland.Internal.Abstract (Moneybag(Moneybag), moneybagL)-import Test.Cleveland.Internal.Client-  (neMoneybagAliasL, neMorleyClientEnvL, neSecretKeyL, runClevelandT)-import Test.Cleveland.Tasty (modifyNetworkEnv, setAliasPrefix, whenNetworkEnabled)--aliasName :: Client.Alias-aliasName = Client.mkAlias "testMoneybagAlias"--aliasPrefix :: Text-aliasPrefix = "testPrefix"--mangleNetworkEnv :: SecretKey -> TestTree -> TestTree-mangleNetworkEnv sk = modifyNetworkEnv $-    (neMorleyClientEnvL . Client.mceTezosClientL . tceAliasPrefixL .~ Just aliasPrefix)-  . (neSecretKeyL .~ Just sk)-  . (neMoneybagAliasL .~ aliasName)--setTmpDir :: FilePath -> NetworkEnv -> NetworkEnv-setTmpDir dir = neMorleyClientEnvL . Client.mceTezosClientL . tceMbTezosClientDataDirL .~ Just dir--test_PrefixNetworkScenario :: IO TestTree-test_PrefixNetworkScenario = do-  -- use 7 digits of the current POSIX time in nanoseconds to generate seed-  -- this ensures we test for a fresh key more often than not-  -- taking 7 digits ensures that we're generating Ed25519 key.-  seed <- encodeUtf8 . takeEnd 7 . show @Text . realToFrac @_ @Nano <$> getPOSIXTime-  let key = detSecretKey seed-  pure $ mangleNetworkEnv key $ whenNetworkEnabled $ \withEnv ->-    testCase "Moneybag alias is not affected by alias prefix" $ withEnv $ \env' ->-      -- NB: we can't have 'withSystemTempDirectory' outside the test because-      -- the outer IO action finishes before the test itself is run.-      -- hence we have to change the tmpdir in env inside the test too-      withSystemTempDirectory "tezos-client" \tmpdir -> do-        let env = setTmpDir tmpdir env'-        Moneybag moneybagAddress <- runClevelandT env $ view moneybagL--        actualAlias <- Client.runMorleyClientM (neMorleyClientEnv env) $-          Client.getAlias $ Client.AddressResolved moneybagAddress-        actualAlias @=? aliasName--test_newAddress_with_prefix :: TestTree-test_newAddress_with_prefix =-  setAliasPrefix "prefix" $-    testScenario "`newAddress` prepends alias prefix to alias hint" $ scenario do-      addr1 <- newAddress "alias"-      addr2 <- resolveAddress "alias"--      addr1 @== addr2

@@ -16,6 +16,7 @@ test_PrettyFailWith :: TestTree test_PrettyFailWith = testScenarioOnEmulator "FailWith shows its argument using human-readable representation" $ scenarioEmulated do   addr <- newFreshAddress auto+  transferMoney addr 1 -- need at least some money to call   withSender addr do     cont <- originateSimple "failing" () failing     call cont CallDefault () &

@@ -16,7 +16,7 @@ import Lorentz as L hiding (comment) import Test.Cleveland import Test.Cleveland.Instances ()-import Test.Cleveland.Internal.Abstract (SpecificOrDefaultAliasHint(..))+import Test.Cleveland.Internal.Abstract (SpecificOrDefaultAlias(..))  publicKeyToAddress :: Contract PublicKey (Maybe Address) () publicKeyToAddress = defaultContract $@@ -32,14 +32,14 @@ test_publicKeyToAddress =   testProperty "The address is calculated correctly from the given public key" $     withTests 200 $ property $ do-      aliasHint <- fromString <$> (forAll $ Gen.string (Range.linear 0 100) Gen.unicode)-      testScenarioProps $ scenario $ scenario' aliasHint+      alias <- fromString <$> (forAll $ Gen.string (Range.linear 0 100) Gen.unicode)+      testScenarioProps $ scenario $ scenario' alias -scenario' :: (MonadCleveland caps m) => AliasHint -> m ()-scenario' aliasHint = do+scenario' :: (MonadCleveland caps m) => Alias -> m ()+scenario' alias = do   c <- originateSimple @PublicKey @(Maybe Address) "publicKeyToAddress" Nothing publicKeyToAddress -  addr1 <- newAddress $ SpecificAliasHint aliasHint+  addr1 <- newAddress $ SpecificAlias alias   addr1pk <- getPublicKey addr1    call c CallDefault addr1pk

@@ -24,6 +24,7 @@ import Lorentz.Base import Lorentz.Value import Morley.Michelson.Runtime.GState (gsAddressesL)+import Morley.Tezos.Core (Timestamp(..)) import Test.Cleveland import Test.Cleveland.Internal.Pure (psGState) import TestSuite.Util (idContract)@@ -38,6 +39,8 @@       , rcAmount = 0       , rcBalance = 0       , rcSource = Nothing+      , rcNow = Nothing+      , rcLevel = Nothing       } @@== 8   where     increment :: Contract Integer Integer ()@@ -49,7 +52,7 @@ test_emulator_state_is_not_modified :: TestTree test_emulator_state_is_not_modified =   testScenarioOnEmulator "the emulator's state is not modified" $ scenario do-    before <- use psGState+    before <- get     runCode RunCode       { rcContract = transferToSender       , rcStorage = NotRPC ()@@ -57,8 +60,10 @@       , rcAmount = 900       , rcBalance = 900       , rcSource = Nothing+      , rcNow = Just (Timestamp 1337)+      , rcLevel = Just 42       }-    after <- use psGState+    after <- get     checkComparesWith Debug.show before (==) Debug.show after   where     transferToSender :: Contract () () ()@@ -88,6 +93,8 @@       , rcAmount = 0       , rcBalance = 0       , rcSource = Nothing+      , rcNow = Nothing+      , rcLevel = Nothing       } @@== 1   where     -- | A contract that calls itself forever, increment the counter in its storage by 1 on every call.@@ -112,6 +119,8 @@       , rcAmount = 0       , rcBalance = 0       , rcSource = Nothing+      , rcNow = Nothing+      , rcLevel = Nothing       }      total @== (50, 20)@@ -133,6 +142,8 @@       , rcAmount = 0       , rcBalance = 0       , rcSource = Nothing+      , rcNow = Nothing+      , rcLevel = Nothing       }      total @== (30, 30)@@ -150,9 +161,12 @@       , rcAmount = 456       , rcBalance = 123       , rcSource = Just source+      , rcNow = Just (Timestamp 8)+      , rcLevel = Just 29       } >>= evalJust "Expected contract to return a `Some`" -    getLevel @@== envLevel envVars+    envLevel envVars @== 29+    envNow envVars @== Timestamp 8     getChainId @@== envChainId envVars     envSender envVars @== sender     envSource envVars @== source@@ -164,6 +178,7 @@       L.drop       # L.constructT @EnvVars             ( L.fieldCtor $ L.level+            , L.fieldCtor $ L.now             , L.fieldCtor $ L.chainId             , L.fieldCtor $ L.sender             , L.fieldCtor $ L.source@@ -174,6 +189,7 @@  data EnvVars = EnvVars   { envLevel :: Natural+  , envNow :: Timestamp   , envChainId :: ChainId   , envSender :: Address   , envSource :: Address@@ -213,6 +229,8 @@       , rcAmount = 0       , rcBalance = 0       , rcSource = Nothing+      , rcNow = Nothing+      , rcLevel = Nothing       } @@== Just contractAddress  test_self_address_does_not_exist_onchain :: TestTree@@ -238,6 +256,8 @@       , rcAmount = 0       , rcBalance = 0       , rcSource = Nothing+      , rcNow = Nothing+      , rcLevel = Nothing       } >>= evalJust "Expected contract to return a `Some`"      emulatorState ^. gsAddressesL . at selfAddr @== Nothing@@ -253,7 +273,7 @@ -- -- ... and stores both results in the storage. lookupBigMapKey :: Contract (MText, BigMap MText Integer) ((Integer, Integer), BigMap MText Integer) ()-lookupBigMapKey = L.mkContractWith L.intactCompilationOptions $+lookupBigMapKey = L.mkContractWith L.intactCompilationOptions $ L.mkContractCode $   L.unpair   # L.dip L.cdr   # L.unpair

@@ -115,13 +115,13 @@     contracts = [createEmptyBigMap, copyToEmptyBigMap]      createEmptyBigMap :: Contract () (BigMap MText Integer) ()-    createEmptyBigMap = L.mkContractWith L.intactCompilationOptions $+    createEmptyBigMap = L.mkContractWith L.intactCompilationOptions $ L.mkContractCode $       L.drop       # L.emptyBigMap       # L.nil # L.pair      copyToEmptyBigMap :: Contract () (BigMap MText Integer) ()-    copyToEmptyBigMap = L.mkContractWith L.intactCompilationOptions $+    copyToEmptyBigMap = L.mkContractWith L.intactCompilationOptions $ L.mkContractCode $       L.drop       # L.emptyBigMap @MText @Integer       # L.push @Integer 1@@ -139,7 +139,7 @@     unBigMapId <$> getStorage addr @@== unBigMapId id0   where     updateBigMap :: Contract () (BigMap MText Integer) ()-    updateBigMap = L.mkContractWith L.intactCompilationOptions $+    updateBigMap = L.mkContractWith L.intactCompilationOptions $ L.mkContractCode $       L.cdr       # L.push 12 # L.some       # L.push "12"@@ -190,7 +190,7 @@   where     -- Duplicate an existing bigmap, save it in the storage, and discard the old bigmap.     dupAndDiscardOld :: Contract () (BigMap MText Integer) ()-    dupAndDiscardOld = L.mkContractWith L.intactCompilationOptions $+    dupAndDiscardOld = L.mkContractWith L.intactCompilationOptions $ L.mkContractCode $       L.cdr       # L.dup       # L.dip L.drop@@ -198,7 +198,7 @@      -- Duplicate an existing bigmap, save both (the old and the new) bigmaps in the storage.     dupAndKeepBoth :: Contract () (BigMap MText Integer, BigMap MText Integer) ()-    dupAndKeepBoth = L.mkContractWith L.intactCompilationOptions $+    dupAndKeepBoth = L.mkContractWith L.intactCompilationOptions $ L.mkContractCode $       L.cdr       # L.car       # L.stackType @'[ BigMap MText Integer ]

@@ -6,7 +6,7 @@   , test_nonUnitParamToImplicitAccount_fails   ) where -import Test.Tasty (TestTree)+import Test.Tasty (TestTree, testGroup)  import Lorentz ((#)) import Lorentz qualified as L@@ -15,16 +15,16 @@ import Test.Cleveland import TestSuite.Util (idContract, shouldFailWithMessage) -test_TransferFromContract :: [TestTree]-test_TransferFromContract =-  [ testScenarioOnEmulator "Disallow transferring ꜩ when revealing a contract (#440)" $ scenarioEmulated do+test_TransferFromContract :: TestTree+test_TransferFromContract = testGroup "Transfers from contract"+  [ testScenarioOnEmulator "Forbid transfers to implicit accounts (#440)" $ scenarioEmulated do       testRevealContract morleyMessage-  , testScenarioOnNetwork "Disallow transferring ꜩ when revealing a contract (#440)" $ scenario do+  , testScenarioOnNetwork "Forbid transfers to implicit accounts (#440)" $ scenario do       testRevealContract rpcMessage -  , testScenarioOnEmulator "Disallow transferring ꜩ from an empty implicit account (#440)" $ scenario do+  , testScenarioOnEmulator "Forbid transfers to empty implicit accounts (#440)" $ scenario do       testEmptyImplicitAccount morleyMessage-  , testScenarioOnNetwork "Disallow transferring ꜩ from an empty implicit account (#440)" $ scenario do+  , testScenarioOnNetwork "Forbid transfers to empty implicit accounts (#440)" $ scenario do       testEmptyImplicitAccount rpcMessage   , testScenario "Fails transfering 0tz to plain account" $ scenario       $ testZeroTransactionFails

@@ -20,7 +20,7 @@         <- originateSimple "vp contract" 0         =<< importContract @KeyHash @Natural @() ("../../contracts/voting_power.tz") -      let keyHash = unsafe $ parseKeyHash "tz1Yq4Hj9u2f9473wAKiFEm36Sp2GfB5aTGa"+      let keyHash = unsafe $ parseHash "tz1Yq4Hj9u2f9473wAKiFEm36Sp2GfB5aTGa"       call contract CallDefault keyHash       getStorage contract @@== 0 @@ -30,8 +30,8 @@         =<< importContract @KeyHash @(Natural, Natural) @() ("../../contracts/voting_powers.tz")        comment "Setting custom voting powers to access them later"-      let keyHash = unsafe $ parseKeyHash "tz1Yq4Hj9u2f9473wAKiFEm36Sp2GfB5aTGa"-      let keyHash2 = unsafe $ parseKeyHash "tz1hvYBbHRJhT3dQ8bEjc34xm3rjJJmTcuqs"+      let keyHash = unsafe $ parseHash "tz1Yq4Hj9u2f9473wAKiFEm36Sp2GfB5aTGa"+      let keyHash2 = unsafe $ parseHash "tz1hvYBbHRJhT3dQ8bEjc34xm3rjJJmTcuqs"       setVotingPowers (mkVotingPowers [(keyHash, 123), (keyHash2, 57)])        call contract CallDefault keyHash