Better

ethereum · Oct 10, 2024 · 733d475 · 733d475
1 parent e48604a
commit 733d475
Showing 1 changed file with 48 additions and 24 deletions.
diff --git a/cli/cli.hs b/cli/cli.hs
@@ -17,7 +17,7 @@ import Data.Text qualified as T
 import Data.Text.IO qualified as T
 import Data.Version (showVersion)
 import Data.Word (Word64)
-import Data.Either (isLeft, fromLeft)
+import Data.Either (isLeft)
 import GHC.Conc (getNumProcessors)
 import Numeric.Natural (Natural)
 import Optics.Core ((&), set)
@@ -443,7 +443,9 @@ vmFromCommand cmd = do
   (miner,ts,baseFee,blockNum,prevRan) <- case cmd.rpc of
     Nothing -> pure (LitAddr 0,Lit 0,0,0,0)
     Just url -> Fetch.fetchBlockFrom block url >>= \case
-      Nothing -> error "Error: Could not fetch block"
+      Nothing -> do
+        putStrLn $ "Error, Could not fetch block" <> show block <> " from URL: " <> show url
+        exitFailure
       Just Block{..} -> pure ( coinbase
                              , timestamp
                              , baseFee
@@ -459,7 +461,9 @@ vmFromCommand cmd = do
         exitFailure
       else
         Fetch.fetchContractFrom block url addr' >>= \case
-          Nothing -> error $ "Error: contract not found: " <> show address
+          Nothing -> do
+            putStrLn $ "Error: contract not found: " <> show address
+            exitFailure
           Just contract ->
             -- if both code and url is given,
             -- fetch the contract and overwrite the code
@@ -471,8 +475,9 @@ vmFromCommand cmd = do
 
     (Just url, Just addr', Nothing) ->
       Fetch.fetchContractFrom block url addr' >>= \case
-        Nothing ->
-          error $ "Error: contract not found: " <> show address
+        Nothing -> do
+          putStrLn $ "Error, contract not found: " <> show address
+          exitFailure
         Just contract -> pure contract
 
     (_, _, Just c)  -> do
@@ -482,21 +487,27 @@ vmFromCommand cmd = do
         exitFailure
       else pure $ initialContract (mkCode $ getRight code)
 
-    (_, _, Nothing) ->
-      error "Error: must provide at least (rpc + address) or code"
+    (_, _, Nothing) -> do
+      putStrLn "Error, must provide at least (rpc + address) or code"
+      exitFailure
 
   let ts' = case maybeLitWord ts of
         Just t -> t
         Nothing -> internalError "unexpected symbolic timestamp when executing vm test"
 
-  vm <- stToIO $ vm0 baseFee miner ts' blockNum prevRan contract
-  pure $ EVM.Transaction.initTx vm
-    where
+  if (isLeft bsCallData) then do
+    putStrLn $ "Error, invalid calldata: " <> getLeft bsCallData
+    exitFailure
+  else do
+    vm <- stToIO $ vm0 baseFee miner ts' blockNum prevRan contract
+    pure $ EVM.Transaction.initTx vm
+  where
+        bsCallData = bytes (.calldata) (Right "")
         block   = maybe Fetch.Latest Fetch.BlockNumber cmd.block
         value   = word (.value) 0
         caller  = addr (.caller) (LitAddr 0)
         origin  = addr (.origin) (LitAddr 0)
-        calldata = ConcreteBuf $ bytes (.calldata) ""
+        calldata = ConcreteBuf $ getRight bsCallData
         decipher = hexByteString "bytes" . strip0x
         mkCode bs = if cmd.create
                     then InitCode bs mempty
@@ -543,7 +554,9 @@ symvmFromCommand cmd calldata = do
   (miner,blockNum,baseFee,prevRan) <- case cmd.rpc of
     Nothing -> pure (SymAddr "miner",0,0,0)
     Just url -> Fetch.fetchBlockFrom block url >>= \case
-      Nothing -> error "Error: Could not fetch block"
+      Nothing -> do
+        putStrLn "Error, could not fetch block"
+        exitFailure
       Just Block{..} -> pure ( coinbase
                              , number
                              , baseFee
@@ -559,26 +572,37 @@ symvmFromCommand cmd calldata = do
   contract <- case (cmd.rpc, cmd.address, cmd.code) of
     (Just url, Just addr', _) ->
       Fetch.fetchContractFrom block url addr' >>= \case
-        Nothing ->
-          error "Error: contract not found."
-        Just contract' -> pure contract''
-          where
-            contract'' = case cmd.code of
-              Nothing -> contract'
+        Nothing -> do
+          putStrLn "Error, contract not found."
+          exitFailure
+        Just contract' -> case cmd.code of
+              Nothing -> pure contract'
               -- if both code and url is given,
               -- fetch the contract and overwrite the code
-              Just c -> initialContract (mkCode $ decipher c)
+              Just c -> do
+                let c' = decipher c
+                if (isLeft c') then do
+                  putStrLn $ "Error, invalid code: " <> show c
+                  exitFailure
+                else pure $ do
+                  initialContract (mkCode $ getRight c')
                         & set #origStorage (contract'.origStorage)
                         & set #balance     (contract'.balance)
                         & set #nonce       (contract'.nonce)
                         & set #external    (contract'.external)
 
-    (_, _, Just c)  -> case storageBase of
-      EmptyBase -> pure (initialContract . mkCode $ decipher c)
-      AbstractBase -> pure ((`abstractContract` address) . mkCode $ decipher c)
+    (_, _, Just c)  -> do
+      let c' = decipher c
+      if (isLeft c') then do
+        putStrLn $ "Error, invalid code: " <> show c
+        exitFailure
+      else case storageBase of
+        EmptyBase -> pure (initialContract . mkCode $ getRight c')
+        AbstractBase -> pure ((`abstractContract` address) . mkCode $ getRight c')
 
-    (_, _, Nothing) ->
-      error "Error: must provide at least (rpc + address) or code"
+    (_, _, Nothing) -> do
+      putStrLn "Error, must provide at least (rpc + address) or code"
+      exitFailure
 
   vm <- stToIO $ vm0 baseFee miner ts blockNum prevRan calldata callvalue caller contract storageBase
   pure $ EVM.Transaction.initTx vm