diff options
Diffstat (limited to 'src/Network/Tox/Crypto/Handlers.hs')
-rw-r--r-- | src/Network/Tox/Crypto/Handlers.hs | 38 |
1 files changed, 25 insertions, 13 deletions
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 | ||
755 | sendKill :: TransportCrypto -> NetCryptoSession -> IO (Either String ()) | 755 | sendKill :: TransportCrypto -> NetCryptoSession -> IO (Either String ()) |
756 | sendKill crypto session = sendCrypto crypto session (return ()) (OneByte KillPacket) | 756 | sendKill crypto session = do |
757 | let cm=OneByte KillPacket | ||
758 | addMsgToLastN False (cm ^. messageType) session cm | ||
759 | sendCrypto crypto session (return ()) cm | ||
757 | 760 | ||
758 | setNick :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String ()) | 761 | setNick :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String ()) |
759 | setNick crypto session nick = do | 762 | setNick 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 | ||
771 | setTyping :: TransportCrypto -> NetCryptoSession -> TypingStatus -> IO (Either String ()) | 775 | setTyping :: 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 | ||
779 | setNoSpam :: TransportCrypto -> NetCryptoSession -> Maybe NoSpam -> IO (Either String ()) | 784 | setNoSpam :: 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 | ||
795 | setStatusMsg :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String ()) | 801 | setStatusMsg :: 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 | ||
861 | hookHelper handledFlg typ session cm = do | 868 | hookHelper 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 | ||
884 | addMsgToLastN :: Bool -> MessageType -> NetCryptoSession -> CryptoMessage -> IO () | ||
885 | addMsgToLastN 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. |
889 | addCryptoDataHook1 :: Map.Map MessageType [NetCryptoHook] -> MessageType -> NetCryptoHook -> Map.Map MessageType [NetCryptoHook] | 901 | addCryptoDataHook1 :: Map.Map MessageType [NetCryptoHook] -> MessageType -> NetCryptoHook -> Map.Map MessageType [NetCryptoHook] |
890 | addCryptoDataHook1 mp typ hook = case Map.lookup typ mp of | 902 | addCryptoDataHook1 mp typ hook = case Map.lookup typ mp of |