{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}

module Network.GRPC.HighLevel.Generated (
  -- * Types
  MetadataMap(..)
, MethodName(..)
, GRPCMethodType(..)
, GRPCImpl(..)
, MkHandler
, Host(..)
, Port(..)
, StatusDetails(..)
, StatusCode(..)
, GRPCIOError(..)

  -- * Server
, ServiceOptions(..)
, defaultServiceOptions
, ServerCall(..)
, serverCallCancel
, serverCallIsExpired
, ServerRequest(..)
, ServerResponse(..)

  -- * Server Auth
, ServerSSLConfig(..)

  -- * Client
, withGRPCClient
, ClientConfig(..)
, ClientError(..)
, ClientRequest(..)
, ClientResult(..)
)
where

import           Network.GRPC.HighLevel.Server
import           Network.GRPC.HighLevel.Client
import           Network.GRPC.LowLevel
import           Network.GRPC.LowLevel.Call
import           Numeric.Natural
import           System.IO (hPutStrLn, stderr)

-- | Used at the kind level as a parameter to service definitions
--   generated by the grpc compiler, with the effect of having the
--   field types reduce to the appropriate types for the method types.
data GRPCImpl = ServerImpl | ClientImpl

-- | GHC does not let us partially apply a type family. However, we
--   can define a type to use as an 'interpreter', and then use this
--   'interpreter' type fully applied to get the same effect.
type family MkHandler (impl :: GRPCImpl) (methodType :: GRPCMethodType) i o

type instance MkHandler 'ServerImpl 'Normal          i o = ServerHandler       i o
type instance MkHandler 'ServerImpl 'ClientStreaming i o = ServerReaderHandler i o
type instance MkHandler 'ServerImpl 'ServerStreaming i o = ServerWriterHandler i o
type instance MkHandler 'ServerImpl 'BiDiStreaming   i o = ServerRWHandler     i o

-- | Options for a service that was generated from a .proto file. This is
-- essentially 'ServerOptions' with the handler fields removed.
data ServiceOptions = ServiceOptions
  { ServiceOptions -> Host
serverHost           :: Host
    -- ^ Name of the host the server is running on.
  , ServiceOptions -> Port
serverPort           :: Port
    -- ^ Port on which to listen for requests.
  , ServiceOptions -> Bool
useCompression       :: Bool
    -- ^ Whether to use compression when communicating with the client.
  , ServiceOptions -> String
userAgentPrefix      :: String
    -- ^ Optional custom prefix to add to the user agent string.
  , ServiceOptions -> String
userAgentSuffix      :: String
    -- ^ Optional custom suffix to add to the user agent string.
  , ServiceOptions -> MetadataMap
initialMetadata      :: MetadataMap
    -- ^ Metadata to send at the beginning of each call.
  , ServiceOptions -> Maybe ServerSSLConfig
sslConfig            :: Maybe ServerSSLConfig
    -- ^ Security configuration.
  , ServiceOptions -> String -> IO ()
logger               :: String -> IO ()
    -- ^ Logging function to use to log errors in handling calls.
  , ServiceOptions -> Maybe Natural
serverMaxReceiveMessageLength :: Maybe Natural
    -- ^ Maximum length (in bytes) that the service may receive in a single message
  }

defaultServiceOptions :: ServiceOptions
defaultServiceOptions :: ServiceOptions
defaultServiceOptions = ServiceOptions :: Host
-> Port
-> Bool
-> String
-> String
-> MetadataMap
-> Maybe ServerSSLConfig
-> (String -> IO ())
-> Maybe Natural
-> ServiceOptions
ServiceOptions
  -- names are fully qualified because we use the same fields in LowLevel.
  { serverHost :: Host
Network.GRPC.HighLevel.Generated.serverHost      = Host
"localhost"
  , serverPort :: Port
Network.GRPC.HighLevel.Generated.serverPort      = Port
50051
  , useCompression :: Bool
Network.GRPC.HighLevel.Generated.useCompression  = Bool
False
  , userAgentPrefix :: String
Network.GRPC.HighLevel.Generated.userAgentPrefix = String
"grpc-haskell/0.0.0"
  , userAgentSuffix :: String
Network.GRPC.HighLevel.Generated.userAgentSuffix = String
""
  , initialMetadata :: MetadataMap
Network.GRPC.HighLevel.Generated.initialMetadata = MetadataMap
forall a. Monoid a => a
mempty
  , sslConfig :: Maybe ServerSSLConfig
Network.GRPC.HighLevel.Generated.sslConfig       = Maybe ServerSSLConfig
forall a. Maybe a
Nothing
  , logger :: String -> IO ()
Network.GRPC.HighLevel.Generated.logger          = Handle -> String -> IO ()
hPutStrLn Handle
stderr
  , serverMaxReceiveMessageLength :: Maybe Natural
Network.GRPC.HighLevel.Generated.serverMaxReceiveMessageLength = Maybe Natural
forall a. Maybe a
Nothing
  }

withGRPCClient :: ClientConfig -> (Client -> IO a) -> IO a
withGRPCClient :: ClientConfig -> (Client -> IO a) -> IO a
withGRPCClient ClientConfig
c Client -> IO a
f = (GRPC -> IO a) -> IO a
forall a. (GRPC -> IO a) -> IO a
withGRPC ((GRPC -> IO a) -> IO a) -> (GRPC -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \GRPC
grpc -> GRPC -> ClientConfig -> (Client -> IO a) -> IO a
forall a. GRPC -> ClientConfig -> (Client -> IO a) -> IO a
withClient GRPC
grpc ClientConfig
c ((Client -> IO a) -> IO a) -> (Client -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Client
client -> Client -> IO a
f Client
client