From 54af27be179f998b17ecff9b5499214df09fb0b2 Mon Sep 17 00:00:00 2001 From: "jim@bo" Date: Fri, 22 Jun 2018 15:46:43 -0400 Subject: OutGoingResult now offers packet for convenience Also, don't send anohter Online, just send duplicate packet. --- src/Network/Tox/Crypto/Handlers.hs | 48 +++++++++++++++++++++----------------- 1 file changed, 26 insertions(+), 22 deletions(-) (limited to 'src/Network/Tox') diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs index 7a7567cf..73e5f686 100644 --- a/src/Network/Tox/Crypto/Handlers.hs +++ b/src/Network/Tox/Crypto/Handlers.hs @@ -796,7 +796,7 @@ runUponHandshake netCryptoSession0 addr pktoq = do seqno <- PQ.getLastDequeuedPlus1 pktq ogresult <- PQ.tryAppendQueueOutgoing getOutGoingParam pktoq (createRequestPacket seqno nums) case ogresult of - PQ.OGSuccess -> return () + PQ.OGSuccess _ -> return () _ -> retry loop dput XNetCrypto $ "runUponHandshake: " ++ show threadid ++ " = NetCryptoRequest." ++ show (key2id remotePublicKey) ++ sidStr @@ -851,13 +851,6 @@ runUponHandshake netCryptoSession0 addr pktoq = do dput XNetCrypto $ "runUponHandshake: Announcing new session" hooks <- atomically $ readTVar (announceNewSessionHooks sessions) sendOnline crypto netCryptoSession - -- in case ONLINE packet is dropped, send anohter after delay - forkIO $ do - tid <- myThreadId - labelThread tid ("Second Online." ++ show (key2id remotePublicKey) ++ sidStr) - threadDelay 1000 - _ <- sendOnline crypto netCryptoSession - return () -- Run new session hooks flip fix (hooks,netCryptoSession) $ \loop (hooks,session) -> case hooks of @@ -1228,7 +1221,7 @@ allMsgTypes fDefault = A.listArray (minBound,maxBound) (0:knownMsgs) , map (const 0) [ 200 .. 255 ] -- All lossy, exept the last ] -sendCrypto :: TransportCrypto -> NetCryptoSession -> (STM ()) -> CryptoMessage -> IO (Either String ()) +sendCrypto :: TransportCrypto -> NetCryptoSession -> (STM ()) -> CryptoMessage -> IO (Either String (CryptoPacket Encrypted)) sendCrypto crypto session updateLocal cm = do HaveHandshake outq <- atomically $ readTVar (ncOutgoingQueue session) -- XXX: potential race? if shared secret comes out of sync with cache? @@ -1238,30 +1231,40 @@ sendCrypto crypto session updateLocal cm = do atomically $ do result <- PQ.tryAppendQueueOutgoing getOutGoingParam outq cm case result of - PQ.OGSuccess -> updateLocal >> return (Right()) + PQ.OGSuccess x -> updateLocal >> return (Right x) PQ.OGFull -> return (Left "Outgoing packet buffer is full") PQ.OGEncodeFail -> return (Left "Failed to encode outgoing packet") -sendPing :: TransportCrypto -> NetCryptoSession -> IO (Either String ()) +sendPing :: TransportCrypto -> NetCryptoSession -> IO (Either String (CryptoPacket Encrypted)) sendPing crypto session = do let cm=OneByte PING addMsgToLastN False (cm ^. messageType) session (Out cm) sendCrypto crypto session (return ()) (OneByte PING) -sendOnline :: TransportCrypto -> NetCryptoSession -> IO (Either String ()) +sendOnline :: TransportCrypto -> NetCryptoSession -> IO (Either String (CryptoPacket Encrypted)) sendOnline crypto session = do let cm=OneByte ONLINE addMsgToLastN False (cm ^. messageType) session (Out cm) - sendCrypto crypto session (return ()) (OneByte ONLINE) - -sendOffline :: TransportCrypto -> NetCryptoSession -> IO (Either String ()) + result <- sendCrypto crypto session (return ()) (OneByte ONLINE) + -- double this packet + case result of + Right pkt -> do + void . forkIO $ do + tid <- myThreadId + labelThread tid "TEMPORARY.PACKET.DOUBLE.ONLINE" + threadDelay 100000 -- delay 10th of a second + case ncSockAddr session of + HaveDHTKey saddr -> sendSessionPacket (ncAllSessions session) saddr pkt + return (Right pkt) + +sendOffline :: TransportCrypto -> NetCryptoSession -> IO (Either String (CryptoPacket Encrypted)) sendOffline crypto session = do let cm=OneByte OFFLINE addMsgToLastN False (cm ^. messageType) session (Out cm) sendCrypto crypto session (return ()) (OneByte OFFLINE) -sendKill :: TransportCrypto -> NetCryptoSession -> IO (Either String ()) +sendKill :: TransportCrypto -> NetCryptoSession -> IO (Either String (CryptoPacket Encrypted)) sendKill crypto session = do let cm=OneByte KillPacket mbOutQ <- atomically $ readTVar (ncOutgoingQueue session) @@ -1294,9 +1297,10 @@ sendKill crypto session = do HaveDHTKey saddr -> do sendSessionPacket (ncAllSessions session) saddr pkt dput XNetCrypto $ "sent kill packet (sessionid: " ++ show (ncSessionId session) ++ ")... now destroying session..." - Right <$> destroySession session + destroySession session + return (Right pkt) -setNick :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String ()) +setNick :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String (CryptoPacket Encrypted)) setNick crypto session nick = do let Just (_,maxlen) = msgSizeParam NICKNAME if B.length nick > maxlen @@ -1310,7 +1314,7 @@ setNick crypto session nick = do addMsgToLastN False (cm ^. messageType) session (Out cm) sendCrypto crypto session updateLocal cm -setTyping :: TransportCrypto -> NetCryptoSession -> TypingStatus -> IO (Either String ()) +setTyping :: TransportCrypto -> NetCryptoSession -> TypingStatus -> IO (Either String (CryptoPacket Encrypted)) setTyping crypto session status = do let updateLocal = do view <- readTVar (ncView session) @@ -1327,7 +1331,7 @@ setNoSpam crypto session mbnospam = do writeTVar (svNoSpam view) mbnospam return (Right ()) -setStatus :: TransportCrypto -> NetCryptoSession -> UserStatus -> IO (Either String ()) +setStatus :: TransportCrypto -> NetCryptoSession -> UserStatus -> IO (Either String (CryptoPacket Encrypted)) setStatus crypto session status = do let updateLocal = do view <- readTVar (ncView session) @@ -1336,7 +1340,7 @@ setStatus crypto session status = do addMsgToLastN False (cm ^. messageType) session (Out cm) sendCrypto crypto session updateLocal cm -setStatusMsg :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String ()) +setStatusMsg :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String (CryptoPacket Encrypted)) setStatusMsg crypto session msg = do let Just (_,maxlen) = msgSizeParam STATUSMESSAGE if B.length msg > maxlen @@ -1349,7 +1353,7 @@ setStatusMsg crypto session msg = do addMsgToLastN False (cm ^. messageType) session (Out cm) sendCrypto crypto session updateLocal cm -sendChatMsg :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String ()) +sendChatMsg :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String (CryptoPacket Encrypted)) sendChatMsg crypto session msg = do let Just (_,maxlen) = msgSizeParam MESSAGE if B.length msg > maxlen -- cgit v1.2.3