Fix payload test bugs (#8)

* fix memory mgmt bug in status details strings

* remove flags

* allow server to specify status details

cbits/grpc_haskell.c

@@ -131,6 +131,10 @@ grpc_metadata_array** metadata_array_create(){
   grpc_metadata_array **retval = malloc(sizeof(grpc_metadata_array*));
   *retval = malloc(sizeof(grpc_metadata_array));
   grpc_metadata_array_init(*retval);
+  #ifdef GRPC_HASKELL_DEBUG
+  printf("C wrapper: metadata_array_create debug: %p %p %p\n", retval, *retval,
+         (*retval)->metadata);
+  #endif
   return retval;
 }
 
@@ -299,7 +303,11 @@ void op_send_status_server(grpc_op *op_array, size_t i,
 }
 
 grpc_status_code* create_status_code_ptr(){
-  return malloc(sizeof(grpc_status_code));
+  grpc_status_code* retval = malloc(sizeof(grpc_status_code));
+  #ifdef GRPC_HASKELL_DEBUG
+  printf("C wrapper: create_status_code_ptr debug: %p\n", retval);
+  #endif
+  return retval;
 }
 
 grpc_status_code deref_status_code_ptr(grpc_status_code* p){

src/Network/GRPC/LowLevel.hs

@@ -47,6 +47,7 @@ GRPC
 , runOps
 , Op(..)
 , OpRecvResult(..)
+, StatusDetails(..)
 
 ) where
 

src/Network/GRPC/LowLevel/Client.hs

@@ -114,9 +114,10 @@ withClientCall client method host timeout f = do
 
 data NormalRequestResult = NormalRequestResult
                              ByteString
-                             MetadataMap --init metadata
+                             (Maybe MetadataMap) --init metadata
                              MetadataMap --trailing metadata
                              C.StatusCode
+                             StatusDetails
   deriving (Show, Eq)
 
 -- | Function for assembling call result when the 'MethodType' is 'Normal'.
@@ -128,8 +129,14 @@ compileNormalRequestResults
   -- core use cases easy.
   [OpRecvInitialMetadataResult m,
    OpRecvMessageResult body,
-   OpRecvStatusOnClientResult m2 status]
+   OpRecvStatusOnClientResult m2 status details]
-    = NormalRequestResult body m m2 status
+    = NormalRequestResult body (Just m) m2 status (StatusDetails details)
+  -- TODO: it seems registered request responses on the server
+  -- don't send initial metadata. Hence the 'Maybe'. Investigate.
+compileNormalRequestResults
+  [OpRecvMessageResult body,
+   OpRecvStatusOnClientResult m2 status details]
+    = NormalRequestResult body Nothing m2 status (StatusDetails details)
 compileNormalRequestResults _ =
   --TODO: impossible case should be enforced by more precise types.
   error "non-normal request input to compileNormalRequestResults."

src/Network/GRPC/LowLevel/CompletionQueue.hs

@@ -30,6 +30,7 @@ import           Control.Concurrent.STM.TVar (TVar, newTVarIO, modifyTVar',
                                               readTVar, writeTVar)
 import           Control.Exception (bracket)
 import           Data.IORef (IORef, newIORef, atomicModifyIORef')
+import           Data.List (intersperse)
 import           Foreign.Marshal.Alloc (malloc, free)
 import           Foreign.Ptr (nullPtr, plusPtr)
 import           Foreign.Storable (peek)
@@ -188,7 +189,8 @@ startBatch :: CompletionQueue -> C.Call -> C.OpArray -> Int -> C.Tag
               -> IO (Either GRPCIOError ())
 startBatch cq@CompletionQueue{..} call opArray opArraySize tag =
     withPermission Push cq $ fmap throwIfCallError $ do
-      grpcDebug "startBatch: calling grpc_call_start_batch."
+      grpcDebug $ "startBatch: calling grpc_call_start_batch with pointers: "
+                  ++ show call ++ " " ++ show opArray
       res <- C.grpcCallStartBatch call opArray opArraySize tag C.reserved
       grpcDebug "startBatch: grpc_call_start_batch call returned."
       return res
@@ -230,6 +232,10 @@ channelCreateRegisteredCall :: C.Channel -> C.Call -> C.PropagationMask
 channelCreateRegisteredCall
   chan parent mask cq@CompletionQueue{..} handle deadline =
   withPermission Push cq $ do
+    grpcDebug $ "channelCreateRegisteredCall: call with "
+                ++ concat (intersperse " " [show chan, show parent, show mask,
+                                            show unsafeCQ, show handle,
+                                            show deadline])
     call <- C.grpcChannelCreateRegisteredCall chan parent mask unsafeCQ
                                               handle deadline C.reserved
     return $ Right $ ClientCall call

src/Network/GRPC/LowLevel/Op.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module Network.GRPC.LowLevel.Op where
 
@@ -6,10 +7,12 @@ import           Control.Exception
 import qualified Data.ByteString as B
 import qualified Data.Map.Strict as M
 import           Data.Maybe (catMaybes)
+import           Data.String (IsString)
+import           Foreign.C.String (CString)
 import           Foreign.C.Types (CInt)
-import           Foreign.Marshal.Alloc (malloc, free)
+import           Foreign.Marshal.Alloc (malloc, mallocBytes, free)
-import           Foreign.Ptr (Ptr)
+import           Foreign.Ptr (Ptr, nullPtr)
-import           Foreign.Storable (peek)
+import           Foreign.Storable (peek, poke)
 import qualified Network.GRPC.Unsafe as C
 import qualified Network.GRPC.Unsafe.Metadata as C
 import qualified Network.GRPC.Unsafe.ByteBuffer as C
@@ -21,13 +24,15 @@ import Network.GRPC.LowLevel.Call
 
 type MetadataMap = M.Map B.ByteString B.ByteString
 
+newtype StatusDetails = StatusDetails B.ByteString deriving (Show, Eq, IsString)
+
 -- | Sum describing all possible send and receive operations that can be batched
 -- and executed by gRPC. Usually these are processed in a handful of
 -- combinations depending on the 'MethodType' of the call being run.
 data Op = OpSendInitialMetadata MetadataMap
           | OpSendMessage B.ByteString
           | OpSendCloseFromClient
-          | OpSendStatusFromServer MetadataMap C.StatusCode --TODO: Issue #6
+          | OpSendStatusFromServer MetadataMap C.StatusCode StatusDetails
           | OpRecvInitialMetadata
           | OpRecvMessage
           | OpRecvStatusOnClient
@@ -42,10 +47,19 @@ data OpContext =
   | OpSendMessageContext C.ByteBuffer
   | OpSendCloseFromClientContext
   | OpSendStatusFromServerContext C.MetadataKeyValPtr Int C.StatusCode
+                                  B.ByteString
   | OpRecvInitialMetadataContext (Ptr C.MetadataArray)
   | OpRecvMessageContext (Ptr C.ByteBuffer)
   | OpRecvStatusOnClientContext (Ptr C.MetadataArray) (Ptr C.StatusCode)
+                                (Ptr CString)
   | OpRecvCloseOnServerContext (Ptr CInt)
+  deriving Show
+
+-- | Length we pass to gRPC for receiving status details
+-- when processing 'OpRecvStatusOnClient'. It appears that gRPC actually ignores
+-- this length and reallocates a longer string if necessary.
+defaultStatusStringLen :: Int
+defaultStatusStringLen = 128
 
 -- | Allocates and initializes the 'Opcontext' corresponding to the given 'Op'.
 createOpContext :: Op -> IO OpContext
@@ -56,19 +70,23 @@ createOpContext (OpSendInitialMetadata m) =
 createOpContext (OpSendMessage bs) =
   fmap OpSendMessageContext (C.createByteBuffer bs)
 createOpContext (OpSendCloseFromClient) = return OpSendCloseFromClientContext
-createOpContext (OpSendStatusFromServer m code) =
+createOpContext (OpSendStatusFromServer m code (StatusDetails str)) =
   OpSendStatusFromServerContext
   <$> C.createMetadata m
   <*> return (M.size m)
   <*> return code
+  <*> return str
 createOpContext OpRecvInitialMetadata =
   fmap OpRecvInitialMetadataContext C.metadataArrayCreate
 createOpContext OpRecvMessage =
   fmap OpRecvMessageContext C.createReceivingByteBuffer
-createOpContext OpRecvStatusOnClient =
+createOpContext OpRecvStatusOnClient = do
-  OpRecvStatusOnClientContext
+  pmetadata <- C.metadataArrayCreate
-  <$> C.metadataArrayCreate
+  pstatus <- C.createStatusCodePtr
-  <*> C.createStatusCodePtr
+  pstr <- malloc
+  cstring <- mallocBytes defaultStatusStringLen
+  poke pstr cstring
+  return $ OpRecvStatusOnClientContext pmetadata pstatus pstr
 createOpContext OpRecvCloseOnServer =
   fmap OpRecvCloseOnServerContext $ malloc
 
@@ -81,15 +99,15 @@ setOpArray arr i (OpSendMessageContext bb) =
   C.opSendMessage arr i bb
 setOpArray arr i OpSendCloseFromClientContext =
   C.opSendCloseClient arr i
-setOpArray arr i (OpSendStatusFromServerContext kvs l code) =
+setOpArray arr i (OpSendStatusFromServerContext kvs l code details) =
-  C.opSendStatusServer arr i l kvs code "" --TODO: Issue #6
+  B.useAsCString details $ \cstr ->
+    C.opSendStatusServer arr i l kvs code cstr
 setOpArray arr i (OpRecvInitialMetadataContext pmetadata) =
   C.opRecvInitialMetadata arr i pmetadata
 setOpArray arr i (OpRecvMessageContext pbb) =
   C.opRecvMessage arr i pbb
-setOpArray arr i (OpRecvStatusOnClientContext pmetadata pstatus) = do
+setOpArray arr i (OpRecvStatusOnClientContext pmetadata pstatus pstr) = do
-  pCString <- malloc --TODO: Issue #6
+  C.opRecvStatusClient arr i pmetadata pstatus pstr defaultStatusStringLen
-  C.opRecvStatusClient arr i pmetadata pstatus pCString 0
 setOpArray arr i (OpRecvCloseOnServerContext pcancelled) = do
   C.opRecvCloseServer arr i pcancelled
 
@@ -98,15 +116,18 @@ freeOpContext :: OpContext -> IO ()
 freeOpContext (OpSendInitialMetadataContext m _) = C.metadataFree m
 freeOpContext (OpSendMessageContext bb) = C.grpcByteBufferDestroy bb
 freeOpContext OpSendCloseFromClientContext = return ()
-freeOpContext (OpSendStatusFromServerContext metadata _ _) =
+freeOpContext (OpSendStatusFromServerContext metadata _ _ _) =
   C.metadataFree metadata
 freeOpContext (OpRecvInitialMetadataContext metadata) =
   C.metadataArrayDestroy metadata
 freeOpContext (OpRecvMessageContext pbb) =
   C.destroyReceivingByteBuffer pbb
-freeOpContext (OpRecvStatusOnClientContext metadata pcode) =
+freeOpContext (OpRecvStatusOnClientContext metadata pcode pstr) = do
   C.metadataArrayDestroy metadata
-  >> C.destroyStatusCodePtr pcode
+  C.destroyStatusCodePtr pcode
+  str <- peek pstr
+  free str
+  free pstr
 freeOpContext (OpRecvCloseOnServerContext pcancelled) =
   grpcDebug ("freeOpContext: freeing pcancelled: " ++ show pcancelled)
   >> free pcancelled
@@ -125,7 +146,7 @@ withOpArray n = bracket (C.opArrayCreate n)
 data OpRecvResult =
   OpRecvInitialMetadataResult MetadataMap
   | OpRecvMessageResult B.ByteString
-  | OpRecvStatusOnClientResult MetadataMap C.StatusCode
+  | OpRecvStatusOnClientResult MetadataMap C.StatusCode B.ByteString
   | OpRecvCloseOnServerResult Bool -- ^ True if call was cancelled.
   deriving (Eq, Show)
 
@@ -145,12 +166,14 @@ resultFromOpContext (OpRecvMessageContext pbb) = do
   bs <- C.copyByteBufferToByteString bb
   grpcDebug "resultFromOpContext: bb copied."
   return $ Just $ OpRecvMessageResult bs
-resultFromOpContext (OpRecvStatusOnClientContext pmetadata pcode) = do
+resultFromOpContext (OpRecvStatusOnClientContext pmetadata pcode pstr) = do
   grpcDebug "resultFromOpContext: OpRecvStatusOnClientContext"
   metadata <- peek pmetadata
   metadataMap <- C.getAllMetadataArray metadata
   code <- C.derefStatusCodePtr pcode
-  return $ Just $ OpRecvStatusOnClientResult metadataMap code
+  cstr <- peek pstr
+  statusInfo <- B.packCString cstr
+  return $ Just $ OpRecvStatusOnClientResult metadataMap code statusInfo
 resultFromOpContext (OpRecvCloseOnServerContext pcancelled) = do
   grpcDebug "resultFromOpContext: OpRecvCloseOnServerContext"
   cancelled <- fmap (\x -> if x > 0 then True else False)
@@ -185,7 +208,7 @@ runOps call cq ops timeLimit =
     withOpArray l $ \opArray -> do
       grpcDebug "runOps: created op array."
       withOpContexts ops $ \contexts -> do
-        grpcDebug "runOps: allocated op contexts."
+        grpcDebug $ "runOps: allocated op contexts: " ++ show contexts
         sequence_ $ zipWith (setOpArray opArray) [0..l-1] contexts
         tag <- newTag cq
         callError <- startBatch cq (internalCall call) opArray l tag

src/Network/GRPC/LowLevel/Server.hs

@@ -2,6 +2,7 @@
 
 module Network.GRPC.LowLevel.Server where
 
+import           Control.Concurrent (threadDelay)
 import           Control.Exception (bracket, finally)
 import           Control.Monad
 import           Data.ByteString (ByteString)
@@ -159,11 +160,12 @@ serverOpsGetNormalCall initMetadata =
 serverOpsSendNormalResponse :: ByteString
                                -> MetadataMap
                                -> C.StatusCode
+                               -> StatusDetails
                                -> [Op]
-serverOpsSendNormalResponse body metadata code =
+serverOpsSendNormalResponse body metadata code details =
   [OpRecvCloseOnServer,
    OpSendMessage body,
-   OpSendStatusFromServer metadata code]
+   OpSendStatusFromServer metadata code details]
 
 serverOpsSendNormalRegisteredResponse :: ByteString
                                          -> MetadataMap
@@ -171,12 +173,14 @@ serverOpsSendNormalRegisteredResponse :: ByteString
                                          -> MetadataMap
                                          -- ^ trailing metadata
                                          -> C.StatusCode
+                                         -> StatusDetails
                                          -> [Op]
-serverOpsSendNormalRegisteredResponse body initMetadata trailingMeta code =
+serverOpsSendNormalRegisteredResponse
+  body initMetadata trailingMeta code details =
   [OpSendInitialMetadata initMetadata,
    OpRecvCloseOnServer,
    OpSendMessage body,
-   OpSendStatusFromServer trailingMeta code]
+   OpSendStatusFromServer trailingMeta code details]
 
 -- TODO: we will want to replace this with some more general concept that also
 -- works with streaming calls in the future.
@@ -189,7 +193,8 @@ serverHandleNormalRegisteredCall :: Server
                           -> (ByteString -> MetadataMap
                               -> IO (ByteString,
                                      MetadataMap,
-                                     MetadataMap))
+                                     MetadataMap,
+                                     StatusDetails))
                              -- ^ Handler function takes a request body and
                              -- metadata and returns a response body and
                              -- metadata.
@@ -209,10 +214,10 @@ serverHandleNormalRegisteredCall s@Server{..} rm timeLimit initMetadata f = do
         requestBody <- C.copyByteBufferToByteString payload
         metadataArray <- peek $ requestMetadataRecv call
         metadata <- C.getAllMetadataArray metadataArray
