summaryrefslogtreecommitdiff
path: root/src/Network/Tox/Crypto/Handlers.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Tox/Crypto/Handlers.hs')
-rw-r--r--src/Network/Tox/Crypto/Handlers.hs29
1 files changed, 15 insertions, 14 deletions
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 12818b2e..c5476371 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -28,7 +28,7 @@ data NetCryptoSessionStatus = Unaccepted | Accepted | Confirmed
28 28
29 29
30type IOHook addr x = addr -> x -> IO (Maybe (x -> x)) 30type IOHook addr x = addr -> x -> IO (Maybe (x -> x))
31type NetCryptoHook = IOHook SockAddr CryptoMessage 31type NetCryptoHook = IOHook SockAddr CryptoData
32 32
33 33
34data NetCryptoSession = NCrypto { ncState :: TVar NetCryptoSessionStatus 34data NetCryptoSession = NCrypto { ncState :: TVar NetCryptoSessionStatus
@@ -160,7 +160,7 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do
160 decodePlain =<< decrypt (computeSharedSecret ncSessionSecret pubkey tempNonce) encrypted 160 decodePlain =<< decrypt (computeSharedSecret ncSessionSecret pubkey tempNonce) encrypted
161 case lr of 161 case lr of
162 Left _ -> return Nothing -- decryption failed, ignore packet 162 Left _ -> return Nothing -- decryption failed, ignore packet
163 Right (CryptoData {bufferStart, bufferEnd, bufferData=cm}) -> do -- decryption succeeded, 163 Right cd@(CryptoData {bufferStart, bufferEnd, bufferData=cm}) -> do -- decryption succeeded,
164 -- TODO: Why do I need bufferStart & bufferEnd? 164 -- TODO: Why do I need bufferStart & bufferEnd?
165 -- 165 --
166 -- buffer_start = highest packet number handled + 1 166 -- buffer_start = highest packet number handled + 1
@@ -177,22 +177,23 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do
177 -- then set session confirmed, 177 -- then set session confirmed,
178 atomically $ writeTVar ncState Confirmed 178 atomically $ writeTVar ncState Confirmed
179 hookmap <- atomically $ readTVar ncHooks 179 hookmap <- atomically $ readTVar ncHooks
180 -- if lossy, just run hook 180 -- run hook
181 if lossyness (msgID cm) == Lossy 181 flip fix cd $ \lookupAgain cd -> do
182 then 182 let msgTyp = cd ^. messageType
183 case Map.lookup (cm ^. messageType) hookmap of 183 case Map.lookup msgTyp hookmap of
184 Nothing -> return Nothing -- discarding, because no hooks 184 Nothing -> return Nothing -- discarding, because no hooks
185 Just hooks -> flip fix (hooks,cm) $ \loop (hooks,msg) -> do 185 Just hooks -> flip fix (hooks,cd,msgTyp) $ \loop (hooks,cd,typ) -> do
186 let _ = cm :: CryptoMessage 186 let _ = cd :: CryptoData
187 case (hooks,cm) of 187 case (hooks,cd) of
188 ([],_) -> return Nothing 188 ([],_) -> return Nothing
189 (hook:more,cm) -> do 189 (hook:more,cd) -> do
190 r <- hook addr cm :: IO (Maybe (CryptoMessage -> CryptoMessage)) 190 r <- hook addr cd :: IO (Maybe (CryptoData -> CryptoData))
191 case r of 191 case r of
192 Just f -> loop (more,f cm) 192 Just f -> let newcd = f cd
193 newtyp = newcd ^. messageType
194 in if newtyp == typ then loop (more,newcd,newtyp)
195 else lookupAgain newcd
193 Nothing -> return Nothing -- message consumed 196 Nothing -> return Nothing -- message consumed
194 else -- Lossless message, so try to restore sequence
195 error "todo try to restore sequence of lossless messages"
196 where 197 where
197 last2Bytes :: Nonce24 -> Word 198 last2Bytes :: Nonce24 -> Word
198 last2Bytes (Nonce24 bs) = case S.decode (B.drop 22 bs) of 199 last2Bytes (Nonce24 bs) = case S.decode (B.drop 22 bs) of