{-# LANGUAGE OverloadedLabels #-}
module Network.GRPC.Common.Protobuf (
Protobuf
, Proto(..)
, getProto
, ProtobufError(..)
, throwProtobufError
, throwProtobufErrorHom
, toProtobufError
, toProtobufErrorHom
, (&)
, (.~)
, (^.)
, (%~)
, StreamingType(..)
, HasField(..)
, FieldDefault(..)
, Message(defMessage)
) where
import Control.Exception
import Control.Lens ((.~), (^.), (%~))
import Control.Monad
import Control.Monad.Except
import Data.Bifunctor
import Data.Function ((&))
import Data.Int
import Data.Maybe (fromMaybe)
import Data.ProtoLens.Field (HasField(..))
import Data.ProtoLens.Labels ()
import Data.ProtoLens.Message (FieldDefault(..), Message(defMessage))
import Data.Text (Text)
import Network.GRPC.Common.Protobuf.Any (Any)
import Network.GRPC.Common.Protobuf.Any qualified as Any
import Network.GRPC.Spec
import Network.GRPC.Spec.Serialization
data ProtobufError a = ProtobufError {
forall a. ProtobufError a -> GrpcError
protobufErrorCode :: GrpcError
, forall a. ProtobufError a -> Maybe Text
protobufErrorMessage :: Maybe Text
, forall a. ProtobufError a -> [a]
protobufErrorDetails :: [a]
}
deriving stock (Int -> ProtobufError a -> ShowS
[ProtobufError a] -> ShowS
ProtobufError a -> String
(Int -> ProtobufError a -> ShowS)
-> (ProtobufError a -> String)
-> ([ProtobufError a] -> ShowS)
-> Show (ProtobufError a)
forall a. Show a => Int -> ProtobufError a -> ShowS
forall a. Show a => [ProtobufError a] -> ShowS
forall a. Show a => ProtobufError a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ProtobufError a -> ShowS
showsPrec :: Int -> ProtobufError a -> ShowS
$cshow :: forall a. Show a => ProtobufError a -> String
show :: ProtobufError a -> String
$cshowList :: forall a. Show a => [ProtobufError a] -> ShowS
showList :: [ProtobufError a] -> ShowS
Show, ProtobufError a -> ProtobufError a -> Bool
(ProtobufError a -> ProtobufError a -> Bool)
-> (ProtobufError a -> ProtobufError a -> Bool)
-> Eq (ProtobufError a)
forall a. Eq a => ProtobufError a -> ProtobufError a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ProtobufError a -> ProtobufError a -> Bool
== :: ProtobufError a -> ProtobufError a -> Bool
$c/= :: forall a. Eq a => ProtobufError a -> ProtobufError a -> Bool
/= :: ProtobufError a -> ProtobufError a -> Bool
Eq, Eq (ProtobufError a)
Eq (ProtobufError a) =>
(ProtobufError a -> ProtobufError a -> Ordering)
-> (ProtobufError a -> ProtobufError a -> Bool)
-> (ProtobufError a -> ProtobufError a -> Bool)
-> (ProtobufError a -> ProtobufError a -> Bool)
-> (ProtobufError a -> ProtobufError a -> Bool)
-> (ProtobufError a -> ProtobufError a -> ProtobufError a)
-> (ProtobufError a -> ProtobufError a -> ProtobufError a)
-> Ord (ProtobufError a)
ProtobufError a -> ProtobufError a -> Bool
ProtobufError a -> ProtobufError a -> Ordering
ProtobufError a -> ProtobufError a -> ProtobufError a
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
forall a. Ord a => Eq (ProtobufError a)
forall a. Ord a => ProtobufError a -> ProtobufError a -> Bool
forall a. Ord a => ProtobufError a -> ProtobufError a -> Ordering
forall a.
Ord a =>
ProtobufError a -> ProtobufError a -> ProtobufError a
$ccompare :: forall a. Ord a => ProtobufError a -> ProtobufError a -> Ordering
compare :: ProtobufError a -> ProtobufError a -> Ordering
$c< :: forall a. Ord a => ProtobufError a -> ProtobufError a -> Bool
< :: ProtobufError a -> ProtobufError a -> Bool
$c<= :: forall a. Ord a => ProtobufError a -> ProtobufError a -> Bool
<= :: ProtobufError a -> ProtobufError a -> Bool
$c> :: forall a. Ord a => ProtobufError a -> ProtobufError a -> Bool
> :: ProtobufError a -> ProtobufError a -> Bool
$c>= :: forall a. Ord a => ProtobufError a -> ProtobufError a -> Bool
>= :: ProtobufError a -> ProtobufError a -> Bool
$cmax :: forall a.
Ord a =>
ProtobufError a -> ProtobufError a -> ProtobufError a
max :: ProtobufError a -> ProtobufError a -> ProtobufError a
$cmin :: forall a.
Ord a =>
ProtobufError a -> ProtobufError a -> ProtobufError a
min :: ProtobufError a -> ProtobufError a -> ProtobufError a
Ord, (forall a b. (a -> b) -> ProtobufError a -> ProtobufError b)
-> (forall a b. a -> ProtobufError b -> ProtobufError a)
-> Functor ProtobufError
forall a b. a -> ProtobufError b -> ProtobufError a
forall a b. (a -> b) -> ProtobufError a -> ProtobufError b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ProtobufError a -> ProtobufError b
fmap :: forall a b. (a -> b) -> ProtobufError a -> ProtobufError b
$c<$ :: forall a b. a -> ProtobufError b -> ProtobufError a
<$ :: forall a b. a -> ProtobufError b -> ProtobufError a
Functor, (forall m. Monoid m => ProtobufError m -> m)
-> (forall m a. Monoid m => (a -> m) -> ProtobufError a -> m)
-> (forall m a. Monoid m => (a -> m) -> ProtobufError a -> m)
-> (forall a b. (a -> b -> b) -> b -> ProtobufError a -> b)
-> (forall a b. (a -> b -> b) -> b -> ProtobufError a -> b)
-> (forall b a. (b -> a -> b) -> b -> ProtobufError a -> b)
-> (forall b a. (b -> a -> b) -> b -> ProtobufError a -> b)
-> (forall a. (a -> a -> a) -> ProtobufError a -> a)
-> (forall a. (a -> a -> a) -> ProtobufError a -> a)
-> (forall a. ProtobufError a -> [a])
-> (forall a. ProtobufError a -> Bool)
-> (forall a. ProtobufError a -> Int)
-> (forall a. Eq a => a -> ProtobufError a -> Bool)
-> (forall a. Ord a => ProtobufError a -> a)
-> (forall a. Ord a => ProtobufError a -> a)
-> (forall a. Num a => ProtobufError a -> a)
-> (forall a. Num a => ProtobufError a -> a)
-> Foldable ProtobufError
forall a. Eq a => a -> ProtobufError a -> Bool
forall a. Num a => ProtobufError a -> a
forall a. Ord a => ProtobufError a -> a
forall m. Monoid m => ProtobufError m -> m
forall a. ProtobufError a -> Bool
forall a. ProtobufError a -> Int
forall a. ProtobufError a -> [a]
forall a. (a -> a -> a) -> ProtobufError a -> a
forall m a. Monoid m => (a -> m) -> ProtobufError a -> m
forall b a. (b -> a -> b) -> b -> ProtobufError a -> b
forall a b. (a -> b -> b) -> b -> ProtobufError a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => ProtobufError m -> m
fold :: forall m. Monoid m => ProtobufError m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ProtobufError a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ProtobufError a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ProtobufError a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ProtobufError a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ProtobufError a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ProtobufError a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ProtobufError a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ProtobufError a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ProtobufError a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ProtobufError a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ProtobufError a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ProtobufError a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ProtobufError a -> a
foldr1 :: forall a. (a -> a -> a) -> ProtobufError a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ProtobufError a -> a
foldl1 :: forall a. (a -> a -> a) -> ProtobufError a -> a
$ctoList :: forall a. ProtobufError a -> [a]
toList :: forall a. ProtobufError a -> [a]
$cnull :: forall a. ProtobufError a -> Bool
null :: forall a. ProtobufError a -> Bool
$clength :: forall a. ProtobufError a -> Int
length :: forall a. ProtobufError a -> Int
$celem :: forall a. Eq a => a -> ProtobufError a -> Bool
elem :: forall a. Eq a => a -> ProtobufError a -> Bool
$cmaximum :: forall a. Ord a => ProtobufError a -> a
maximum :: forall a. Ord a => ProtobufError a -> a
$cminimum :: forall a. Ord a => ProtobufError a -> a
minimum :: forall a. Ord a => ProtobufError a -> a
$csum :: forall a. Num a => ProtobufError a -> a
sum :: forall a. Num a => ProtobufError a -> a
$cproduct :: forall a. Num a => ProtobufError a -> a
product :: forall a. Num a => ProtobufError a -> a
Foldable, Functor ProtobufError
Foldable ProtobufError
(Functor ProtobufError, Foldable ProtobufError) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProtobufError a -> f (ProtobufError b))
-> (forall (f :: * -> *) a.
Applicative f =>
ProtobufError (f a) -> f (ProtobufError a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ProtobufError a -> m (ProtobufError b))
-> (forall (m :: * -> *) a.
Monad m =>
ProtobufError (m a) -> m (ProtobufError a))
-> Traversable ProtobufError
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ProtobufError (m a) -> m (ProtobufError a)
forall (f :: * -> *) a.
Applicative f =>
ProtobufError (f a) -> f (ProtobufError a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ProtobufError a -> m (ProtobufError b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProtobufError a -> f (ProtobufError b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProtobufError a -> f (ProtobufError b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProtobufError a -> f (ProtobufError b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ProtobufError (f a) -> f (ProtobufError a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ProtobufError (f a) -> f (ProtobufError a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ProtobufError a -> m (ProtobufError b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ProtobufError a -> m (ProtobufError b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ProtobufError (m a) -> m (ProtobufError a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ProtobufError (m a) -> m (ProtobufError a)
Traversable)
throwProtobufError :: ProtobufError (Proto Any) -> IO x
throwProtobufError :: forall x. ProtobufError (Proto Any) -> IO x
throwProtobufError ProtobufError{
GrpcError
protobufErrorCode :: forall a. ProtobufError a -> GrpcError
protobufErrorCode :: GrpcError
protobufErrorCode
, Maybe Text
protobufErrorMessage :: forall a. ProtobufError a -> Maybe Text
protobufErrorMessage :: Maybe Text
protobufErrorMessage
, [Proto Any]
protobufErrorDetails :: forall a. ProtobufError a -> [a]
protobufErrorDetails :: [Proto Any]
protobufErrorDetails
} = GrpcException -> IO x
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (GrpcException -> IO x) -> GrpcException -> IO x
forall a b. (a -> b) -> a -> b
$ GrpcException {
grpcError :: GrpcError
grpcError = GrpcError
protobufErrorCode
, grpcErrorMessage :: Maybe Text
grpcErrorMessage = Maybe Text
protobufErrorMessage
, grpcErrorDetails :: Maybe ByteString
grpcErrorDetails = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Proto Status -> ByteString
buildStatus Proto Status
status
, grpcErrorMetadata :: [CustomMetadata]
grpcErrorMetadata = []
}
where
status :: Proto Status
status :: Proto Status
status =
Proto Status
forall msg. Message msg => msg
defMessage
Proto Status -> (Proto Status -> Proto Status) -> Proto Status
forall a b. a -> (a -> b) -> b
& ASetter (Proto Status) (Proto Status) Int32 Int32
#code ASetter (Proto Status) (Proto Status) Int32 Int32
-> Int32 -> Proto Status -> Proto Status
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GrpcError -> Word
fromGrpcError GrpcError
protobufErrorCode)
Proto Status -> (Proto Status -> Proto Status) -> Proto Status
forall a b. a -> (a -> b) -> b
& ASetter (Proto Status) (Proto Status) Text Text
#message ASetter (Proto Status) (Proto Status) Text Text
-> Text -> Proto Status -> Proto Status
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall value. FieldDefault value => value
fieldDefault Maybe Text
protobufErrorMessage
Proto Status -> (Proto Status -> Proto Status) -> Proto Status
forall a b. a -> (a -> b) -> b
& ASetter (Proto Status) (Proto Status) [Proto Any] [Proto Any]
#details ASetter (Proto Status) (Proto Status) [Proto Any] [Proto Any]
-> [Proto Any] -> Proto Status -> Proto Status
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Proto Any]
protobufErrorDetails
throwProtobufErrorHom :: Message a => ProtobufError (Proto a) -> IO x
throwProtobufErrorHom :: forall a x. Message a => ProtobufError (Proto a) -> IO x
throwProtobufErrorHom = ProtobufError (Proto Any) -> IO x
forall x. ProtobufError (Proto Any) -> IO x
throwProtobufError (ProtobufError (Proto Any) -> IO x)
-> (ProtobufError (Proto a) -> ProtobufError (Proto Any))
-> ProtobufError (Proto a)
-> IO x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto a -> Proto Any)
-> ProtobufError (Proto a) -> ProtobufError (Proto Any)
forall a b. (a -> b) -> ProtobufError a -> ProtobufError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Proto a -> Proto Any
forall a. Message a => Proto a -> Proto Any
Any.pack
toProtobufError :: GrpcException -> Either String (ProtobufError (Proto Any))
toProtobufError :: GrpcException -> Either String (ProtobufError (Proto Any))
toProtobufError GrpcException
err =
case GrpcException -> Maybe ByteString
grpcErrorDetails GrpcException
err of
Maybe ByteString
Nothing ->
ProtobufError (Proto Any)
-> Either String (ProtobufError (Proto Any))
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ProtobufError{
protobufErrorCode :: GrpcError
protobufErrorCode = GrpcException -> GrpcError
grpcError GrpcException
err
, protobufErrorMessage :: Maybe Text
protobufErrorMessage = GrpcException -> Maybe Text
grpcErrorMessage GrpcException
err
, protobufErrorDetails :: [Proto Any]
protobufErrorDetails = []
}
Just ByteString
statusEnc -> do
status :: Proto Status <- ByteString -> Either String (Proto Status)
parseStatus ByteString
statusEnc
protobufErrorCode <- checkErrorCode (status ^. #code)
return ProtobufError{
protobufErrorCode
, protobufErrorMessage = constructErrorMessage (status ^. #message)
, protobufErrorDetails = status ^. #details
}
where
checkErrorCode :: Int32 -> Either String GrpcError
checkErrorCode :: Int32 -> Either String GrpcError
checkErrorCode Int32
statusCode
| Int32
statusCode Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
forall value. FieldDefault value => value
fieldDefault
= GrpcError -> Either String GrpcError
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (GrpcError -> Either String GrpcError)
-> GrpcError -> Either String GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcException -> GrpcError
grpcError GrpcException
err
| GrpcError -> Word
fromGrpcError (GrpcException -> GrpcError
grpcError GrpcException
err) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Int32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
statusCode
= GrpcError -> Either String GrpcError
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (GrpcError -> Either String GrpcError)
-> GrpcError -> Either String GrpcError
forall a b. (a -> b) -> a -> b
$ GrpcException -> GrpcError
grpcError GrpcException
err
| Bool
otherwise
= String -> Either String GrpcError
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Either String GrpcError)
-> String -> Either String GrpcError
forall a b. (a -> b) -> a -> b
$ String
"'Status.code' does not match 'grpc-status'"
constructErrorMessage :: Text -> Maybe Text
constructErrorMessage :: Text -> Maybe Text
constructErrorMessage Text
msg =
if Text
msg Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
forall value. FieldDefault value => value
fieldDefault
then GrpcException -> Maybe Text
grpcErrorMessage GrpcException
err
else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
msg
toProtobufErrorHom :: forall a.
Message a
=> GrpcException -> Either String (ProtobufError (Proto a))
toProtobufErrorHom :: forall a.
Message a =>
GrpcException -> Either String (ProtobufError (Proto a))
toProtobufErrorHom = (Proto Any -> Either String (Proto a))
-> ProtobufError (Proto Any)
-> Either String (ProtobufError (Proto a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ProtobufError a -> f (ProtobufError b)
traverse Proto Any -> Either String (Proto a)
aux (ProtobufError (Proto Any)
-> Either String (ProtobufError (Proto a)))
-> (GrpcException -> Either String (ProtobufError (Proto Any)))
-> GrpcException
-> Either String (ProtobufError (Proto a))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< GrpcException -> Either String (ProtobufError (Proto Any))
toProtobufError
where
aux :: Proto Any -> Either String (Proto a)
aux :: Proto Any -> Either String (Proto a)
aux = (UnpackError -> String)
-> Either UnpackError (Proto a) -> Either String (Proto a)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first UnpackError -> String
forall a. Show a => a -> String
show (Either UnpackError (Proto a) -> Either String (Proto a))
-> (Proto Any -> Either UnpackError (Proto a))
-> Proto Any
-> Either String (Proto a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto Any -> Either UnpackError (Proto a)
forall a. Message a => Proto Any -> Either UnpackError (Proto a)
Any.unpack