From 2fdb0342f8cfcaf4924a0ce43e7fccb236eb0d5e Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 10 Jul 2017 20:30:10 -0400 Subject: Fixed Tox decryption. --- src/Network/DatagramServer.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'src/Network/DatagramServer.hs') diff --git a/src/Network/DatagramServer.hs b/src/Network/DatagramServer.hs index bcf8b9af..55a26e58 100644 --- a/src/Network/DatagramServer.hs +++ b/src/Network/DatagramServer.hs @@ -451,14 +451,15 @@ prettyQF e = T.encodeUtf8 $ "handler fail while performing query: " -- corresponding 'QueryFailure's. -- handler :: forall h a b msg raw. (Applicative h, Functor msg, WireFormat raw msg, SerializableTo raw a, SerializableTo raw b) - => QueryMethod msg -> (SockAddr -> msg a -> h b) -> Handler h msg raw -handler name body = (name, wrapper) + => (SockAddr -> h (NodeId msg)) -> QueryMethod msg -> (SockAddr -> msg a -> h b) -> Handler h msg raw +handler whoami name body = (name, wrapper) where wrapper :: SockAddr -> msg raw -> h (Either String (msg raw)) wrapper addr args = case decodePayload args of Left e -> pure $ Left e - Right a -> Right . encodePayload . buildReply (error "self node-id") addr args <$> body addr a + Right a -> do + (\me bs -> Right $ encodePayload $ buildReply me addr args bs) <$> whoami addr <*> body addr a runHandler :: ( Envelope msg , Show (QueryMethod msg) @@ -528,8 +529,8 @@ handleQuery :: ( WireFormat raw msg handleQuery mgr@Manager{..} hs meth raw q addr = void $ fork $ do myThreadId >>= liftIO . flip labelThread "KRPC.handleQuery" res <- dispatchHandler mgr hs meth q addr + (me,ctx) <- serverState (error "TODO TOX ToxCipherContext 2 or () for Mainline") let res' = either buildError Just res - ctx = error "TODO TOX ToxCipherContext 2 or () for Mainline" dest = makeAddress (Right q) addr resbs = fmap (\raw -> encodeHeaders ctx raw dest) res' :: Maybe BS.ByteString -- TODO: Generalize this debug print. @@ -565,7 +566,7 @@ listener :: forall raw msg. ) => Manager raw msg -> [Handler IO msg raw] -> Protocol raw msg -> IO () listener mgr@Manager{..} hs p = do fix $ \again -> do - let ctx = error "TODO TOX ToxCipherContext or () for Mainline" + (me, ctx) <- serverState (error "TODO TOX ToxCipherContext or () for Mainline") (bs, addr) <- liftIO $ do handle exceptions $ BS.recvFrom sock (optMaxMsgSize options) case parsePacket (msgProxy p) bs >>= \r -> (,) r <$> decodeHeaders ctx r of -- cgit v1.2.3