-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Various errors that can happen in the RPC part of @morley-client@.
module Morley.Client.RPC.Error
  ( ClientRpcError (..)
  , RunCodeErrors (..)
  , UnexpectedErrors (..)
  , IncorrectRpcResponse (..)
  ) where

import Fmt (Buildable(..), blockListF, pretty, (+|), (|+))

import Morley.Micheline (Expression)
import Morley.Tezos.Address

import Morley.Client.RPC.Types

----------------------------------------------------------------------------
-- Caused by invalid user action
----------------------------------------------------------------------------

-- | Errors that can happen in the RPC part when a user tries to make
-- failing actions.
data ClientRpcError
  -- | Smart contract execution has failed.
  = ContractFailed
      Address -- ^ Smart contract address.
      Expression -- ^ Value the contract has failed with.

  | BadParameter
    -- ^ Parameter passed to a contract does not match its type.
      Address -- ^ Smart contract address.
      Expression -- ^ Value passed as parameter.
  | EmptyTransaction
    -- ^ Transfer of 0 to an implicit account.
      Address -- ^ Receiver address.
  | ShiftOverflow
    -- ^ A smart contract execution failed due to a shift overflow.
    Address
    -- ^ Smart contract address.
  | GasExhaustion
    -- ^ A smart contract execution failed due gas exhaustion.
    Address
    -- ^ Smart contract address.
  | KeyAlreadyRevealed
    -- ^ A key has already been revealed.
    Address
    -- ^ The address corresponding to the key.
  | ClientInternalError
    -- ^ An error that RPC considers internal occurred. These errors
    -- are considered internal by mistake, they are actually quite
    -- realistic and normally indicate bad user action. Currently we
    -- put 'InternalError' here as is, because it's easy for a user of
    -- @morley-client@ to work with this type. In #284 we will
    -- consider more errors and maybe some of them will need to be
    -- mapped into something more user-friendly, then we will
    -- reconsider this approach.
    InternalError
  deriving stock Int -> ClientRpcError -> ShowS
[ClientRpcError] -> ShowS
ClientRpcError -> String
(Int -> ClientRpcError -> ShowS)
-> (ClientRpcError -> String)
-> ([ClientRpcError] -> ShowS)
-> Show ClientRpcError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientRpcError] -> ShowS
$cshowList :: [ClientRpcError] -> ShowS
show :: ClientRpcError -> String
$cshow :: ClientRpcError -> String
showsPrec :: Int -> ClientRpcError -> ShowS
$cshowsPrec :: Int -> ClientRpcError -> ShowS
Show

instance Buildable ClientRpcError where
  build :: ClientRpcError -> Builder
build = \case
    ContractFailed Address
addr Expression
expr ->
      Builder
"The execution of the smart contract " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Address
addr Address -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
      Builder
" failed with " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expression
expr Expression -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    BadParameter Address
addr Expression
expr ->
      Builder
"Parameter " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expression
expr Expression -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" does not match the type of " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Address
addr Address -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"."
    EmptyTransaction Address
addr -> RunError -> Builder
forall p. Buildable p => p -> Builder
build (Address -> RunError
REEmptyTransaction Address
addr)
    ShiftOverflow Address
addr -> Address
addr Address -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" failed due to shift overflow"
    GasExhaustion Address
addr -> Address
addr Address -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" failed due to gas exhaustion"
    KeyAlreadyRevealed Address
addr -> Builder
"Key for " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Address
addr Address -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" has already been revealed"
    ClientInternalError InternalError
err -> InternalError -> Builder
forall p. Buildable p => p -> Builder
build InternalError
err

instance Exception ClientRpcError where
  displayException :: ClientRpcError -> String
displayException = ClientRpcError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty

-- | Errors that can happen during @run_code@ endpoint call.
-- These errors returned along with 500 code, so we have to handle
-- them a bit differently in comparison to other run errors that are
-- returned as a part of successful JSON response.
data RunCodeErrors = RunCodeErrors [RunError]
  deriving stock Int -> RunCodeErrors -> ShowS
[RunCodeErrors] -> ShowS
RunCodeErrors -> String
(Int -> RunCodeErrors -> ShowS)
-> (RunCodeErrors -> String)
-> ([RunCodeErrors] -> ShowS)
-> Show RunCodeErrors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunCodeErrors] -> ShowS
$cshowList :: [RunCodeErrors] -> ShowS
show :: RunCodeErrors -> String
$cshow :: RunCodeErrors -> String
showsPrec :: Int -> RunCodeErrors -> ShowS
$cshowsPrec :: Int -> RunCodeErrors -> ShowS
Show

