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 +7/−0
- morley-client.cabal +1/−1
- src/Morley/Client/Action/Origination/Large.hs +1/−4
- src/Morley/Client/OnlyRPC.hs +1/−1
- src/Morley/Client/RPC/Class.hs +1/−1
- src/Morley/Client/RPC/Error.hs +1/−4
- src/Morley/Client/RPC/Getters.hs +3/−7
- src/Morley/Client/TezosClient/Class.hs +1/−1
- test/Test/BigMapGet.hs +10/−10
- test/Test/Fees.hs +6/−6
- test/Test/KeyRevealing.hs +7/−7
- test/Test/Origination.hs +6/−6
- test/Test/ParameterTypeGet.hs +7/−7
- test/Test/ReadBigMapValue.hs +8/−8
- test/Test/Transaction.hs +8/−8
- test/Test/Util.hs +46/−46
- test/TestM.hs +35/−35
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