Refactor, and bitflags in binary message type

1 files changed, 62 insertions, 35 deletions

diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 0cb2d4db..d6f2de7e 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -13,6 +13,7 @@ import Control.Applicative
 import Control.Monad
 import Data.Time.Clock.POSIX
 import qualified Data.ByteString  as B
+import Data.ByteString (ByteString)
 import Control.Lens
 import Data.Function
 import Data.Serialize             as S
@@ -34,6 +35,21 @@ type IOHook addr x = addr -> x -> IO (Maybe (x -> x))
 type NetCryptoHook = IOHook NetCryptoSession CryptoData
 type MsgTypeArray = A.UArray Word8 Word16
 
+
+-- | Information, that may be made visible in multiple sessions, as well
+-- as displayed in some way to the user via mutiple views.
+data SessionView = SessionView
+        { svNick :: TVar ByteString
+        , svStatus :: TVar UserStatus
+        , svStatusMsg :: TVar ByteString
+        , svGroups :: TVar (Map.Map GroupChatId (Set.Set SockAddr))
+        , svCacheDir :: FilePath -- ^ directory path used if the session has to use the disk for cache
+                                 --   clean up only if space is needed
+        , svTmpDir :: FilePath -- Once off storage goes here, should clean up quickly
+        , svConfigDir :: FilePath -- profile related storage, etc, never clean up
+        }
+
+
 data NetCryptoSession = NCrypto { ncState         :: TVar NetCryptoSessionStatus
                                 , ncTheirBaseNonce :: TVar Nonce24 -- base nonce + packet number
                                 , ncMyPacketNonce :: TVar Nonce24 -- base nonce + packet number
@@ -54,23 +70,29 @@ data NetCryptoSession = NCrypto { ncState         :: TVar NetCryptoSessionStatus
                                 , ncAllSessions :: NetCryptoSessions -- ^ may be needed if one net-crypto session
                                                                      --   needs to possibly start another, as is
                                                                      --   the case in group chats
-                                , ncGroups :: TVar (Map.Map GroupChatId (Set.Set SockAddr))
+                                , ncView :: TVar SessionView
                                 }
 
 data NetCryptoSessions = NCSessions { netCryptoSessions :: TVar (Map.Map SockAddr NetCryptoSession)
                                     , transportCrypto :: TransportCrypto
                                     , defaultHooks :: Map.Map MessageType [NetCryptoHook]
                                     , defaultUnrecognizedHook :: MessageType -> NetCryptoHook
+                                    , sessionView :: SessionView
                                     , msgTypeArray :: MsgTypeArray
                                     }
 
 newSessionsState :: TransportCrypto -> (MessageType -> NetCryptoHook) -> Map.Map MessageType [NetCryptoHook] -> IO NetCryptoSessions
 newSessionsState crypto unrechook hooks = do
     x <- atomically $ newTVar Map.empty
+    nick <- atomically $ newTVar B.empty
+    status <- atomically $ newTVar Online
+    statusmsg <- atomically $ newTVar B.empty
+    grps <- atomically $ newTVar Map.empty
     return NCSessions { netCryptoSessions = x
                       , transportCrypto = crypto
                       , defaultHooks = hooks
                       , defaultUnrecognizedHook = unrechook
+                      , sessionView = SessionView { svNick = nick, svStatus = status, svStatusMsg = statusmsg, svGroups = grps }
                       , msgTypeArray = allMsgTypes -- todo make this a parameter
                       }
 
@@ -117,8 +139,8 @@ freshCryptoSession  sessions
     newsession <- generateSecretKey
     ncHooks0 <- atomically $ newTVar (defaultHooks sessions)
     ncUnrecognizedHook0 <- atomically $ newTVar (defaultUnrecognizedHook sessions)
-    ncGroups0 <- atomically $ newTVar (Map.empty)
     ncMessageTypes0 <- atomically $ newTVar (msgTypeArray sessions)
+    ncView0 <- atomically $ newTVar (sessionView sessions)
     let netCryptoSession =
             NCrypto { ncState         = ncState0
                     , ncTheirBaseNonce= ncTheirBaseNonce0
@@ -132,8 +154,8 @@ freshCryptoSession  sessions
                     , ncHooks         = ncHooks0
                     , ncUnrecognizedHook = ncUnrecognizedHook0
                     , ncAllSessions = sessions
-                    , ncGroups = ncGroups0
                     , ncMessageTypes = ncMessageTypes0
+                    , ncView = ncView0
                     }
     atomically $ modifyTVar allsessions (Map.insert addr netCryptoSession)
 
@@ -247,38 +269,7 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do
                             writeTVar ncTheirBaseNonce y
                     -- then set session confirmed,
                     atomically $ writeTVar ncState Confirmed
-                    hookmap <- atomically $ readTVar ncHooks
-                    -- run hook
-                    flip fix (cd,hookmap) $ \lookupAgain (cd,hookmap) -> do
-                        msgTyps <- atomically $ readTVar ncMessageTypes
-                        let msgTyp = cd ^. messageType
-                            msgTypMapped16 = msgTypes ! msgId cd
-                            msgTypMapped = fromIntegral msgTypMapped16
-                        if msgTypMapped16 == 0
-                         then return id
-                         else
-                           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
-                                             case mbConsume of
-                                                Just f -> do
-                                                           -- ncUnrecognizedHook0 may have updated the hookmap
-                                                           hookmap' <- atomically $ readTVar ncHooks
-                                                           lookupAgain (f cd,hookmap')
-                                                Nothing -> return Nothing
-                                Just hooks -> flip fix (hooks,cd,msgTypMapped) $ \loop (hooks,cd,typ) -> do
-                                                let _ = cd :: CryptoData
-                                                case (hooks,cd) of
-                                                    ([],_) ->  return Nothing
-                                                    (hook:more,cd) -> do
-                                                        r <- hook session cd :: IO (Maybe (CryptoData -> CryptoData))
-                                                        case r of
-                                                            Just f -> let newcd = f cd
-                                                                          newtyp = newcd ^. messageType
-                                                                          in if newtyp == typ then loop (more,newcd,newtyp)
-                                                                                              else lookupAgain (newcd,hookmap)
-                                                            Nothing -> return Nothing -- message consumed
+                    runCryptoHook session cd
     where
         last2Bytes :: Nonce24 -> Word
         last2Bytes (Nonce24 bs) = case S.decode (B.drop 22 bs) of
@@ -286,6 +277,42 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do
                                     _ -> error "unreachable-last2Bytes"
         dATA_NUM_THRESHOLD = 21845 -- = 65535 / 3
 
+runCryptoHook :: NetCryptoSession -> CryptoData -> IO (Maybe (x -> x))
+runCryptoHook session@(NCrypto {ncState, ncHooks,ncSessionSecret,ncTheirSessionPublic,ncTheirBaseNonce,ncMessageTypes})
+              cd@(CryptoData {bufferStart, bufferEnd, bufferData=cm}) = do
+    hookmap <- atomically $ readTVar ncHooks
+    -- run hook
+    flip fix (cd,hookmap) $ \lookupAgain (cd,hookmap) -> do
+        msgTypes <- atomically $ readTVar ncMessageTypes
+        let msgTyp = cd ^. messageType
+            msgTypMapped16 = msgTypes A.! fromEnum8 (msgID cm)
+            msgTypMapped = fromWord16 $ msgTypMapped16
+        if msgTypMapped16 == 0
+         then return $ Just id
+         else
+           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
+                             case mbConsume of
+                                Just f -> do
+                                           -- ncUnrecognizedHook0 may have updated the hookmap
+                                           hookmap' <- atomically $ readTVar ncHooks
+                                           lookupAgain (f cd,hookmap')
+                                Nothing -> return Nothing
+                Just hooks -> flip fix (hooks,cd,msgTypMapped) $ \loop (hooks,cd,typ) -> do
+                                let _ = cd :: CryptoData
+                                case (hooks,cd) of
+                                    ([],_) ->  return Nothing
+                                    (hook:more,cd) -> do
+                                        r <- hook session cd :: IO (Maybe (CryptoData -> CryptoData))
+                                        case r of
+                                            Just f -> let newcd = f cd
+                                                          newtyp = newcd ^. messageType
+                                                          in if newtyp == typ then loop (more,newcd,newtyp)
+                                                                              else lookupAgain (newcd,hookmap)
+                                            Nothing -> return Nothing -- message consumed
+
 -- | construct a 'MsgTypeArray' for specified types, using their known common positions
 --   in the MessageId space if they have such a thing.
 mkMsgTypes :: [MessageType] -> MsgTypeArray