[#158] Pass --description option in the cleveland tests

tqtezos · Jan 21, 2021 · 14d59e2 · 14d59e2
1 parent 301188f
commit 14d59e2
Show file tree

Hide file tree

Showing 3 changed files with 37 additions and 19 deletions.
diff --git a/haskell/nettest/StablecoinClientTest.hs b/haskell/nettest/StablecoinClientTest.hs
@@ -7,10 +7,12 @@ module StablecoinClientTest
   ( stablecoinClientScenario
   ) where
 
+import Lorentz (fromVal)
 import Morley.Nettest as NT
 import Tezos.Address (Address)
 import Util.Named ((.!))
 
+import Lorentz.Contracts.Stablecoin (Storage'(..), StorageView)
 import Stablecoin.Client
   (AddressAndAlias(..), InitialStorageData(..), UpdateOperatorData(AddOperator, RemoveOperator))
 import Stablecoin.Client.Cleveland
@@ -44,14 +46,20 @@ stablecoinClientScenario = do
     , isdTokenName = "b"
     , isdTokenDecimals = 3
     , isdDefaultExpiry = 1000
-    , isdContractMetadataStorage = OpRemoteContract Nothing
+    , isdContractMetadataStorage = OpRemoteContract (Just "some description")
     }
   let contract = #contract .! AddressResolved contractAddr
   comment "Testing get-balance"
   actualBalance <- SC.getBalance contract
   expectedBalance <- NT.getBalance (AddressResolved contractAddr)
   actualBalance `assertEq` expectedBalance
 
+  comment "Testing contract metadata"
+  storage <- fromVal @StorageView <$> getStorage (AddressResolved contractAddr)
+  let _metadataBigMapID = sMetadata storage
+  -- TODO: find the key "" in the bigmap with id 'metadataBigMapID'.
+  -- Check that the metadata contains the correct description
+
   comment "Testing set/get-transferlist"
   getTransferlist contract >>= \tl ->
     tl `assertEq` Just (AddressAndAlias transferlistAddr (Just transferlistAlias))

diff --git a/haskell/src/Stablecoin/Client/Cleveland/Caps.hs b/haskell/src/Stablecoin/Client/Cleveland/Caps.hs
@@ -59,7 +59,8 @@ runStablecoinClient :: MorleyClientConfig -> MorleyClientEnv -> StablecoinScenar
 runStablecoinClient conf env scenario =
   displayUncaughtException $ do
     disableAlphanetWarning
-    uncapsStablecoin scenario (stablecoinImplClient conf env) (nettestImplClient env)
+    let nettestImpl = nettestImplClient env
+    uncapsStablecoin scenario (stablecoinImplClient conf env nettestImpl) nettestImpl
   where
     uncapsStablecoin :: forall m a. Monad m => StablecoinScenario m a -> StablecoinImpl m -> NettestImpl m -> m a
     uncapsStablecoin action stablecoinImpl nettestImpl =

diff --git a/haskell/src/Stablecoin/Client/Cleveland/StablecoinImpl.hs b/haskell/src/Stablecoin/Client/Cleveland/StablecoinImpl.hs
@@ -7,10 +7,10 @@ module Stablecoin.Client.Cleveland.StablecoinImpl
   ) where
 
 import Data.Text (isInfixOf)
-import Fmt (Buildable(build), pretty)
+import Fmt (Buildable(build), pretty, unlinesF)
 import Lorentz (arg)
 import Morley.Client (Alias, MorleyClientConfig)
-import Morley.Nettest (AddressOrAlias, MorleyClientEnv)
+import Morley.Nettest (AddressOrAlias, MorleyClientEnv, NettestImpl(niFailure))
 import Morley.Nettest.Client (revealKeyUnlessRevealed)
 import Tezos.Address (Address)
 import Tezos.Core (Mutez)
@@ -21,6 +21,7 @@ import Stablecoin.Client
 import Stablecoin.Client.Cleveland.IO
   (OutputParseError(..), addressAndAliasParser, addressParser, callStablecoinClient,
   encodeMaybeOption, labelled, mutezParser, naturalParser, runParser, textParser)
+import Stablecoin.Client.Parser (ContractMetadataOptions(OpRemoteContract))
 
 data StablecoinTestError where
   STEDiff :: forall a. Show a => a -> a -> StablecoinTestError
@@ -95,22 +96,30 @@ data StablecoinImpl m = StablecoinImpl
   }
 
 -- | Implementation of `StablecoinImpl` that defers to `stablecoin-client`.
-stablecoinImplClient :: MorleyClientConfig -> MorleyClientEnv -> StablecoinImpl IO
-stablecoinImplClient conf env = StablecoinImpl
+stablecoinImplClient :: MorleyClientConfig -> MorleyClientEnv -> NettestImpl IO -> StablecoinImpl IO
+stablecoinImplClient conf env nettestImpl = StablecoinImpl
   { siDeploy = \sender (InitialStorageData {..}) -> do
-      output <- callStablecoinClient conf $
-        [ "deploy"
-        , "--master-minter", pretty isdMasterMinter
-        , "--contract-owner", pretty isdContractOwner
-        , "--pauser", pretty isdPauser
-        , "--transferlist", pretty isdTransferlist
-        , "--token-name", pretty isdTokenName
-        , "--token-symbol", pretty isdTokenSymbol
-        , "--token-decimals", pretty isdTokenDecimals
-        , "--default-expiry", pretty isdDefaultExpiry
-        , "--replace-alias"
-        ] <> mkUserOpt sender
-      runParser output (labelled "Contract address" addressParser)
+      case isdContractMetadataStorage of
+        OpRemoteContract mbDesc -> do
+          output <- callStablecoinClient conf $
+            [ "deploy"
+            , "--master-minter", pretty isdMasterMinter
+            , "--contract-owner", pretty isdContractOwner
+            , "--pauser", pretty isdPauser
+            , "--transferlist", pretty isdTransferlist
+            , "--token-name", pretty isdTokenName
+            , "--token-symbol", pretty isdTokenSymbol
+            , "--token-decimals", pretty isdTokenDecimals
+            , "--default-expiry", pretty isdDefaultExpiry
+            , "--replace-alias"
+            ]
+            <> maybe [] (\desc -> ["--description", toString desc]) mbDesc
+            <> mkUserOpt sender
+          runParser output (labelled "Contract address" addressParser)
+        _ -> niFailure nettestImpl $ unlinesF
+              [ "StablecoinImpl only supports storing the contract's metadata in a separate dedicated."
+              , "Got: " <> show @Text isdContractMetadataStorage
+              ]
   , siTransfer = \sender contract from to amount ->
       void $ callStablecoinClient conf $
         [ "transfer"