diff options
Diffstat (limited to 'src/Network/Tox/Crypto/Handlers.hs')
-rw-r--r-- | src/Network/Tox/Crypto/Handlers.hs | 29 |
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 | ||
30 | type IOHook addr x = addr -> x -> IO (Maybe (x -> x)) | 30 | type IOHook addr x = addr -> x -> IO (Maybe (x -> x)) |
31 | type NetCryptoHook = IOHook SockAddr CryptoMessage | 31 | type NetCryptoHook = IOHook SockAddr CryptoData |
32 | 32 | ||
33 | 33 | ||
34 | data NetCryptoSession = NCrypto { ncState :: TVar NetCryptoSessionStatus | 34 | data 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 |