packages feed

morley-client 0.1.1 → 0.1.2

raw patch · 17 files changed

+149/−152 lines, 17 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Morley.Client: mceClientEnvL :: forall m_a1sYc. Lens' (MorleyClientEnv' m_a1sYc) ClientEnv
+ Morley.Client: mceClientEnvL :: forall m_a1tcq. Lens' (MorleyClientEnv' m_a1tcq) ClientEnv
- Morley.Client: mceLogActionL :: forall m_a1sYc m_a1sYT. Lens (MorleyClientEnv' m_a1sYc) (MorleyClientEnv' m_a1sYT) (ClientLogAction m_a1sYc) (ClientLogAction m_a1sYT)
+ Morley.Client: mceLogActionL :: forall m_a1tcq m_a1td7. Lens (MorleyClientEnv' m_a1tcq) (MorleyClientEnv' m_a1td7) (ClientLogAction m_a1tcq) (ClientLogAction m_a1td7)
- Morley.Client: mceSecretKeyL :: forall m_a1sYc. Lens' (MorleyClientEnv' m_a1sYc) (Maybe SecretKey)
+ Morley.Client: mceSecretKeyL :: forall m_a1tcq. Lens' (MorleyClientEnv' m_a1tcq) (Maybe SecretKey)
- Morley.Client: mceTezosClientL :: forall m_a1sYc. Lens' (MorleyClientEnv' m_a1sYc) TezosClientEnv
+ Morley.Client: mceTezosClientL :: forall m_a1tcq. Lens' (MorleyClientEnv' m_a1tcq) TezosClientEnv
- Morley.Client.Env: mceClientEnvL :: forall m_a1sYc. Lens' (MorleyClientEnv' m_a1sYc) ClientEnv
+ Morley.Client.Env: mceClientEnvL :: forall m_a1tcq. Lens' (MorleyClientEnv' m_a1tcq) ClientEnv
- Morley.Client.Env: mceLogActionL :: forall m_a1sYc m_a1sYT. Lens (MorleyClientEnv' m_a1sYc) (MorleyClientEnv' m_a1sYT) (ClientLogAction m_a1sYc) (ClientLogAction m_a1sYT)
+ Morley.Client.Env: mceLogActionL :: forall m_a1tcq m_a1td7. Lens (MorleyClientEnv' m_a1tcq) (MorleyClientEnv' m_a1td7) (ClientLogAction m_a1tcq) (ClientLogAction m_a1td7)
- Morley.Client.Env: mceSecretKeyL :: forall m_a1sYc. Lens' (MorleyClientEnv' m_a1sYc) (Maybe SecretKey)
+ Morley.Client.Env: mceSecretKeyL :: forall m_a1tcq. Lens' (MorleyClientEnv' m_a1tcq) (Maybe SecretKey)
- Morley.Client.Env: mceTezosClientL :: forall m_a1sYc. Lens' (MorleyClientEnv' m_a1sYc) TezosClientEnv
+ Morley.Client.Env: mceTezosClientL :: forall m_a1tcq. Lens' (MorleyClientEnv' m_a1tcq) TezosClientEnv
- Morley.Client.Util: withAmount :: forall cp_a1miO st_a1miP. Lens' (RunContractParameters cp_a1miO st_a1miP) Mutez
+ Morley.Client.Util: withAmount :: forall cp_a1mx2 st_a1mx3. Lens' (RunContractParameters cp_a1mx2 st_a1mx3) Mutez
- Morley.Client.Util: withBalance :: forall cp_a1miO st_a1miP. Lens' (RunContractParameters cp_a1miO st_a1miP) Mutez
+ Morley.Client.Util: withBalance :: forall cp_a1mx2 st_a1mx3. Lens' (RunContractParameters cp_a1mx2 st_a1mx3) Mutez
- Morley.Client.Util: withSender :: forall cp_a1miO st_a1miP. Lens' (RunContractParameters cp_a1miO st_a1miP) (Maybe Address)
+ Morley.Client.Util: withSender :: forall cp_a1mx2 st_a1mx3. Lens' (RunContractParameters cp_a1mx2 st_a1mx3) (Maybe Address)
- Morley.Client.Util: withSource :: forall cp_a1miO st_a1miP. Lens' (RunContractParameters cp_a1miO st_a1miP) (Maybe Address)
+ Morley.Client.Util: withSource :: forall cp_a1mx2 st_a1mx3. Lens' (RunContractParameters cp_a1mx2 st_a1mx3) (Maybe Address)

Files