instance Buildable RunCodeErrors where
  build :: RunCodeErrors -> Builder
build (RunCodeErrors [RunError]
errs) = Builder
"'run_code' failed with the following errors: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      [RunError] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
blockListF [RunError]
errs Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

instance Exception RunCodeErrors where
  displayException :: RunCodeErrors -> String
displayException = RunCodeErrors -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty

----------------------------------------------------------------------------
-- Caused by unexpected node behavior or incorrect assumption in our code
----------------------------------------------------------------------------

-- | Errors that we don't expect to happen, but they can be reported
-- by the server.
data UnexpectedErrors
  = UnexpectedRunErrors [RunError]
  | UnexpectedInternalErrors [InternalError]
  deriving stock (Int -> UnexpectedErrors -> ShowS
[UnexpectedErrors] -> ShowS
UnexpectedErrors -> String
(Int -> UnexpectedErrors -> ShowS)
-> (UnexpectedErrors -> String)
-> ([UnexpectedErrors] -> ShowS)
-> Show UnexpectedErrors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnexpectedErrors] -> ShowS
$cshowList :: [UnexpectedErrors] -> ShowS
show :: UnexpectedErrors -> String
$cshow :: UnexpectedErrors -> String
showsPrec :: Int -> UnexpectedErrors -> ShowS
$cshowsPrec :: Int -> UnexpectedErrors -> ShowS
Show)

instance Buildable UnexpectedErrors where
  build :: UnexpectedErrors -> Builder
build = \case
    UnexpectedRunErrors [RunError]
errs ->
      Builder
"Preapply failed due to the following errors:\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((RunError -> Builder) -> [RunError] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n\n") (Builder -> Builder)
-> (RunError -> Builder) -> RunError -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunError -> Builder
forall p. Buildable p => p -> Builder
build) [RunError]
errs) Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    UnexpectedInternalErrors [InternalError]
errs ->
      Builder
"RPC failed with unexpected internal errors:\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((InternalError -> Builder) -> [InternalError] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n\n") (Builder -> Builder)
-> (InternalError -> Builder) -> InternalError -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalError -> Builder
forall p. Buildable p => p -> Builder
build) [InternalError]
errs) Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

instance Exception UnexpectedErrors where
  displayException :: UnexpectedErrors -> String
displayException = UnexpectedErrors -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty

-- | Errors that we can throw when we get a response from a node that
-- doesn't match our expectations. It means that either the node we
-- are talking to misbehaves or our code is incorrect.
data IncorrectRpcResponse
  = RpcUnexpectedSize Int Int
  | RpcOriginatedNoContracts
  | RpcNoOperationsRun
  | RpcOriginatedMoreContracts [Address]
  deriving stock Int -> IncorrectRpcResponse -> ShowS
[IncorrectRpcResponse] -> ShowS
IncorrectRpcResponse -> String
(Int -> IncorrectRpcResponse -> ShowS)
-> (IncorrectRpcResponse -> String)
-> ([IncorrectRpcResponse] -> ShowS)
-> Show IncorrectRpcResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IncorrectRpcResponse] -> ShowS
$cshowList :: [IncorrectRpcResponse] -> ShowS
show :: IncorrectRpcResponse -> String
$cshow :: IncorrectRpcResponse -> String
showsPrec :: Int -> IncorrectRpcResponse -> ShowS
$cshowsPrec :: Int -> IncorrectRpcResponse -> ShowS
Show

instance Buildable IncorrectRpcResponse where
  build :: IncorrectRpcResponse -> Builder
build = \case
    RpcUnexpectedSize Int
expected Int
got ->
      Builder
"An RPC call returned a list that has " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Int
got Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
      Builder
" items, but we expected to get " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Int
expected Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" results"
    RpcOriginatedMoreContracts [Address]
addresses ->
      Builder
"Operation expected to originate one contract, but will more:\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Address -> Builder) -> [Address] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") (Builder -> Builder) -> (Address -> Builder) -> Address -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Builder
forall p. Buildable p => p -> Builder
build) [Address]
addresses) Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    IncorrectRpcResponse
RpcOriginatedNoContracts ->
      Builder
"Operation expected to originate a contract, but produced nothing"
    IncorrectRpcResponse
RpcNoOperationsRun ->
      Builder
"No operations was run"

instance Exception IncorrectRpcResponse where
  displayException :: IncorrectRpcResponse -> String
displayException = IncorrectRpcResponse -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty