Revamp error codes to have the same format as legacy errors

pact-repl/Main.hs

@@ -22,8 +22,6 @@ import Pact.Core.Command.Server
 import Pact.Core.Command.Util
 import Pact.Core.Repl.Compile
 import System.IO
-import Pact.Core.Errors
-import Pact.Core.Info
 import qualified Pact.Core.Version as PI
 import System.Directory
 import System.Exit(exitFailure, exitSuccess)
@@ -52,8 +50,6 @@ data ReplOpts
   | OServer FilePath
   -- Crypto
   | OGenKey
-  | OExplainErrorCode String
-  -- | OServer
   deriving (Eq, Show)
 
 replOpts :: O.Parser (Maybe ReplOpts)
@@ -64,7 +60,6 @@ replOpts = O.optional $
   <|> apiReqFlag
   <|> unsignedReqFlag
   <|> loadFlag
-  <|> explainErrorCodeFlag
   <|> OServer <$> O.strOption (O.metavar "CONFIG" <> O.short 's' <> O.long "server" <> O.help "Run Pact-Server")
 
 -- Todo: trace output and coverage?
@@ -92,11 +87,6 @@ apiReqFlag =
                   O.help "Format API request JSON using REQ_YAML file")
   <*> localFlag
 
-explainErrorCodeFlag :: O.Parser ReplOpts
-explainErrorCodeFlag =
-  OExplainErrorCode <$> O.strOption (O.long "explain-error-code" <> O.metavar "ERROR_CODE" <>
-                                     O.help "Describe the error code")
-
 unsignedReqFlag :: O.Parser ReplOpts
 unsignedReqFlag = OUnsignedReq
   <$> O.strOption (O.short 'u' <> O.long "unsigned" <> O.metavar "REQ_YAML" <>
@@ -128,10 +118,6 @@ main = O.execParser argParser >>= \case
           Just s -> runScript s dbg
           Nothing -> runScript fp dbg
       | otherwise -> runScript fp dbg
-    OExplainErrorCode errCodeStr -> case errorCodeFromText $ T.pack errCodeStr of
-      Nothing -> putStrLn $ "Invalid error code format" -- todo enhance error
-      Just errCode -> let (PrettyErrorCode phase cause _ _) = prettyErrorCode $ PactErrorCode errCode "" NoInfo
-        in T.putStrLn ("Encountered failure in: " <> phase <> ", caused by: " <> cause)
     OServer configPath -> Y.decodeFileEither configPath >>= \case
       Left perr -> putStrLn $ Y.prettyPrintParseException perr
       Right config -> runServer config noSPVSupport

pact-request-api/Pact/Core/Command/Server.hs

@@ -89,7 +89,7 @@ instance Show ProcessResult where
     PEUnknownException _ -> "UnkownException"
 
 data ProcessMsg
-  = StoreMsg RequestKey (CommandResult Hash (PactErrorCompat (LocatedErrorInfo Info))) (MVar ProcessResult)
+  = StoreMsg RequestKey (CommandResult Hash PactOnChainError) (MVar ProcessResult)
 
 instance Show ProcessMsg where
   show = \case
@@ -115,7 +115,7 @@ instance JE.Encode PollRequest where
   build (PollRequest rks) = JE.object [ "requestKeys" JE..= JE.Array rks ]
 
 newtype PollResponse
-  = PollResponse (HM.HashMap RequestKey (CommandResult Hash (PactErrorCompat (LocatedErrorInfo Info))))
+  = PollResponse (HM.HashMap RequestKey (CommandResult Hash (PactOnChainError)))
   deriving newtype (Eq, Show)
 
 instance JE.Encode PollResponse where
@@ -138,7 +138,7 @@ instance JD.FromJSON ListenRequest where
     ListenRequest <$> o JD..: "listen"
 
 newtype ListenResponse
-  = ListenResponse (CommandResult Hash (PactErrorCompat (LocatedErrorInfo Info)))
+  = ListenResponse (CommandResult Hash (PactOnChainError))
   deriving newtype (Eq, Show)
 
 instance JD.FromJSON ListenResponse where
@@ -154,7 +154,7 @@ instance JE.Encode LocalRequest where
   build (LocalRequest cmd) = JE.build cmd
 
 newtype LocalResponse
-  = LocalResponse { _localResponse :: CommandResult Hash (PactErrorCompat (LocatedErrorInfo Info)) }
+  = LocalResponse { _localResponse :: CommandResult Hash (PactOnChainError) }
 
 instance JD.FromJSON LocalResponse where
   parseJSON v = LocalResponse <$> JD.parseJSON v
@@ -288,7 +288,7 @@ sendHandler runtime (SendRequest submitBatch) = do
         Left (_::SomeException)-> throwError err500
     pure $ SendResponse $ RequestKeys requestKeys
 
-computeResultAndUpdateState :: ServerRuntime -> RequestKey -> Command Text -> IO (CommandResult Hash (PactErrorCompat (LocatedErrorInfo Info)))
+computeResultAndUpdateState :: ServerRuntime -> RequestKey -> Command Text -> IO (CommandResult Hash (PactOnChainError))
 computeResultAndUpdateState runtime requestKey cmd =
   case verifyCommand @(StableEncoding PublicMeta) (fmap E.encodeUtf8 cmd) of
     ProcFail errStr -> do
@@ -331,7 +331,7 @@ computeResultAndUpdateState runtime requestKey cmd =
             pure $ pactErrorToCommandResult requestKey pe (Gas 0)
           Right evalResult -> pure $ evalResultToCommandResult requestKey evalResult
 
-evalResultToCommandResult :: RequestKey -> EvalResult -> CommandResult Hash (PactErrorCompat (LocatedErrorInfo Info))
+evalResultToCommandResult :: RequestKey -> EvalResult -> CommandResult Hash (PactOnChainError)
 evalResultToCommandResult requestKey (EvalResult out logs exec gas _lm txid _lgas ev) =
   CommandResult
   { _crReqKey = requestKey
@@ -344,11 +344,11 @@ evalResultToCommandResult requestKey (EvalResult out logs exec gas _lm txid _lga
   , _crMetaData = Nothing
   }
 
-pactErrorToCommandResult :: RequestKey -> PactError Info -> Gas -> CommandResult Hash (PactErrorCompat (LocatedErrorInfo Info))
+pactErrorToCommandResult :: RequestKey -> PactError Info -> Gas -> CommandResult Hash (PactOnChainError)
 pactErrorToCommandResult rk pe gas = CommandResult
   { _crReqKey = rk
   , _crTxId = Nothing
-  , _crResult = PactResultErr $ PEPact5Error $ pactErrorToLocatedErrorCode $ pe
+  , _crResult = PactResultErr $ pactErrorToOnChainError pe
   , _crGas = gas
   , _crLogs = Nothing
   , _crEvents = [] -- todo
@@ -357,10 +357,10 @@ pactErrorToCommandResult rk pe gas = CommandResult
   }
 
  -- TODO: once base-4.19 switch to L.unsnoc
-evalOutputToCommandResult :: [CompileValue Info] -> PactResult (PactErrorCompat (LocatedErrorInfo Info))
+evalOutputToCommandResult :: [CompileValue Info] -> PactResult (PactOnChainError)
 evalOutputToCommandResult li = case L.uncons $ L.reverse li of
   Just (v, _) -> PactResultOk (compileValueToPactValue v)
-  Nothing -> PactResultErr $ PEPact5Error $ pactErrorToErrorCode $ PEExecutionError (EvalError "empty input") [] def
+  Nothing -> PactResultErr $ pactErrorToOnChainError $ PEExecutionError (EvalError "empty input") [] def
 
 localHandler :: ServerRuntime -> LocalRequest -> Handler LocalResponse
 localHandler env (LocalRequest cmd) = do

pact-request-api/Pact/Core/Command/Server/History.hs

@@ -28,7 +28,7 @@ import qualified Pact.JSON.Decode as J
 import Pact.Core.Persistence.SQLite
 import Pact.Core.Serialise
 
-type Cmd = CommandResult Hash (PactErrorCompat (LocatedErrorInfo Info))
+type Cmd = CommandResult Hash (PactOnChainError)
 
 data HistoryDb
   = HistoryDb

pact-tests/Pact/Core/Test/ClientTests.hs

@@ -18,7 +18,6 @@ import Pact.Core.Command.Client
 
 import Pact.Core.Test.ServerUtils
 import Pact.Core.Errors
-import Pact.Core.Evaluate
 
 simpleServerCmd :: IO (Command Text)
 simpleServerCmd = do
@@ -44,7 +43,7 @@ tests = testGroup "Servant API client tests" [
       cmd <- simpleServerCmdWithPactErr
       res <- withTestPactServer "clientspec" $ \clientEnv -> do
         runClientM (localClient (LocalRequest cmd)) clientEnv
-      (_crResult . _localResponse <$> res) `shouldSatisfy` failWith (ErrorCode 0)
+      (_crResult . _localResponse <$> res) `shouldSatisfy` failWith (ErrorType "ExecutionError")
 
     , testCase "correctly runs a simple command publicly and listens to the result" $ do
       cmd <- simpleServerCmd
@@ -72,15 +71,13 @@ tests = testGroup "Servant API client tests" [
         Left _ -> assertFailure "client request failed"
         Right r -> case r of
           -- ListenTimeout _ -> assertFailure "timeout"
-          ListenResponse lr -> Right (_crResult lr) `shouldSatisfy` failWith (ErrorCode 0)
+          ListenResponse lr -> Right (_crResult lr) `shouldSatisfy` failWith (ErrorType "ExecutionError")
   ]
 
-failWith :: ErrorCode -> Either ClientError (PactResult (PactErrorCompat (LocatedErrorInfo Info))) -> Bool
+failWith :: ErrorType -> Either ClientError (PactResult (PactOnChainError)) -> Bool
 failWith errType res = case res of
   Left _ -> False
   Right r -> case r of
     PactResultOk _ -> False
-    PactResultErr r' -> case r' of
-      PELegacyError _ -> False
-      PEPact5Error pe -> _peCode pe == errType
+    PactResultErr pe -> _peType pe == errType
 

pact-tests/Pact/Core/Test/JSONRoundtripTests.hs

@@ -70,4 +70,5 @@ tests = testGroup "JSON Roundtrips" $ stableEncodings ++ jsonRoundtrips
   jsonRoundtrips = fmap testJSONRoundtrip $
     [ EncodingCase signerGen
     , EncodingCase lineInfoGen
+    , EncodingCase pactOnChainErrorGen
     ]