Fixing errors to be much more user-friendly

cli/cli.hs

@@ -12,12 +12,11 @@ import Control.Monad.IO.Unlift
 import Data.ByteString (ByteString)
 import Data.DoubleWord (Word256)
 import Data.List (intersperse)
-import Data.Maybe (fromMaybe, mapMaybe, fromJust)
+import Data.Maybe (fromMaybe, mapMaybe, fromJust, isNothing)
 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)
 import GHC.Conc (getNumProcessors)
 import Numeric.Natural (Natural)
 import Optics.Core ((&), set)
@@ -244,17 +243,17 @@ main = withUtf8 $ do
 
 equivalence :: App m => Command Options.Unwrapped -> m ()
 equivalence cmd = do
-  let bytecodeA' = hexByteString "--code" . strip0x $ cmd.codeA
-      bytecodeB' = hexByteString "--code" . strip0x $ cmd.codeB
-  if (isLeft bytecodeA') then liftIO $ do
-    putStrLn $ "Error, invalid bytecode for program A: " <> getLeft bytecodeA'
+  let bytecodeA' = hexByteString $ strip0x cmd.codeA
+      bytecodeB' = hexByteString $ strip0x cmd.codeB
+  if (isNothing bytecodeA') then liftIO $ do
+    putStrLn $ "Error, invalid bytecode for program A: " <> show cmd.codeA
     exitFailure
-  else if (isLeft bytecodeB') then liftIO $ do
-    putStrLn $ "Error, invalid bytecode for program B: " <> getLeft bytecodeB'
+  else if (isNothing bytecodeB') then liftIO $ do
+    putStrLn $ "Error, invalid bytecode for program B: " <> show cmd.codeB
     exitFailure
   else do
-    let bytecodeA = getRight bytecodeA'
-        bytecodeB = getRight bytecodeB'
+    let bytecodeA = fromJust bytecodeA'
+        bytecodeB = fromJust bytecodeB'
         veriOpts = VeriOpts { simp = True
                             , maxIter = cmd.maxIterations
                             , askSmtIters = cmd.askSmtIterations
@@ -281,11 +280,6 @@ equivalence cmd = do
             ] <> (intersperse (T.unlines [ "", "-----" ]) $ fmap (formatCex (AbstractBuf "txdata") Nothing) cexs)
           exitFailure
 
-getLeft (Left e) = e
-getLeft _ = internalError "unexpected Right"
-getRight (Right e) = e
-getRight _ = internalError "unexpected Right"
-
 getSolver :: Command Options.Unwrapped -> IO Solver
 getSolver cmd = case cmd.solver of
                   Nothing -> pure Z3
@@ -325,11 +319,11 @@ buildCalldata cmd = case (cmd.calldata, cmd.sig) of
   (Nothing, Nothing) -> pure $ mkCalldata Nothing []
   -- fully concrete calldata
   (Just c, Nothing) -> do
-    let val = hexByteString "bytes" . strip0x $ c
-    if (isLeft val) then do
-      putStrLn $ "Error, invalid calldata: " <> getLeft val
+    let val = hexByteString $ strip0x c
+    if (isNothing val) then do
+      putStrLn $ "Error, invalid calldata: " <>  show c
       exitFailure
-    else pure (ConcreteBuf (getRight val), [])
+    else pure (ConcreteBuf (fromJust val), [])
   -- calldata according to given abi with possible specializations from the `arg` list
   (Nothing, Just sig') -> do
     method' <- functionAbi sig'
@@ -455,9 +449,9 @@ vmFromCommand cmd = do
 
   contract <- case (cmd.rpc, cmd.address, cmd.code) of
     (Just url, Just addr', Just c) -> do
-      let code = hexByteString "--code" $ strip0x c
-      if (isLeft code) then do
-        putStrLn $ "Error, invalid code: " <> getLeft code
+      let code = hexByteString $ strip0x c
+      if (isNothing code) then do
+        putStrLn $ "Error, invalid code: " <> show c
         exitFailure
       else
         Fetch.fetchContractFrom block url addr' >>= \case
@@ -468,7 +462,7 @@ vmFromCommand cmd = do
             -- if both code and url is given,
             -- fetch the contract and overwrite the code
             pure $
-              initialContract  (mkCode $ getRight code)
+              initialContract  (mkCode $ fromJust code)
                 & set #balance  (contract.balance)
                 & set #nonce    (contract.nonce)
                 & set #external (contract.external)
@@ -481,11 +475,11 @@ vmFromCommand cmd = do
         Just contract -> pure contract
 
     (_, _, Just c)  -> do
-      let code = hexByteString "--code" $ strip0x c
-      if (isLeft code) then do
-        putStrLn $ "Error, invalid code: " <> getLeft code
+      let code = hexByteString $ strip0x c
+      if (isNothing code) then do
+        putStrLn $ "Error, invalid code: " <> show c
         exitFailure
-      else pure $ initialContract (mkCode $ getRight code)
+      else pure $ initialContract (mkCode $ fromJust code)
 
     (_, _, Nothing) -> do
       putStrLn "Error, must provide at least (rpc + address) or code"
@@ -495,20 +489,20 @@ vmFromCommand cmd = do
         Just t -> t
         Nothing -> internalError "unexpected symbolic timestamp when executing vm test"
 
-  if (isLeft bsCallData) then do
-    putStrLn $ "Error, invalid calldata: " <> getLeft bsCallData
+  if (isNothing bsCallData) then do
+    putStrLn $ "Error, invalid calldata: " <> show calldata
     exitFailure
   else do
     vm <- stToIO $ vm0 baseFee miner ts' blockNum prevRan contract
     pure $ EVM.Transaction.initTx vm
   where
-        bsCallData = bytes (.calldata) (Right "")
+        bsCallData = bytes (.calldata) (pure "")
         block   = maybe Fetch.Latest Fetch.BlockNumber cmd.block
         value   = word (.value) 0
         caller  = addr (.caller) (LitAddr 0)
         origin  = addr (.origin) (LitAddr 0)
-        calldata = ConcreteBuf $ getRight bsCallData
-        decipher = hexByteString "bytes" . strip0x
+        calldata = ConcreteBuf $ fromJust bsCallData
+        decipher = hexByteString . strip0x
         mkCode bs = if cmd.create
                     then InitCode bs mempty
                     else RuntimeCode (ConcreteRuntimeCode bs)
@@ -581,24 +575,24 @@ symvmFromCommand cmd calldata = do
               -- fetch the contract and overwrite the code
               Just c -> do
                 let c' = decipher c
-                if (isLeft c') then do
+                if (isNothing c') then do
                   putStrLn $ "Error, invalid code: " <> show c
                   exitFailure
                 else pure $ do
-                  initialContract (mkCode $ getRight c')
+                  initialContract (mkCode $ fromJust c')
                         & set #origStorage (contract'.origStorage)
                         & set #balance     (contract'.balance)
                         & set #nonce       (contract'.nonce)
                         & set #external    (contract'.external)
 
     (_, _, Just c)  -> do
       let c' = decipher c
-      if (isLeft c') then do
+      if (isNothing 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')
+        EmptyBase -> pure (initialContract . mkCode $ fromJust c')
+        AbstractBase -> pure ((`abstractContract` address) . mkCode $ fromJust c')
 
     (_, _, Nothing) -> do
       putStrLn "Error, must provide at least (rpc + address) or code"
@@ -608,7 +602,7 @@ symvmFromCommand cmd calldata = do
   pure $ EVM.Transaction.initTx vm
 
   where
-    decipher = hexByteString "bytes" . strip0x
+    decipher = hexByteString . strip0x
     block = maybe Fetch.Latest Fetch.BlockNumber cmd.block
     origin = eaddr (.origin) (SymAddr "origin")
     mkCode bs = if cmd.create

src/EVM/Format.hs

@@ -824,11 +824,11 @@ strip0x bs = if "0x" `Char8.isPrefixOf` bs then Char8.drop 2 bs else bs
 strip0x' :: String -> String
 strip0x' s = if "0x" `isPrefixOf` s then drop 2 s else s
 
-hexByteString :: String -> ByteString -> Either String ByteString
-hexByteString msg bs =
+hexByteString :: ByteString -> Maybe ByteString
+hexByteString bs =
   case BS16.decodeBase16Untyped bs of
     Right x -> pure x
-    Left _ -> Left $ "Invalid hex bytestring provided for '" ++ msg ++ "'. Bytestring provided: '" ++ show bs ++ "'"
+    Left _ -> Nothing
 
 hexText :: Text -> ByteString
 hexText t =