module Database.IAVL.RPC.Types where

import           Control.Exception           (Exception, throwIO)
import           Data.Text                   (Text, pack)
import           Network.GRPC.Client         (uncompressed)
import           Network.GRPC.Client.Helpers (GrpcClient, GrpcClientConfig (..),
                                              grpcClientConfigSimple,
                                              setupGrpcClient)
import           Network.HTTP2.Client        (runClientIO)


--------------------------------------------------------------------------------
-- | GRPCClientError
--------------------------------------------------------------------------------
-- | This type represents error with the GRPC Client
data GRPCClientError = ClientSetupError Text
  deriving Int -> GRPCClientError -> ShowS
[GRPCClientError] -> ShowS
GRPCClientError -> String
(Int -> GRPCClientError -> ShowS)
-> (GRPCClientError -> String)
-> ([GRPCClientError] -> ShowS)
-> Show GRPCClientError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GRPCClientError] -> ShowS
$cshowList :: [GRPCClientError] -> ShowS
show :: GRPCClientError -> String
$cshow :: GRPCClientError -> String
showsPrec :: Int -> GRPCClientError -> ShowS
$cshowsPrec :: Int -> GRPCClientError -> ShowS
Show

instance Exception GRPCClientError

--------------------------------------------------------------------------------
-- | initGrpcClient
--------------------------------------------------------------------------------

data GrpcConfig = GrpcConfig
  { GrpcConfig -> String
grpcHost :: String
  , GrpcConfig -> Integer
grpcPort :: Integer
  }

-- | Initialize the GRPC Client
initGrpcClient :: GrpcConfig -> IO GrpcClient
initGrpcClient :: GrpcConfig -> IO GrpcClient
initGrpcClient (GrpcConfig host :: String
host port :: Integer
port) =
-- usually 0.0.0.0:8090
  let grpcClient :: GrpcClientConfig
grpcClient = String -> PortNumber -> UseTlsOrNot -> GrpcClientConfig
grpcClientConfigSimple String
host (Integer -> PortNumber
forall a. Num a => Integer -> a
fromInteger Integer
port) UseTlsOrNot
False
  in  ClientIO GrpcClient -> IO (Either ClientError GrpcClient)
forall a. ClientIO a -> IO (Either ClientError a)
runClientIO (GrpcClientConfig -> ClientIO GrpcClient
setupGrpcClient (GrpcClientConfig
grpcClient{_grpcClientConfigCompression :: Compression
_grpcClientConfigCompression=Compression
uncompressed})) IO (Either ClientError GrpcClient)
-> (Either ClientError GrpcClient -> IO GrpcClient)
-> IO GrpcClient
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right gc :: GrpcClient
gc -> GrpcClient -> IO GrpcClient
forall (f :: * -> *) a. Applicative f => a -> f a
pure GrpcClient
gc
        Left err :: ClientError
err -> GRPCClientError -> IO GrpcClient
forall e a. Exception e => e -> IO a
throwIO (GRPCClientError -> IO GrpcClient)
-> (String -> GRPCClientError) -> String -> IO GrpcClient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> GRPCClientError
ClientSetupError (Text -> GRPCClientError)
-> (String -> Text) -> String -> GRPCClientError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> IO GrpcClient) -> String -> IO GrpcClient
forall a b. (a -> b) -> a -> b
$ ClientError -> String
forall a. Show a => a -> String
show ClientError
err