module Network.GRPC.Spec.Status (
    -- * GRPC status
    GrpcStatus(..)
  , GrpcError(..)
  , fromGrpcStatus
  , fromGrpcError
  , toGrpcStatus
  , toGrpcError
    -- * Exceptions
  , GrpcException(..)
  , throwGrpcError
    -- * Details
  , Status
  ) where

import Control.Exception
import Data.ByteString qualified as Strict (ByteString)
import Data.List (intercalate)
import Data.Text (Text)
import Data.Text qualified as Text
import GHC.Generics (Generic)

import Network.GRPC.Spec.CustomMetadata.Raw (CustomMetadata)

import Proto.Status

{-------------------------------------------------------------------------------
  gRPC status
-------------------------------------------------------------------------------}

-- | gRPC status
--
-- Defined in <https://github.com/grpc/grpc/blob/master/doc/statuscodes.md>.
data GrpcStatus =
    GrpcOk
  | GrpcError GrpcError
  deriving stock (Int -> GrpcStatus -> ShowS
[GrpcStatus] -> ShowS
GrpcStatus -> String
(Int -> GrpcStatus -> ShowS)
-> (GrpcStatus -> String)
-> ([GrpcStatus] -> ShowS)
-> Show GrpcStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GrpcStatus -> ShowS
showsPrec :: Int -> GrpcStatus -> ShowS
$cshow :: GrpcStatus -> String
show :: GrpcStatus -> String
$cshowList :: [GrpcStatus] -> ShowS
showList :: [GrpcStatus] -> ShowS
Show, GrpcStatus -> GrpcStatus -> Bool
(GrpcStatus -> GrpcStatus -> Bool)
-> (GrpcStatus -> GrpcStatus -> Bool) -> Eq GrpcStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GrpcStatus -> GrpcStatus -> Bool
== :: GrpcStatus -> GrpcStatus -> Bool
$c/= :: GrpcStatus -> GrpcStatus -> Bool
/= :: GrpcStatus -> GrpcStatus -> Bool
Eq, (forall x. GrpcStatus -> Rep GrpcStatus x)
-> (forall x. Rep GrpcStatus x -> GrpcStatus) -> Generic GrpcStatus
forall x. Rep GrpcStatus x -> GrpcStatus
forall x. GrpcStatus -> Rep GrpcStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GrpcStatus -> Rep GrpcStatus x
from :: forall x. GrpcStatus -> Rep GrpcStatus x
$cto :: forall x. Rep GrpcStatus x -> GrpcStatus
to :: forall x. Rep GrpcStatus x -> GrpcStatus
Generic)

