content: {-# LANGUAGE OverloadedLabels #-}
  
  -- | Common functionality for working with Protobuf
  module Network.GRPC.Common.Protobuf (
      Protobuf
    , Proto(..)
    , getProto
  
      -- * Exceptions
    , ProtobufError(..)
    , throwProtobufError
    , throwProtobufErrorHom
    , toProtobufError
    , toProtobufErrorHom
  
      -- * Re-exports
      -- ** "Data.Function"
    , (&)
      -- ** "Control.Lens"
    , (.~)
    , (^.)
    , (%~)
      -- ** "Data.ProtoLens"
    , 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(..), field)
  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
  
  {-------------------------------------------------------------------------------
    Protobuf-specific errors
  -------------------------------------------------------------------------------}
  
  -- | gRPC exception with protobuf-specific error details
  --
  -- See also 'Status' and @google.rpc.Status@.
  data ProtobufError a = ProtobufError {
        protobufErrorCode     :: GrpcError
      , protobufErrorMessage  :: Maybe Text
      , protobufErrorDetails  :: [a]
      }
    deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable)
  
  -- | Throw 'GrpcException' with Protobuf-specific details
  throwProtobufError :: ProtobufError (Proto Any) -> IO x
  throwProtobufError ProtobufError{
                         protobufErrorCode
                       , protobufErrorMessage
                       , protobufErrorDetails
                       } = throwIO $ GrpcException {
        grpcError         = protobufErrorCode
      , grpcErrorMessage  = protobufErrorMessage
      , grpcErrorDetails  = Just $ buildStatus status
      , grpcErrorMetadata = []
      }
    where
      status :: Proto Status
      status =
          defMessage
            & field @"code"    .~ fromIntegral (fromGrpcError protobufErrorCode)
            & field @"message" .~ fromMaybe fieldDefault protobufErrorMessage
            & field @"details" .~ protobufErrorDetails
  
  -- | Variation of 'throwProtobufError' for a homogenous list of details
  --
  -- The @google.rpc.Status@ message uses the Protobuf 'Any' type to store a
  -- heterogenous list of details. In case that all elements in this list are
  -- actually of the /same/ type, we can provide a simpler API.
  throwProtobufErrorHom :: Message a => ProtobufError (Proto a) -> IO x
  throwProtobufErrorHom = throwProtobufError . fmap Any.pack
  
  -- | Construct 'ProtobufError' by parsing 'grpcErrorDetails' as 'Status'
  --
  -- See also 'throwProtobufError'.
  toProtobufError :: GrpcException -> Either String (ProtobufError (Proto Any))
  toProtobufError err =
      case grpcErrorDetails err of
        Nothing ->
          return ProtobufError{
              protobufErrorCode    = grpcError err
            , protobufErrorMessage = grpcErrorMessage err
            , protobufErrorDetails = []
            }
        Just statusEnc -> do
          status :: Proto Status <- parseStatus statusEnc
          protobufErrorCode <- checkErrorCode (status ^. field @"code")
          return ProtobufError{
              protobufErrorCode
            , protobufErrorMessage = constructErrorMessage (status ^. field @"message")
            , protobufErrorDetails = status ^. field @"details"
            }
    where
      -- The gRPC specification mandates
      --
      -- > If [Status-Details] contains a status code field, it MUST NOT
      -- > contradict the Status header. The consumer MUST verify this
      -- > requirement.
      --
      -- We cannot do this check without knowing the format of the status details,
      -- so we do it here for the specific case of Protobuf. Since we cannot
      -- distinguish between an absent field and a field with a default value in
      -- Protobuf, we add a special case for this.
      checkErrorCode :: Int32 -> Either String GrpcError
      checkErrorCode statusCode
        | statusCode == fieldDefault
        = return $ grpcError err
  
        | fromGrpcError (grpcError err) == fromIntegral statusCode
        = return $ grpcError err
  
        | otherwise
        = throwError $ "'Status.code' does not match 'grpc-status'"
  
      -- If the Status-Details does not contain a message (that is, the field is
      -- at its default value), we fall back to the status message in the
      -- exception itself (if any).
      constructErrorMessage :: Text -> Maybe Text
      constructErrorMessage msg =
          if msg == fieldDefault
            then grpcErrorMessage err
            else Just msg
  
  -- | Variation of 'toProtobufError' for a homogenous list of details
  toProtobufErrorHom :: forall a.
       Message a
    => GrpcException -> Either String (ProtobufError (Proto a))
  toProtobufErrorHom = traverse aux <=< toProtobufError
    where
      aux :: Proto Any -> Either String (Proto a)
      aux = first show . Any.unpack
  