module Morley.Client.RPC.Error
( ClientRpcError (..)
, ClientRpcErrorWithStack (..)
, RunCodeErrors (..)
, UnexpectedErrors (..)
, IncorrectRpcResponse (..)
, WaitForOperationError (..)
) where
import Data.Typeable (cast)
import Fmt (Buildable(..), blockListF, nameF, pretty, unlinesF, (+|), (|+))
import Morley.Micheline (Expression)
import Morley.Tezos.Address
import Morley.Client.RPC.Types
data ClientRpcErrorWithStack a = ClientRpcErrorWithStack
{ forall a.
ClientRpcErrorWithStack a -> NonEmpty (OperationResp WithSource)
crewsStack :: NonEmpty (OperationResp WithSource)
, forall a. ClientRpcErrorWithStack a -> a
crewsError :: a
} deriving stock Int -> ClientRpcErrorWithStack a -> ShowS
[ClientRpcErrorWithStack a] -> ShowS
ClientRpcErrorWithStack a -> String
(Int -> ClientRpcErrorWithStack a -> ShowS)
-> (ClientRpcErrorWithStack a -> String)
-> ([ClientRpcErrorWithStack a] -> ShowS)
-> Show (ClientRpcErrorWithStack a)
forall a. Show a => Int -> ClientRpcErrorWithStack a -> ShowS
forall a. Show a => [ClientRpcErrorWithStack a] -> ShowS
forall a. Show a => ClientRpcErrorWithStack a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientRpcErrorWithStack a] -> ShowS
$cshowList :: forall a. Show a => [ClientRpcErrorWithStack a] -> ShowS
show :: ClientRpcErrorWithStack a -> String
$cshow :: forall a. Show a => ClientRpcErrorWithStack a -> String
showsPrec :: Int -> ClientRpcErrorWithStack a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ClientRpcErrorWithStack a -> ShowS
Show
instance Buildable a => Buildable (ClientRpcErrorWithStack a) where
build :: ClientRpcErrorWithStack a -> Doc
build ClientRpcErrorWithStack{a
NonEmpty (OperationResp WithSource)
crewsError :: a
crewsStack :: NonEmpty (OperationResp WithSource)
crewsError :: forall a. ClientRpcErrorWithStack a -> a
crewsStack :: forall a.
ClientRpcErrorWithStack a -> NonEmpty (OperationResp WithSource)
..} = [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
[ a -> Doc
forall a. Buildable a => a -> Doc
build a
crewsError
, Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Call stack" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ OperationResp WithSource -> Doc
forall a. Buildable a => a -> Doc
build (OperationResp WithSource -> Doc)
-> [OperationResp WithSource] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (OperationResp WithSource)
-> [Element (NonEmpty (OperationResp WithSource))]
forall t. Container t => t -> [Element t]
toList NonEmpty (OperationResp WithSource)
crewsStack
]
instance (Show a, Typeable a, Buildable a) => Exception (ClientRpcErrorWithStack a) where
displayException :: ClientRpcErrorWithStack a -> String
displayException = ClientRpcErrorWithStack a -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty
data ClientRpcError
= ContractFailed
ContractAddress
Expression
| BadParameter
Address
Expression
| EmptyTransaction
ImplicitAddress
| ShiftOverflow
ContractAddress
| GasExhaustion
ContractAddress
| KeyAlreadyRevealed
ImplicitAddress
| DelegateNotRegistered
ImplicitAddress
| ClientInternalError
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 -> Doc
build = \case
ContractFailed ContractAddress
addr Expression
expr ->
Doc
"The execution of the smart contract " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ContractAddress
addr ContractAddress -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+
Doc
" failed with " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Expression
expr Expression -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
BadParameter Address
addr Expression
expr ->
Doc
"Parameter " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Expression
expr Expression -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" does not match the type of " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Address
addr Address -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"."
EmptyTransaction ImplicitAddress
addr -> RunError -> Doc
forall a. Buildable a => a -> Doc
build (ImplicitAddress -> RunError
REEmptyTransaction ImplicitAddress
addr)
ShiftOverflow ContractAddress
addr -> ContractAddress
addr ContractAddress -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" failed due to shift overflow"
GasExhaustion ContractAddress
addr -> ContractAddress
addr ContractAddress -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" failed due to gas exhaustion"
KeyAlreadyRevealed ImplicitAddress
addr -> Doc
"Key for " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ImplicitAddress
addr ImplicitAddress -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" has already been revealed"
DelegateNotRegistered ImplicitAddress
addr -> ImplicitAddress
addr ImplicitAddress -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" not registered as delegate"
ClientInternalError InternalError
err -> InternalError -> Doc
forall a. Buildable a => a -> Doc
build InternalError
err
instance Exception ClientRpcError where
displayException :: ClientRpcError -> String
displayException = ClientRpcError -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty
fromException :: SomeException -> Maybe ClientRpcError
fromException (SomeException e
e) = e -> Maybe ClientRpcError
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e Maybe ClientRpcError
-> Maybe ClientRpcError -> Maybe ClientRpcError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ClientRpcErrorWithStack ClientRpcError -> ClientRpcError)
-> Maybe (ClientRpcErrorWithStack ClientRpcError)
-> Maybe ClientRpcError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClientRpcErrorWithStack ClientRpcError -> ClientRpcError
forall a. ClientRpcErrorWithStack a -> a
crewsError (e -> Maybe (ClientRpcErrorWithStack ClientRpcError)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e)
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 -> Doc
build (RunCodeErrors [RunError]
errs) = Doc
"'run_code' failed with the following errors: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+|
[RunError] -> Doc
forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
blockListF [RunError]
errs Doc -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
instance Exception RunCodeErrors where
displayException :: RunCodeErrors -> String
displayException = RunCodeErrors -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty
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 -> Doc
build = \case
UnexpectedRunErrors [RunError]
errs ->
Doc
"Preapply failed due to the following errors:\n" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+|
[Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ((RunError -> Doc) -> [RunError] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"\n\n") (Doc -> Doc) -> (RunError -> Doc) -> RunError -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunError -> Doc
forall a. Buildable a => a -> Doc
build) [RunError]
errs) Doc -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
UnexpectedInternalErrors [InternalError]
errs ->
Doc
"RPC failed with unexpected internal errors:\n" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+|
[Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ((InternalError -> Doc) -> [InternalError] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"\n\n") (Doc -> Doc) -> (InternalError -> Doc) -> InternalError -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalError -> Doc
forall a. Buildable a => a -> Doc
build) [InternalError]
errs) Doc -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
instance Exception UnexpectedErrors where
displayException :: UnexpectedErrors -> String
displayException = UnexpectedErrors -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty
fromException :: SomeException -> Maybe UnexpectedErrors
fromException (SomeException e
e) = e -> Maybe UnexpectedErrors
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e Maybe UnexpectedErrors
-> Maybe UnexpectedErrors -> Maybe UnexpectedErrors
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ClientRpcErrorWithStack UnexpectedErrors -> UnexpectedErrors)
-> Maybe (ClientRpcErrorWithStack UnexpectedErrors)
-> Maybe UnexpectedErrors
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClientRpcErrorWithStack UnexpectedErrors -> UnexpectedErrors
forall a. ClientRpcErrorWithStack a -> a
crewsError (e -> Maybe (ClientRpcErrorWithStack UnexpectedErrors)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e)
data IncorrectRpcResponse
= RpcUnexpectedSize Int Int
| RpcOriginatedNoContracts
| RpcOriginatedMoreContracts [ContractAddress]
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 -> Doc
build = \case
RpcUnexpectedSize Int
expected Int
got ->
Doc
"An RPC call returned a list that has " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Int
got Int -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+
Doc
" items, but we expected to get " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Int
expected Int -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" results"
RpcOriginatedMoreContracts [ContractAddress]
addresses ->
Doc
"Operation expected to originate one contract, but will more:\n" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+|
[Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ((ContractAddress -> Doc) -> [ContractAddress] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"\n") (Doc -> Doc) -> (ContractAddress -> Doc) -> ContractAddress -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractAddress -> Doc
forall a. Buildable a => a -> Doc
build) [ContractAddress]
addresses) Doc -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
IncorrectRpcResponse
RpcOriginatedNoContracts ->
Doc
"Operation expected to originate a contract, but produced nothing"
instance Exception IncorrectRpcResponse where
displayException :: IncorrectRpcResponse -> String
displayException = IncorrectRpcResponse -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty
data WaitForOperationError
= WaitForOperationBlockout Word
| WaitForOperationStreamingError Text
deriving stock Int -> WaitForOperationError -> ShowS
[WaitForOperationError] -> ShowS
WaitForOperationError -> String
(Int -> WaitForOperationError -> ShowS)
-> (WaitForOperationError -> String)
-> ([WaitForOperationError] -> ShowS)
-> Show WaitForOperationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WaitForOperationError] -> ShowS
$cshowList :: [WaitForOperationError] -> ShowS
show :: WaitForOperationError -> String
$cshow :: WaitForOperationError -> String
showsPrec :: Int -> WaitForOperationError -> ShowS
$cshowsPrec :: Int -> WaitForOperationError -> ShowS
Show
instance Buildable WaitForOperationError where
build :: WaitForOperationError -> Doc
build = \case
WaitForOperationBlockout Word
n -> Doc
"Operation not included after " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Word
n Word -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" blocks"
WaitForOperationStreamingError Text
s ->
Doc
"Streaming error received waiting for operation: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Text
s Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
instance Exception WaitForOperationError where
displayException :: WaitForOperationError -> String
displayException = WaitForOperationError -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty