gRPC-haskell/src/Network/GRPC/LowLevel/Call.hs

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Network.GRPC.LowLevel.Call where

import           Control.Monad
import           Data.String (IsString)
import           Foreign.Marshal.Alloc (free)
import           Foreign.Ptr (Ptr, castPtr)
import           Foreign.Storable (peek)

import qualified Network.GRPC.Unsafe as C
import qualified Network.GRPC.Unsafe.Time as C
import qualified Network.GRPC.Unsafe.Metadata as C
import qualified Network.GRPC.Unsafe.ByteBuffer as C

import Network.GRPC.LowLevel.GRPC (grpcDebug)

-- | Models the four types of RPC call supported by gRPC. We currently only
-- support the first alternative, and only in a preliminary fashion.
data GRPCMethodType = Normal | ClientStreaming | ServerStreaming | BiDiStreaming
  deriving (Show, Eq, Ord, Enum)

newtype MethodName = MethodName {unMethodName :: String}
  deriving (Show, Eq, IsString)

newtype Host = Host {unHost :: String}
  deriving (Show, Eq, IsString)

-- | Represents a registered method. Methods can optionally be registered in
-- order to make the C-level request/response code simpler.
-- Before making or awaiting a registered call, the
-- method must be registered with the client (see 'clientRegisterMethod') and
-- the server (see 'serverRegisterMethod').
-- Contains state for identifying that method in the underlying gRPC library.
data RegisteredMethod = RegisteredMethod {methodType :: GRPCMethodType,
                                          methodName :: MethodName,
                                          methodHost :: Host,
                                          methodHandle :: C.CallHandle}

-- | Represents one GRPC call (i.e. request). This type is used on both the
-- client and server. Contains pointers to all the necessary C state needed to
-- send and respond to a call.
-- This is used to associate send/receive 'Op's with a request.
-- There are separate functions for creating these depending on whether the
-- method is registered and whether the call is on the client or server side.
data Call = ClientCall {internalCall :: C.Call}
            | ServerCall
            {internalCall :: C.Call,
             requestMetadataRecv :: (Ptr C.MetadataArray),
             optionalPayload :: Maybe (Ptr C.ByteBuffer),
             parentPtr :: Maybe (Ptr C.Call),
             callDetails :: Maybe (C.CallDetails),
             -- ^ used on the server for non-registered calls
             --, to identify the endpoint being used.
             callDeadline :: Maybe C.CTimeSpecPtr
            }

debugCall :: Call -> IO ()
#ifdef DEBUG
debugCall (ClientCall (C.Call ptr)) =
  grpcDebug $ "debugCall: client call: " ++ (show ptr)
debugCall call@(ServerCall (C.Call ptr) _ _ _ _ _) = do
  grpcDebug $ "debugCall: server call: " ++ (show ptr)
  grpcDebug $ "debugCall: metadata ptr: " ++ show (requestMetadataRecv call)
  metadataArr <- peek (requestMetadataRecv call)
  metadata <- C.getAllMetadataArray metadataArr
  grpcDebug $ "debugCall: metadata received: " ++ (show metadata)
  forM_ (optionalPayload call) $ \payloadPtr -> do
    grpcDebug $ "debugCall: payload ptr: " ++ show payloadPtr
    payload <- peek payloadPtr
    bs <- C.copyByteBufferToByteString payload
    grpcDebug $ "debugCall: payload contents: " ++ show bs
  forM_ (parentPtr call) $ \parentPtr' -> do
    grpcDebug $ "debugCall: parent ptr: " ++ show parentPtr'
    (C.Call parent) <- peek parentPtr'
    grpcDebug $ "debugCall: parent: " ++ show parent
  forM_ (callDetails call) $ \(C.CallDetails callDetailsPtr) -> do
    grpcDebug $ "debugCall: callDetails ptr: " ++ show callDetailsPtr
    --TODO: need functions for getting data out of call_details.
  forM_ (callDeadline call) $ \timespecptr -> do
    grpcDebug $ "debugCall: deadline ptr: " ++ show timespecptr
    timespec <- peek timespecptr
    grpcDebug $ "debugCall: deadline: " ++ show (C.timeSpec timespec)
#else
{-# INLINE debugCall #-}
debugCall = const $ return ()
#endif

-- | Destroys a 'Call'.
destroyCall :: Call -> IO ()
destroyCall ClientCall{..} = do
  grpcDebug "Destroying client-side call object."
  C.grpcCallDestroy internalCall
destroyCall call@ServerCall{..} = do
  grpcDebug "destroyCall: entered."
  debugCall call
  grpcDebug $ "Destroying server-side call object: " ++ show internalCall
  C.grpcCallDestroy internalCall
  grpcDebug $ "destroying metadata array: " ++ show requestMetadataRecv
  C.metadataArrayDestroy requestMetadataRecv
  grpcDebug $ "destroying optional payload" ++ show optionalPayload
  forM_ optionalPayload C.destroyReceivingByteBuffer
  grpcDebug $ "freeing parentPtr: " ++ show parentPtr
  forM_ parentPtr free
  grpcDebug $ "destroying call details" ++ show callDetails
  forM_ callDetails C.destroyCallDetails
  grpcDebug $ "destroying deadline." ++ show callDeadline
  forM_ callDeadline C.timespecDestroy

_nowarn_unused :: a
_nowarn_unused =
  castPtr `undefined`
  (peek :: Ptr Int -> IO Int) `undefined`
  ()