-- | gRPC error code
--
-- This is a subset of the gRPC status codes. See 'GrpcStatus'.
data GrpcError =
    -- | Cancelled
    --
    -- The operation was cancelled, typically by the caller.
    GrpcCancelled

    -- | Unknown error
    --
    -- For example, this error may be returned when a @Status@ value received
    -- from another address space belongs to an error space that is not known in
    -- this address space. Also errors raised by APIs that do not return enough
    -- error information may be converted to this error.
  | GrpcUnknown

    -- | Invalid argument
    --
    -- The client specified an invalid argument. Note that this differs from
    -- 'GrpcFailedPrecondition': 'GrpcInvalidArgument' indicates arguments that
    -- are problematic regardless of the state of the system (e.g., a malformed
    -- file name).
  | GrpcInvalidArgument

    -- | Deadline exceeded
    --
    -- The deadline expired before the operation could complete. For operations
    -- that change the state of the system, this error may be returned even if
    -- the operation has completed successfully. For example, a successful
    -- response from a server could have been delayed long.
  | GrpcDeadlineExceeded

    -- | Not found
    --
    -- Some requested entity (e.g., file or directory) was not found.
    --
    -- Note to server developers: if a request is denied for an entire class of
    -- users, such as gradual feature rollout or undocumented allowlist,
    -- 'GrpcNotFound' may be used.
    --
    -- If a request is denied for some users within a class of users, such as
    -- user-based access control, 'GrpcPermissionDenied' must be used.
  | GrpcNotFound

    -- | Already exists
    --
    -- The entity that a client attempted to create (e.g., file or directory)
    -- already exists.
  | GrpcAlreadyExists

    -- | Permission denied
    --
    -- The caller does not have permission to execute the specified operation.
    --
    -- * 'GrpcPermissionDenied' must not be used for rejections caused by
    --   exhausting some resource (use 'GrpcResourceExhausted' instead for those
    --   errors).
    -- * 'GrpcPermissionDenied' must not be used if the caller can not be
    --   identified (use 'GrpcUnauthenticated' instead for those errors).
    --
    -- This error code does not imply the request is valid or the requested
    -- entity exists or satisfies other pre-conditions.
  | GrpcPermissionDenied

    -- | Resource exhausted
    --
    -- Some resource has been exhausted, perhaps a per-user quota, or perhaps
    -- the entire file system is out of space.
  | GrpcResourceExhausted

    -- | Failed precondition
    --
    -- The operation was rejected because the system is not in a state required
    -- for the operation's execution. For example, the directory to be deleted
    -- is non-empty, an rmdir operation is applied to a non-directory, etc.
    --
    -- Service implementors can use the following guidelines to decide between
    -- 'GrpcFailedPrecondition', 'GrpcAborted', and 'GrpcUnavailable':
    --
    -- (a) Use 'GrpcUnavailable' if the client can retry just the failing call.
    -- (b) Use 'GrpcAborted' if the client should retry at a higher level (e.g.,
    --     when a client-specified test-and-set fails, indicating the client
    --     should restart a read-modify-write sequence).
    -- (c) Use `GrpcFailedPrecondition` if the client should not retry until the
    --     system state has been explicitly fixed. E.g., if an @rmdir@ fails
    --     because the directory is non-empty, 'GrpcFailedPrecondition' should
    --     be returned since the client should not retry unless the files are
    --     deleted from the directory.
  | GrpcFailedPrecondition

    -- | Aborted
    --
    -- The operation was aborted, typically due to a concurrency issue such as a
    -- sequencer check failure or transaction abort. See the guidelines above
    -- for deciding between 'GrpcFailedPrecondition', 'GrpcAborted', and
    -- 'GrpcUnavailable'.
  | GrpcAborted

    -- | Out of range
    --
    -- The operation was attempted past the valid range. E.g., seeking or
    -- reading past end-of-file.
    --
    -- Unlike 'GrpcInvalidArgument', this error indicates a problem that may be
    -- fixed if the system state changes. For example, a 32-bit file system will
    -- generate 'GrpcInvalidArgument' if asked to read at an offset that is not
    -- in the range @[0, 2^32-1]@, but it will generate 'GrpcOutOfRange' if
    -- asked to read from an offset past the current file size.
    --
    -- There is a fair bit of overlap between 'GrpcFailedPrecondition' and
    -- 'GrpcOutOfRange'. We recommend using 'GrpcOutOfRange' (the more specific
    -- error) when it applies so that callers who are iterating through a space
    -- can easily look for an 'GrpcOutOfRange' error to detect when they are
    -- done.
  | GrpcOutOfRange

    -- | Unimplemented
    --
    -- The operation is not implemented or is not supported/enabled in this
    -- service.
  | GrpcUnimplemented

    -- | Internal errors
    --
    -- This means that some invariants expected by the underlying system have
    -- been broken. This error code is reserved for serious errors.
  | GrpcInternal

    -- | Unavailable
    --
    -- The service is currently unavailable. This is most likely a transient
    -- condition, which can be corrected by retrying with a backoff. Note that
    -- it is not always safe to retry non-idempotent operations.
  | GrpcUnavailable

    -- | Data loss
    --
    -- Unrecoverable data loss or corruption.
  | GrpcDataLoss

    -- | Unauthenticated
    --
    -- The request does not have valid authentication credentials for the
    -- operation.
  | GrpcUnauthenticated
  deriving stock (Int -> GrpcError -> ShowS
[GrpcError] -> ShowS
GrpcError -> String
(Int -> GrpcError -> ShowS)
-> (GrpcError -> String)
-> ([GrpcError] -> ShowS)
-> Show GrpcError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GrpcError -> ShowS
showsPrec :: Int -> GrpcError -> ShowS
$cshow :: GrpcError -> String
show :: GrpcError -> String
$cshowList :: [GrpcError] -> ShowS
showList :: [GrpcError] -> ShowS
Show, GrpcError -> GrpcError -> Bool
(GrpcError -> GrpcError -> Bool)
-> (GrpcError -> GrpcError -> Bool) -> Eq GrpcError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GrpcError -> GrpcError -> Bool
== :: GrpcError -> GrpcError -> Bool
$c/= :: GrpcError -> GrpcError -> Bool
/= :: GrpcError -> GrpcError -> Bool
Eq, Eq GrpcError
Eq GrpcError =>
(GrpcError -> GrpcError -> Ordering)
-> (GrpcError -> GrpcError -> Bool)
-> (GrpcError -> GrpcError -> Bool)
-> (GrpcError -> GrpcError -> Bool)
-> (GrpcError -> GrpcError -> Bool)
-> (GrpcError -> GrpcError -> GrpcError)
-> (GrpcError -> GrpcError -> GrpcError)
-> Ord GrpcError
GrpcError -> GrpcError -> Bool
GrpcError -> GrpcError -> Ordering
GrpcError -> GrpcError -> GrpcError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GrpcError -> GrpcError -> Ordering
compare :: GrpcError -> GrpcError -> Ordering
$c< :: GrpcError -> GrpcError -> Bool
< :: GrpcError -> GrpcError -> Bool
$c<= :: GrpcError -> GrpcError -> Bool
<= :: GrpcError -> GrpcError -> Bool
$c> :: GrpcError -> GrpcError -> Bool
> :: GrpcError -> GrpcError -> Bool
$c>= :: GrpcError -> GrpcError -> Bool
>= :: GrpcError -> GrpcError -> Bool
$cmax :: GrpcError -> GrpcError -> GrpcError
max :: GrpcError -> GrpcError -> GrpcError
$cmin :: GrpcError -> GrpcError -> GrpcError
min :: GrpcError -> GrpcError -> GrpcError
Ord, (forall x. GrpcError -> Rep GrpcError x)
-> (forall x. Rep GrpcError x -> GrpcError) -> Generic GrpcError
forall x. Rep GrpcError x -> GrpcError
forall x. GrpcError -> Rep GrpcError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GrpcError -> Rep GrpcError x
from :: forall x. GrpcError -> Rep GrpcError x
$cto :: forall x. Rep GrpcError x -> GrpcError
to :: forall x. Rep GrpcError x -> GrpcError
Generic)
  deriving anyclass (Show GrpcError
Typeable GrpcError
(Typeable GrpcError, Show GrpcError) =>
(GrpcError -> SomeException)
-> (SomeException -> Maybe GrpcError)
-> (GrpcError -> String)
-> (GrpcError -> Bool)
-> Exception GrpcError
SomeException -> Maybe GrpcError
GrpcError -> Bool
GrpcError -> String
GrpcError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> (e -> Bool)
-> Exception e
$ctoException :: GrpcError -> SomeException
toException :: GrpcError -> SomeException
$cfromException :: SomeException -> Maybe GrpcError
fromException :: SomeException -> Maybe GrpcError
$cdisplayException :: GrpcError -> String
displayException :: GrpcError -> String
$cbacktraceDesired :: GrpcError -> Bool
backtraceDesired :: GrpcError -> Bool
Exception)

{-------------------------------------------------------------------------------
  Status codes
-------------------------------------------------------------------------------}

-- | Translate 'GrpcStatus' to numerical status code
--
-- See <https://grpc.github.io/grpc/core/md_doc_statuscodes.html>
fromGrpcStatus :: GrpcStatus -> Word
fromGrpcStatus :: GrpcStatus -> Word
fromGrpcStatus  GrpcStatus
GrpcOk         =  Word
0
fromGrpcStatus (GrpcError GrpcError
err) = GrpcError -> Word
fromGrpcError GrpcError
err

-- | Translate 'GrpcError' to numerical status code
--
-- See also 'fromGrpcStatus'
fromGrpcError :: GrpcError -> Word
fromGrpcError :: GrpcError -> Word
fromGrpcError GrpcError
GrpcCancelled          =  Word
1
fromGrpcError GrpcError
GrpcUnknown            =  Word
2
fromGrpcError GrpcError
GrpcInvalidArgument    =  Word
3
fromGrpcError GrpcError
GrpcDeadlineExceeded   =  Word
4
fromGrpcError GrpcError
GrpcNotFound           =  Word
5
fromGrpcError GrpcError
GrpcAlreadyExists      =  Word
6
fromGrpcError GrpcError
GrpcPermissionDenied   =  Word
7
fromGrpcError GrpcError
GrpcResourceExhausted  =  Word
8
fromGrpcError GrpcError
GrpcFailedPrecondition =  Word
9
fromGrpcError GrpcError
GrpcAborted            = Word
10
fromGrpcError GrpcError
GrpcOutOfRange         = Word
11
fromGrpcError GrpcError
GrpcUnimplemented      = Word
12
fromGrpcError GrpcError
GrpcInternal           = Word
13
fromGrpcError GrpcError
GrpcUnavailable        = Word
14
fromGrpcError GrpcError
GrpcDataLoss           = Word
15
fromGrpcError GrpcError
GrpcUnauthenticated    = Word
16

