Deploy m (#4)

* DeployM

* move to types

* main compiles

* fix console log

* tests pass

src/ContractConfig.purs

@@ -24,7 +24,7 @@ simpleStorageConfig =
     }
   where
     simpleStorageArgs = do
-      _count <- uIntNFromBigNumber $ embed 12345
+      _count <- uIntNFromBigNumber $ embed 1234
       pure {_count}
 
 --------------------------------------------------------------------------------

src/Deploy.purs

@@ -6,13 +6,14 @@ module Deploy
 
 import Prelude
 import Control.Error.Util ((??))
-import Control.Monad.Aff (Aff, Milliseconds(..), liftEff', attempt)
-import Control.Monad.Aff.Class (liftAff)
+import Control.Monad.Aff (Milliseconds(..), attempt)
+import Control.Monad.Aff.Class (class MonadAff, liftAff)
 import Control.Monad.Aff.Console (CONSOLE)
 import Control.Monad.Aff.Console as C
 import Control.Monad.Aff.Unsafe (unsafeCoerceAff)
-import Control.Monad.Except (ExceptT(..), runExceptT, throwError)
-import Control.Monad.Eff.Exception (throw)
+import Control.Monad.Except (ExceptT(..), runExceptT)
+import Control.Monad.Error.Class (class MonadThrow, throwError)
+import Control.Monad.Reader.Class (class MonadAsk, ask)
 import Data.Argonaut (stringify, _Object, _String, jsonEmptyObject, (~>), (:=))
 import Data.Argonaut.Parser (jsonParser)
 import Data.Either (Either(..), either)
@@ -21,29 +22,29 @@ import Data.Lens ((^?), (?~), (%~))
 import Data.Lens.Index (ix)
 import Data.Maybe (isNothing, fromJust)
 import Data.StrMap as M
-import Network.Ethereum.Web3 (ETH, Web3, Address, BigNumber, HexString, TransactionOptions, mkHexString, _data, fromWei, _value, runWeb3, mkAddress)
+import Network.Ethereum.Web3 (runWeb3)
 import Network.Ethereum.Web3.Api (eth_sendTransaction)
-import Network.Ethereum.Web3.Types (NoPay)
+import Network.Ethereum.Web3.Types (NoPay, ETH, Web3, Address, BigNumber, HexString, TransactionOptions, TransactionReceipt(..), mkHexString, _data, fromWei, _value, mkAddress)
 import Network.Ethereum.Web3.Types.Provider (Provider)
-import Data.Newtype (unwrap)
 import Node.Encoding (Encoding(UTF8))
 import Node.FS.Aff (FS, readTextFile, writeTextFile)
 import Node.Path (FilePath)
 import Partial.Unsafe (unsafePartial)
-import Utils (withTimeout, pollTransactionReceipt, reportIfErrored)
-import Types (DeployConfig, ContractConfig)
+import Utils (withTimeout, pollTransactionReceipt)
+import Types (DeployM, DeployError(..), DeployConfig(..), ContractConfig)
 
 
 -- | Fetch the bytecode from a solidity build artifact
 getBytecode
-  :: forall eff.
-     FilePath
+  :: forall eff m.
+     MonadAff (fs :: FS | eff) m
+  => FilePath
   -- ^ filename of contract artifact
-  -> Aff (fs :: FS | eff) (Either String HexString)
+  -> m (Either String HexString)
 getBytecode filename = runExceptT $ do
-  artifact <- ExceptT $ jsonParser <$> readTextFile UTF8 filename
+  artifact <- ExceptT $ jsonParser <$> liftAff (readTextFile UTF8 filename)
   bytecode <- (artifact ^? _Object <<< ix "bytecode" <<< _String) ?? "artifact missing 'bytecode' field."
-  mkHexString bytecode ?? "bytecode not a valid hex string"
+  mkHexString bytecode ?? "bytecode not a valid hex) string"
 
 -- | Publish a contract based on the bytecode. Used for contracts with no constructor.
 defaultPublishContract
@@ -60,58 +61,62 @@ defaultPublishContract txOpts bytecode =
 -- | the given id.
 -- | TODO: this currently overwrites the entire network object
 writeDeployAddress
-  :: forall eff.
-     FilePath
+  :: forall eff m.
+     MonadAff (fs :: FS | eff) m
+  => FilePath
   -- filename of contract artifact
   -> Address
   -- deployed contract address
   -> BigNumber
   -- network id
-  -> Aff (fs :: FS | eff) (Either String Unit)
+  -> m (Either String Unit)
 writeDeployAddress filename deployAddress nid = runExceptT $ do
-  artifact <- ExceptT $ jsonParser <$> readTextFile UTF8 filename
+  artifact <- ExceptT $ jsonParser <$> liftAff (readTextFile UTF8 filename)
   let networkIdObj = "address" := show deployAddress ~> jsonEmptyObject
       artifactWithAddress = artifact # _Object <<< ix "networks" <<< _Object %~ M.insert (show nid) networkIdObj
   liftAff $ writeTextFile UTF8 filename $ stringify artifactWithAddress
 
 readDeployAddress
-  :: forall eff.
-     FilePath
+  :: forall eff m.
+     MonadThrow DeployError m
+  => MonadAff (fs :: FS | eff) m
+  => FilePath
   -- contract filepath
   -> BigNumber
   -- network id
-  -> Aff (fs :: FS | eff) Address
+  -> m Address
 readDeployAddress filepath nid = do
   eAddr <- runExceptT $ do
-    artifact <- ExceptT $ jsonParser <$> readTextFile UTF8 filepath
+    artifact <- ExceptT $ jsonParser <$> liftAff (readTextFile UTF8 filepath)
     let maddress = do
           addrString <- artifact ^? _Object <<< ix "networks" <<< _Object <<< ix (show nid) <<< _Object <<< ix "address" <<< _String
           mkAddress =<< mkHexString addrString
     maddress ?? ("Couldn't find valid Deploy Address in artifact: " <> filepath)
-  either (liftEff' <<< throw) pure eAddr
+  either (throwError <<< ConfigurationError) pure eAddr
 
 getPublishedContractAddress
-  :: forall eff.
-     HexString
+  :: forall eff m.
+     MonadThrow DeployError m
+  => MonadAff (console :: CONSOLE, eth :: ETH | eff) m
+  => HexString
    -- ^ publishing transaction hash
   -> Provider
   -- ^ web3 connection
   -> String
   -- ^ contract name
-  -> Aff (eth :: ETH, console :: CONSOLE | eff) Address
+  -> m Address
 getPublishedContractAddress txHash provider name = do
-  C.log $ "Polling for TransactionReceipt: " <> show txHash
-  etxReceipt <- attempt $ withTimeout (Milliseconds $ 90.0 * 1000.0) (pollTransactionReceipt txHash provider)
-  case unwrap <$> etxReceipt of
-    Left err -> do
-      liftAff $ C.error $ "No Transaction Receipt found for deployment : " <> name <> " : " <> show txHash
-      liftAff $ throwError err
-    Right txReceipt ->
+  liftAff <<< C.log $ "Polling for TransactionReceipt: " <> show txHash
+  etxReceipt <- liftAff <<< attempt $ withTimeout (Milliseconds $ 90.0 * 1000.0) (pollTransactionReceipt txHash provider)
+  case etxReceipt of
+    Left err ->
+      let errMsg = "No Transaction Receipt found for deployment : " <> name <> " : " <> show txHash
+      in throwError $ OnDeploymentError errMsg
+    Right (TransactionReceipt txReceipt) ->
       if txReceipt.status == "0x0" || isNothing (unNullOrUndefined txReceipt.contractAddress)
-         then do
+         then
             let missingMessage = "Deployment failed to create contract, no address found or status 0x0 in receipt: " <> name
-            liftAff $ C.error missingMessage
-            liftAff $ liftEff' $ throw missingMessage
+            in throwError $ OnDeploymentError missingMessage
          else do
            let contractAddress = unsafePartial fromJust <<< unNullOrUndefined $ txReceipt.contractAddress
            liftAff <<< C.log $ "Contract " <> name <> " deployed to address " <> show contractAddress
@@ -121,48 +126,69 @@ getPublishedContractAddress txHash provider name = do
 -- | from the primary account, writing the contract address to the artifact.
 deployContractNoArgs
   :: forall eff.
-     DeployConfig
-  -> ContractConfig ()
+     ContractConfig ()
   -> TransactionOptions NoPay
-  -> Aff (eth :: ETH, console :: CONSOLE, fs :: FS | eff) Address
-deployContractNoArgs cfg@{provider} {filepath, name} txOpts = do
+  -> DeployM eff Address
+deployContractNoArgs {filepath, name} txOpts = do
+  cfg@(DeployConfig {provider}) <- ask
   bytecode <- do
     ebc <- getBytecode filepath
-    reportIfErrored ("Couln't find contract bytecode in artifact " <> filepath) ebc
+    case ebc of
+      Left err ->
+        let errMsg = "Couln't find contract bytecode in artifact " <> filepath <> " -- " <> show err
+        in throwError $ ConfigurationError errMsg
+      Right bc -> pure bc
   let deployAction =  defaultPublishContract txOpts bytecode
-  deployContractAndWriteToArtifact cfg filepath name deployAction
+  deployContractAndWriteToArtifact filepath name deployAction
 
 -- | `deployContractWithArgs` grabs the bytecode from the artifact and uses the
 -- | args defined in the contract config to deploy, then writes the address
 -- | to the artifact.
 deployContractWithArgs
-  :: forall eff args.
-     DeployConfig
-  -> ContractConfig (deployArgs :: args)
+  :: forall eff args m.
+     MonadThrow DeployError m
+  => MonadAsk DeployConfig m
+  => MonadAff (console :: CONSOLE, eth :: ETH, fs :: FS | eff) m
+  => ContractConfig (deployArgs :: args)
   -> (HexString -> args -> Web3 eff HexString)
-  -> Aff (eth :: ETH, console :: CONSOLE, fs :: FS | eff) Address
-deployContractWithArgs cfg@{provider, primaryAccount} {filepath, name, deployArgs} deployer = do
+  -> m Address
+deployContractWithArgs {filepath, name, deployArgs} deployer = do
+  cfg@(DeployConfig {provider, primaryAccount}) <- ask
   bytecode <- do
     ebc <- getBytecode filepath
-    reportIfErrored ("Couln't find contract bytecode in artifact " <> filepath) ebc
-  deployContractAndWriteToArtifact cfg filepath name (deployer bytecode deployArgs)
+    case ebc of
+      Left err ->
+        let errMsg = "Couln't find contract bytecode in artifact " <> filepath
+        in throwError $ ConfigurationError errMsg
+      Right bc -> pure bc
+  deployContractAndWriteToArtifact filepath name (deployer bytecode deployArgs)
 
 -- | The common deployment function for contracts with or without args.
 deployContractAndWriteToArtifact
-  :: forall eff.
-     DeployConfig
-  -> FilePath
+  :: forall eff m.
+     MonadThrow DeployError m
+  => MonadAsk DeployConfig m
+  => MonadAff (console :: CONSOLE , eth :: ETH, fs :: FS | eff) m
+  => FilePath
   -- ^ artifact filepath
   -> String
   -- ^ contract name
   -> Web3 eff HexString
   -- ^ deploy action returning txHash
-  -> Aff (eth :: ETH, console :: CONSOLE, fs :: FS | eff) Address
-deployContractAndWriteToArtifact {provider, networkId, primaryAccount} filepath name deployAction = do
-    C.log $ "Deploying contract " <> name
-    etxHash <- unsafeCoerceAff $ runWeb3 provider deployAction
-    txHash <- reportIfErrored ("Web3 error during contract deployment for " <> show name) etxHash
-    contractAddress <- getPublishedContractAddress txHash provider name
-    writeDeployAddress filepath contractAddress networkId >>= reportIfErrored ("Failed to write address for artifact " <> filepath)
-    pure contractAddress
-
+  -> m Address
+deployContractAndWriteToArtifact filepath name deployAction = do
+  (DeployConfig {provider, networkId, primaryAccount}) <- ask
+  liftAff $ C.log $ "Deploying contract " <> name
+  etxHash <- liftAff <<< unsafeCoerceAff $ runWeb3 provider deployAction
+  case etxHash of
+    Left err ->
+      let errMsg = "Web3 error during contract deployment for " <> show name <> " -- " <> show err
+      in throwError $ OnDeploymentError errMsg
+    Right txHash -> do
+      contractAddress <- getPublishedContractAddress txHash provider name
+      eWriteRes <- writeDeployAddress filepath contractAddress networkId
+      case eWriteRes of
+        Left err ->
+          let errMsg = "Failed to write address for artifact " <> filepath <> " -- " <> err
+          in throwError $ PostDeploymentError errMsg
+        Right _ -> pure contractAddress

src/Main.purs

@@ -1,34 +1,44 @@
 module Main where
 
 import Prelude
-import Control.Monad.Aff (launchAff, liftEff')
+import Control.Monad.Aff (launchAff)
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE)
+import Control.Monad.Except (runExceptT)
+import Data.Either (Either(..))
 import Data.Lens ((?~))
 import Data.Maybe (fromJust)
 import Network.Ethereum.Web3 (ETH, defaultTransactionOptions, _from, _gas)
 import Network.Ethereum.Web3.Types.BigNumber (parseBigNumber, decimal)
 import Node.FS.Aff (FS)
+import Node.Process (PROCESS)
 import Partial.Unsafe (unsafePartial)
-
+import Control.Monad.Reader.Class (ask)
 import Contracts.SimpleStorage as SimpleStorage
 import Contracts.ParkingAuthority as ParkingAuthority
 
 import Deploy (deployContractWithArgs, deployContractNoArgs)
 import Utils (makeDeployConfig, validateDeployArgs)
 import ContractConfig (simpleStorageConfig, foamCSRConfig, makeParkingAuthorityConfig)
+import Types (DeployConfig(..), runDeployM, logDeployError)
 
-
--- | TODO: This passing of config indicates a ReaderMonad
-main :: forall e. Eff (eth :: ETH, console :: CONSOLE, fs :: FS | e) Unit
+main :: forall e. Eff (console :: CONSOLE, eth :: ETH, fs :: FS, process :: PROCESS | e) Unit
 main = void <<< launchAff $ do
-  deployCfg <- makeDeployConfig
-  let bigGasLimit = unsafePartial fromJust $ parseBigNumber decimal "9000000"
-      txOpts = defaultTransactionOptions # _from ?~ deployCfg.primaryAccount
-                                         # _gas ?~ bigGasLimit
-  ssConfig <- liftEff' $ validateDeployArgs simpleStorageConfig
-  _ <- deployContractWithArgs deployCfg ssConfig $ SimpleStorage.constructor txOpts
-  foamCSR <- deployContractNoArgs deployCfg foamCSRConfig txOpts
-  let parkingAuthorityConfig = makeParkingAuthorityConfig {foamCSR}
-  _ <- deployContractWithArgs deployCfg parkingAuthorityConfig $ ParkingAuthority.constructor txOpts
-  pure unit
+  edeployConfig <- runExceptT $ makeDeployConfig
+  case edeployConfig of
+    Left err -> logDeployError err *> pure unit
+    Right deployConfig -> do
+      eRes <- flip runDeployM deployConfig $ do
+        deployCfg@(DeployConfig {primaryAccount}) <- ask
+        let bigGasLimit = unsafePartial fromJust $ parseBigNumber decimal "9000000"
+            txOpts = defaultTransactionOptions # _from ?~ primaryAccount
+                                               # _gas ?~ bigGasLimit
+        ssConfig <- validateDeployArgs simpleStorageConfig
+        _ <- deployContractWithArgs ssConfig $ SimpleStorage.constructor txOpts
+        foamCSR <- deployContractNoArgs foamCSRConfig txOpts
+        let parkingAuthorityConfig = makeParkingAuthorityConfig {foamCSR}
+        _ <- deployContractWithArgs parkingAuthorityConfig $ ParkingAuthority.constructor txOpts
+        pure unit
+      case eRes of
+        Left err -> logDeployError err
+        Right _ -> pure unit