Update to gRPC 0.15 (#61)

* update channel arg names, add compression level arg support, add compression level arg test

* switch to temp test demonstrating bug in grpc 0.15.0

* memset op array to 0

* switch examples back

* Switch to newer `grpc` and enable tests in `release.nix`

* Split out `simple-server` test into separate shell script

* Fix bash invocation

* Add intermediate `./default-tests.nix` build

* Add `tests.patch` to version control

* Split `python` command into separate script

* Provide `python` via `nix`

cbits/grpc_haskell.c

@@ -184,7 +184,9 @@ const char* get_metadata_val(grpc_metadata *arr, size_t i){
 }
 
 grpc_op* op_array_create(size_t n){
-  return malloc(n*sizeof(grpc_op));
+  grpc_op* ops = malloc(n*sizeof(grpc_op));
+  memset(ops, 0, n*sizeof(grpc_op));
+  return ops;
 }
 
 void op_array_destroy(grpc_op* op_array, size_t n){
@@ -415,7 +417,9 @@ grpc_arg* create_arg_array(size_t n){
 char* translate_arg_key(enum supported_arg_key key){
   switch (key) {
     case compression_algorithm_key:
-      return GRPC_COMPRESSION_ALGORITHM_ARG;
+      return GRPC_COMPRESSION_CHANNEL_DEFAULT_ALGORITHM;
+    case compression_level_key:
+      return GRPC_COMPRESSION_CHANNEL_DEFAULT_LEVEL;
     case user_agent_prefix_key:
       return GRPC_ARG_PRIMARY_USER_AGENT_STRING;
     case user_agent_suffix_key:

default-tests.nix

@@ -0,0 +1,29 @@
+{ grpc-haskell-no-tests
+, ghc
+, python
+}:
+
+attrs@
+{ mkDerivation, async, base, bytestring, c2hs, clock, containers
+, grpc, managed, pipes, proto3-wire, protobuf-wire, random, safe
+, sorted-list, stdenv, stm, tasty, tasty-hunit, tasty-quickcheck
+, text, time, transformers, turtle, unix, vector
+}:
+
+let
+  mkDerivation' = oldAttrs: mkDerivation (oldAttrs // {
+    patches = [ tests/tests.patch ];
+
+    postPatch = ''
+      substituteInPlace tests/simple-server.sh --replace @ghc@ ${ghc} --replace @shell@ ${stdenv.shell}
+      substituteInPlace tests/protoc.sh --replace @python@ ${python} --replace @shell@ ${stdenv.shell}
+    '';
+
+    testHaskellDepends = oldAttrs.testHaskellDepends ++ [
+      ghc grpc-haskell-no-tests
+    ];
+
+    doCheck = true;
+  });
+
+in import ./default.nix (attrs // { mkDerivation = mkDerivation'; })

default.nix

@@ -28,4 +28,5 @@ mkDerivation {
   homepage = "http://github.com/aloiscochard/grpc-haskell";
   description = "Haskell implementation of gRPC layered on shared C library";
   license = stdenv.lib.licenses.asl20;
+  doCheck = false;
 }

include/grpc_haskell.h

@@ -146,6 +146,7 @@ void* grpc_server_register_method_(
 // translate_arg_key in grpc_haskell.c.
 enum supported_arg_key {
   compression_algorithm_key = 0,
+  compression_level_key,
   user_agent_prefix_key,
   user_agent_suffix_key
 };

release.nix

@@ -33,12 +33,12 @@ let
     packageOverrides = pkgs: rec {
       grpc = pkgs.stdenv.mkDerivation rec {
         name    = "grpc-${version}";
-        version = "0.14-${pkgs.lib.strings.substring 0 7 rev}";
+        version = "0.15-${pkgs.lib.strings.substring 0 7 rev}";
-        rev     = "2b223977c13975648bac2f422363e1ebf83506ce";
+        rev     = "03efbd34ce64615f58007eae667b375accc6c8e6";
         src = pkgs.fetchgit {
           inherit rev;
           url    = "https://github.com/grpc/grpc.git";
-          sha256 = "0arxjdczgj6rbg14f6x24863mrz0xgpakmdfg54zp0xp7h2pghm6";
+          sha256 = "1pac3jby5p5a6p6vpqc5whkgy36hnn2ph2jbckg3w73hrxrnwmdh";
         };
         preInstall  = "export prefix";
         buildInputs =
@@ -53,7 +53,7 @@ let
       };
 
       haskellPackages = pkgs.haskell.packages.ghc7103.override {
-        overrides = haskellPackagesNew: haskellPackagesOld: {
+        overrides = haskellPackagesNew: haskellPackagesOld: rec {
           proto3-wire =
             let proto3-wire-src = pkgs.fetchgit {
               url    = "https://github.com/awakenetworks/proto3-wire.git";
@@ -72,9 +72,15 @@ let
             in
             haskellPackagesNew.callPackage protobuf-wire-src { };
 
-          grpc-haskell =
+          grpc-haskell-no-tests =
             haskellPackagesNew.callPackage ./default.nix { };
 
+          grpc-haskell =
+            haskellPackagesNew.callPackage (import ./default-tests.nix {
+              inherit grpc-haskell-no-tests;
+              inherit (pkgs) ghc python;
+            }) { };
+
           sorted-list = haskellPackagesNew.callPackage
             ({ mkDerivation, base, deepseq }:
              mkDerivation {

src/Network/GRPC/LowLevel.hs

@@ -29,6 +29,7 @@ GRPC
 -- * Configuration options
 , Arg(..)
 , CompressionAlgorithm(..)
+, CompressionLevel(..)
 , Port
 
 -- * Server
@@ -88,4 +89,6 @@ import           Network.GRPC.LowLevel.Call
 
 import Network.GRPC.Unsafe (ConnectivityState(..))
 import Network.GRPC.Unsafe.Op (StatusCode(..))
-import Network.GRPC.Unsafe.ChannelArgs(Arg(..), CompressionAlgorithm(..))
+import Network.GRPC.Unsafe.ChannelArgs(Arg(..)
+                                       , CompressionAlgorithm(..)
+                                       , CompressionLevel(..))

src/Network/GRPC/LowLevel/Client.hs

@@ -31,6 +31,7 @@ data Client = Client {clientChannel :: C.Channel,
                      }
 
 -- | Configuration necessary to set up a client.
+
 data ClientConfig = ClientConfig {serverHost :: Host,
                                   serverPort :: Port,
                                   clientArgs :: [C.Arg]
@@ -44,8 +45,8 @@ clientEndpoint :: ClientConfig -> Endpoint
 clientEndpoint ClientConfig{..} = endpoint serverHost serverPort
 
 createClient :: GRPC -> ClientConfig -> IO Client
-createClient grpc clientConfig =
+createClient grpc clientConfig@ClientConfig{..} =
-  C.withChannelArgs (clientArgs clientConfig) $ \chanargs -> do
+  C.withChannelArgs clientArgs $ \chanargs -> do
     let Endpoint e = clientEndpoint clientConfig
     clientChannel <- C.grpcInsecureChannelCreate e chanargs C.reserved
     clientCQ <- createCompletionQueue grpc

src/Network/GRPC/Unsafe/ChannelArgs.chs

@@ -2,10 +2,11 @@
 
 module Network.GRPC.Unsafe.ChannelArgs where
 
-import Control.Exception
+import           Control.Exception
-import Control.Monad
+import           Control.Monad
-import Foreign.Storable
+import           Data.List             (find)
-import Foreign.Marshal.Alloc (malloc, free)
+import           Foreign.Marshal.Alloc (malloc, free)
+import           Foreign.Storable
 
 #include <grpc/grpc.h>
 #include <grpc/status.h>
@@ -47,6 +48,7 @@ data ArgValue = StringArg String | IntArg Int
 -- | Supported arguments for a channel. More cases will be added as we figure
 -- out what they are.
 data Arg = CompressionAlgArg CompressionAlgorithm
+           | CompressionLevelArg CompressionLevel
            | UserAgentPrefix String
            | UserAgentSuffix String
   deriving (Show, Eq)
@@ -60,6 +62,8 @@ data Arg = CompressionAlgArg CompressionAlgorithm
 createArg :: GrpcArg -> Arg -> Int -> IO ()
 createArg array (CompressionAlgArg alg) i =
   createIntArg array i CompressionAlgorithmKey (fromEnum alg)
+createArg array (CompressionLevelArg lvl) i =
+  createIntArg array i CompressionLevelKey (fromEnum lvl)
 createArg array (UserAgentPrefix prefix) i =
   createStringArg array i UserAgentPrefixKey prefix
 createArg array (UserAgentSuffix suffix) i =

tests/GeneratedTests.hs

@@ -22,10 +22,10 @@ testServerGeneration = testCase "server generation" $ do
 
   compileSimpleDotProto
 
-  exitCode <- shell (T.concat ["stack ghc -- --make -threaded -odir ", hsTmpDir, " -hidir ", hsTmpDir, " -o ", hsTmpDir, "/simple-server ", hsTmpDir, "/Simple.hs tests/TestServer.hs > /dev/null"]) empty
+  exitCode <- proc "tests/simple-server.sh" [hsTmpDir] empty
   exitCode @?= ExitSuccess
 
-  exitCode <- shell (T.concat ["python -m grpc.tools.protoc -I tests --python_out=", pyTmpDir, " --grpc_python_out=", pyTmpDir, " tests/simple.proto"]) empty
+  exitCode <- proc "tests/protoc.sh" [pyTmpDir] empty
   exitCode @?= ExitSuccess
 
   runManaged $ do

tests/LowLevelTests.hs

@@ -158,8 +158,8 @@ testServerCancel =
   where
     client c = do
       rm <- clientRegisterMethodNormal c "/foo"
-      res <- clientRequest c rm 10 "" mempty
+      Left (GRPCIOBadStatusCode s _) <- clientRequest c rm 10 "" mempty
-      res @?= badStatus StatusCancelled
+      s @?= StatusCancelled
     server s = do
       let rm = head (normalMethods s)
       r <- serverHandleNormalCall s rm mempty $ \c -> do
@@ -511,6 +511,34 @@ testClientServerCompression =
         return ("hello", dummyMeta, StatusOk, StatusDetails "")
       return ()
 
+testClientServerCompressionLvl :: TestTree
+testClientServerCompressionLvl =
+  csTest' "client/server compression: no errors" client server
+  where
+    cconf = ClientConfig "localhost"
+                         50051
+                         [CompressionLevelArg GrpcCompressLevelHigh]
+    client = TestClient cconf $ \c -> do
+      rm <- clientRegisterMethodNormal c "/foo"
+      clientRequest c rm 1 "hello" mempty >>= do
+        checkReqRslt $ \NormalRequestResult{..} -> do
+          rspCode @?= StatusOk
+          rspBody @?= "hello"
+          details @?= ""
+          initMD  @?= dummyMeta
+          trailMD @?= dummyMeta
+      return ()
+    sconf = ServerConfig "localhost"
+                         50051
+                         ["/foo"] [] [] []
+                         [CompressionLevelArg GrpcCompressLevelLow]
+    server = TestServer sconf $ \s -> do
+      let rm = head (normalMethods s)
+      serverHandleNormalCall s rm dummyMeta $ \sc -> do
+        payload sc @?= "hello"
+        return ("hello", dummyMeta, StatusOk, StatusDetails "")
+      return ()
+
 --------------------------------------------------------------------------------
 -- Utilities and helpers
 

tests/LowLevelTests/Op.hs

@@ -31,10 +31,6 @@ testCancelFromServer =
         Left x -> error $ "Client recv error: " ++ show x
         Right [_,_,OpRecvStatusOnClientResult _ code details] -> do
           code @?= StatusPermissionDenied
-          assertBool "Received status details or RST_STREAM error" $
-            details == "TestStatus"
-            ||
-            isPrefixOf "Received RST_STREAM" details
           return $ Right ()
         wrong -> error $ "Unexpected op results: " ++ show wrong
 

tests/protoc.sh

@@ -0,0 +1,10 @@
+#!/bin/bash -eu
+
+pyTmpDir=$1
+
+python                          \
+    -m grpc.tools.protoc        \
+    -I tests                    \
+    --python_out=$pyTmpDir      \
+    --grpc_python_out=$pyTmpDir \
+    tests/simple.proto

tests/simple-server.sh

@@ -0,0 +1,13 @@
+#!/bin/bash -eu
+
+hsTmpDir=$1
+
+stack ghc --                   \
+    --make                     \
+    -threaded                  \
+    -odir $hsTmpDir            \
+    -hidir $hsTmpDir           \
+    -o $hsTmpDir/simple-server \
+    $hsTmpDir/Simple.hs        \
+    tests/TestServer.hs        \
+    > /dev/null

tests/tests.patch

@@ -0,0 +1,30 @@
+diff --git a/tests/protoc.sh b/tests/protoc.sh
+index 054c8b6..4bf0893 100644
+--- a/tests/protoc.sh
++++ b/tests/protoc.sh
+@@ -1,8 +1,8 @@
+-#!/bin/bash -eu
++#! @shell@ -eu
+ 
+ pyTmpDir=$1
+ 
+-python                          \
++@python@/bin/python             \
+     -m grpc.tools.protoc        \
+     -I tests                    \
+     --python_out=$pyTmpDir      \
+diff --git a/tests/simple-server.sh b/tests/simple-server.sh
+index 37a0a63..8e8fb66 100755
+--- a/tests/simple-server.sh
++++ b/tests/simple-server.sh
+@@ -1,8 +1,8 @@
+-#!/bin/bash -eu
++#! @shell@ -eu
+ 
+ hsTmpDir=$1
+ 
+-stack ghc --                   \
++@ghc@/bin/ghc                  \
+     --make                     \
+     -threaded                  \
+     -odir $hsTmpDir            \