{-# LANGUAGE OverloadedStrings #-}
module Network.GRPC.Spec.RPC.JSON (
JsonRpc
, JsonObject(..)
, Required(..)
, Optional(..)
, DecodeFields
, EncodeFields
) 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
data JsonRpc (serv :: Symbol) (meth :: Symbol)
instance ( KnownSymbol serv
, KnownSymbol meth
, NFData (Input (JsonRpc serv meth))
, NFData (Output (JsonRpc serv meth))
, 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 :: Proxy (JsonRpc serv meth) -> ByteString
rpcContentType Proxy (JsonRpc serv meth)
_ = ByteString -> ByteString
defaultRpcContentType ByteString
"json"
rpcServiceName :: HasCallStack => Proxy (JsonRpc serv meth) -> ByteString
rpcServiceName Proxy (JsonRpc serv meth)
_ = String -> ByteString
BS.Char8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy serv -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @serv)
rpcMethodName :: HasCallStack => Proxy (JsonRpc serv meth) -> ByteString
rpcMethodName Proxy (JsonRpc serv meth)
_ = String -> ByteString
BS.Char8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy meth -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @meth)
rpcMessageType :: HasCallStack => Proxy (JsonRpc serv meth) -> Maybe ByteString
rpcMessageType Proxy (JsonRpc serv meth)
_ = Maybe ByteString
forall a. Maybe a
Nothing
instance ( IsRPC (JsonRpc serv meth)
, ToJSON (Input (JsonRpc serv meth))
, FromJSON (Output (JsonRpc serv meth))
, BuildMetadata (RequestMetadata (JsonRpc serv meth))
, ParseMetadata (ResponseInitialMetadata (JsonRpc serv meth))
, ParseMetadata (ResponseTrailingMetadata (JsonRpc serv meth))
) => SupportsClientRpc (JsonRpc serv meth) where
rpcSerializeInput :: Proxy (JsonRpc serv meth)
-> Input (JsonRpc serv meth) -> ByteString
rpcSerializeInput Proxy (JsonRpc serv meth)
_ = Input (JsonRpc serv meth) -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode
rpcDeserializeOutput :: Proxy (JsonRpc serv meth)
-> ByteString -> Either String (Output (JsonRpc serv meth))
rpcDeserializeOutput Proxy (JsonRpc serv meth)
_ = ByteString -> Either String (Output (JsonRpc serv meth))
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode
instance ( IsRPC (JsonRpc serv meth)
, FromJSON (Input (JsonRpc serv meth))
, ToJSON (Output (JsonRpc serv meth))
, ParseMetadata (RequestMetadata (JsonRpc serv meth))
, BuildMetadata (ResponseInitialMetadata (JsonRpc serv meth))
, StaticMetadata (ResponseTrailingMetadata (JsonRpc serv meth))
) => SupportsServerRpc (JsonRpc serv meth) where
rpcDeserializeInput :: Proxy (JsonRpc serv meth)
-> ByteString -> Either String (Input (JsonRpc serv meth))
rpcDeserializeInput Proxy (JsonRpc serv meth)
_ = ByteString -> Either String (Input (JsonRpc serv meth))
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode
rpcSerializeOutput :: Proxy (JsonRpc serv meth)
-> Output (JsonRpc serv meth) -> ByteString
rpcSerializeOutput Proxy (JsonRpc serv meth)
_ = Output (JsonRpc serv meth) -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode
instance ValidStreamingType styp
=> SupportsStreamingType (JsonRpc serv meth) styp
data JsonObject :: [(Symbol, Type)] -> Type where
JsonObject :: JsonObject '[]
(:*) :: forall f x fs. x -> JsonObject fs -> JsonObject ('(f, x) : fs)
instance Show (JsonObject '[]) where
showsPrec :: Int -> JsonObject '[] -> ShowS
showsPrec Int
_ JsonObject '[]
JsonObject = String -> ShowS
showString String
"JsonObject"
instance (Show x, Show (JsonObject fs))
=> Show (JsonObject ('(f, x) : fs)) where
showsPrec :: Int -> JsonObject ('(f, x) : fs) -> ShowS
showsPrec Int
p (x
x :* JsonObject fs
xs) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
6) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
Int -> x -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
6 x
x
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" :* "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> JsonObject fs -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
6 JsonObject fs
xs
instance NFData (JsonObject '[]) where
rnf :: JsonObject '[] -> ()
rnf JsonObject '[]
JsonObject = ()
instance (NFData x, NFData (JsonObject fs))
=> NFData (JsonObject ('(f, x) : fs)) where
rnf :: JsonObject ('(f, x) : fs) -> ()
rnf (x
x :* JsonObject fs
xs) = (x, JsonObject fs) -> ()
forall a. NFData a => a -> ()
rnf (x
x, JsonObject fs
xs)
newtype Required a = Required {
forall a. Required a -> a
getRequired :: a
}
deriving stock (Int -> Required a -> ShowS
[Required a] -> ShowS
Required a -> String
(Int -> Required a -> ShowS)
-> (Required a -> String)
-> ([Required a] -> ShowS)
-> Show (Required a)
forall a. Show a => Int -> Required a -> ShowS
forall a. Show a => [Required a] -> ShowS
forall a. Show a => Required a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Required a -> ShowS
showsPrec :: Int -> Required a -> ShowS
$cshow :: forall a. Show a => Required a -> String
show :: Required a -> String
$cshowList :: forall a. Show a => [Required a] -> ShowS
showList :: [Required a] -> ShowS
Show)
deriving newtype (Required a -> ()
(Required a -> ()) -> NFData (Required a)
forall a. NFData a => Required a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => Required a -> ()
rnf :: Required a -> ()
NFData)
newtype Optional a = Optional {
forall a. Optional a -> Maybe a
getOptional :: Maybe a
}
deriving stock (Int -> Optional a -> ShowS
[Optional a] -> ShowS
Optional a -> String
(Int -> Optional a -> ShowS)
-> (Optional a -> String)
-> ([Optional a] -> ShowS)
-> Show (Optional a)
forall a. Show a => Int -> Optional a -> ShowS
forall a. Show a => [Optional a] -> ShowS
forall a. Show a => Optional a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Optional a -> ShowS
showsPrec :: Int -> Optional a -> ShowS
$cshow :: forall a. Show a => Optional a -> String
show :: Optional a -> String
$cshowList :: forall a. Show a => [Optional a] -> ShowS
showList :: [Optional a] -> ShowS
Show)
deriving newtype (Optional a -> ()
(Optional a -> ()) -> NFData (Optional a)
forall a. NFData a => Optional a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => Optional a -> ()
rnf :: Optional a -> ()
NFData)
infixr 5 :*
class EncodeFields fs where
encodeFields :: JsonObject fs -> [Aeson.Pair]
encodeFields = JsonObject fs -> [Pair]
forall a. HasCallStack => a
undefined
instance EncodeFields '[] where
encodeFields :: JsonObject '[] -> [Pair]
encodeFields JsonObject '[]
JsonObject = []
instance (KnownSymbol f, ToJSON x, EncodeFields fs)
=> EncodeFields ('(f, Required x) : fs) where
encodeFields :: JsonObject ('(f, Required x) : fs) -> [Pair]
encodeFields (Required x
x :* JsonObject fs
xs) =
(String -> Key
forall a. IsString a => String -> a
fromString (Proxy f -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @f)) Key -> x -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= x
x)
Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: JsonObject fs -> [Pair]
forall (fs :: [(Symbol, *)]).
EncodeFields fs =>
JsonObject fs -> [Pair]
encodeFields JsonObject fs
xs
instance (KnownSymbol f, ToJSON x, EncodeFields fs)
=> EncodeFields ('(f, Optional x) : fs) where
encodeFields :: JsonObject ('(f, Optional x) : fs) -> [Pair]
encodeFields (Optional Maybe x
Nothing :* JsonObject fs
xs) = JsonObject fs -> [Pair]
forall (fs :: [(Symbol, *)]).
EncodeFields fs =>
JsonObject fs -> [Pair]
encodeFields JsonObject fs
xs
encodeFields (Optional (Just x
x) :* JsonObject fs
xs) =
(String -> Key
forall a. IsString a => String -> a
fromString (Proxy f -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @f)) Key -> x -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= x
x)
Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: JsonObject fs -> [Pair]
forall (fs :: [(Symbol, *)]).
EncodeFields fs =>
JsonObject fs -> [Pair]
encodeFields JsonObject fs
xs
instance EncodeFields fs => ToJSON (JsonObject fs) where
toJSON :: JsonObject fs -> Value
toJSON = [Pair] -> Value
Aeson.object ([Pair] -> Value)
-> (JsonObject fs -> [Pair]) -> JsonObject fs -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonObject fs -> [Pair]
forall (fs :: [(Symbol, *)]).
EncodeFields fs =>
JsonObject fs -> [Pair]
encodeFields
class DecodeFields fs where
decodeFields :: Aeson.Object -> Aeson.Parser (JsonObject fs)
decodeFields = Object -> Parser (JsonObject fs)
forall a. HasCallStack => a
undefined
instance DecodeFields '[] where
decodeFields :: Object -> Parser (JsonObject '[])
decodeFields Object
_ = JsonObject '[] -> Parser (JsonObject '[])
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return JsonObject '[]
JsonObject
instance (KnownSymbol f, FromJSON x, DecodeFields fs)
=> DecodeFields ('(f, Required x) : fs) where
decodeFields :: Object -> Parser (JsonObject ('(f, Required x) : fs))
decodeFields Object
obj = do
fs <- Object -> Parser (JsonObject fs)
forall (fs :: [(Symbol, *)]).
DecodeFields fs =>
Object -> Parser (JsonObject fs)
decodeFields Object
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 :: Object -> Parser (JsonObject ('(f, Optional x) : fs))
decodeFields Object
obj = do
fs <- Object -> Parser (JsonObject fs)
forall (fs :: [(Symbol, *)]).
DecodeFields fs =>
Object -> Parser (JsonObject fs)
decodeFields Object
obj
x <- obj .:? fromString (symbolVal (Proxy @f))
return (Optional x :* fs)
instance DecodeFields fs => FromJSON (JsonObject fs) where
parseJSON :: Value -> Parser (JsonObject fs)
parseJSON = String
-> (Object -> Parser (JsonObject fs))
-> Value
-> Parser (JsonObject fs)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"JsonObject" ((Object -> Parser (JsonObject fs))
-> Value -> Parser (JsonObject fs))
-> (Object -> Parser (JsonObject fs))
-> Value
-> Parser (JsonObject fs)
forall a b. (a -> b) -> a -> b
$ Object -> Parser (JsonObject fs)
forall (fs :: [(Symbol, *)]).
DecodeFields fs =>
Object -> Parser (JsonObject fs)
decodeFields