Resolves # 12

- running contracts with bot plutus interface

Author: mikekeke

example/Main.hs

@@ -1,57 +1,54 @@
 module Main (main) where
 
-import BotInterface.Wallet qualified as BW
 import Control.Monad (forever, replicateM_, void)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Reader (ask)
+import DSL (
+  ada,
+  addSomeWallet,
+  mkMainnetAddress,
+  report,
+  runContract,
+  runUsingCluster,
+  waitSeconds,
+ )
 import Data.Text (Text, unpack)
-import LocalCluster.Cluster (runUsingCluster)
+import DebugContract.DebugGet qualified as DebugContract
+import LocalCluster.Types (supportDir)
 import System.Environment (setEnv)
 import Tools.DebugCli qualified as CLI
-import Utils (ada, waitSeconds)
-
-import Data.Either (fromRight)
-import LocalCluster.Types (ClusterEnv (chainIndexUrl), supportDir)
-
-import BotInterface.Run qualified as Bot
-import DebugContract.DebugGet qualified as DebugContract
-
--- debug stuff
-
-import DebugContract.DebugGet qualified as DebugContract
-import Tools.ChainIndex qualified as CIX
-
--- debug stuff - END
 
 main :: IO ()
 main = do
   -- todo: maybe some better configuring procedure should be introduced
   setEnv "SHELLEY_TEST_DATA" "cluster-data/cardano-node-shelley"
   setEnv "NO_POOLS" "1"
-  setEnv "CARDANO_NODE_TRACING_MIN_SEVERITY" "Debug"
-
-  runUsingCluster $ \cEnv -> do
-    ws <- -- ? maybe it will be more ergonomic to get rid of `Ether` and just fail hard
-      BW.usingEnv cEnv . fmap sequence . sequence $
-        [ BW.addSomeWallet (ada 101)
-        , BW.addSomeWallet (ada 202)
-        , BW.addSomeWallet (ada 303)
-        ]
 
-    debugWallets ws cEnv
+  runUsingCluster $ do
+    w1 <- -- ? maybe it will be more ergonomic to get rid of `Ether` and just fail hard
+    -- as there is no reason to continue if wallet can't be set up
+      addSomeWallet (ada 101)
+    w2 <- addSomeWallet (ada 202)
 
-    let wallet = head $ tail $ fromRight (error "Ouch") ws
-    Bot.runWrapped cEnv wallet DebugContract.getUtxos >>= print
-    Bot.runWrapped cEnv wallet DebugContract.getUtxosThrowsErr >>= print
-    Bot.runWrapped cEnv wallet DebugContract.getUtxosThrowsEx >>= print
+    debugWallets (sequence [w1, w2]) --temporary, for debugging
+    testWallet <- either (error . show) pure w1
+    runContract testWallet DebugContract.getUtxos
+      >>= report
+    runContract testWallet DebugContract.getUtxosThrowsErr
+      >>= report
+    runContract testWallet DebugContract.getUtxosThrowsEx
+      >>= report
 
-    putStrLn "Done. Debug awaiting - interrupt to exit" >> forever (waitSeconds 60)
+  putStrLn "Done. Debug awaiting - interrupt to exit" >> forever (waitSeconds 60)
   where
-    debugWallets ws cEnv = do
-      putStrLn "\nDebug check:"
-      putStrLn $ "Cluster dir: " <> show (supportDir cEnv)
-      waitSeconds 2
+    debugWallets ws = do
+      cEnv <- ask
+      liftIO $ putStrLn "\nDebug check:"
+      liftIO $ putStrLn $ "Cluster dir: " <> show (supportDir cEnv)
+      liftIO $ waitSeconds 2
       either
         (error . ("Err: " <>) . show)
-        (mapM_ (CLI.utxoAtAddress cEnv . BW.mkMainnetAddress))
+        (mapM_ (liftIO . CLI.utxoAtAddress cEnv . mkMainnetAddress))
         ws
 
 testMnemonic :: [Text]

plutip.cabal

@@ -113,16 +113,17 @@ library
 
   hs-source-dirs:  src/
   exposed-modules:
-    Address
     BotInterface.Keys
     BotInterface.Run
     BotInterface.Setup
     BotInterface.Types
     BotInterface.Wallet
