summaryrefslogtreecommitdiff
path: root/src/Network/DatagramServer.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2017-06-22 01:37:04 -0400
committerjoe <joe@jerkface.net>2017-06-22 01:37:04 -0400
commite0ada56c116255a2feddcf7b09cec808f79afefc (patch)
treecf68a3015821039f707591684a237f8d7cf1c7cb /src/Network/DatagramServer.hs
parent012d138b1061d967ef3a05dfb7dc819d199b3902 (diff)
Propagated MonadKRPC deletion to Network.BitTorrent.DHT.
Diffstat (limited to 'src/Network/DatagramServer.hs')
-rw-r--r--src/Network/DatagramServer.hs24
1 files changed, 12 insertions, 12 deletions
diff --git a/src/Network/DatagramServer.hs b/src/Network/DatagramServer.hs
index f212ffdf..2140e2cd 100644
--- a/src/Network/DatagramServer.hs
+++ b/src/Network/DatagramServer.hs
@@ -196,7 +196,7 @@ data Manager h raw msg = Manager
196 , listenerThread :: !(MVar ThreadId) 196 , listenerThread :: !(MVar ThreadId)
197 , transactionCounter :: {-# UNPACK #-} !TransactionCounter 197 , transactionCounter :: {-# UNPACK #-} !TransactionCounter
198 , pendingCalls :: {-# UNPACK #-} !(PendingCalls msg raw) 198 , pendingCalls :: {-# UNPACK #-} !(PendingCalls msg raw)
199 , handlers :: [Handler h msg raw] 199 , handlers :: [Handler h msg raw] -- TODO delete this, it's not used
200 , logMsg :: Char -> String -> T.Text -> IO () 200 , logMsg :: Char -> String -> T.Text -> IO ()
201 } 201 }
202 202
@@ -462,8 +462,8 @@ dispatchHandler :: ( Eq (QueryMethod msg)
462 , Show (QueryMethod msg) 462 , Show (QueryMethod msg)
463 , Serialize (TransactionID msg) 463 , Serialize (TransactionID msg)
464 , Envelope msg 464 , Envelope msg
465 ) => Manager IO raw msg -> QueryMethod msg -> msg raw -> SockAddr -> IO (KResult msg raw) 465 ) => Manager IO raw msg -> [Handler IO msg raw] -> QueryMethod msg -> msg raw -> SockAddr -> IO (KResult msg raw)
466dispatchHandler mgr@Manager{..} meth q addr = do 466dispatchHandler mgr handlers meth q addr = do
467 case L.lookup meth handlers of 467 case L.lookup meth handlers of
468 Nothing -> return $ Left $ KError MethodUnknown ("Unknown method " <> BC.pack (show meth)) (envelopeTransaction q) 468 Nothing -> return $ Left $ KError MethodUnknown ("Unknown method " <> BC.pack (show meth)) (envelopeTransaction q)
469 Just h -> runHandler mgr meth h addr q 469 Just h -> runHandler mgr meth h addr q
@@ -483,10 +483,10 @@ handleQuery :: ( WireFormat raw msg
483 , Eq (QueryMethod msg) 483 , Eq (QueryMethod msg)
484 , Show (QueryMethod msg) 484 , Show (QueryMethod msg)
485 , Serialize (TransactionID msg) 485 , Serialize (TransactionID msg)
486 ) => Manager IO raw msg -> QueryMethod msg -> raw -> msg raw -> SockAddr -> IO () 486 ) => Manager IO raw msg -> [Handler IO msg raw] -> QueryMethod msg -> raw -> msg raw -> SockAddr -> IO ()
487handleQuery mgr@Manager{..} meth raw q addr = void $ fork $ do 487handleQuery mgr@Manager{..} hs meth raw q addr = void $ fork $ do
488 myThreadId >>= liftIO . flip labelThread "KRPC.handleQuery" 488 myThreadId >>= liftIO . flip labelThread "KRPC.handleQuery"
489 res <- dispatchHandler mgr meth q addr 489 res <- dispatchHandler mgr hs meth q addr
490 let res' = either buildError Just res 490 let res' = either buildError Just res
491 ctx = error "TODO TOX ToxCipherContext 2 or () for Mainline" 491 ctx = error "TODO TOX ToxCipherContext 2 or () for Mainline"
492 resbs = fmap (encodeHeaders ctx) res' :: Maybe BS.ByteString 492 resbs = fmap (encodeHeaders ctx) res' :: Maybe BS.ByteString
@@ -520,8 +520,8 @@ listener :: forall raw msg.
520 , Eq (QueryMethod msg) 520 , Eq (QueryMethod msg)
521 , Show (QueryMethod msg) 521 , Show (QueryMethod msg)
522 , Serialize (TransactionID msg) 522 , Serialize (TransactionID msg)
523 ) => Manager IO raw msg -> Protocol raw msg -> IO () 523 ) => Manager IO raw msg -> [Handler IO msg raw] -> Protocol raw msg -> IO ()
524listener mgr@Manager{..} p = do 524listener mgr@Manager{..} hs p = do
525 fix $ \again -> do 525 fix $ \again -> do
526 let ctx = error "TODO TOX ToxCipherContext or () for Mainline" 526 let ctx = error "TODO TOX ToxCipherContext or () for Mainline"
527 (bs, addr) <- liftIO $ do 527 (bs, addr) <- liftIO $ do
@@ -532,7 +532,7 @@ listener mgr@Manager{..} p = do
532 return () -- Without transaction id, error message isn't very useful. 532 return () -- Without transaction id, error message isn't very useful.
533 Right (raw,m) -> 533 Right (raw,m) ->
534 case envelopeClass m of 534 case envelopeClass m of
535 Query meth -> handleQuery mgr meth (raw::raw) m addr 535 Query meth -> handleQuery mgr hs meth (raw::raw) m addr
536 Response _ -> handleResponse mgr raw (Right m) addr 536 Response _ -> handleResponse mgr raw (Right m) addr
537 Error e -> handleResponse mgr raw (Left e) addr 537 Error e -> handleResponse mgr raw (Left e) addr
538 538
@@ -551,10 +551,10 @@ listen :: ( WireFormat raw msg
551 , Eq (QueryMethod msg) 551 , Eq (QueryMethod msg)
552 , Show (QueryMethod msg) 552 , Show (QueryMethod msg)
553 , Serialize (TransactionID msg) 553 , Serialize (TransactionID msg)
554 ) => Manager IO raw msg -> Protocol raw msg -> IO () 554 ) => Manager IO raw msg -> [Handler IO msg raw] -> Protocol raw msg -> IO ()
555listen mgr@Manager{..} p = do 555listen mgr@Manager{..} hs p = do
556 tid <- fork $ do 556 tid <- fork $ do
557 myThreadId >>= liftIO . flip labelThread "KRPC.listen" 557 myThreadId >>= liftIO . flip labelThread "KRPC.listen"
558 listener mgr p `Lifted.finally` 558 listener mgr hs p `Lifted.finally`
559 liftIO (takeMVar listenerThread) 559 liftIO (takeMVar listenerThread)
560 liftIO $ putMVar listenerThread tid 560 liftIO $ putMVar listenerThread tid