summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--dht-client.cabal1
-rw-r--r--src/Network/Tox/Crypto/Handlers.hs38
2 files changed, 26 insertions, 13 deletions
diff --git a/dht-client.cabal b/dht-client.cabal
index 02b5cdbe..9e3c78ae 100644
--- a/dht-client.cabal
+++ b/dht-client.cabal
@@ -73,6 +73,7 @@ library
73 Data.Wrapper.PSQ 73 Data.Wrapper.PSQ
74 Data.Wrapper.PSQInt 74 Data.Wrapper.PSQInt
75 Data.MinMaxPSQ 75 Data.MinMaxPSQ
76 Data.InOrOut
76 Network.Address 77 Network.Address
77 Network.Kademlia.Bootstrap 78 Network.Kademlia.Bootstrap
78 Network.Kademlia.Routing 79 Network.Kademlia.Routing
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 0ad868a7..b227e5ee 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -753,7 +753,10 @@ sendOffline crypto session = sendCrypto crypto session (return ()) (OneByte OFFL
753 753
754 754
755sendKill :: TransportCrypto -> NetCryptoSession -> IO (Either String ()) 755sendKill :: TransportCrypto -> NetCryptoSession -> IO (Either String ())
756sendKill crypto session = sendCrypto crypto session (return ()) (OneByte KillPacket) 756sendKill crypto session = do
757 let cm=OneByte KillPacket
758 addMsgToLastN False (cm ^. messageType) session cm
759 sendCrypto crypto session (return ()) cm
757 760
758setNick :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String ()) 761setNick :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String ())
759setNick crypto session nick = do 762setNick crypto session nick = do
@@ -766,6 +769,7 @@ setNick crypto session nick = do
766 view <- readTVar viewVar 769 view <- readTVar viewVar
767 writeTVar (svNick view) nick 770 writeTVar (svNick view) nick
768 let cm = UpToN NICKNAME nick 771 let cm = UpToN NICKNAME nick
772 addMsgToLastN False (cm ^. messageType) session cm
769 sendCrypto crypto session updateLocal cm 773 sendCrypto crypto session updateLocal cm
770 774
771setTyping :: TransportCrypto -> NetCryptoSession -> TypingStatus -> IO (Either String ()) 775setTyping :: TransportCrypto -> NetCryptoSession -> TypingStatus -> IO (Either String ())
@@ -774,6 +778,7 @@ setTyping crypto session status = do
774 view <- readTVar (ncView session) 778 view <- readTVar (ncView session)
775 writeTVar (svTyping view) status 779 writeTVar (svTyping view) status
776 let cm = TwoByte TYPING (fromEnum8 status) 780 let cm = TwoByte TYPING (fromEnum8 status)
781 addMsgToLastN False (cm ^. messageType) session cm
777 sendCrypto crypto session updateLocal cm 782 sendCrypto crypto session updateLocal cm
778 783
779setNoSpam :: TransportCrypto -> NetCryptoSession -> Maybe NoSpam -> IO (Either String ()) 784setNoSpam :: TransportCrypto -> NetCryptoSession -> Maybe NoSpam -> IO (Either String ())
@@ -790,6 +795,7 @@ setStatus crypto session status = do
790 view <- readTVar (ncView session) 795 view <- readTVar (ncView session)
791 writeTVar (svStatus view) status 796 writeTVar (svStatus view) status
792 let cm = TwoByte USERSTATUS (fromEnum8 status) 797 let cm = TwoByte USERSTATUS (fromEnum8 status)
798 addMsgToLastN False (cm ^. messageType) session cm
793 sendCrypto crypto session updateLocal cm 799 sendCrypto crypto session updateLocal cm
794 800
795setStatusMsg :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String ()) 801setStatusMsg :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String ())
@@ -802,6 +808,7 @@ setStatusMsg crypto session msg = do
802 view <- readTVar (ncView session) 808 view <- readTVar (ncView session)
803 writeTVar (svStatusMsg view) msg 809 writeTVar (svStatusMsg view) msg
804 let cm = UpToN STATUSMESSAGE msg 810 let cm = UpToN STATUSMESSAGE msg
811 addMsgToLastN False (cm ^. messageType) session cm
805 sendCrypto crypto session updateLocal cm 812 sendCrypto crypto session updateLocal cm
806 813
807-- | handles nothings 814-- | handles nothings
@@ -859,18 +866,7 @@ hookHelper _ typ session cm | any ($ typ) [isKillPacket, isOFFLINE] = atomically
859 return Nothing 866 return Nothing
860 867
861hookHelper handledFlg typ session cm = do 868hookHelper handledFlg typ session cm = do
862 let msgQ = ncLastNMsgs session 869 addMsgToLastN handledFlg typ session cm
863 msgNumVar = ncMsgNumVar session
864 dropCntVar = ncDropCntVar session
865 atomically $ do
866 num <- readTVar msgNumVar
867 view <- readTVar (ncView session)
868 snapshot <- viewSnapshot view
869 (wraps,offset) <- PQ.enqueue msgQ num (handledFlg,(snapshot,Out cm))
870 capacity <- PQ.getCapacity msgQ
871 let dropped = wraps * capacity + offset
872 modifyTVar' msgNumVar (+1)
873 writeTVar dropCntVar dropped
874 atomically $ do 870 atomically $ do
875 idtmchans <- IntMap.assocs <$> readTVar (ncListeners session) 871 idtmchans <- IntMap.assocs <$> readTVar (ncListeners session)
876 mbChans 872 mbChans
@@ -885,6 +881,22 @@ hookHelper handledFlg typ session cm = do
885 writeTMChan chan cm 881 writeTMChan chan cm
886 return Nothing 882 return Nothing
887 883
884addMsgToLastN :: Bool -> MessageType -> NetCryptoSession -> CryptoMessage -> IO ()
885addMsgToLastN handledFlg typ session cm = do
886 let lastNQ = ncLastNMsgs session
887 msgNumVar = ncMsgNumVar session
888 dropCntVar = ncDropCntVar session
889 atomically $ do
890 num <- readTVar msgNumVar
891 view <- readTVar (ncView session)
892 snapshot <- viewSnapshot view
893 (wraps,offset) <- PQ.enqueue lastNQ num (handledFlg,(snapshot,Out cm))
894 capacity <- PQ.getCapacity lastNQ
895 let dropped = wraps * capacity + offset
896 modifyTVar' msgNumVar (+1)
897 writeTVar dropCntVar dropped
898
899
888-- | use to add a single hook to a specific session. 900-- | use to add a single hook to a specific session.
889addCryptoDataHook1 :: Map.Map MessageType [NetCryptoHook] -> MessageType -> NetCryptoHook -> Map.Map MessageType [NetCryptoHook] 901addCryptoDataHook1 :: Map.Map MessageType [NetCryptoHook] -> MessageType -> NetCryptoHook -> Map.Map MessageType [NetCryptoHook]
890addCryptoDataHook1 mp typ hook = case Map.lookup typ mp of 902addCryptoDataHook1 mp typ hook = case Map.lookup typ mp of