-- | Inverse to 'fromGrpcStatus'
toGrpcStatus :: Word -> Maybe GrpcStatus
toGrpcStatus :: Word -> Maybe GrpcStatus
toGrpcStatus Word
0 = GrpcStatus -> Maybe GrpcStatus
forall a. a -> Maybe a
Just (GrpcStatus -> Maybe GrpcStatus) -> GrpcStatus -> Maybe GrpcStatus
forall a b. (a -> b) -> a -> b
$ GrpcStatus
GrpcOk
toGrpcStatus Word
s = GrpcError -> GrpcStatus
GrpcError (GrpcError -> GrpcStatus) -> Maybe GrpcError -> Maybe GrpcStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> Maybe GrpcError
toGrpcError Word
s

-- | Inverse to 'fromGrpcError'
toGrpcError :: Word -> Maybe GrpcError
toGrpcError :: Word -> Maybe GrpcError
toGrpcError  Word
1 = GrpcError -> Maybe GrpcError
forall a. a -> Maybe a
Just (GrpcError -> Maybe GrpcError) -> GrpcError -> Maybe GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcError
GrpcCancelled
toGrpcError  Word
2 = GrpcError -> Maybe GrpcError
forall a. a -> Maybe a
Just (GrpcError -> Maybe GrpcError) -> GrpcError -> Maybe GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcError
GrpcUnknown
toGrpcError  Word
3 = GrpcError -> Maybe GrpcError
forall a. a -> Maybe a
Just (GrpcError -> Maybe GrpcError) -> GrpcError -> Maybe GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcError
GrpcInvalidArgument
toGrpcError  Word
4 = GrpcError -> Maybe GrpcError
forall a. a -> Maybe a
Just (GrpcError -> Maybe GrpcError) -> GrpcError -> Maybe GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcError
GrpcDeadlineExceeded
toGrpcError  Word
5 = GrpcError -> Maybe GrpcError
forall a. a -> Maybe a
Just (GrpcError -> Maybe GrpcError) -> GrpcError -> Maybe GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcError
GrpcNotFound
toGrpcError  Word
6 = GrpcError -> Maybe GrpcError
forall a. a -> Maybe a
Just (GrpcError -> Maybe GrpcError) -> GrpcError -> Maybe GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcError
GrpcAlreadyExists
toGrpcError  Word
7 = GrpcError -> Maybe GrpcError
forall a. a -> Maybe a
Just (GrpcError -> Maybe GrpcError) -> GrpcError -> Maybe GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcError
GrpcPermissionDenied
toGrpcError  Word
8 = GrpcError -> Maybe GrpcError
forall a. a -> Maybe a
Just (GrpcError -> Maybe GrpcError) -> GrpcError -> Maybe GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcError
GrpcResourceExhausted
toGrpcError  Word
9 = GrpcError -> Maybe GrpcError
forall a. a -> Maybe a
Just (GrpcError -> Maybe GrpcError) -> GrpcError -> Maybe GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcError
GrpcFailedPrecondition
toGrpcError Word
10 = GrpcError -> Maybe GrpcError
forall a. a -> Maybe a
Just (GrpcError -> Maybe GrpcError) -> GrpcError -> Maybe GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcError
GrpcAborted
toGrpcError Word
11 = GrpcError -> Maybe GrpcError
forall a. a -> Maybe a
Just (GrpcError -> Maybe GrpcError) -> GrpcError -> Maybe GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcError
GrpcOutOfRange
toGrpcError Word
12 = GrpcError -> Maybe GrpcError
forall a. a -> Maybe a
Just (GrpcError -> Maybe GrpcError) -> GrpcError -> Maybe GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcError
GrpcUnimplemented
toGrpcError Word
13 = GrpcError -> Maybe GrpcError
forall a. a -> Maybe a
Just (GrpcError -> Maybe GrpcError) -> GrpcError -> Maybe GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcError
GrpcInternal
toGrpcError Word
14 = GrpcError -> Maybe GrpcError
forall a. a -> Maybe a
Just (GrpcError -> Maybe GrpcError) -> GrpcError -> Maybe GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcError
GrpcUnavailable
toGrpcError Word
15 = GrpcError -> Maybe GrpcError
forall a. a -> Maybe a
Just (GrpcError -> Maybe GrpcError) -> GrpcError -> Maybe GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcError
GrpcDataLoss
toGrpcError Word
16 = GrpcError -> Maybe GrpcError
forall a. a -> Maybe a
Just (GrpcError -> Maybe GrpcError) -> GrpcError -> Maybe GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcError
GrpcUnauthenticated
toGrpcError Word
_  = Maybe GrpcError
forall a. Maybe a
Nothing