-        (respBody, initMeta, trailingMeta) <- f requestBody metadata
+        (respBody, initMeta, trailingMeta, details) <- f requestBody metadata
         let status = C.GrpcStatusOk
         let respOps = serverOpsSendNormalRegisteredResponse
-                        respBody initMeta trailingMeta status
+                        respBody initMeta trailingMeta status details
         respOpsResults <- runOps call serverCQ respOps timeLimit
         grpcDebug "serverHandleNormalRegisteredCall: finished response ops."
         case respOpsResults of
@@ -226,7 +231,7 @@ serverHandleNormalCall :: Server -> TimeoutSeconds
                           -> MetadataMap
                           -- ^ Initial metadata.
                           -> (ByteString -> MetadataMap
-                              -> IO (ByteString, MetadataMap))
+                              -> IO (ByteString, MetadataMap, StatusDetails))
                           -- ^ Handler function takes a request body and
                           -- metadata and returns a response body and metadata.
                           -> IO (Either GRPCIOError ())
@@ -239,9 +244,10 @@ serverHandleNormalCall s@Server{..} timeLimit initMetadata f = do
       Left x -> return $ Left x
       Right [OpRecvMessageResult body] -> do
         --TODO: we need to get client metadata
-        (respBody, respMetadata) <- f body M.empty
+        (respBody, respMetadata, details) <- f body M.empty
         let status = C.GrpcStatusOk
