Client helpers, re-exports, and fixups (#70)

* Derive `Show` instance for `ClientSSLKeyCertPair`

* Add a couple client helper functions & add additional exports

* Add `grpc-haskell-core` target; add `c2hs` dep

* Fix examples broken by #68

* rm `build-tools` and `include-dirs` directives from toplevel `.cabal`

* More `ClientConfig` fixes

* Ensure examples are built

bench/Bench.hs

@@ -97,7 +97,7 @@ serverOpts =
 
 main :: IO ()
 main = bracket startServer stopServer $ const $ withGRPC $ \grpc ->
-  withClient grpc (ClientConfig "localhost" 50051 [] Nothing) $ \c -> do
+  withClient grpc (ClientConfig "localhost" 50051 [] Nothing Nothing) $ \c -> do
     rmAdd <- clientRegisterMethodNormal c addMethod
     rmClientStream <- clientRegisterMethodClientStreaming c addClientStreamMethod
     rmServerStream <- clientRegisterMethodServerStreaming c addServerStreamMethod

core/src/Network/GRPC/LowLevel/Client.hs

@@ -38,7 +38,8 @@ data Client = Client {clientChannel :: C.Channel,
 
 data ClientSSLKeyCertPair = ClientSSLKeyCertPair
   { clientPrivateKey :: FilePath,
-   clientCert :: FilePath}
+    clientCert       :: FilePath
+  } deriving Show
 
 -- | SSL configuration for the client. It's perfectly acceptable for both fields
 -- to be 'Nothing', in which case default fallbacks will be used for the server

examples/echo/echo-hs/EchoClient.hs

@@ -36,7 +36,7 @@ main = do
     cfg      = ClientConfig
                  (Host . fromMaybe "localhost" . unHelpful $ bind)
                  (Port . fromMaybe 50051       . unHelpful $ port)
-                 [] Nothing
+                 [] Nothing Nothing
   withGRPC $ \g -> withClient g cfg $ \c -> do
     Echo{..} <- echoClient c
     echoDoEcho (ClientNormalRequest rqt 5 mempty) >>= \case

examples/hellos/hellos-client/Main.hs

@@ -110,7 +110,7 @@ doHelloBi c n = do
 
 highlevelMain :: IO ()
 highlevelMain = withGRPC $ \g ->
-  withClient g (ClientConfig "localhost" 50051 [] Nothing) $ \c -> do
+  withClient g (ClientConfig "localhost" 50051 [] Nothing Nothing) $ \c -> do
     let n = 100000
     putStrLn "-------------- HelloSS --------------"
     doHelloSS c n

examples/tutorial/ArithmeticClient.hs

@@ -11,6 +11,7 @@ clientConfig = ClientConfig { clientServerHost = "localhost"
                             , clientServerPort = 50051
                             , clientArgs = []
                             , clientSSLConfig = Nothing
+                            , clientAuthority = Nothing
                             }
 
 main :: IO ()

examples/tutorial/TUTORIAL.md

@@ -159,6 +159,7 @@ clientConfig = ClientConfig { clientServerHost = "localhost"
                             , clientServerPort = 50051
                             , clientArgs = []
                             , clientSSLConfig = Nothing
+                            , clientAuthority = Nothing
                             }
 
 main :: IO ()

grpc-haskell.cabal

@@ -30,6 +30,7 @@ library
     , grpc-haskell-core
 
     , async ==2.1.*
+    , managed >= 1.0.5
 
   exposed-modules:
     Network.GRPC.HighLevel
@@ -37,10 +38,8 @@ library
     Network.GRPC.HighLevel.Server
     Network.GRPC.HighLevel.Server.Unregistered
     Network.GRPC.HighLevel.Client
-  build-tools:          c2hs
   default-language:     Haskell2010
   ghc-options:          -Wall -fwarn-incomplete-patterns -fno-warn-unused-do-bind
-  include-dirs:         include
   hs-source-dirs:       src
   default-extensions:   CPP
   CC-Options: -std=c99

release.nix

@@ -213,7 +213,10 @@ let
               (haskellPackagesNew.callPackage ./nix/proto3-suite.nix {});
 
           grpc-haskell-core =
-            usesGRPC (haskellPackagesNew.callPackage ./core { });
+            usesGRPC
+              (pkgs.haskell.lib.overrideCabal
+                (haskellPackagesNew.callPackage ./core { })
+                (_: { buildDepends = [ haskellPackagesNew.c2hs ]; }));
 
           grpc-haskell-no-tests =
             usesGRPC
@@ -242,11 +245,18 @@ let
                     ]);
 
                   in rec {
+                    configureFlags = (oldDerivation.configureFlags or []) ++ [
+                      "--flags=with-examples"
+                    ];
+
                     buildDepends = [
                       pkgs.makeWrapper
                       # Give our nix-shell its own cabal so we don't pick up one
                       # from the user's environment by accident.
                       haskellPackagesNew.cabal-install
+
+                      # And likewise for c2hs
+                      haskellPackagesNew.c2hs
                     ];
 
                     patches = [ tests/tests.patch ];
@@ -299,11 +309,18 @@ let
         pkgs = import nixpkgs { inherit config; };
 
 in
-  { grpc-haskell-linux    =  linuxPkgs.haskellPackages.grpc-haskell;
+  {
+    grpc-haskell-core-linux    =  linuxPkgs.haskellPackages.grpc-haskell-core;
+    grpc-haskell-core-darwin   = darwinPkgs.haskellPackages.grpc-haskell-core;
+    grpc-haskell-core          =       pkgs.haskellPackages.grpc-haskell-core;
+
+    grpc-haskell-linux         =  linuxPkgs.haskellPackages.grpc-haskell;
     grpc-haskell-darwin        = darwinPkgs.haskellPackages.grpc-haskell;
     grpc-haskell               =       pkgs.haskellPackages.grpc-haskell;
     grpc-haskell-no-tests      =       pkgs.haskellPackages.grpc-haskell-no-tests;
+
     grpc-linux                 =  linuxPkgs.grpc;
     grpc-darwin                = darwinPkgs.grpc;
+
     grpc                       =       pkgs.grpc;
   }

src/Network/GRPC/HighLevel/Client.hs

@@ -1,44 +1,58 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE GADTs               #-}
+{-# LANGUAGE KindSignatures      #-}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Network.GRPC.HighLevel.Client
-  ( RegisteredMethod
-  , TimeoutSeconds
-  , MetadataMap(..)
-  , StatusDetails(..)
-  , GRPCMethodType(..)
-  , StreamRecv
-  , StreamSend
-  , WritesDone
-  , LL.Client
-  , ServiceClient
-  , ClientError(..)
+  ( ClientError(..)
+  , ClientRegisterable(..)
   , ClientRequest(..)
   , ClientResult(..)
-  , ClientRegisterable(..)
+  , GRPCMethodType(..)
+  , MetadataMap(..)
+  , RegisteredMethod
+  , ServiceClient
+  , StatusCode(..)
+  , StatusDetails(..)
+  , StreamRecv
+  , StreamSend
+  , TimeoutSeconds
+  , WritesDone
+
+  , LL.Client
+  , LL.ClientConfig(..)
+  , LL.ClientSSLConfig(..)
+  , LL.ClientSSLKeyCertPair(..)
+  , LL.Host(..)
+  , LL.Port(..)
+
   , clientRequest
+
+  -- * Client utility functions
+  , acquireClient
+  , simplifyUnary
   )
 
 where
 
-import qualified Network.GRPC.LowLevel.Client as LL
-import qualified Network.GRPC.LowLevel.Call as LL
-import Network.GRPC.LowLevel.CompletionQueue (TimeoutSeconds)
-import Network.GRPC.LowLevel ( GRPCMethodType(..)
-                             , StatusCode(..)
-                             , StatusDetails(..)
-                             , MetadataMap(..)
-                             , GRPCIOError(..)
-                             , StreamRecv
-                             , StreamSend )
-import Network.GRPC.LowLevel.Op (WritesDone)
-import Network.GRPC.HighLevel.Server (convertRecv, convertSend)
-
-import Proto3.Suite (Message, toLazyByteString, fromByteString)
-import Proto3.Wire.Decode (ParseError)
+import           Control.Monad.Managed                 (Managed, liftIO,
+                                                        managed)
 import qualified Data.ByteString.Lazy                  as BL
+import           Network.GRPC.HighLevel.Server         (convertRecv,
+                                                        convertSend)
+import           Network.GRPC.LowLevel                 (GRPCIOError (..),
+                                                        GRPCMethodType (..),
+                                                        MetadataMap (..),
+                                                        StatusCode (..),
+                                                        StatusDetails (..),
+                                                        StreamRecv, StreamSend)
+import qualified Network.GRPC.LowLevel                 as LL
+import           Network.GRPC.LowLevel.CompletionQueue (TimeoutSeconds)
+import           Network.GRPC.LowLevel.Op              (WritesDone)
+import           Proto3.Suite                          (Message, fromByteString,
+                                                        toLazyByteString)
+import           Proto3.Wire.Decode                    (ParseError)
 
 newtype RegisteredMethod (mt :: GRPCMethodType) request response
   = RegisteredMethod (LL.RegisteredMethod mt)
@@ -121,3 +135,45 @@ clientRequest client (RegisteredMethod method) (ClientBiDiRequest timeout meta h
     mkResponse (Left ioError_) = ClientErrorResponse (ClientIOError ioError_)
     mkResponse (Right (meta_, rspCode_, details_)) =
       ClientBiDiResponse meta_ rspCode_ details_
+
+acquireClient
+  :: LL.ClientConfig
+     -- ^ The client configuration (host, port, SSL settings, etc)
+  -> (LL.Client -> IO (ServiceClient service))
+     -- ^ The client implementation (typically generated)
+  -> Managed (ServiceClient service)
+acquireClient cfg impl = do
+  g <- managed LL.withGRPC
+  c <- managed (LL.withClient g cfg)
+  liftIO (impl c)
+
+-- | A utility for simplifying gRPC client requests in common cases; you can use
+-- this to avoid 'ClientRequest' and 'ClientResponse' pattern-matching
+-- boilerplate at call sites.
+simplifyUnary :: TimeoutSeconds
+                -- ^ RPC call timeout, in seconds
+              -> MetadataMap
+                 -- ^ RPC call metadata
+              -> (ClientError -> IO (b, StatusDetails))
+                 -- ^ Handler for client errors
+              -> (b -> StatusCode -> StatusDetails -> IO (b, StatusDetails))
+                 -- ^ Handler for non-StatusOK responses
+              -> (ClientRequest 'Normal a b -> IO (ClientResult 'Normal b))
+                 -- ^ gRPC function implementation (typically generated by gRPC-haskell)
+              -> (a -> IO (b, StatusDetails))
+                 -- ^ The simplified happy-path (StatusOk) unary call action
+simplifyUnary timeout meta clientError nonStatusOkError f x = do
+
+  let request = ClientNormalRequest x timeout meta
+
+  response <- f request
+
+  case response of
+    ClientNormalResponse y _ _ StatusOk details
+      -> pure (y, details)
+
+    ClientNormalResponse y _ _ code details
+      -> nonStatusOkError y code details
+
+    ClientErrorResponse err
+      -> clientError err