{-------------------------------------------------------------------------------
  gRPC exceptions
-------------------------------------------------------------------------------}

-- | Server indicated a gRPC error
--
-- For the common case where you just want to set 'grpcError', you can use
-- 'throwGrpcError'.
data GrpcException = GrpcException {
      GrpcException -> GrpcError
grpcError          :: GrpcError
    , GrpcException -> Maybe Text
grpcErrorMessage   :: Maybe Text
    , GrpcException -> Maybe ByteString
grpcErrorDetails   :: Maybe Strict.ByteString
    , GrpcException -> [CustomMetadata]
grpcErrorMetadata  :: [CustomMetadata]
    }
  deriving stock (Int -> GrpcException -> ShowS
[GrpcException] -> ShowS
GrpcException -> String
(Int -> GrpcException -> ShowS)
-> (GrpcException -> String)
-> ([GrpcException] -> ShowS)
-> Show GrpcException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GrpcException -> ShowS
showsPrec :: Int -> GrpcException -> ShowS
$cshow :: GrpcException -> String
show :: GrpcException -> String
$cshowList :: [GrpcException] -> ShowS
showList :: [GrpcException] -> ShowS
Show, GrpcException -> GrpcException -> Bool
(GrpcException -> GrpcException -> Bool)
-> (GrpcException -> GrpcException -> Bool) -> Eq GrpcException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GrpcException -> GrpcException -> Bool
== :: GrpcException -> GrpcException -> Bool
$c/= :: GrpcException -> GrpcException -> Bool
/= :: GrpcException -> GrpcException -> Bool
Eq)

instance Exception GrpcException where
  displayException :: GrpcException -> String
displayException GrpcException{
                       GrpcError
grpcError :: GrpcException -> GrpcError
grpcError :: GrpcError
grpcError
                     , Maybe Text
grpcErrorMessage :: GrpcException -> Maybe Text
grpcErrorMessage :: Maybe Text
grpcErrorMessage
                     , Maybe ByteString
grpcErrorDetails :: GrpcException -> Maybe ByteString
grpcErrorDetails :: Maybe ByteString
grpcErrorDetails
                     , [CustomMetadata]
grpcErrorMetadata :: GrpcException -> [CustomMetadata]
grpcErrorMetadata :: [CustomMetadata]
grpcErrorMetadata
                     } = (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String)
-> ([[String]] -> [String]) -> [[String]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) [
        [ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
            String
"gRPC exception "
          , GrpcError -> String
forall a. Show a => a -> String
show GrpcError
grpcError
          , String
" ("
          , Word -> String
forall a. Show a => a -> String
show (GrpcError -> Word
fromGrpcError GrpcError
grpcError)
          , String
")"
          ]
        ]
      , [ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
              String
"Error message:"
            String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"| " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
msg)
        | Just Text
msg <- [Maybe Text
grpcErrorMessage]
        ]
      , [ String
"Additional details are available (see 'grpcErrorDetails')."
        | Just ByteString
_details <- [Maybe ByteString
grpcErrorDetails]
        ]
      , [ CustomMetadata -> String
forall a. Show a => a -> String
show CustomMetadata
md
        | CustomMetadata
md <- [CustomMetadata]
grpcErrorMetadata
        ]
      ]


-- | Convenience function to throw an t'GrpcException' with the specified error
throwGrpcError :: GrpcError -> IO a
throwGrpcError :: forall a. GrpcError -> IO a
throwGrpcError GrpcError
grpcError = GrpcException -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (GrpcException -> IO a) -> GrpcException -> IO a
forall a b. (a -> b) -> a -> b
$ GrpcException {
      GrpcError
grpcError :: GrpcError
grpcError :: GrpcError
grpcError
    , grpcErrorMessage :: Maybe Text
grpcErrorMessage  = Maybe Text
forall a. Maybe a
Nothing
    , grpcErrorDetails :: Maybe ByteString
grpcErrorDetails  = Maybe ByteString
forall a. Maybe a
Nothing
    , grpcErrorMetadata :: [CustomMetadata]
grpcErrorMetadata = []
    }