From 262f8da7911e1b2c085b9588af731e4df110e014 Mon Sep 17 00:00:00 2001 From: blinky3713 <31280145+blinky3713@users.noreply.github.com> Date: Tue, 27 Mar 2018 14:09:15 -0400 Subject: [PATCH] Deploy m (#4) * DeployM * move to types * main compiles * fix console log * tests pass --- src/ContractConfig.purs | 2 +- src/Deploy.purs | 148 ++++++++++++++++------------ src/Main.purs | 40 +++++--- src/Types.purs | 97 ++++++++++++++++-- src/Utils.purs | 94 ++++++++++-------- test/Main.purs | 17 +++- test/Spec/ParkingAuthoritySpec.purs | 54 +++++----- test/Spec/SimpleStorageSpec.purs | 13 ++- 8 files changed, 308 insertions(+), 157 deletions(-) diff --git a/src/ContractConfig.purs b/src/ContractConfig.purs index 8ca8348..cf4415b 100644 --- a/src/ContractConfig.purs +++ b/src/ContractConfig.purs @@ -24,7 +24,7 @@ simpleStorageConfig = } where simpleStorageArgs = do - _count <- uIntNFromBigNumber $ embed 12345 + _count <- uIntNFromBigNumber $ embed 1234 pure {_count} -------------------------------------------------------------------------------- diff --git a/src/Deploy.purs b/src/Deploy.purs index 03313c6..bb42cdc 100644 --- a/src/Deploy.purs +++ b/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 diff --git a/src/Main.purs b/src/Main.purs index 3a4ec4c..de974c3 100644 --- a/src/Main.purs +++ b/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 diff --git a/src/Types.purs b/src/Types.purs index 4f28c81..1f4d1de 100644 --- a/src/Types.purs +++ b/src/Types.purs @@ -1,19 +1,102 @@ module Types - ( DeployConfig + ( DeployM + , runDeployM + , DeployError(..) + , logDeployError + , throwDeploy + , DeployConfig(..) , ContractConfig ) where -import Network.Ethereum.Web3.Types (Address, BigNumber) +import Prelude +import Ansi.Codes (Color(Red)) +import Ansi.Output (withGraphics, foreground) +import Control.Monad.Aff (Aff, liftEff') +import Control.Monad.Aff.Class (class MonadAff, liftAff) +import Control.Monad.Aff.Console (CONSOLE) +import Control.Monad.Aff.Console as C +import Control.Monad.Eff.Class (class MonadEff) +import Control.Monad.Eff.Exception (Error, throwException) +import Control.Monad.Except (ExceptT, runExceptT) +import Control.Monad.Error.Class (class MonadThrow) +import Control.Monad.Reader (ReaderT, runReaderT) +import Control.Monad.Reader.Class (class MonadAsk) +import Data.Either (Either) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Network.Ethereum.Web3 (ETH, Address, BigNumber) import Network.Ethereum.Web3.Types.Provider (Provider) +import Node.FS.Aff (FS) import Node.Path (FilePath) +-------------------------------------------------------------------------------- +-- | DeployM +-------------------------------------------------------------------------------- + +newtype DeployM eff a = + DeployM (ReaderT DeployConfig (ExceptT DeployError (Aff (eth :: ETH, fs :: FS, console :: CONSOLE | eff))) a) + +runDeployM + :: forall eff a. + DeployM eff a + -> DeployConfig + -> Aff (fs :: FS, console :: CONSOLE, eth :: ETH | eff) (Either DeployError a) +runDeployM (DeployM deploy) = runExceptT <<< runReaderT deploy + +derive newtype instance functorDeployM :: Functor (DeployM eff) +derive newtype instance applyDeployM :: Apply (DeployM eff) +derive newtype instance applicativeDeployM :: Applicative (DeployM eff) +derive newtype instance bindDeployM :: Bind (DeployM eff) +derive newtype instance monadDeployM :: Monad (DeployM eff) +derive newtype instance monadAskDeployM :: MonadAsk DeployConfig (DeployM eff) +derive newtype instance monadThrowDeployM :: MonadThrow DeployError (DeployM eff) +derive newtype instance monadEffDeployM :: MonadEff (eth :: ETH, fs :: FS, console :: CONSOLE | eff) (DeployM eff) +derive newtype instance monadAffDeployM :: MonadAff (eth :: ETH, fs :: FS, console :: CONSOLE | eff) (DeployM eff) + +-------------------------------------------------------------------------------- +-- | Error Types +-------------------------------------------------------------------------------- + +data DeployError = + ConfigurationError String + | OnDeploymentError String + | PostDeploymentError String + +derive instance genericError :: Generic DeployError _ + +instance showDeployError :: Show DeployError where + show = genericShow + +logDeployError + :: forall eff m. + MonadAff (console :: CONSOLE | eff) m + => DeployError + -> m Unit +logDeployError err = liftAff $ case err of + ConfigurationError errMsg -> C.error $ makeRed "Configuration Error: " <> errMsg + OnDeploymentError errMsg -> C.error $ makeRed "On Deployment Error: " <> errMsg + PostDeploymentError errMsg -> C.error $ makeRed "Post Deployment Error: " <> errMsg + where + makeRed :: String -> String + makeRed = withGraphics (foreground Red) + +throwDeploy + :: forall eff a. + Error + -> DeployM eff a +throwDeploy = liftAff <<< liftEff' <<< throwException + +-------------------------------------------------------------------------------- +-- | Config Types +-------------------------------------------------------------------------------- + -- | primary deployment configuration -type DeployConfig = - { networkId :: BigNumber - , primaryAccount :: Address - , provider :: Provider - } +newtype DeployConfig = + DeployConfig { networkId :: BigNumber + , primaryAccount :: Address + , provider :: Provider + } -- | configuration for deployment of a single contract type ContractConfig args = diff --git a/src/Utils.purs b/src/Utils.purs index 376b950..afe073d 100644 --- a/src/Utils.purs +++ b/src/Utils.purs @@ -9,72 +9,82 @@ module Utils ) where import Prelude -import Control.Monad.Eff (Eff) -import Control.Monad.Aff (Aff, Milliseconds(..), delay, liftEff') -import Control.Monad.Aff.Class (liftAff) +import Control.Monad.Eff.Class (class MonadEff, liftEff) +import Control.Monad.Aff (Aff, Milliseconds(..), delay) +import Control.Monad.Aff.Class (class MonadAff, liftAff) import Control.Monad.Aff.Console (CONSOLE) import Control.Monad.Aff.Console as C -import Control.Monad.Eff.Unsafe (unsafeCoerceEff) -import Control.Monad.Eff.Exception (EXCEPTION, error, throw) -import Control.Monad.Except (throwError) +import Control.Monad.Eff.Exception (error, try) +import Control.Monad.Error.Class (class MonadThrow, throwError) import Control.Parallel (parOneOf) import Data.Array ((!!)) -import Data.Maybe (Maybe, maybe, fromJust) +import Data.Maybe (Maybe(..), maybe) import Data.Either (Either(..)) import Network.Ethereum.Web3 (ETH, Web3, HexString, Address, runWeb3) import Network.Ethereum.Web3.Api (eth_getAccounts, eth_getTransactionReceipt, net_version) -import Network.Ethereum.Web3.Types (TransactionReceipt) +import Network.Ethereum.Web3.Types (TransactionReceipt, Web3Error(NullError)) import Network.Ethereum.Web3.Types.Provider (Provider, httpProvider) -import Node.Process (lookupEnv) -import Partial.Unsafe (unsafePartial) -import Types (DeployConfig, ContractConfig) +import Node.Process (PROCESS, lookupEnv) +import Types (DeployError(..), DeployConfig(..), ContractConfig) -- | Make an http provider with address given by NODE_URL, falling back -- | to localhost. makeProvider - :: forall eff. - Eff (eth :: ETH, exception :: EXCEPTION | eff) Provider -makeProvider = unsafeCoerceEff $ do - murl <- lookupEnv "NODE_URL" - url <- maybe (pure "http://localhost:8545") pure murl - httpProvider url + :: forall eff m. + MonadEff (eth :: ETH, process :: PROCESS | eff) m + => MonadThrow DeployError m + => m Provider +makeProvider = do + eProvider <- liftEff do + murl <- lookupEnv "NODE_URL" + url <- maybe (pure "http://localhost:8545") pure murl + try $ httpProvider url + case eProvider of + Left _ -> throwError $ ConfigurationError "Cannot connect to Provider, check NODE_URL" + Right p -> pure p makeDeployConfig - :: forall eff. - Aff (console :: CONSOLE, eth :: ETH | eff) DeployConfig + :: forall eff m. + MonadAff (eth :: ETH, console :: CONSOLE, process :: PROCESS | eff) m + => MonadThrow DeployError m + => m DeployConfig makeDeployConfig = do - provider <- liftAff <<< liftEff' $ makeProvider - econfig <- runWeb3 provider $ do - primaryAccount <- unsafePartial getPrimaryAccount + provider <- makeProvider + econfig <- liftAff $ runWeb3 provider do + primaryAccount <- getPrimaryAccount networkId <- net_version - pure {provider, primaryAccount, networkId} + pure $ DeployConfig {provider, primaryAccount, networkId} case econfig of - Left err -> do - C.error $ "Couldn't create DeployConfig: " <> show err - throwError <<< error <<< show $ err + Left err -> + let errMsg = "Couldn't create DeployConfig -- " <> show err + in throwError $ ConfigurationError errMsg Right config -> pure config -- | get the primary account for the ethereum client getPrimaryAccount :: forall eff. - Partial - => Web3 eff Address + Web3 (console :: CONSOLE | eff) Address getPrimaryAccount = do - accounts <- eth_getAccounts - pure $ fromJust $ accounts !! 0 + accounts <- eth_getAccounts + maybe accountsError pure $ accounts !! 0 + where + accountsError = do + liftAff $ C.error "No PrimaryAccount found on ethereum client!" + throwError NullError -- | indefinitely poll for a transaction receipt, sleeping for 3 -- | seconds in between every call. pollTransactionReceipt - :: forall eff. - HexString + :: forall eff m. + MonadAff (eth :: ETH | eff) m + => HexString -> Provider - -> Aff (eth :: ETH, console :: CONSOLE | eff) TransactionReceipt + -> m TransactionReceipt pollTransactionReceipt txHash provider = do - etxReceipt <- runWeb3 provider $ eth_getTransactionReceipt txHash + etxReceipt <- liftAff <<< runWeb3 provider $ eth_getTransactionReceipt txHash case etxReceipt of Left _ -> do - delay (Milliseconds 3000.0) + liftAff $ delay (Milliseconds 3000.0) pollTransactionReceipt txHash provider Right txRec -> pure txRec @@ -104,9 +114,11 @@ reportIfErrored msg eRes = Right res -> pure res validateDeployArgs - :: forall args eff. - ContractConfig (deployArgs :: Maybe args) - -> Eff (exception :: EXCEPTION | eff) (ContractConfig (deployArgs :: args)) -validateDeployArgs cfg = do - args <- maybe (throw $ "Couldn't validate args for contract deployment: " <> cfg.name) pure cfg.deployArgs - pure cfg {deployArgs = args} + :: forall m args. + MonadThrow DeployError m + => ContractConfig (deployArgs :: Maybe args) + -> m (ContractConfig (deployArgs :: args)) +validateDeployArgs cfg = + case cfg.deployArgs of + Nothing -> throwError $ ConfigurationError ("Couldn't validate args for contract deployment: " <> cfg.name) + Just args -> pure $ cfg {deployArgs = args} diff --git a/test/Main.purs b/test/Main.purs index eacdc96..ef6a000 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -4,15 +4,20 @@ import Prelude import Control.Monad.Aff (launchAff) import Control.Monad.Aff.AVar (AVAR) import Control.Monad.Aff.Console (CONSOLE) +import Control.Monad.Aff.Unsafe (unsafeCoerceAff) import Control.Monad.Eff (Eff) import Control.Monad.Eff.Class (liftEff) +import Control.Monad.Except (runExceptT) import Data.Maybe (Maybe(..)) +import Data.Either (Either(..)) import Test.Spec.Reporter.Console (consoleReporter) import Test.Spec.Runner (PROCESS, run', defaultConfig) import Network.Ethereum.Web3 (ETH) import Node.FS.Aff (FS) +import Node.Process as NP import Utils (makeDeployConfig) +import Types (logDeployError) import SimpleStorageSpec (simpleStorageSpec) import ParkingAuthoritySpec (parkingAuthoritySpec) @@ -24,10 +29,14 @@ main , avar :: AVAR , fs :: FS , process :: PROCESS + , process :: NP.PROCESS | e ) Unit main = void <<< launchAff $ do - deployConfig <- makeDeployConfig - liftEff $ run' defaultConfig {timeout = Just (60 * 1000)} [consoleReporter] do - simpleStorageSpec deployConfig - parkingAuthoritySpec deployConfig + edeployConfig <- unsafeCoerceAff <<< runExceptT $ makeDeployConfig + case edeployConfig of + Left err -> logDeployError err *> pure unit + Right deployConfig -> + liftEff $ run' defaultConfig {timeout = Just (60 * 1000)} [consoleReporter] do + simpleStorageSpec deployConfig + parkingAuthoritySpec deployConfig diff --git a/test/Spec/ParkingAuthoritySpec.purs b/test/Spec/ParkingAuthoritySpec.purs index df59792..7fa7893 100644 --- a/test/Spec/ParkingAuthoritySpec.purs +++ b/test/Spec/ParkingAuthoritySpec.purs @@ -11,6 +11,7 @@ import Control.Monad.Aff (Aff) import Control.Monad.Aff.AVar (AVAR, makeEmptyVar, putVar, takeVar) import Control.Monad.Aff.Class (liftAff) import Control.Monad.Aff.Console (CONSOLE, log) +import Control.Monad.Except (runExceptT) import Data.Array ((!!)) import Data.ByteString as BS import Data.Either (Either(..)) @@ -30,20 +31,10 @@ import Partial.Unsafe (unsafeCrashWith) import Test.Spec (Spec, describe, it) import Test.Spec.Assertions (shouldEqual) import Type.Prelude (Proxy(..)) -import Types (DeployConfig, ContractConfig) +import Types (DeployConfig(..), ContractConfig) import Utils (pollTransactionReceipt) -buildParkingAuthorityConfig - :: forall eff. - BigNumber - -> Aff (fs :: FS | eff) (ContractConfig (deployArgs :: {foamCSR :: Address}, parkingAuthority :: Address)) -buildParkingAuthorityConfig networkId= do - foamCSRAddress <- readDeployAddress foamCSRConfig.filepath networkId - let parkingAuthorityConfig = makeParkingAuthorityConfig {foamCSR : foamCSRAddress} - parkingAuthorityAddress <- readDeployAddress parkingAuthorityConfig.filepath networkId - pure $ insert (SProxy :: SProxy "parkingAuthority") parkingAuthorityAddress parkingAuthorityConfig - parkingAuthoritySpec :: forall e. DeployConfig @@ -53,7 +44,7 @@ parkingAuthoritySpec , console :: CONSOLE | e ) Unit -parkingAuthoritySpec deployConfig = do +parkingAuthoritySpec deployCfg@(DeployConfig deployConfig) = do let run :: forall e' a. Web3 e' a -> Aff (eth :: ETH | e') a @@ -64,18 +55,17 @@ parkingAuthoritySpec deployConfig = do describe "Testing basic functionality of the parking authority" do it "has the correct foamCSR contract" do parkingAuthorityConfig <- buildParkingAuthorityConfig deployConfig.networkId - parkingAuthorityAddress <- readDeployAddress parkingAuthorityConfig.filepath deployConfig.networkId - let txOpts = defaultTransactionOptions # _to ?~ parkingAuthorityAddress + let txOpts = defaultTransactionOptions # _to ?~ parkingAuthorityConfig.parkingAuthority ecsr <- run $ PA.parkingCSR txOpts Latest ecsr `shouldEqual` (Right parkingAuthorityConfig.deployArgs.foamCSR) describe "App Flow" do it "can register a user and that user is owned by the right account" $ run do - void $ createUser deployConfig 1 + void $ createUser deployCfg 1 it "can create a user and that user can request more zones from the authority" $ run do - {user, owner} <- createUser deployConfig 1 + {user, owner} <- createUser deployCfg 1 let zone :: BytesN D4 zone = case fromByteString =<< BS.fromString "01234567" BS.Hex of @@ -95,10 +85,10 @@ parkingAuthoritySpec deployConfig = do _geohash = case fromByteString =<< BS.fromString ("0123456701234567") BS.Hex of Just x -> x Nothing -> unsafeCrashWith "geohash should result in valid BytesN 8" - void $ createParkingAnchor deployConfig 2 {_geohash, _anchorId} + void $ createParkingAnchor deployCfg 2 {_geohash, _anchorId} it "can create a user and an anchor, the user requests permission at the anchor, then parks there, but not another zone" $ run do - userResult <- createUser deployConfig 1 + userResult <- createUser deployCfg 1 let _anchorId = case fromByteString =<< BS.fromString (unHex $ sha3 "I'm an anchor!") BS.Hex of Just x -> x Nothing -> unsafeCrashWith "anchorId should result in valid BytesN 32" @@ -106,7 +96,7 @@ parkingAuthoritySpec deployConfig = do _geohash = case fromByteString =<< BS.fromString geohashString BS.Hex of Just x -> x Nothing -> unsafeCrashWith "geohash should result in valid BytesN 8" - parkingAnchorResult <- createParkingAnchor deployConfig 2 {_geohash, _anchorId} + parkingAnchorResult <- createParkingAnchor deployCfg 2 {_geohash, _anchorId} let zoneStr = take 8 geohashString zone = case fromByteString =<< BS.fromString zoneStr BS.Hex of @@ -122,7 +112,7 @@ parkingAuthoritySpec deployConfig = do liftAff $ user `shouldEqual` userResult.user liftAff $ anchor `shouldEqual` parkingAnchorResult.anchor - badUserResult <- createUser deployConfig 3 + badUserResult <- createUser deployCfg 3 let badZone :: BytesN D4 badZone = case fromByteString =<< BS.fromString "00000000" BS.Hex of @@ -151,13 +141,13 @@ createUser -> Int -- ^ the index of the account to use for transactions -> Web3 (fs :: FS, avar :: AVAR, console :: CONSOLE | eff) {owner :: Address, user :: Address} -createUser deployConfig accountIndex = do +createUser deployCfg@(DeployConfig deployConfig) accountIndex = do accounts <- eth_getAccounts let account = case accounts !! accountIndex of Just x -> x Nothing -> unsafeCrashWith $ "no index " <> show accountIndex <> "in accounts" - {owner, user} <- registerUser account deployConfig + {owner, user} <- registerUser account deployCfg let txOpts = defaultTransactionOptions # _from ?~ account # _to ?~ user actualOwner <- User.owner txOpts Latest <#> case _ of @@ -221,7 +211,7 @@ registerUser -- ^ from address -> DeployConfig -> Web3 (fs :: FS, avar :: AVAR, console :: CONSOLE | eff) {owner :: Address, user :: Address} -registerUser fromAccount {provider, networkId} = do +registerUser fromAccount (DeployConfig {provider, networkId}) = do {parkingAuthority} <- liftAff $ buildParkingAuthorityConfig networkId let txOpts = defaultTransactionOptions # _from ?~ fromAccount # _gas ?~ bigGasLimit @@ -238,7 +228,7 @@ registerAnchor -> {_geohash :: BytesN D8, _anchorId :: BytesN (D3 :& D2)} -> DeployConfig -> Web3 (fs :: FS, console :: CONSOLE, avar :: AVAR | eff) {owner :: Address, anchor :: Address, anchorId :: BytesN (D3 :& D2) , geohash :: BytesN D8} -registerAnchor fromAccount args {provider, networkId} = do +registerAnchor fromAccount args (DeployConfig {provider, networkId}) = do {parkingAuthority} <- liftAff $ buildParkingAuthorityConfig networkId let txOpts = defaultTransactionOptions # _from ?~ fromAccount # _gas ?~ bigGasLimit @@ -252,3 +242,19 @@ bigGasLimit :: BigNumber bigGasLimit = case parseBigNumber decimal "9000000" of Just x -> x Nothing -> unsafeCrashWith "expected to get big number from 9000000 but it failed" + +buildParkingAuthorityConfig + :: forall eff. + BigNumber + -> Aff (fs :: FS | eff) (ContractConfig (deployArgs :: {foamCSR :: Address}, parkingAuthority :: Address)) +buildParkingAuthorityConfig networkId= do + efoamCSRAddress <- runExceptT $ readDeployAddress foamCSRConfig.filepath networkId + let foamCSRAddress = case efoamCSRAddress of + Right x -> x + Left err -> unsafeCrashWith $ "Expected FoamCSR Address in artifact, got error" <> show err + let parkingAuthorityConfig = makeParkingAuthorityConfig {foamCSR : foamCSRAddress} + eparkingAuthorityAddress <- runExceptT $ readDeployAddress parkingAuthorityConfig.filepath networkId + let parkingAuthorityAddress = case eparkingAuthorityAddress of + Right x -> x + Left err -> unsafeCrashWith $ "Expected ParkingAuthority Address in artifact, got error" <> show err + pure $ insert (SProxy :: SProxy "parkingAuthority") parkingAuthorityAddress parkingAuthorityConfig diff --git a/test/Spec/SimpleStorageSpec.purs b/test/Spec/SimpleStorageSpec.purs index 13758cf..3c474dc 100644 --- a/test/Spec/SimpleStorageSpec.purs +++ b/test/Spec/SimpleStorageSpec.purs @@ -8,16 +8,18 @@ import Control.Monad.Aff.AVar (AVAR, makeEmptyVar, putVar, takeVar) import Control.Monad.Aff.Class (liftAff) import Control.Monad.Eff.Class (liftEff) import Control.Monad.Eff.Console (CONSOLE, log) +import Control.Monad.Except (runExceptT) +import Data.Either (Either(..)) import Data.Lens.Setter ((?~)) import Data.Maybe (Maybe(..), fromJust) import Deploy (readDeployAddress) import Network.Ethereum.Web3 (ETH, EventAction(..), _from, _gas, _to, defaultTransactionOptions, embed, event, eventFilter, runWeb3, uIntNFromBigNumber) import Node.FS.Aff (FS) -import Partial.Unsafe (unsafePartial) +import Partial.Unsafe (unsafePartial, unsafeCrashWith) import Test.Spec (Spec, describe, it) import Test.Spec.Assertions (shouldEqual) import Type.Prelude (Proxy(..)) -import Types (DeployConfig) +import Types (DeployConfig(..)) simpleStorageSpec :: forall e. @@ -28,11 +30,14 @@ simpleStorageSpec , console :: CONSOLE | e ) Unit -simpleStorageSpec deployConfig = do +simpleStorageSpec (DeployConfig deployConfig) = do describe "Setting the value of a SimpleStorage Contract" do it "can set the value of simple storage" $ do - simpleStorageAddress <- readDeployAddress simpleStorageConfig.filepath deployConfig.networkId + esimpleStorageAddress <- runExceptT $ readDeployAddress simpleStorageConfig.filepath deployConfig.networkId + let simpleStorageAddress = case esimpleStorageAddress of + Right x -> x + Left err -> unsafeCrashWith $ "Expected SimpleStorage Address in artifact, got error" <> show err var <- makeEmptyVar let n = unsafePartial $ fromJust <<< uIntNFromBigNumber <<< embed $ 42 txOptions = defaultTransactionOptions # _from ?~ deployConfig.primaryAccount