+    DSL
     DebugContract.DebugGet
     LocalCluster.Cluster
     LocalCluster.Types
     LocalCluster.Wallet
+    Tools.Address
     Tools.CardanoApi
     Tools.ChainIndex
     Tools.DebugCli
@@ -135,6 +136,7 @@ executable plutip-example
     , base
     , plutip
     , text
+    , mtl
 
 test-suite plutip-tests
   import:             common-imports

src/BotInterface/Run.hs

@@ -1,10 +1,10 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 
-module BotInterface.Run (execute, runWrapped) where
+module BotInterface.Run (runContract, runContract_) where
 
 import BotInterface.Setup qualified as BIS
 import BotInterface.Wallet (BpiWallet, ledgerPkh)
-import BotPlutusInterface.Contract (runContract)
+import BotPlutusInterface.Contract qualified as BIC
 import BotPlutusInterface.Types (
   CLILocation (Local),
   ContractEnvironment (ContractEnvironment),
@@ -32,39 +32,27 @@ import BotPlutusInterface.Types (
  )
 import Cardano.Api.ProtocolParameters (ProtocolParameters)
 import Control.Concurrent.STM (newTVarIO, readTVarIO)
+import Control.Monad (void)
 import Control.Monad.Catch (MonadCatch, handleAll)
 import Control.Monad.IO.Class (MonadIO, liftIO)
-import Control.Monad.Reader (MonadReader (ask), ReaderT (runReaderT))
+import Control.Monad.Reader (MonadReader (ask), ReaderT)
 import Data.Aeson (ToJSON, eitherDecodeFileStrict')
 import Data.Kind (Type)
 import Data.Row (Row)
-import Data.Text (Text, pack)
+import Data.Text (pack)
 import Data.UUID.V4 qualified as UUID
-import LocalCluster.Types (ClusterEnv (chainIndexUrl, networkId))
+import LocalCluster.Types (ClusterEnv (chainIndexUrl, networkId), FailReason (ContractErr, OtherErr), RunResult (RunFailed, RunSuccess))
 import Plutus.Contract (Contract)
 import Plutus.PAB.Core.ContractInstance.STM (Activity (Active))
 import Wallet.Types (ContractInstanceId (ContractInstanceId))
 
-data FailReason e
-  = ContractErr e
-  | OtherErr Text
-  deriving stock (Show)
-
-data RunResult w e a
-  = RunSuccess
-      { contractResult :: a
-      , contractState :: ContractState w
-      }
-  | RunFailed {reason :: FailReason e}
-  deriving stock (Show)
-
-execute ::
+runContract ::
   forall (w :: Type) (s :: Row Type) (e :: Type) (a :: Type) (m :: Type -> Type).
   (ToJSON w, Monoid w, MonadIO m, MonadCatch m) =>
   BpiWallet ->
   Contract w s e a ->
   ReaderT ClusterEnv m (RunResult w e a)
-execute bpiWallet contract =
+runContract bpiWallet contract =
   ask
     >>= readProtocolParams
     >>= either
@@ -101,15 +89,15 @@ execute bpiWallet contract =
               , ceWallet = playGroundWallet
               , ceContractInstanceId = contractInstanceID
               }
-      res <- liftIO $ runContract contractEnv playGroundWallet contract
+      res <- liftIO $ BIC.runContract contractEnv playGroundWallet contract
       case res of
         Left e -> return $ RunFailed (ContractErr e)
         Right a -> RunSuccess a <$> liftIO (readTVarIO contractState)
 
-runWrapped ::
+runContract_ ::
+  forall (w :: Type) (s :: Row Type) (e :: Type) (a :: Type) (m :: Type -> Type).
   (ToJSON w, Monoid w, MonadIO m, MonadCatch m) =>
-  ClusterEnv ->
   BpiWallet ->
   Contract w s e a ->
-  m (RunResult w e a)
-runWrapped cEnv bpiWallet contract = runReaderT (execute bpiWallet contract) cEnv
+  ReaderT ClusterEnv m ()
+runContract_ bpiWallet contract = void $ runContract bpiWallet contract

src/BotInterface/Wallet.hs

@@ -5,7 +5,6 @@ module BotInterface.Wallet (
   mkMainnetAddress,
   cardanoMainnetAddress,
   ledgerPkh,
-  whateverJsonYouNeed,
 ) where
 
 import BotInterface.Setup qualified as Setup
@@ -20,12 +19,10 @@ import Cardano.Wallet.Shelley.Launch.Cluster (
 import Control.Arrow (ArrowChoice (left))
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.Reader (MonadReader (ask), ReaderT (runReaderT))
-import Data.Aeson (encode)
 import Data.Bool (bool)
-import Data.ByteString.Lazy.Char8 qualified as C8
 import Data.Text (Text, pack, unpack)
 import GHC.Natural (Natural)
-import Ledger (Address (addressCredential), PaymentPubKeyHash (PaymentPubKeyHash), PubKey (PubKey), PubKeyHash, pubKeyHash, pubKeyHashAddress)
+import Ledger (PubKey (PubKey), PubKeyHash, pubKeyHash)
 import LocalCluster.Types (ClusterEnv, nodeSocket, supportDir)
 import Plutus.V1.Ledger.Api qualified as LAPI
 import System.FilePath ((<.>), (</>))
@@ -112,6 +109,6 @@ ledgerPkh =
     . CAPI.serialiseToRawBytes
     . vrfKey
 
-whateverJsonYouNeed :: BpiWallet -> String
-whateverJsonYouNeed wallet =
-  (C8.unpack $ encode $ addressCredential $ pubKeyHashAddress (PaymentPubKeyHash $ ledgerPkh wallet) Nothing)
+-- whateverJsonYouNeed :: BpiWallet -> String
+-- whateverJsonYouNeed wallet =
+--   (C8.unpack $ encode $ addressCredential $ pubKeyHashAddress (PaymentPubKeyHash $ ledgerPkh wallet) Nothing)

src/DSL.hs

@@ -0,0 +1,30 @@
+module DSL (
+  BpiWallet,
+  addSomeWallet,
+  runContract,
+  runContract_,
+  runUsingCluster,
+  runUsingCluster',
+  ada,
+  waitSeconds,
+  report,
+  mkMainnetAddress,
+  cardanoMainnetAddress,
+) where
+
+import BotInterface.Run (runContract, runContract_)
+import BotInterface.Wallet (
+  BpiWallet,
+  addSomeWallet,
+  cardanoMainnetAddress,
+  mkMainnetAddress,
+ )
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import LocalCluster.Cluster (runUsingCluster, runUsingCluster')
+import Utils (ada, waitSeconds)
+
+{- | Stand-in for upcoming report functionality
+ (just print out for now)
+-}
+report :: (Show a, MonadIO m) => a -> m ()
+report = liftIO . print

src/DebugContract/DebugGet.hs

@@ -1,20 +1,20 @@
 module DebugContract.DebugGet (getUtxos, getUtxosThrowsErr, getUtxosThrowsEx) where
 
+import Data.Map (Map)
 import Data.Text (Text, pack)
-import Ledger (pubKeyHashAddress, TxOutRef, ChainIndexTxOut)
+import Ledger (ChainIndexTxOut, TxOutRef, pubKeyHashAddress)
 import Plutus.Contract (Contract, utxosAt)
 import Plutus.Contract qualified as Contract
 import Plutus.PAB.Effects.Contract.Builtin (EmptySchema)
 import Text.Printf (printf)
-import Data.Map (Map)
 
 getUtxos :: Contract () EmptySchema Text (Map TxOutRef ChainIndexTxOut)
 getUtxos = do
   pkh <- Contract.ownPaymentPubKeyHash
   Contract.logInfo @String $ printf "Own PKH: %s" (show pkh)
   utxosAt $ pubKeyHashAddress pkh Nothing
 
-getUtxosThrowsErr :: Contract () EmptySchema Text  (Map TxOutRef ChainIndexTxOut)
+getUtxosThrowsErr :: Contract () EmptySchema Text (Map TxOutRef ChainIndexTxOut)
 getUtxosThrowsErr = do
   pkh <- Contract.ownPaymentPubKeyHash
   Contract.logInfo @String $ printf "Own PKH: %s" (show pkh)
@@ -28,7 +28,7 @@ getUtxosThrowsErr = do
           , "Debug: Own UTxOs: " <> show utxos <> "\n"
           ]
 
-getUtxosThrowsEx :: Contract () EmptySchema Text  (Map TxOutRef ChainIndexTxOut)
+getUtxosThrowsEx :: Contract () EmptySchema Text (Map TxOutRef ChainIndexTxOut)
 getUtxosThrowsEx = do
   pkh <- Contract.ownPaymentPubKeyHash
   Contract.logInfo @String $ printf "Own PKH: %s" (show pkh)

src/LocalCluster/Cluster.hs

@@ -3,7 +3,7 @@
 -- temporary measure while module under development
 {-# OPTIONS_GHC -Wno-unused-imports #-}
 
-module LocalCluster.Cluster (runUsingCluster) where
+module LocalCluster.Cluster (runUsingCluster, runUsingCluster') where
 
 import BotInterface.Setup qualified as BotSetup
 import Cardano.Api qualified as CAPI
@@ -68,6 +68,7 @@ import Control.Arrow (
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.Async (async)
 import Control.Monad (unless, void, when)
+import Control.Monad.Reader (ReaderT (runReaderT))
 import Control.Tracer (
   Tracer,
   contramap,
@@ -111,13 +112,15 @@ import Test.Integration.Faucet (
 {- | Start cluster and run action using provided `CalusterEnv`
  under development (mostly borrowed from `cardano-wallet`)
 -}
+runUsingCluster :: ReaderT ClusterEnv IO () -> IO ()
+runUsingCluster act = runUsingCluster' (runReaderT act)
 
 {- Examples:
    `plutus-apps` local cluster: https://github.com/input-output-hk/plutus-apps/blob/75a581c6eb98d36192ce3d3f86ea60a04bc4a52a/plutus-pab/src/Plutus/PAB/LocalCluster/Run.hs
    `cardano-wallet` local cluster: https://github.com/input-output-hk/cardano-wallet/blob/99b13e50f092ffca803fd38b9e435c24dae05c91/lib/shelley/exe/local-cluster.hs
 -}
-runUsingCluster :: (ClusterEnv -> IO ()) -> IO ()
-runUsingCluster action = do
+runUsingCluster' :: (ClusterEnv -> IO ()) -> IO ()
+runUsingCluster' action = do
   checkProcessesAvailable ["cardano-node", "cardano-cli"]
   withLocalClusterSetup $ \dir clusterLogs _walletLogs -> do
     withLoggingNamed "cluster" clusterLogs $ \(_, (_, trCluster)) -> do

src/LocalCluster/Types.hs

@@ -1,8 +1,11 @@
 module LocalCluster.Types (
   ClusterEnv (..),
+  RunResult (..),
+  FailReason (..),
   nodeSocket,
 ) where
 
+import BotPlutusInterface.Types (ContractState)
 import Cardano.Api (NetworkId)
 import Cardano.BM.Tracing (Trace)
 import Cardano.Launcher.Node (CardanoNodeConn)
@@ -23,3 +26,16 @@ data ClusterEnv = ClusterEnv
 -- | Helper function to get socket path from
 nodeSocket :: ClusterEnv -> CardanoNodeConn
 nodeSocket (ClusterEnv (RunningNode sp _ _) _ _ _ _) = sp
+
+data FailReason e
+  = ContractErr e
+  | OtherErr Text
+  deriving stock (Show)
+
+data RunResult w e a
+  = RunSuccess
+      { contractResult :: a
+      , contractState :: ContractState w
+      }
+  | RunFailed {reason :: FailReason e}
+  deriving stock (Show)

src/Address.hs src/Tools/Address.hssrc/Address.hs renamed to src/Tools/Address.hs

@@ -1,5 +1,5 @@
 -- | Cardano-Api/Ledger/Cardano-Wallet address conversions
-module Address (
+module Tools.Address (
   walletToCardano,
   walletToCardanoAny,
   walletToLedger,

src/Tools/DebugCli.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE ViewPatterns #-}
-
 module Tools.DebugCli (
   debugCli,
   utxoAtAddress,