1 files changed, 26 insertions, 22 deletions

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