Further improve ping.

kolmodin · Mar 20, 2013 · 65664ad · 65664ad
1 parent 07fe298
commit 65664ad
Show file tree

Hide file tree

Showing 2 changed files with 11 additions and 7 deletions.
diff --git a/Network/SPDY/Base.hs b/Network/SPDY/Base.hs
@@ -8,7 +8,6 @@ import           Control.Concurrent.MVar
 import           Control.Concurrent.STM      (atomically, retry)
 import           Control.Concurrent.STM.TVar
 import           Control.Monad               (liftM)
-import           Control.Monad               (when)
 import           Data.Binary.Get             (runGetOrFail)
 import           Data.Binary.Put             (runPut)
 import           Data.Bits                   (testBit)
@@ -71,6 +70,7 @@ data Callbacks = Callbacks
   , cb_recv_data_frame      :: Flags -> StreamID -> L.ByteString -> IO ()
   , cb_recv_syn_frame       :: Flags -> StreamID -> StreamID -> Priority -> NVH -> IO ()
   , cb_recv_syn_reply_frame :: Flags -> StreamID -> NVH -> IO ()
+  , cb_recv_ping_frame      :: PingID -> IO ()
   , cb_go_away              :: Flags -> StreamID -> IO ()
   , cb_settings_frame       :: Flags -> [(Word32, Word8, Word32)] -> IO ()
   , cb_rst_frame            :: Flags -> StreamID -> RstStreamStatusCode -> IO ()
@@ -131,13 +131,15 @@ receiver sessionMVar inp cb = go
             cb_rst_frame cb flags streamId statusCode
             go
           PingControlFrame pingID -> do
-            let match SpdyServer = odd pingID -- remote is client
-                match SpdyClient = even pingID -- remote is server
             role <- myRole sessionMVar
-            when (match role) $ do
-                queue <- getQueue sessionMVar
-                enqueueFrame queue maxBound Nothing
-                  (OutgoingFrame (PingControlFrame pingID))
+            let reply = do
+                  queue <- getQueue sessionMVar
+                  enqueueFrame queue maxBound Nothing
+                    (OutgoingFrame (PingControlFrame pingID))
+            case role of
+              SpdyClient | even pingID -> reply -- remote is server
+              SpdyServer | odd pingID -> reply -- remote is client
+              _ -> cb_recv_ping_frame cb pingID
             go
           NoopControlFrame -> go
 

diff --git a/example/NewAPITest.hs b/example/NewAPITest.hs
@@ -41,6 +41,8 @@ callbacks stateRef = Callbacks
      print ("syn_frame"::String, flags, streamId, associatedStreamId, priority, nvh)
   , cb_recv_syn_reply_frame = \flags streamId nvh ->
       print ("syn_reply_frame"::String, flags, streamId, nvh)
+  , cb_recv_ping_frame = \pingId ->
+      print ("ping reply"::String, pingId)
   , cb_settings_frame = \flags settings -> print ("settiongs"::String, flags, settings)
   , cb_rst_frame = \flags streamId code -> print ("rst"::String, flags, streamId, code)
   , cb_go_away = \flags streamId -> print ("go away"::String, flags, streamId)