From b3d0b8a4a75682a0a75f079bea26e75fa41ae3f8 Mon Sep 17 00:00:00 2001
From: Connor Clark <connor@awakenetworks.com>
Date: Tue, 26 Jul 2016 13:16:44 -0700
Subject: [PATCH] high-level server: add initial metadata to options (#53)

---
 src/Network/GRPC/HighLevel/Server.hs              |  6 ++++--
 src/Network/GRPC/HighLevel/Server/Unregistered.hs | 14 ++++++++------
 2 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/src/Network/GRPC/HighLevel/Server.hs b/src/Network/GRPC/HighLevel/Server.hs
index 1c57817..b6d1cb9 100644
--- a/src/Network/GRPC/HighLevel/Server.hs
+++ b/src/Network/GRPC/HighLevel/Server.hs
@@ -175,7 +175,8 @@ data ServerOptions = ServerOptions
                       optServerPort           :: Port,
                       optUseCompression       :: Bool,
                       optUserAgentPrefix      :: String,
-                      optUserAgentSuffix      :: String}
+                      optUserAgentSuffix      :: String,
+                      optInitialMetadata      :: MetadataMap}
 
 defaultOptions :: ServerOptions
 defaultOptions =
@@ -186,7 +187,8 @@ defaultOptions =
                  optServerPort = 50051,
                  optUseCompression = False,
                  optUserAgentPrefix = "grpc-haskell/0.0.0",
-                 optUserAgentSuffix = ""}
+                 optUserAgentSuffix = "",
+                 optInitialMetadata = mempty}
 
 serverLoop :: ServerOptions -> IO ()
 serverLoop opts =
diff --git a/src/Network/GRPC/HighLevel/Server/Unregistered.hs b/src/Network/GRPC/HighLevel/Server/Unregistered.hs
index 01f3323..2b83d88 100644
--- a/src/Network/GRPC/HighLevel/Server/Unregistered.hs
+++ b/src/Network/GRPC/HighLevel/Server/Unregistered.hs
@@ -15,12 +15,13 @@ import qualified Network.GRPC.LowLevel.Server.Unregistered as U
 import qualified Network.GRPC.LowLevel.Call.Unregistered as U
 
 dispatchLoop :: Server
+              -> MetadataMap
               -> [Handler 'Normal]
               -> [Handler 'ClientStreaming]
               -> [Handler 'ServerStreaming]
               -> [Handler 'BiDiStreaming]
               -> IO ()
-dispatchLoop server hN hC hS hB =
+dispatchLoop server meta hN hC hS hB =
   forever $ U.withServerCallAsync server $ \call -> do
     case findHandler call allHandlers of
       Just (AnyHandler (UnaryHandler _ h)) -> unaryHandler call h
@@ -35,7 +36,7 @@ dispatchLoop server hN hC hS hB =
         findHandler call = find ((== (U.callMethod call))
                                  . anyHandlerMethodName)
         unknownHandler call =
-          void $ U.serverHandleNormalCall' server call mempty $ \_ _ ->
+          void $ U.serverHandleNormalCall' server call meta $ \_ _ ->
             return (mempty
                     , mempty
                     , StatusNotFound
@@ -47,7 +48,7 @@ dispatchLoop server hN hC hS hB =
                         -> IO ()
         unaryHandler call h =
           handleError $
-            U.serverHandleNormalCall' server call mempty $ \_call' bs ->
+            U.serverHandleNormalCall' server call meta $ \_call' bs ->
               convertServerHandler h (fmap (const bs) $ U.convertCall call)
         csHandler :: (Message a, Message b) =>
                      U.ServerCall
@@ -55,27 +56,28 @@ dispatchLoop server hN hC hS hB =
                      -> IO ()
         csHandler call h =
           handleError $
-            U.serverReader server call mempty (convertServerReaderHandler h)
+            U.serverReader server call meta (convertServerReaderHandler h)
         ssHandler :: (Message a, Message b) =>
                      U.ServerCall
                      -> ServerWriterHandler a b
                      -> IO ()
         ssHandler call h =
           handleError $
-            U.serverWriter server call mempty (convertServerWriterHandler h)
+            U.serverWriter server call meta (convertServerWriterHandler h)
         bdHandler :: (Message a, Message b) =>
                      U.ServerCall
                      -> ServerRWHandler a b
                      -> IO ()
         bdHandler call h =
           handleError $
-            U.serverRW server call mempty (convertServerRWHandler h)
+            U.serverRW server call meta (convertServerRWHandler h)
 
 serverLoop :: ServerOptions -> IO ()
 serverLoop ServerOptions{..} =
   withGRPC $ \grpc ->
     withServer grpc config $ \server -> do
       dispatchLoop server
+                   optInitialMetadata
                    optNormalHandlers
                    optClientStreamHandlers
                    optServerStreamHandlers