-        let respOps = serverOpsSendNormalResponse respBody respMetadata status
+        let respOps = serverOpsSendNormalResponse
+                        respBody respMetadata status details
         respOpsResults <- runOps call serverCQ respOps timeLimit
         case respOpsResults of
           Left x -> do grpcDebug "serverHandleNormalCall: resp failed."

src/Network/GRPC/Unsafe.chs

@@ -1,3 +1,5 @@
+{-# LANGUAGE StandaloneDeriving #-}
+
 module Network.GRPC.Unsafe where
 
 import Control.Monad
@@ -20,9 +22,13 @@ import Network.GRPC.Unsafe.Constants
 
 {#pointer *grpc_completion_queue as CompletionQueue newtype #}
 
+deriving instance Show CompletionQueue
+
 -- | Represents a connection to a server. Created on the client side.
 {#pointer *grpc_channel as Channel newtype #}
 
+deriving instance Show Channel
+
 -- | Represents a server. Created on the server side.
 {#pointer *grpc_server as Server newtype #}
 
@@ -30,13 +36,11 @@ import Network.GRPC.Unsafe.Constants
 -- type is abstract; we have no access to its fields.
 {#pointer *grpc_call as Call newtype #}
 
-instance Show Call where
+deriving instance Show Call
-  show (Call ptr) = show ptr
 
 {#pointer *grpc_call_details as CallDetails newtype #}
 
-instance Show CallDetails where
+deriving instance Show CallDetails
-  show (CallDetails ptr) = show ptr
 
 {#fun create_call_details as ^ {} -> `CallDetails'#}
 {#fun destroy_call_details as ^ {`CallDetails'} -> `()'#}

src/Network/GRPC/Unsafe/ByteBuffer.chs

@@ -1,3 +1,5 @@
+{-# LANGUAGE StandaloneDeriving #-}
+
 module Network.GRPC.Unsafe.ByteBuffer where
 
 #include <grpc/grpc.h>
@@ -21,6 +23,8 @@ import Foreign.Storable
 -- Must be destroyed manually with 'grpcByteBufferDestroy'.
 {#pointer *grpc_byte_buffer as ByteBuffer newtype #}
 
+deriving instance Show ByteBuffer
+
 --Trivial Storable instance because 'ByteBuffer' type is a pointer.
 instance Storable ByteBuffer where
   sizeOf (ByteBuffer r) = sizeOf r

src/Network/GRPC/Unsafe/Metadata.chs

@@ -1,3 +1,5 @@
+{-# LANGUAGE StandaloneDeriving #-}
+
 module Network.GRPC.Unsafe.Metadata where
 
 import Control.Exception
@@ -18,6 +20,8 @@ import Foreign.Storable
 -- is intended to be used when sending metadata.
 {#pointer *grpc_metadata as MetadataKeyValPtr newtype#}
 
+deriving instance Show MetadataKeyValPtr
+
 -- | Represents a pointer to a grpc_metadata_array. Must be destroyed with
 -- 'metadataArrayDestroy'. This type is intended for receiving metadata.
 -- This can be populated by passing it to e.g. 'grpcServerRequestCall'.
@@ -25,6 +29,8 @@ import Foreign.Storable
 -- and length from this type.
 {#pointer *grpc_metadata_array as MetadataArray newtype#}
 
+deriving instance Show MetadataArray
+
 {#fun metadata_array_get_metadata as ^
   {`MetadataArray'} -> `MetadataKeyValPtr'#}
 

src/Network/GRPC/Unsafe/Op.chs

@@ -1,3 +1,5 @@
+{-# LANGUAGE StandaloneDeriving #-}
+
 module Network.GRPC.Unsafe.Op where
 
 import Control.Exception
@@ -34,6 +36,8 @@ import Foreign.Ptr
 -- 'opArrayDestroy'.
 {#pointer *grpc_op as OpArray newtype #}
 
+deriving instance Show OpArray
+
 -- | Creates an empty 'OpArray' with space for the given number of ops.
 {#fun op_array_create as ^ {`Int'} -> `OpArray'#}
 
@@ -98,5 +102,5 @@ withOpArray n f = bracket (opArrayCreate n) (flip opArrayDestroy n) f
 -- Metadata and string are copied when creating the op, and can be safely
 -- destroyed immediately after calling this function.
 {#fun op_send_status_server as ^
-  {`OpArray', `Int', `Int', `MetadataKeyValPtr', `StatusCode', `String'}
+  {`OpArray', `Int', `Int', `MetadataKeyValPtr', `StatusCode', `CString'}
   -> `()'#}

tests/LowLevelTests.hs

@@ -17,10 +17,10 @@ lowLevelTests = testGroup "Unit tests of low-level Haskell library"
    , testClientCreateDestroy
    , testWithServerCall
    , testWithClientCall
-   --, testPayloadLowLevel --TODO: currently crashing from free on unalloced ptr
+   , testPayloadLowLevel
-   --, testClientRequestNoServer --TODO: succeeds when no other tests run.
+   , testClientRequestNoServer
    , testServerAwaitNoClient
-   --, testPayloadLowLevelUnregistered --TODO: succeeds when no other tests run.
+   , testPayloadLowLevelUnregistered
    ]
 
 dummyMeta :: M.Map ByteString ByteString
@@ -53,7 +53,9 @@ testPayloadLowLevelServer grpc = do
   withServer grpc conf $ \server -> do
     let method = head (registeredMethods server)
     result <- serverHandleNormalRegisteredCall server method 11 M.empty $
-                \reqBody reqMeta -> return ("reply test", dummyMeta, dummyMeta)
+                \reqBody reqMeta ->
+                  return ("reply test", dummyMeta, dummyMeta,
+                          StatusDetails "details string")
     case result of
       Left err -> error $ show err
       Right _ -> return ()
@@ -66,7 +68,8 @@ testPayloadLowLevelClient grpc =
     reqResult <- clientRegisteredRequest client method 10 "Hello!" M.empty
     case reqResult of
       Left x -> error $ "Client got error: " ++ show x
-      Right (NormalRequestResult respBody initMeta trailingMeta respCode) -> do
+      Right (NormalRequestResult respBody initMeta trailingMeta respCode details) -> do
+        details @?= "details string"
         respBody @?= "reply test"
         respCode @?= GrpcStatusOk
 
@@ -76,15 +79,18 @@ testPayloadLowLevelClientUnregistered grpc = do
     reqResult <- clientRequest client "/foo" "localhost" 10 "Hello!" M.empty
     case reqResult of
       Left x -> error $ "Client got error: " ++ show x
-      Right (NormalRequestResult respBody initMeta trailingMeta respCode) -> do
+      Right (NormalRequestResult
+              respBody initMeta trailingMeta respCode details) -> do
         respBody @?= "reply test"
         respCode @?= GrpcStatusOk
+        details @?= "details string"
 
 testPayloadLowLevelServerUnregistered :: GRPC -> IO ()
 testPayloadLowLevelServerUnregistered grpc = do
   withServer grpc (ServerConfig "localhost" 50051 []) $ \server -> do
     result <- serverHandleNormalCall server 11 M.empty $
-                \reqBody reqMeta -> return ("reply test", M.empty)
+                \reqBody reqMeta -> return ("reply test", M.empty,
+                                            StatusDetails "details string")
     case result of
       Left x -> error $ show x
       Right _ -> return ()
@@ -104,7 +110,7 @@ testServerAwaitNoClient = testCase "server wait times out when no client " $ do
     withServer grpc conf $ \server -> do
       let method = head (registeredMethods server)
       result <- serverHandleNormalRegisteredCall server method 1 M.empty $
-                  \_ _ -> return ("", M.empty, M.empty)
+                  \_ _ -> return ("", M.empty, M.empty, StatusDetails "details")
       result @?= Left GRPCIOTimeout
 
 testServerUnregisteredAwaitNoClient :: TestTree
@@ -114,7 +120,7 @@ testServerUnregisteredAwaitNoClient =
       let conf = ServerConfig "localhost" 50051 []
       withServer grpc conf $ \server -> do
         result <- serverHandleNormalCall server 10 M.empty $
-                    \_ _ -> return ("", M.empty)
+                    \_ _ -> return ("", M.empty, StatusDetails "")
         case result of
           Left err -> error $ show err
           Right _ -> return ()

tests/Properties.hs

@@ -165,8 +165,9 @@ testPayloadServer = do
           cancelledPtr <- malloc
           opRecvCloseServer respOps 0 cancelledPtr
           opSendMessage respOps 1 respbb
-          opSendStatusServer respOps 2 0 (MetadataKeyValPtr nullPtr)
+          B.useAsCString "ok" $ \detailsStr ->
-                             GrpcStatusOk "ok"
+            opSendStatusServer respOps 2 0 (MetadataKeyValPtr nullPtr)
+                               GrpcStatusOk detailsStr
           serverCall <- peek serverCallPtr
           respBatchError <- grpcCallStartBatch serverCall respOps 3
                                                (tag 103) reserved