content: {-# LANGUAGE OverloadedStrings #-}
  
  module Network.GRPC.Spec.RPC.JSON (
      JsonRpc
  
      -- Aeson support
    , JsonObject(..)
    , Required(..)
    , Optional(..)
    , DecodeFields -- opaque
    , EncodeFields -- opaque
    ) where
  
  import Control.DeepSeq (NFData(..))
  import Data.Aeson (ToJSON(..), FromJSON(..), (.=), (.:), (.:?))
  import Data.Aeson qualified as Aeson
  import Data.Aeson.Types qualified as Aeson
  import Data.ByteString.Char8 qualified as BS.Char8
  import Data.Kind
  import Data.Proxy
  import Data.String
  import GHC.TypeLits
  
  import Network.GRPC.Spec.CustomMetadata.Typed
  import Network.GRPC.Spec.RPC
  import Network.GRPC.Spec.RPC.StreamType
  
  -- | gRPC using JSON as the message encoding
  --
  -- "JSON over gRPC" is a bit of an ambiguous phrase. It can be a very general
  -- term, simply meaning using an otherwise-unspecified JSON encoding, or it can
  -- refer to "Protobuf over JSON" (see
  -- <https://protobuf.dev/programming-guides/proto3/#json>). In this module we
  -- deal with the former, and don't deal with anything Protobuf-specific at all,
  -- nor do we rely on any of the infrastructure generated by the Protobuf
  -- compiler (in other words, there is no need to use @protoc@). See
  -- <https://grpc.io/blog/grpc-with-json/> for a Java example of using gRPC with
  -- JSON without Protobuf.
  --
  -- In the absence of the infrastructure provided by @protoc@, you will need to
  -- manually provide 'Input' and 'Output' instances for each RPC you use.
  -- For example:
  --
  -- > type Create   = JsonRpc KeyValueService "Create"
  -- > type Delete   = JsonRpc KeyValueService "Delete"
  -- > ..
  -- >
  -- > type instance Input  Create   = ..
  -- > type instance Output Create   = ..
  -- > type instance Input  Retrieve = ..
  -- > type instance Output Retrieve = ..
  -- > ..
  --
  -- On the client, you will need 'ToJSON' instances for inputs and 'FromJSON'
  -- instances for outputs; on the server the situation is dual. You may find it
  -- convenient to use t'JsonObject' (but this is certainly not required).
  --
  -- TODO: <https://github.com/well-typed/grapesy/issues/166>
  -- We don't currently offer explicit support for "Protobuf JSON".
  data JsonRpc (serv :: Symbol) (meth :: Symbol)
  
  instance ( KnownSymbol serv
           , KnownSymbol meth
  
             -- Serialization
           , NFData (Input  (JsonRpc serv meth))
           , NFData (Output (JsonRpc serv meth))
  
             -- Debugging constraints
           , Show (Input  (JsonRpc serv meth))
           , Show (Output (JsonRpc serv meth))
           , Show (RequestMetadata (JsonRpc serv meth))
           , Show (ResponseInitialMetadata (JsonRpc serv meth))
           , Show (ResponseTrailingMetadata (JsonRpc serv meth))
           ) => IsRPC (JsonRpc serv meth) where
    rpcContentType _ = defaultRpcContentType "json"
    rpcServiceName _ = BS.Char8.pack $ symbolVal (Proxy @serv)
    rpcMethodName  _ = BS.Char8.pack $ symbolVal (Proxy @meth)
    rpcMessageType _ = Nothing
  
  instance ( IsRPC (JsonRpc serv meth)
  
             -- Serialization constraints
           , ToJSON   (Input  (JsonRpc serv meth))
           , FromJSON (Output (JsonRpc serv meth))
  
             -- Metadata constraints
           , BuildMetadata (RequestMetadata          (JsonRpc serv meth))
           , ParseMetadata (ResponseInitialMetadata  (JsonRpc serv meth))
           , ParseMetadata (ResponseTrailingMetadata (JsonRpc serv meth))
           ) => SupportsClientRpc (JsonRpc serv meth) where
    rpcSerializeInput    _ = Aeson.encode
    rpcDeserializeOutput _ = Aeson.eitherDecode
  
  instance ( IsRPC (JsonRpc serv meth)
  
             -- Serialization constraints
           , FromJSON (Input  (JsonRpc serv meth))
           , ToJSON   (Output (JsonRpc serv meth))
  
             -- Metadata constraints
           , ParseMetadata (RequestMetadata           (JsonRpc serv meth))
           , BuildMetadata (ResponseInitialMetadata   (JsonRpc serv meth))
           , StaticMetadata (ResponseTrailingMetadata (JsonRpc serv meth))
           ) => SupportsServerRpc (JsonRpc serv meth) where
    rpcDeserializeInput _ = Aeson.eitherDecode
    rpcSerializeOutput  _ = Aeson.encode
  
  -- | For JSON protocol we do not check communication protocols
  instance ValidStreamingType styp
        => SupportsStreamingType (JsonRpc serv meth) styp
  
  {-------------------------------------------------------------------------------
    Support for constructing JSON objects
  -------------------------------------------------------------------------------}
  
  -- | Convenient way to construct JSON values
  --
  -- Example:
  --
  -- > type instance Input Create =
  -- >   JsonObject '[ '("key"   , Required Key)
  -- >               , '("value" , Required Value)
  -- >               ]
  data JsonObject :: [(Symbol, Type)] -> Type where
    JsonObject :: JsonObject '[]
    (:*) :: forall f x fs. x -> JsonObject fs -> JsonObject ('(f, x) : fs)
  
  instance Show (JsonObject '[]) where
    showsPrec _ JsonObject = showString "JsonObject"
  
  instance (Show x, Show (JsonObject fs))
        => Show (JsonObject ('(f, x) : fs)) where
    showsPrec p (x :* xs) = showParen (p >= 6) $
          showsPrec 6 x
        . showString " :* "
        . showsPrec 6 xs
  
  instance NFData (JsonObject '[]) where
    rnf JsonObject = ()
  
  instance (NFData x, NFData (JsonObject fs))
        => NFData (JsonObject ('(f, x) : fs)) where
    rnf (x :* xs) = rnf (x, xs)
  
  -- | Required field
  newtype Required a = Required {
       getRequired :: a
     }
   deriving stock (Show)
   deriving newtype (NFData)
  
  -- | Optional field
  --
  -- 'Maybe' will be represented by the /absence/ of the field in the object.
  newtype Optional a = Optional {
        getOptional :: Maybe a
      }
   deriving stock (Show)
   deriving newtype (NFData)
  
  infixr 5 :*
  
  -- | Auxiliary class used for the 'ToJSON' instance for t'JsonObject'
  --
  -- It is not possible (nor necessary) to define additional instances.
  class EncodeFields fs where
    encodeFields :: JsonObject fs -> [Aeson.Pair]
    encodeFields = undefined
  
  instance EncodeFields '[] where
    encodeFields JsonObject = []
  
  instance (KnownSymbol f, ToJSON x, EncodeFields fs)
        => EncodeFields ('(f, Required x) : fs) where
    encodeFields (Required x :* xs) =
          (fromString (symbolVal (Proxy @f)) .= x)
        : encodeFields xs
  
  instance (KnownSymbol f, ToJSON x, EncodeFields fs)
        => EncodeFields ('(f, Optional x) : fs) where
    encodeFields (Optional Nothing  :* xs) = encodeFields xs
    encodeFields (Optional (Just x) :* xs) =
          (fromString (symbolVal (Proxy @f)) .= x)
        : encodeFields xs
  
  instance EncodeFields fs => ToJSON (JsonObject fs) where
    toJSON = Aeson.object . encodeFields
  
  -- | Auxiliary class used for the 'FromJSON' instance for t'JsonObject'
  --
  -- It is not possible (nor necessary) to define additional instances.
  class DecodeFields fs where
    decodeFields :: Aeson.Object -> Aeson.Parser (JsonObject fs)
    decodeFields = undefined
  
  instance DecodeFields '[] where
    decodeFields _ = return JsonObject
  
  instance (KnownSymbol f, FromJSON x, DecodeFields fs)
        => DecodeFields ('(f, Required x) : fs) where
    decodeFields obj = do
        fs <- decodeFields obj
        x  <- obj .: fromString (symbolVal (Proxy @f))
        return (Required x :* fs)
  
  instance (KnownSymbol f, FromJSON x, DecodeFields fs)
        => DecodeFields ('(f, Optional x) : fs) where
    decodeFields obj = do
        fs <- decodeFields obj
        x  <- obj .:? fromString (symbolVal (Proxy @f))
        return (Optional x :* fs)
  
  instance DecodeFields fs => FromJSON (JsonObject fs) where
    parseJSON = Aeson.withObject "JsonObject" $ decodeFields
  
  