[#77] Implement stablecoin-client

.buildkite/pipeline.yml

@@ -3,7 +3,7 @@
 
 env:
   FETCH_CONTRACT:
-    "mkdir -p test/resources/ && buildkite-agent artifact download stablecoin.tz test/resources/ --step \"LIGO-contract\""
+    "mkdir -p haskell/test/resources/ && buildkite-agent artifact download stablecoin.tz haskell/test/resources/ --step \"LIGO-contract\""
 
 steps:
  - label: hlint
@@ -21,20 +21,23 @@ steps:
    if: *not_scheduled
    label: xrefcheck
    soft_fail: true
- - label: build library
-   if: *not_scheduled
-   command: nix build -L -f. lib
  - label: LIGO-contract
    commands:
      - nix-build -A tezos-contract -o stablecoin_raw.tz
      - nix run -f. morley -c morley optimize --contract stablecoin_raw.tz --output stablecoin.tz
    artifact_paths:
      - stablecoin.tz
+ - label: build library
+   if: *not_scheduled
+   commands:
+     - eval "$FETCH_CONTRACT"
+     - nix build -L -f. lib
  - label: test
    if: *not_scheduled
    commands:
      - eval "$FETCH_CONTRACT"
-     - nix build -L -f. test
+     - cd haskell
+     - nix build -L -f .. test
      - ./result/bin/stablecoin-test
  - label: nettest-local-chain
    if: *not_scheduled
@@ -44,10 +47,10 @@ steps:
      NETTEST_NODE_PORT: "8734"
      MONEYBAG: "unencrypted:edsk3GjD83F7oj2LrnRGYQer99Fj69U2QLyjWGiJ4UoBZNQwS38J4v"
    commands: &run-nettest
-     - nix build -L -f. nettest
-     - cd haskell/
      - eval "$FETCH_CONTRACT"
-     - nix run -f ../ tezos-client -c ../scripts/ci/run-local-chain-nettest.sh ../result/bin/stablecoin-nettest
+     - cd haskell/
+     - nix build -L -f ../ nettest
+     - nix run -f ../ tezos-client stablecoin-client -c ../scripts/ci/run-local-chain-nettest.sh ./result/bin/stablecoin-nettest
    retry: &retry-nettest
       automatic:
         limit: 1
@@ -66,6 +69,7 @@ steps:
  - label: weeder
    if: *not_scheduled
    commands:
+     - eval "$FETCH_CONTRACT"
      - cd haskell
      - nix-build .. -A weeder-script
      # weeder needs .cabal file:

Makefile

@@ -16,7 +16,8 @@ all: build-ligo build-haskell
 build-ligo:
 	$(MAKE_LIGO) stablecoin.tz
 
-# Build everything haskell-related (including tests and benchmarks) with development options.
+# Compile LIGO contract and then build everything haskell-related (including tests and benchmarks)
+# with development options.
 build-haskell:
 	$(MAKE_HASKELL) build
 

README.md

@@ -19,6 +19,11 @@ Apart from LIGO implementation of the contract we have [a Haskell library](haske
 It is based on the [morley framework](https://gitlab.com/morley-framework/morley).
 It allows us to use features of `morley` (such as testing engine) with this contract.
 
+## Stablecoin client
+
+We have a `stablecoin-client` executable that allows deploying and interacting with the stablecoin contract.
+Please refer to the [`haskell/`] directory for details.
+
 ## Tests
 
 Tests are implemented in the same Haskell package.

default.nix

@@ -53,5 +53,6 @@ in
   lib = project.stablecoin.components.library;
   test = project.stablecoin.components.tests.stablecoin-test;
   nettest = project.stablecoin.components.tests.stablecoin-nettest;
+  stablecoin-client = project.stablecoin.components.exes.stablecoin-client;
   inherit tezos-contract tezos-client pkgs weeder-script morley;
 }

haskell/.weeder.yaml

@@ -7,6 +7,11 @@
     - message:
       - name: Redundant build-depends entry
       - depends: base-noprelude
+  - section:
+    - name: exe:stablecoin-client
+    - message:
+      - name: Redundant build-depends entry
+      - depends: base-noprelude
   - section:
     - name: library
     - message:

haskell/Makefile

@@ -34,6 +34,7 @@ endef
 
 # Build everything haskell-related (including tests and benchmarks) with development options.
 build:
+	$(call build_stablecoin_contract)
 	stack build $(STACK_DEV_OPTIONS) $(STACK_BUILD_MORE_OPTIONS) $(PACKAGE)
 
 test:
@@ -59,10 +60,12 @@ nettest:
 
 # Run haddock for all packages.
 haddock:
+	$(call build_stablecoin_contract)
 	stack haddock $(STACK_DEV_OPTIONS) $(PACKAGE)
 
 # Run haddock for all our packages, but not for dependencies.
 haddock-no-deps:
+	$(call build_stablecoin_contract)
 	stack haddock $(STACK_DEV_OPTIONS) $(PACKAGE) --no-haddock-deps
 
 stylish:

haskell/README.md

@@ -5,12 +5,28 @@ SPDX-License-Identifier: MIT
 
 # Stablecoin Haskell
 
-This folder contains a Haskell library to interact with the stablecoin contract (basically Haskell bindings) and tests for it.
+This folder contains:
+
+1. a Haskell library to interact with the stablecoin contract (basically Haskell bindings) and tests for it.
+2. a `stablecoin-client` executable to deploy and interact with the stablecoin contract.
 
 ## Build Instructions
 
 You need [Stack](http://haskellstack.org/) to build this package.
-Run `stack build` to build the library.
+
+To build the library and the executable:
+1. Copy the stablecoin contract to `test/resources/stablecoin.tz` and then run `stack build`.
+2. Or, alternatively, run `make build`.
+
+Run `stack install` to install the `stablecoin-client` globally.
+
+## Run Instructions
+
+Pre-requisites: `tezos-client` must be installed.
+
+If the `stablecoin-client` was installed globally with `stack install`, then run `stablecoin-client --help`
+to see a list of the available commands.
+Otherwise, run `stack run stablecoin-client -- --help`.
 
 ## Tests
 

haskell/client/Main.hs

@@ -0,0 +1,11 @@
+-- SPDX-FileCopyrightText: 2020 tqtezos
+-- SPDX-License-Identifier: MIT
+
+module Main
+  ( main
+  ) where
+
+import Stablecoin.Client.Main
+
+main :: IO ()
+main = mainProgramIO

haskell/nettest/Main.hs

@@ -11,28 +11,33 @@ import qualified Indigo.Contracts.Transferlist.External as External
 import qualified Indigo.Contracts.Transferlist.Internal as Internal
 import Lorentz (ToT, compileLorentzContract, toVal)
 import Lorentz.Contracts.Test.Common
-import Michelson.Runtime (parseExpandContract, prepareContract)
+import Michelson.Runtime (parseExpandContract)
 import Michelson.Typed (untypeValue)
 import Michelson.Typed.Convert (convertContract)
 import Morley.Nettest
-import Nettest (scNettestScenario)
 import Tezos.Address
 import Util.IO
 import Util.Named
 
+import Nettest (scNettestScenario)
+import Stablecoin.Client.Cleveland.Caps (runStablecoinClient)
+import Stablecoin.Client.Contract (parseStablecoinContract)
+import StablecoinClientTest (stablecoinClientScenario)
+
 externalTransferlistContractPath :: FilePath
 externalTransferlistContractPath = "test/resources/transferlist.tz"
 
 main :: IO ()
 main = do
-  let clientParser = clientConfigParser . pure $ Just "nettest.Stablecoin"
+  let aliasPrefix = "nettest.Stablecoin"
+  let clientParser = clientConfigParser . pure $ Just aliasPrefix
   parsedConfig <- execParser $
     parserInfo
       (#usage .! mempty)
       (#description .! "Stablecoin nettest scenarioWithInternalTransferlist")
       (#header .! "ManagedLedger nettest")
       (#parser .! clientParser)
-  stablecoinContract <- prepareContract $ Just "test/resources/stablecoin.tz"
+  stablecoinContract <- parseStablecoinContract
   externalTransferlistFile <- readFileUtf8 externalTransferlistContractPath
   externalTransferlistContract <- either (error "cannot parse transferlist contract") pure $
     parseExpandContract (Just externalTransferlistContractPath) externalTransferlistFile
@@ -73,3 +78,5 @@ main = do
 
   runNettestClient env scenarioWithInternalTransferlist
   runNettestClient env scenarioWithExternalTransferlist
+
+  runStablecoinClient parsedConfig env (stablecoinClientScenario aliasPrefix)

haskell/nettest/Nettest.hs

@@ -90,23 +90,23 @@ scNettestScenario constructInitialStorage stablecoinContract originateTransferli
       (#amount .! value)
 
     callTransferWithOperator op from to value =
-      callFrom (AddressResolved op) sc (ep "transfer") (tp from to value)
+      callFrom' (AddressResolved op) sc (ep "transfer") (tp from to value)
 
     callTransfer = join callTransferWithOperator
 
     callTransfers
       :: [("from_" :! Address, [("to_" :! Address, "amount" :! Natural)])]
       -> capsM ()
     callTransfers = mapM_ $ \(from@(arg #from_ -> from_), destinations) ->
-      callFrom
+      callFrom'
         (AddressResolved from_)
         sc
         (ep "transfer")
         (constructTransfersFromSender from destinations)
 
     configureMinter :: Address -> Address -> Maybe Natural -> Natural -> capsM ()
     configureMinter from for expectedAllowance newAllowance =
-      callFrom
+      callFrom'
         (AddressResolved from)
         sc
         (ep "configure_minter")
@@ -116,103 +116,103 @@ scNettestScenario constructInitialStorage stablecoinContract originateTransferli
 
     removeMinter :: Address -> Address -> capsM ()
     removeMinter from whom =
-      callFrom
+      callFrom'
         (AddressResolved from)
         sc
         (ep "remove_minter")
         whom
 
     addOperatorNettest :: Address -> Address -> capsM ()
     addOperatorNettest from op =
-      callFrom
+      callFrom'
         (AddressResolved from)
         sc
         (ep "update_operators")
         [FA2.Add_operator (#owner .! from, #operator .! op)]
 
     removeOperator :: Address -> Address -> capsM ()
     removeOperator from op =
-      callFrom
+      callFrom'
         (AddressResolved from)
         sc
         (ep "update_operators")
         [FA2.Remove_operator (#owner .! from, #operator .! op)]
 
     mint :: Address -> Natural -> capsM ()
     mint to_ value =
-      callFrom
+      callFrom'
         (AddressResolved to_)
         sc
         (ep "mint")
         [(#to_ .! to_, #amount .! value)]
 
     burn :: Address -> Natural -> capsM ()
     burn from amount_ =
-      callFrom
+      callFrom'
         (AddressResolved from)
         sc
         (ep "burn")
         [amount_]
 
     pause :: Address -> capsM ()
     pause from =
-      callFrom
+      callFrom'
         (AddressResolved from)
         sc
         (ep "pause")
         ()
 
     unpause :: Address -> capsM ()
     unpause from =
-      callFrom
+      callFrom'
         (AddressResolved from)
         sc
         (ep "unpause")
         ()
 
     transferOwnership :: Address -> Address -> capsM ()
     transferOwnership from to =
-      callFrom
+      callFrom'
         (AddressResolved from)
         sc
         (ep "transfer_ownership")
         to
 
     acceptOwnership :: Address -> capsM ()
     acceptOwnership from =
-      callFrom
+      callFrom'
         (AddressResolved from)
         sc
         (ep "accept_ownership")
         ()
 
     changeMasterMinter :: Address -> Address -> capsM ()
     changeMasterMinter from to =
-      callFrom
+      callFrom'
         (AddressResolved from)
         sc
         (ep "change_master_minter")
         to
 
     changePauser :: Address -> Address -> capsM ()
     changePauser from to =
-      callFrom
+      callFrom'
         (AddressResolved from)
         sc
         (ep "change_pauser")
         to
 
     setTransferlist :: Address -> Address -> capsM ()
     setTransferlist from transferlistAddress =
-      callFrom
+      callFrom'
         (AddressResolved from)
         sc
         (ep "set_transferlist")
         (Just transferlistAddress)
 
     unsetTransferlist :: Address -> capsM ()
     unsetTransferlist from =
-      callFrom
+      callFrom'
         (AddressResolved from)
         sc
         (ep "set_transferlist")
@@ -344,3 +344,29 @@ scNettestScenario constructInitialStorage stablecoinContract originateTransferli
   burnScenario
   permissionReassigmentScenario
   transferlistScenario
+
+-- This is a temporary solution.
+-- Changes made in cleveland's `callFrom` have caused some issues when calling
+-- entrypoints other than the default.
+-- So we've temporarily copied the old `callFrom` implementation here and
+-- renamed it to `callFrom'`.
+-- See discussion here: https://github.com/tqtezos/stablecoin/pull/79#discussion_r464983707
+--
+-- TODO: delete this after these comments have been addressed:
+-- https://gitlab.com/morley-framework/morley/-/merge_requests/499#note_388448660
+callFrom'
+  :: (MonadNettest caps base m, NiceParameter v)
+  => AddressOrAlias
+  -> AddressOrAlias
+  -> EpName
+  -> v
+  -> m ()
+callFrom' from to epName param =
+  transfer $
+    TransferData
+      { tdFrom = from
+      , tdTo = to
+      , tdAmount = zeroMutez
+      , tdEntrypoint = epName
+      , tdParameter = param
+      }