CHANGES.md view
@@ -1,6 +1,13 @@ <!-- Unreleased: append new entries here -->  +0.1.2+=====+* [!1017](https://gitlab.com/morley-framework/morley/-/merge_requests/1017)+  Resolve some TODOs and link TODOs without issue id to the corresponding gitlab tickets.+* [!1082](https://gitlab.com/morley-framework/morley/-/merge_requests/1082)+  Fix/drop/comment noncanonical Show instances+ 0.1.1 ===== * [!1094](https://gitlab.com/morley-framework/morley/-/merge_requests/1094)
morley-client.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           morley-client-version:        0.1.1+version:        0.1.2 synopsis:       Client to interact with the Tezos blockchain description:    A client to interact with the Tezos blockchain, by use of the tezos-node RPC and/or of the tezos-client binary. category:       Blockchain
src/Morley/Client/Action/Origination/Large.hs view
@@ -1,10 +1,7 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA --- TODO: ideally the "originator" contract would be the same for every large--- contract, but due to a bug (tezos/tezos/1154) we cannot push @big_map@s right--- before calling @CREATE_CONTRACT@, so we have to store those in the originator.--- When that bug gets fixed we should reconsider changing the implementation.+-- TODO [#606]: reconsider the implementation  -- | Functions to originate large smart contracts via @tezos-client@ and node RPC. --
src/Morley/Client/OnlyRPC.hs view
@@ -136,7 +136,7 @@   -- We return a dummy value here, because this function is used in a lot of   -- places and with an exception here it's not possible to send transactions.   -- So be aware of this and do not rely on this value!-  -- TODO #652: consider using a `Map` instead+  -- TODO [#652]: consider using a `Map` instead   getAlias _ = pure (mkAlias "MorleyOnlyRpc")    -- Actions that are not supported and simply throw exceptions.
src/Morley/Client/RPC/Class.hs view
@@ -2,7 +2,7 @@ -- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | An abstraction layer over RPC implementation.--- The primary reason it exists is to make it possible to mock+-- The primary reason it exists is to make it possible to fake -- RPC in tests.  module Morley.Client.RPC.Class
src/Morley/Client/RPC/Error.hs view
@@ -10,7 +10,6 @@   ) where  import Fmt (Buildable(..), blockListF, pretty, (+|), (|+))-import Text.Show qualified (show)  import Morley.Micheline (Expression) import Morley.Tezos.Address@@ -99,6 +98,7 @@ data UnexpectedErrors   = UnexpectedRunErrors [RunError]   | UnexpectedInternalErrors [InternalError]+  deriving stock (Show)  instance Buildable UnexpectedErrors where   build = \case@@ -108,9 +108,6 @@     UnexpectedInternalErrors errs ->       "RPC failed with unexpected internal errors:\n" +|       mconcat (map ((<> "\n\n") . build) errs) |+ ""--instance Show UnexpectedErrors where-  show = pretty  instance Exception UnexpectedErrors where   displayException = pretty
src/Morley/Client/RPC/Getters.hs view
@@ -37,7 +37,6 @@ import Fmt (Buildable(..), pretty, (+|), (|+)) import Network.HTTP.Types.Status (statusCode) import Servant.Client (ClientError(..), responseStatusCode)-import Text.Show qualified  import Lorentz (NicePackedValue, NiceUnpackedValue, niceUnpackedValueEvi, valueToScriptExpr) import Lorentz.Value@@ -55,9 +54,8 @@ import Morley.Client.RPC.Types  data ContractGetCounterAttempt = ContractGetCounterAttempt Address+  deriving stock (Show) instance Exception ContractGetCounterAttempt-instance Show ContractGetCounterAttempt where-  show = pretty instance Buildable ContractGetCounterAttempt where   build (ContractGetCounterAttempt addr) =     "Failed to get counter of contract '" <> build addr <> "', " <>@@ -65,18 +63,16 @@  -- | Failed to decode received value to the given type. data ValueDecodeFailure = ValueDecodeFailure Text T+  deriving stock (Show) instance Exception ValueDecodeFailure-instance Show ValueDecodeFailure where-  show = pretty instance Buildable ValueDecodeFailure where   build (ValueDecodeFailure desc ty) =     "Failed to decode value with expected type " <> build ty <> " \     \for '" <> build desc <> "'"  data ValueNotFound = ValueNotFound+  deriving stock (Show) instance Exception ValueNotFound-instance Show ValueNotFound where-  show = pretty instance Buildable ValueNotFound where   build ValueNotFound =     "Value with such coordinates is not found in contract big maps"
src/Morley/Client/TezosClient/Class.hs view
@@ -2,7 +2,7 @@ -- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | Abstraction layer for @tezos-client@ functionality.--- We use it to mock @tezos-client@ in tests.+-- We use it to fake @tezos-client@ in tests.  module Morley.Client.TezosClient.Class   ( HasTezosClient (..)
test/Test/BigMapGet.hs view
@@ -29,7 +29,7 @@   { hGetContractBigMap = \blkId addr GetBigMap{..} -> do       assertHeadBlockId blkId       st <- get-      case lookup addr (msContracts st) of+      case lookup addr (fsContracts st) of         Nothing -> throwM $ UnknownContract $ AddressResolved addr         Just ContractState{..} -> case csContractData of           ImplicitContractData _ -> throwM $ UnexpectedImplicitContract addr@@ -40,10 +40,10 @@               Just serializedValue -> pure $ GetBigMapResult $ decodeExpression serializedValue   } -mockStateWithBigMapContract-  :: MockState-mockStateWithBigMapContract = defaultMockState-  { msContracts = fromList $+fakeStateWithBigMapContract+  :: FakeState+fakeStateWithBigMapContract = defaultFakeState+  { fsContracts = fromList $     [ (genesisAddress1, dumbContractState         { csContractData = (csContractData dumbContractState) & \case             ContractData os _ -> ContractData os $ Just $@@ -58,21 +58,21 @@     bigMapId = BigMapId 123  test_BigMapGetUnit :: TestTree-test_BigMapGetUnit = testGroup "Mock test big map getter"+test_BigMapGetUnit = testGroup "Fake test big map getter"   [ testCase "Successful big map get" $ handleSuccessfulGet $-    runMockTest bigMapGetHandlers mockStateWithBigMapContract $+    runFakeTest bigMapGetHandlers fakeStateWithBigMapContract $       readContractBigMapValue @'TInt @'TInt genesisAddress1 $         L.toVal (3 :: Integer)   , testCase "Value not found in big map" $ handleValueNotFound $-    runMockTest bigMapGetHandlers mockStateWithBigMapContract $+    runFakeTest bigMapGetHandlers fakeStateWithBigMapContract $       readContractBigMapValue @'TInt @'TInt genesisAddress1 $         L.toVal (4 :: Integer)   , testCase "Contract without big map" $ handleContractWithoutBigMap $-    runMockTest bigMapGetHandlers mockStateWithBigMapContract $+    runFakeTest bigMapGetHandlers fakeStateWithBigMapContract $       readContractBigMapValue @'TInt @'TInt genesisAddress2 $         L.toVal (2 :: Integer)   , testCase "Big map get for unknown contract" $ handleUnknownContract $-    runMockTest bigMapGetHandlers mockStateWithBigMapContract $+    runFakeTest bigMapGetHandlers fakeStateWithBigMapContract $       readContractBigMapValue @'TInt @'TInt genesisAddress3 $         L.toVal (2 :: Integer)   ]
test/Test/Fees.hs view
@@ -21,10 +21,10 @@ import Test.Util import TestM -mockState-  :: MockState-mockState = defaultMockState-  { msContracts = fromList $+fakeState+  :: FakeState+fakeState = defaultFakeState+  { fsContracts = fromList $     [ (genesisAddress1, dumbImplicitContractState)     , (genesisAddress2, dumbContractState)     ]@@ -34,7 +34,7 @@ countForgesHandlers = chainOperationHandlers   { hForgeOperation = \blkId op -> do       assertHeadBlockId blkId-      liftToMockTest $ modify (+1)+      liftToFakeTest $ modify (+1)       hForgeOperation chainOperationHandlers blkId op    , hRunOperation = \blkId RunOperation{..} -> do@@ -60,7 +60,7 @@ runForgesCountingTest :: HasCallStack => TestT (State Word) a -> Word runForgesCountingTest action = do   let (res, count) =-        usingState 0 $ runMockTestT countForgesHandlers mockState action+        usingState 0 $ runFakeTestT countForgesHandlers fakeState action   case res of     Left e -> error . toText $ "Test action failed: " <> displayException e     Right _ -> count
test/Test/KeyRevealing.hs view
@@ -17,18 +17,18 @@ import Test.Util import TestM -mockState :: MockState-mockState = defaultMockState-  { msContracts = one ( genesisAddress1+fakeState :: FakeState+fakeState = defaultFakeState+  { fsContracts = one ( genesisAddress1                       , dumbImplicitContractState                           { csContractData = ImplicitContractData $ Just dumbManagerKey }                       )   }  test_keyRevealing :: TestTree-test_keyRevealing = testGroup "Mock test key revealing"+test_keyRevealing = testGroup "Fake test key revealing"   [ testCase "Manager key for new address is revealed only once for transfer" $ handleSuccess $-    runMockTest chainOperationHandlers mockState $ do+    runFakeTest chainOperationHandlers fakeState $ do       senderAddress <- genKey $ AnAlias "sender"       dummyTransfer genesisAddress1 senderAddress       mbManagerKey <- getManagerKey senderAddress@@ -47,7 +47,7 @@         (dummyTransfer senderAddress genesisAddress1)    , testCase "Manager key for new address is revealed only once for origination" $ handleSuccess $-    runMockTest chainOperationHandlers mockState $ do+    runFakeTest chainOperationHandlers fakeState $ do       originatorAddress <- genKey $ AnAlias "originator"       dummyTransfer genesisAddress1 originatorAddress @@ -67,7 +67,7 @@         (originateDummy originatorAddress)    , testCase "Transfer from contract fails with proper error message, without details about revealing" $-    (runMockTest chainOperationHandlers mockState $ do+    (runFakeTest chainOperationHandlers fakeState $ do       (_, addr) <- originateDummy genesisAddress1       dummyTransfer addr genesisAddress1)     &
test/Test/Origination.hs view
@@ -18,10 +18,10 @@ import Test.Util import TestM -mockState-  :: MockState-mockState = defaultMockState-  { msContracts = fromList $+fakeState+  :: FakeState+fakeState = defaultFakeState+  { fsContracts = fromList $     [ (genesisAddress1, dumbImplicitContractState)     , (genesisAddress2, dumbContractState)     ]@@ -34,11 +34,11 @@ test_lRunTransactionsUnit :: TestTree test_lRunTransactionsUnit = testGroup "Mock test transaction sending"   [ testCase "Successful origination" $ handleSuccess $-    runMockTest chainOperationHandlers mockState $+    runFakeTest chainOperationHandlers fakeState $       lOriginateContract True "dummy" (AddressResolved genesisAddress1) [tz|100500u|]       dumbLorentzContract () Nothing   , testCase "Originator doesn't exist" $ handleUnknownContract $-    runMockTest chainOperationHandlers mockState $+    runFakeTest chainOperationHandlers fakeState $       lOriginateContract True "dummy" (AddressResolved genesisAddress3) [tz|100500u|]       dumbLorentzContract () Nothing   ]
test/Test/ParameterTypeGet.hs view
@@ -48,10 +48,10 @@ smartContractAddr2 = ContractAddress contractHash2 smartContractAddr3 = ContractAddress contractHash3 -mockStateWithSmartContracts-  :: MockState-mockStateWithSmartContracts = defaultMockState-  { msContracts = fromList $+fakeStateWithSmartContracts+  :: FakeState+fakeStateWithSmartContracts = defaultFakeState+  { fsContracts = fromList $     [ (smartContractAddr1, buildSmartContractState "lol" (testContract @Natural))     , (smartContractAddr2, buildSmartContractState "kek" (testContract @Bool))     , (genesisAddress1, dumbImplicitContractState)@@ -59,9 +59,9 @@   }  test_parameterTypeGetUnit :: TestTree-test_parameterTypeGetUnit = testGroup "Mock test big map getter"+test_parameterTypeGetUnit = testGroup "Fake test big map getter"   [ testCase "Only parameters for smart contracts are extracted" $ expectContractMap-    (runMockTest chainOperationHandlers mockStateWithSmartContracts $+    (runFakeTest chainOperationHandlers fakeStateWithSmartContracts $       getContractsParameterTypes       [genesisAddress1, smartContractAddr1, smartContractAddr2]     ) $ fromList@@ -70,7 +70,7 @@     ]   , testCase "Parameter type for nonexistent smart contract is not extracted" $     expectContractMap-    (runMockTest chainOperationHandlers mockStateWithSmartContracts $+    (runFakeTest chainOperationHandlers fakeStateWithSmartContracts $       getContractsParameterTypes       [smartContractAddr3]     ) $ Map.empty
test/Test/ReadBigMapValue.hs view
@@ -22,10 +22,10 @@   { hGetBigMapValue = handleGetBigMapValue   } -mockStateWithBigMapContract-  :: MockState-mockStateWithBigMapContract = defaultMockState-  { msContracts = fromList $+fakeStateWithBigMapContract+  :: FakeState+fakeStateWithBigMapContract = defaultFakeState+  { fsContracts = fromList $     [ (genesisAddress1, dumbContractState          { csContractData = (csContractData dumbContractState) & \case              ContractData os _ -> ContractData os $ Just $@@ -52,7 +52,7 @@   testGroup "readBigMapValue"     [ testCase "Retrieves existing value" $         resultShouldBe 5 $-          runMockTest bigMapGetHandlers mockStateWithBigMapContract $+          runFakeTest bigMapGetHandlers fakeStateWithBigMapContract $             readBigMapValue validBigMapId (3 :: Integer)     ] @@ -61,14 +61,14 @@   testGroup "readBigMapValueMaybe"     [ testCase "Retrieves existing value" $         resultShouldBe (Just 5) $-          runMockTest bigMapGetHandlers mockStateWithBigMapContract $+          runFakeTest bigMapGetHandlers fakeStateWithBigMapContract $             readBigMapValueMaybe validBigMapId (3 :: Integer)     , testCase "Returns Nothing when contract does not exist" $         resultShouldBe Nothing $-          runMockTest bigMapGetHandlers mockStateWithBigMapContract $+          runFakeTest bigMapGetHandlers fakeStateWithBigMapContract $             readBigMapValueMaybe invalidBigMapId (3 :: Integer)     , testCase "Returns Nothing when key does not exist" $         resultShouldBe Nothing $-          runMockTest bigMapGetHandlers mockStateWithBigMapContract $+          runFakeTest bigMapGetHandlers fakeStateWithBigMapContract $             readBigMapValueMaybe validBigMapId (9 :: Integer)     ]
test/Test/Transaction.hs view
@@ -18,27 +18,27 @@ import Test.Util import TestM -mockState-  :: MockState-mockState = defaultMockState-  { msContracts = fromList $+fakeState+  :: FakeState+fakeState = defaultFakeState+  { fsContracts = fromList $     [ (genesisAddress1, dumbImplicitContractState)     , (genesisAddress2, dumbContractState)     ]   }  test_lRunTransactionsUnit :: TestTree-test_lRunTransactionsUnit = testGroup "Mock test transaction sending"+test_lRunTransactionsUnit = testGroup "Fake test transaction sending"   [ testCase "Successful transaction" $ handleSuccess $-    runMockTest chainOperationHandlers mockState $+    runFakeTest chainOperationHandlers fakeState $       lTransfer genesisAddress1 genesisAddress2         [tz|10u|] DefEpName () Nothing   , testCase "Sender doesn't exist" $ handleUnknownContract $-    runMockTest chainOperationHandlers mockState $+    runFakeTest chainOperationHandlers fakeState $       lTransfer genesisAddress3 genesisAddress2         [tz|10u|] DefEpName () Nothing   , testCase "Destination doesn't exist" $ handleUnknownContract $-    runMockTest chainOperationHandlers mockState $+    runFakeTest chainOperationHandlers fakeState $       lTransfer genesisAddress1 genesisAddress3         [tz|10u|] DefEpName () Nothing   ]
test/Test/Util.hs view
@@ -1,7 +1,7 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA --- | Module with various helpers that are used in morley-client mock tests.+-- | Module with various helpers that are used in morley-client fake tests. module Test.Util   ( chainOperationHandlers   , dumbContractState@@ -45,7 +45,7 @@ import TestM  -- | Function to convert given map to big map representation--- used in mock state.+-- used in fake state. mapToContractStateBigMap   :: forall k v. (NicePackedValue k, NicePackedValue v)   => BigMapId k v -> Map k v -> ContractStateBigMap@@ -58,7 +58,7 @@   , csbmId = bigMapId   } --- | Initial simple contract mock state.+-- | Initial simple contract fake state. dumbContractState :: ContractState dumbContractState = ContractState   { csCounter = 100500@@ -78,7 +78,7 @@   , csContractData = ImplicitContractData Nothing   } --- | Mock handlers used for transaction sending and contract origination.+-- | Fake handlers used for transaction sending and contract origination. chainOperationHandlers :: Monad m => Handlers (TestT m) chainOperationHandlers = defaultHandlers   { hGetBlockHash = handleGetBlockHash@@ -122,45 +122,45 @@   unless (blkId == FinalHeadId) do     throwString "Expected `getBlockHash` to be called with `head~2`." -  MockState{..} <- get-  pure msFinalHeadBlock+  FakeState{..} <- get+  pure fsFinalHeadBlock  handleGetCounter-  :: ( MonadState MockState m+  :: ( MonadState FakeState m      , MonadThrow m      )   => BlockId -> Address -> m TezosInt64 handleGetCounter blk addr = do   assertHeadBlockId blk-  MockState{..} <- get-  case lookup addr msContracts of+  FakeState{..} <- get+  case lookup addr fsContracts of     Nothing -> throwM $ UnknownContract $ AddressResolved addr     Just ContractState{..} -> pure $ csCounter  handleGetBlockConstants-  :: MonadState MockState m+  :: MonadState FakeState m   => BlockId -> m BlockConstants handleGetBlockConstants blkId = do-  MockState{..} <- get-  pure $ msBlockConstants blkId+  FakeState{..} <- get+  pure $ fsBlockConstants blkId  handleGetProtocolParameters-  :: (MonadState MockState m, MonadThrow m)+  :: (MonadState FakeState m, MonadThrow m)   => BlockId -> m ProtocolParameters handleGetProtocolParameters blk = do   assertHeadBlockId blk-  MockState{..} <- get-  pure $ msProtocolParameters+  FakeState{..} <- get+  pure $ fsProtocolParameters  handleRunOperation :: Monad m => BlockId -> RunOperation -> TestT m RunOperationResult handleRunOperation blk RunOperation{..} = do   assertHeadBlockId blk-  MockState{..} <- get-  -- Ensure that passed chain id matches with one that mock state has-  unless (roChainId == bcChainId (msBlockConstants blk)) (throwM $ InvalidChainId)+  FakeState{..} <- get+  -- Ensure that passed chain id matches with one that fake state has+  unless (roChainId == bcChainId (fsBlockConstants blk)) (throwM $ InvalidChainId)   -- As of release of the ithaca protocol, the "branch" field should be "head~2".   -- https://web.archive.org/web/20220305165609/https://tezos.gitlab.io/protocols/tenderbake.html-  unless (roiBranch roOperation == msFinalHeadBlock) do+  unless (roiBranch roOperation == fsFinalHeadBlock) do     throwM $ InvalidBranch $ roiBranch roOperation   originatedContracts <- handleRunOperationInternal roOperation   pure $ mkRunOperationResult originatedContracts@@ -168,13 +168,13 @@ handlePreApplyOperation :: Monad m => BlockId -> PreApplyOperation -> TestT m RunOperationResult handlePreApplyOperation blk PreApplyOperation{..} = do   assertHeadBlockId blk-  MockState{..} <- get+  FakeState{..} <- get   -- Ensure that passed protocol matches with one that mock state has-  unless (paoProtocol == bcProtocol (msBlockConstants blk)) $+  unless (paoProtocol == bcProtocol (fsBlockConstants blk)) $     throwM InvalidProtocol   -- As of release of the ithaca protocol, the "branch" field should be "head~2".   -- https://web.archive.org/web/20220305165609/https://tezos.gitlab.io/protocols/tenderbake.html-  unless (paoBranch == msFinalHeadBlock) do+  unless (paoBranch == fsFinalHeadBlock) do     throwM $ InvalidBranch paoBranch   originatedContracts <- concatMapM handleTransactionOrOrigination paoContents   pure $ mkRunOperationResult originatedContracts@@ -185,7 +185,7 @@   ms <- get   -- As of release of the ithaca protocol, the "branch" field should be "head~2".   -- https://web.archive.org/web/20220305165609/https://tezos.gitlab.io/protocols/tenderbake.html-  unless (foBranch op == msFinalHeadBlock ms) do+  unless (foBranch op == fsFinalHeadBlock ms) do     throwM $ InvalidBranch $ foBranch op   pure . HexJSONByteString . LBS.toStrict . encode $ op @@ -196,19 +196,19 @@ handleTransactionOrOrigination   :: Monad m => OperationInput -> TestT m [Address] handleTransactionOrOrigination op = do-  MockState{..} <- get+  FakeState{..} <- get   case oiCustom op of     -- Ensure that transaction sender exists-    OpTransfer TransactionOperation{..} -> case lookup codSource msContracts of+    OpTransfer TransactionOperation{..} -> case lookup codSource fsContracts of       Nothing -> throwM $ UnknownContract $ AddressResolved codSource       Just ContractState{..} -> do         -- Ensure that sender counter matches         unless (csCounter + 1 == codCounter) (throwM CounterMismatch)-        case lookup toDestination msContracts of+        case lookup toDestination fsContracts of           Nothing -> throwM $ UnknownContract $ AddressResolved toDestination           Just _ -> pure []     -- Ensure that originator exists-    OpOriginate _ -> case lookup codSource msContracts of+    OpOriginate _ -> case lookup codSource fsContracts of       Nothing -> throwM $ UnknownContract $ AddressResolved codSource       Just ContractState{..} -> do         -- Ensure that originator counter matches@@ -228,7 +228,7 @@   throwString "Accessing non-head block is not supported in tests"  handleGetContractScript-  :: ( MonadState MockState m+  :: ( MonadState FakeState m      , MonadThrow m      )   => BlockId@@ -236,8 +236,8 @@   -> m OriginationScript handleGetContractScript blockId addr = do   assertHeadBlockId blockId-  MockState{..} <- get-  case lookup addr msContracts of+  FakeState{..} <- get+  case lookup addr fsContracts of     Nothing -> throwM $ err404 path     Just ContractState{..} -> case csContractData of       ImplicitContractData _ -> throwM $ UnexpectedImplicitContract addr@@ -252,7 +252,7 @@    let allBigMaps :: [ContractStateBigMap] =         catMaybes $-          Map.elems (msContracts st) <&> \cs -> case (csContractData cs) of+          Map.elems (fsContracts st) <&> \cs -> case (csContractData cs) of             ContractData _ bigMapMaybe -> bigMapMaybe             ImplicitContractData _ -> Nothing @@ -278,11 +278,11 @@ handleRememberContract replaceExisting addr (getAlias -> alias) = do   let     cs = dumbContractState { csAlias = alias }-    remember addr' cs' MockState{..} =-      modify $ \s -> s { msContracts = insert addr' cs' msContracts }+    remember addr' cs' FakeState{..} =+      modify $ \s -> s { fsContracts = insert addr' cs' fsContracts } -  st@MockState{..} <- get-  case lookup addr msContracts of+  st@FakeState{..} <- get+  case lookup addr fsContracts of     Nothing -> remember addr cs st     _       -> bool pass (remember addr cs st) replaceExisting @@ -292,15 +292,15 @@     addr = detGenKeyAddress (encodeUtf8 $ unsafeGetAliasText alias)     newContractState = dumbImplicitContractState { csAlias =  alias }   modify $ \s ->-    s & msContractsL . at addr ?~ newContractState+    s & fsContractsL . at addr ?~ newContractState   pure addr  handleGetAlias :: Monad m => AddressOrAlias -> TestT m Alias handleGetAlias = \case   AddressAlias alias -> pure alias   AddressResolved addr -> do-    MockState{..} <- get-    case lookup addr msContracts of+    FakeState{..} <- get+    case lookup addr fsContracts of       Nothing                -> throwM $ UnknownContract $ AddressResolved addr       Just ContractState{..} -> pure $ csAlias @@ -308,7 +308,7 @@ handleGetManagerKey blk addr = do   assertHeadBlockId blk   s <- get-  let mbCs = s ^. msContractsL . at addr+  let mbCs = s ^. fsContractsL . at addr   case mbCs of     Just ContractState{..} -> case csContractData of       ImplicitContractData mbManagerKey -> pure mbManagerKey@@ -316,7 +316,7 @@     Nothing -> throwM $ UnknownContract $ AddressResolved addr  -- In scenarios where the system under test checks for 404 errors, we--- use this function to mock and simulate those errors.+-- use this function to fake and simulate those errors. err404 :: Text -> ClientError err404 path = FailureResponse   (defaultRequest { requestBody = Nothing, requestPath = (baseUrl , "") })@@ -339,8 +339,8 @@ handleResolveAddressMaybe = \case   AddressResolved addr -> pure (Just addr)   AddressAlias alias -> do-    MockState{..} <- get-    case find checkAlias $ Map.toList msContracts of+    FakeState{..} <- get+    case find checkAlias $ Map.toList fsContracts of       Just (addr, _) -> pure (Just addr)       Nothing -> pure Nothing     where@@ -348,7 +348,7 @@  handleRevealKey :: Monad m => Alias -> Maybe ScrubbedBytes -> TestT m () handleRevealKey alias _ = do-  contracts <- gets (Map.toList . msContracts)+  contracts <- gets (Map.toList . fsContracts)   let contracts' = filter (\(_, ContractState{..}) -> csAlias == alias) contracts   case contracts' of     []  -> throwM $ UnknownContract $ AddressAlias alias@@ -361,13 +361,13 @@         (KeyAddress _, ImplicitContractData Nothing) ->             -- We don't care about the public key itself, but only its presence.             let newContractState = cs { csContractData = ImplicitContractData $ Just dumbManagerKey }-            in modify $ \s -> s & msContractsL . at addr ?~ newContractState-        _ -> error "Inconsitent mock state. This most likely a bug in tests."+            in modify $ \s -> s & fsContractsL . at addr ?~ newContractState+        _ -> error "Inconsitent fake state. This most likely a bug in tests."     _   ->       error $ "Multiple contracts have alias '" +| alias |+         "'. This is most likely a bug in tests." --- | Dummy public key used in mock tests.+-- | Dummy public key used in fake tests. dumbManagerKey :: PublicKey dumbManagerKey = fromRight (error "impossible") $ parsePublicKey   "edpkuwTWKgQNnhR5v17H2DYHbfcxYepARyrPGbf1tbMoGQAj8Ljr3V"
test/TestM.hs view
@@ -4,25 +4,25 @@ {-# OPTIONS_GHC -Wno-orphans #-}  -- | Module that defines some basic infrastructure--- for mocking tezos-node RPC interaction.+-- for faking tezos-node RPC interaction. module TestM   ( ContractData (..)   , ContractState (..)   , ContractStateBigMap (..)   , Handlers (..)-  , MockState (..)+  , FakeState (..)   , TestError (..)   , TestHandlers (..)   , TestM   , TestT   , defaultHandlers-  , defaultMockState-  , runMockTest-  , runMockTestT-  , liftToMockTest+  , defaultFakeState+  , runFakeTest+  , runFakeTestT+  , liftToFakeTest    -- * Lens-  , msContractsL+  , fsContractsL   ) where  import Colog.Core.Class (HasLog(..))@@ -48,7 +48,7 @@ instance IsString Alias where   fromString = mkAlias . fromString --- | Reader environment to interact with the mock state.+-- | Reader environment to interact with the fake state. data Handlers m = Handlers   { -- HasTezosRpc     hGetBlockHash :: BlockId -> m Text@@ -135,7 +135,7 @@   , hLogAction = mempty   } --- | Type to represent contract state in the @MockState@.+-- | Type to represent contract state in the @FakeState@. -- This type can represent both implicit accounts and contracts. data ContractState = ContractState   { csCounter :: TezosInt64@@ -160,22 +160,22 @@ newtype TestHandlers m = TestHandlers {unTestHandlers :: Handlers (TestT m)}  -- | Type to represent chain state in mock tests.-data MockState = MockState-  { msContracts :: Map Address ContractState-  , msHeadBlock :: Text+data FakeState = FakeState+  { fsContracts :: Map Address ContractState+  , fsHeadBlock :: Text   -- ^ Hash of the `head` block-  , msFinalHeadBlock :: Text+  , fsFinalHeadBlock :: Text   -- ^ Hash of the `head~2` block-  , msBlockConstants :: BlockId -> BlockConstants-  , msProtocolParameters :: ProtocolParameters+  , fsBlockConstants :: BlockId -> BlockConstants+  , fsProtocolParameters :: ProtocolParameters   } -defaultMockState :: MockState-defaultMockState = MockState-  { msContracts = mempty-  , msHeadBlock = "HEAD"-  , msFinalHeadBlock = "HEAD~2"-  , msBlockConstants = \blkId -> BlockConstants+defaultFakeState :: FakeState+defaultFakeState = FakeState+  { fsContracts = mempty+  , fsHeadBlock = "HEAD"+  , fsFinalHeadBlock = "HEAD~2"+  , fsBlockConstants = \blkId -> BlockConstants     { bcProtocol = "PROTOCOL"     , bcChainId = "CHAIN_ID"     , bcHeader = BlockHeaderNoHash@@ -185,32 +185,32 @@       }     , bcHash = BlockHash $ pretty blkId     }-  , msProtocolParameters = ProtocolParameters 257 1040000 60000 15+  , fsProtocolParameters = ProtocolParameters 257 1040000 60000 15                                               (TezosMutez [tz|250u|])   } -type TestT m = StateT MockState (ReaderT (TestHandlers m) (CatchT m))+type TestT m = StateT FakeState (ReaderT (TestHandlers m) (CatchT m))  type TestM = TestT Identity -runMockTestT+runFakeTestT   :: forall a m. Monad m =>-     Handlers (TestT m) -> MockState -> TestT m a -> m (Either SomeException a)-runMockTestT handlers mockState action =-  runCatchT $ runReaderT (evalStateT action mockState) (TestHandlers handlers)+     Handlers (TestT m) -> FakeState -> TestT m a -> m (Either SomeException a)+runFakeTestT handlers fakeState action =+  runCatchT $ runReaderT (evalStateT action fakeState) (TestHandlers handlers) -runMockTest-  :: forall a. Handlers TestM -> MockState -> TestM a -> Either SomeException a-runMockTest =-  runIdentity ... runMockTestT+runFakeTest+  :: forall a. Handlers TestM -> FakeState -> TestM a -> Either SomeException a+runFakeTest =+  runIdentity ... runFakeTestT  getHandler :: Monad m => (Handlers (TestT m) -> fn) -> TestT m fn getHandler fn = fn . unTestHandlers <$> ask -liftToMockTest :: Monad m => m a -> TestT m a-liftToMockTest = lift . lift . lift+liftToFakeTest :: Monad m => m a -> TestT m a+liftToFakeTest = lift . lift . lift --- | Various mock test errors.+-- | Various fake test errors. data TestError   = AlreadyRevealed Address   | UnexpectedRpcCall Text@@ -338,4 +338,4 @@     h <- getHandler hGetDelegateAtBlock     h block addr -makeLensesFor [("msContracts", "msContractsL")] ''MockState+makeLensesFor [("fsContracts", "fsContractsL")] ''FakeState