From de92c277aafcb8c85ff5f0824ad062ca560eefdd Mon Sep 17 00:00:00 2001 From: James Crayne Date: Thu, 24 May 2018 22:00:28 +0000 Subject: crypto hooks now take CryptoMessage not CryptoData --- src/Network/Tox/Crypto/Handlers.hs | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) (limited to 'src/Network') diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs index f4b79272..cca8b899 100644 --- a/src/Network/Tox/Crypto/Handlers.hs +++ b/src/Network/Tox/Crypto/Handlers.hs @@ -48,7 +48,7 @@ data NetCryptoSessionStatus = Unaccepted | Accepted | Confirmed type IOHook addr x = addr -> x -> IO (Maybe (x -> x)) -type NetCryptoHook = IOHook NetCryptoSession CryptoData +type NetCryptoHook = IOHook NetCryptoSession CryptoMessage type MsgTypeArray = A.UArray Word8 Word64 -- type MsgOutMap = RangeMap STArray Word8 STRef -- type MsgOutMap = W64.Word64Map Word8 @@ -367,7 +367,7 @@ freshCryptoSession sessions labelThread tid ("NetCryptoDequeue." ++ show (key2id remotePublicKey)) fix $ \loop -> do cd <- atomically $ PQ.dequeue pktq - _ <- runCryptoHook (netCryptoSession0 {ncDequeueThread=Just tid}) cd + _ <- runCryptoHook (netCryptoSession0 {ncDequeueThread=Just tid}) (bufferData cd) loop -- launch dequeueOutgoing thread threadidOutgoing <- forkIO $ do @@ -525,7 +525,7 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do isLossy _ = False if isLossy msgTypMapped then do atomically $ PQ.observeOutOfBand ncPacketQueue bufferEnd - runCryptoHook session cd + runCryptoHook session (bufferData cd) else do atomically $ PQ.enqueue ncPacketQueue bufferEnd cd return Nothing where @@ -535,15 +535,14 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do _ -> error "unreachable-last2Bytes" dATA_NUM_THRESHOLD = 21845 -- = 65535 / 3 --- | TODO: make this accept CrytpoMessage instead -runCryptoHook :: NetCryptoSession -> CryptoData -> IO (Maybe (x -> x)) +runCryptoHook :: NetCryptoSession -> CryptoMessage -> IO (Maybe (x -> x)) runCryptoHook session@(NCrypto {ncState, ncHooks,ncSessionSecret,ncTheirSessionPublic,ncTheirBaseNonce,ncIncomingTypeArray}) - cd@(CryptoData {bufferStart, bufferEnd, bufferData=cm}) = do + cm {-cd@(CryptoData {bufferStart, bufferEnd, bufferData=cm})-} = do hookmap <- atomically $ readTVar ncHooks -- run hook - flip fix (cd,hookmap) $ \lookupAgain (cd,hookmap) -> do + flip fix (cm,hookmap) $ \lookupAgain (cm,hookmap) -> do msgTypes <- atomically $ readTVar ncIncomingTypeArray - let msgTyp = cd ^. messageType + let msgTyp = cm ^. messageType msgTypMapped64 = msgTypes A.! fromEnum8 (msgID cm) msgTypMapped = fromWord64 $ msgTypMapped64 if msgTypMapped64 == 0 @@ -552,19 +551,19 @@ runCryptoHook session@(NCrypto {ncState, ncHooks,ncSessionSecret,ncTheirSessionP case Map.lookup msgTypMapped hookmap of Nothing -> do -- no recognizing hook, run ncUnrecognizedHook0, loopAgain on result unrecognize <- atomically $ readTVar (ncUnrecognizedHook session) - mbConsume <- unrecognize msgTypMapped session cd + mbConsume <- unrecognize msgTypMapped session cm case mbConsume of Just f -> do -- ncUnrecognizedHook0 may have updated the hookmap hookmap' <- atomically $ readTVar ncHooks - lookupAgain (f cd,hookmap') + lookupAgain (f cm,hookmap') Nothing -> return Nothing - Just hooks -> flip fix (hooks,cd,msgTypMapped) $ \loop (hooks,cd,typ) -> do - let _ = cd :: CryptoData - case (hooks,cd) of + Just hooks -> flip fix (hooks,cm,msgTypMapped) $ \loop (hooks,cm,typ) -> do + let _ = cm :: CryptoMessage + case (hooks,cm) of ([],_) -> return Nothing (hook:more,cd) -> do - r <- hook session cd :: IO (Maybe (CryptoData -> CryptoData)) + r <- hook session cm :: IO (Maybe (CryptoMessage -> CryptoMessage)) case r of Just f -> let newcd = f cd newtyp = newcd ^. messageType -- cgit v1.2.3