Nicer handling for gRPC status codes. about http2-grpc-haskell HOT 3 OPEN

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}

module Main where

import Control.Concurrent
import Control.Concurrent.Async
import Control.Monad (forever)
import Control.Monad.Except
import Data.Text (Text)
import GHC.TypeLits
import Mu.Adapter.ProtoBuf
import Mu.GRpc.Client.Optics
import Mu.GRpc.Client.TyApps
import Mu.GRpc.Server
import Mu.Rpc
import Mu.Schema
import Mu.Server

main :: IO ()
main =
  concurrently_ serve (forever $ query >> threadDelay 1000000)

type MySchema = '[ 'DRecord "Foo" '[ 'FieldDef "foo" ('TPrimitive Text)]]

type MyService =
  'Package
    ('Just "pkg")
    '[ 'Service
         "MyService"
         '[ 'Method
              "identityFoo"
              '[ 'ArgSingle ('Nothing :: Maybe Symbol) ('SchemaRef MySchema "Foo")]
              ('RetSingle ('SchemaRef MySchema "Foo"))
          ]
     ]

type instance
  AnnotatedSchema ProtoBufAnnotation MySchema =
    '[ 'AnnField "Foo" "foo" ('ProtoBufId 1 '[])]

type Foo = Term MySchema (MySchema :/: "Foo")

identityFoo :: MonadServer m => Foo -> m Foo
identityFoo _ = throwError $ ServerError NotFound "nothing to see here"

-- identityFoo = pure

service :: MonadServer m => SingleServerT i MyService m _
service = singleService (method @"identityFoo" identityFoo)

serve :: IO ()
serve = runGRpcApp msgProtoBuf 8080 service

mkClient :: IO GrpcClient
mkClient = assertRight =<< setupGrpcClient' (grpcClientConfigSimple "127.0.0.1" 8080 False)

assertRight :: Show a => Either a b -> IO b
assertRight = either (error . show) pure

query :: IO ()
query = do
  c <- mkClient
  r :: GRpcReply Foo <- gRpcCall @'MsgProtoBuf @MyService @"MyService" @"identityFoo" c bar
  case r of
    GRpcErrorString str -> putStrLn $ "GRpcError: " <> str
    GRpcOk x -> putStrLn $ "Ok: " <> show x
    _ -> putStrLn "Unexpected!"

bar :: Foo
bar = record1 "bar"