diff options
author | joe <joe@jerkface.net> | 2017-06-22 01:37:04 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2017-06-22 01:37:04 -0400 |
commit | e0ada56c116255a2feddcf7b09cec808f79afefc (patch) | |
tree | cf68a3015821039f707591684a237f8d7cf1c7cb /src/Network/DatagramServer.hs | |
parent | 012d138b1061d967ef3a05dfb7dc819d199b3902 (diff) |
Propagated MonadKRPC deletion to Network.BitTorrent.DHT.
Diffstat (limited to 'src/Network/DatagramServer.hs')
-rw-r--r-- | src/Network/DatagramServer.hs | 24 |
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) |
466 | dispatchHandler mgr@Manager{..} meth q addr = do | 466 | dispatchHandler 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 () |
487 | handleQuery mgr@Manager{..} meth raw q addr = void $ fork $ do | 487 | handleQuery 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 () |
524 | listener mgr@Manager{..} p = do | 524 | listener 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 () |
555 | listen mgr@Manager{..} p = do | 555 | listen 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 |