diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,13 @@ +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) diff --git a/morley-client.cabal b/morley-client.cabal --- a/morley-client.cabal +++ b/morley-client.cabal @@ -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 diff --git a/src/Morley/Client/Action/Origination/Large.hs b/src/Morley/Client/Action/Origination/Large.hs --- a/src/Morley/Client/Action/Origination/Large.hs +++ b/src/Morley/Client/Action/Origination/Large.hs @@ -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. -- diff --git a/src/Morley/Client/OnlyRPC.hs b/src/Morley/Client/OnlyRPC.hs --- a/src/Morley/Client/OnlyRPC.hs +++ b/src/Morley/Client/OnlyRPC.hs @@ -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. diff --git a/src/Morley/Client/RPC/Class.hs b/src/Morley/Client/RPC/Class.hs --- a/src/Morley/Client/RPC/Class.hs +++ b/src/Morley/Client/RPC/Class.hs @@ -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 diff --git a/src/Morley/Client/RPC/Error.hs b/src/Morley/Client/RPC/Error.hs --- a/src/Morley/Client/RPC/Error.hs +++ b/src/Morley/Client/RPC/Error.hs @@ -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 diff --git a/src/Morley/Client/RPC/Getters.hs b/src/Morley/Client/RPC/Getters.hs --- a/src/Morley/Client/RPC/Getters.hs +++ b/src/Morley/Client/RPC/Getters.hs @@ -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" diff --git a/src/Morley/Client/TezosClient/Class.hs b/src/Morley/Client/TezosClient/Class.hs --- a/src/Morley/Client/TezosClient/Class.hs +++ b/src/Morley/Client/TezosClient/Class.hs @@ -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 (..) diff --git a/test/Test/BigMapGet.hs b/test/Test/BigMapGet.hs --- a/test/Test/BigMapGet.hs +++ b/test/Test/BigMapGet.hs @@ -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) ] diff --git a/test/Test/Fees.hs b/test/Test/Fees.hs --- a/test/Test/Fees.hs +++ b/test/Test/Fees.hs @@ -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 diff --git a/test/Test/KeyRevealing.hs b/test/Test/KeyRevealing.hs --- a/test/Test/KeyRevealing.hs +++ b/test/Test/KeyRevealing.hs @@ -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) & diff --git a/test/Test/Origination.hs b/test/Test/Origination.hs --- a/test/Test/Origination.hs +++ b/test/Test/Origination.hs @@ -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 ] diff --git a/test/Test/ParameterTypeGet.hs b/test/Test/ParameterTypeGet.hs --- a/test/Test/ParameterTypeGet.hs +++ b/test/Test/ParameterTypeGet.hs @@ -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 diff --git a/test/Test/ReadBigMapValue.hs b/test/Test/ReadBigMapValue.hs --- a/test/Test/ReadBigMapValue.hs +++ b/test/Test/ReadBigMapValue.hs @@ -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) ] diff --git a/test/Test/Transaction.hs b/test/Test/Transaction.hs --- a/test/Test/Transaction.hs +++ b/test/Test/Transaction.hs @@ -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 ] diff --git a/test/Test/Util.hs b/test/Test/Util.hs --- a/test/Test/Util.hs +++ b/test/Test/Util.hs @@ -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" diff --git a/test/TestM.hs b/test/TestM.hs --- a/test/TestM.hs +++ b/test/TestM.hs @@ -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