crypto hooks now take CryptoMessage not CryptoData

1 files changed, 13 insertions, 14 deletions

diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index f4b79272..cca8b899 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -48,7 +48,7 @@ data NetCryptoSessionStatus = Unaccepted | Accepted | Confirmed
 
 
 type IOHook addr x = addr -> x -> IO (Maybe (x -> x))
-type NetCryptoHook = IOHook NetCryptoSession CryptoData
+type NetCryptoHook = IOHook NetCryptoSession CryptoMessage
 type MsgTypeArray = A.UArray Word8 Word64
 -- type MsgOutMap = RangeMap STArray Word8 STRef
 -- type MsgOutMap = W64.Word64Map Word8
@@ -367,7 +367,7 @@ freshCryptoSession  sessions
         labelThread tid ("NetCryptoDequeue." ++ show (key2id remotePublicKey))
         fix $ \loop -> do
             cd <- atomically $ PQ.dequeue pktq
-            _ <- runCryptoHook (netCryptoSession0 {ncDequeueThread=Just tid}) cd
+            _ <- runCryptoHook (netCryptoSession0 {ncDequeueThread=Just tid}) (bufferData cd)
             loop
     -- launch dequeueOutgoing thread
     threadidOutgoing <- forkIO $ do
@@ -525,7 +525,7 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do
                         isLossy _ = False
                     if isLossy msgTypMapped
                         then do atomically $ PQ.observeOutOfBand ncPacketQueue bufferEnd
-                                runCryptoHook session cd
+                                runCryptoHook session (bufferData cd)
                         else do atomically $ PQ.enqueue ncPacketQueue bufferEnd cd
                                 return Nothing
     where
@@ -535,15 +535,14 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do
                                     _ -> error "unreachable-last2Bytes"
         dATA_NUM_THRESHOLD = 21845 -- = 65535 / 3
 
--- | TODO: make this accept CrytpoMessage instead
-runCryptoHook :: NetCryptoSession -> CryptoData -> IO (Maybe (x -> x))
+runCryptoHook :: NetCryptoSession -> CryptoMessage -> IO (Maybe (x -> x))
 runCryptoHook session@(NCrypto {ncState, ncHooks,ncSessionSecret,ncTheirSessionPublic,ncTheirBaseNonce,ncIncomingTypeArray})
-              cd@(CryptoData {bufferStart, bufferEnd, bufferData=cm}) = do
+              cm {-cd@(CryptoData {bufferStart, bufferEnd, bufferData=cm})-} = do
     hookmap <- atomically $ readTVar ncHooks
     -- run hook
-    flip fix (cd,hookmap) $ \lookupAgain (cd,hookmap) -> do
+    flip fix (cm,hookmap) $ \lookupAgain (cm,hookmap) -> do
         msgTypes <- atomically $ readTVar ncIncomingTypeArray
-        let msgTyp = cd ^. messageType
+        let msgTyp = cm ^. messageType
             msgTypMapped64 = msgTypes A.! fromEnum8 (msgID cm)
             msgTypMapped = fromWord64 $ msgTypMapped64
         if msgTypMapped64 == 0
@@ -552,19 +551,19 @@ runCryptoHook session@(NCrypto {ncState, ncHooks,ncSessionSecret,ncTheirSessionP
            case Map.lookup msgTypMapped hookmap of
                 Nothing -> do -- no recognizing hook, run ncUnrecognizedHook0, loopAgain on result
                              unrecognize <- atomically $ readTVar (ncUnrecognizedHook session)
-                             mbConsume <- unrecognize msgTypMapped session cd
+                             mbConsume <- unrecognize msgTypMapped session cm
                              case mbConsume of
                                 Just f -> do
                                            -- ncUnrecognizedHook0 may have updated the hookmap
                                            hookmap' <- atomically $ readTVar ncHooks
-                                           lookupAgain (f cd,hookmap')
+                                           lookupAgain (f cm,hookmap')
                                 Nothing -> return Nothing
-                Just hooks -> flip fix (hooks,cd,msgTypMapped) $ \loop (hooks,cd,typ) -> do
-                                let _ = cd :: CryptoData
-                                case (hooks,cd) of
+                Just hooks -> flip fix (hooks,cm,msgTypMapped) $ \loop (hooks,cm,typ) -> do
+                                let _ = cm :: CryptoMessage
+                                case (hooks,cm) of
                                     ([],_) ->  return Nothing
                                     (hook:more,cd) -> do
-                                        r <- hook session cd :: IO (Maybe (CryptoData -> CryptoData))
+                                        r <- hook session cm :: IO (Maybe (CryptoMessage -> CryptoMessage))
                                         case r of
                                             Just f -> let newcd = f cd
                                                           newtyp = newcd ^. messageType