From fd633795d755049c528d6594e6645fd15a1c57e6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Fri, 8 May 2020 22:45:43 +0200
Subject: Service: global state

---
 src/Network.hs | 21 ++++++++++++++-------
 1 file changed, 14 insertions(+), 7 deletions(-)

(limited to 'src/Network.hs')

diff --git a/src/Network.hs b/src/Network.hs
index 7b69040..429dee1 100644
--- a/src/Network.hs
+++ b/src/Network.hs
@@ -163,6 +163,7 @@ startServer origHead logd bhost services = do
     let storage = refStorage $ headRef origHead
     chanPeer <- newChan
     chanSvc <- newChan
+    svcStates <- newMVar M.empty
     peers <- newMVar M.empty
     midentity <- newMVar $ headLocalIdentity origHead
     mshared <- newMVar $ lsShared $ load $ headRef origHead
@@ -282,21 +283,27 @@ startServer origHead logd bhost services = do
     void $ forkIO $ forever $ readChan chanSvc >>= \case
         (peer, svc, ref)
             | PeerIdentityFull peerId <- peerIdentity peer
-            -> modifyMVar_ (peerServiceState peer) $ \svcs ->
-                   case maybe (someServiceEmptyState <$> find ((svc ==) . someServiceID) services) Just $ M.lookup svc svcs of
-                        Nothing -> do logd $ "unhandled service '" ++ show (toUUID svc) ++ "'"
-                                      return svcs
-                        Just (SomeServiceState (proxy :: Proxy s) s) -> do
+            -> modifyMVar_ svcStates $ \global ->
+               modifyMVar (peerServiceState peer) $ \svcs ->
+                   case (maybe (someServiceEmptyState <$> find ((svc ==) . someServiceID) services) Just $ M.lookup svc svcs,
+                            maybe (someServiceEmptyGlobalState <$> find ((svc ==) . someServiceID) services) Just $ M.lookup svc global) of
+                        (Just (SomeServiceState (proxy :: Proxy s) s),
+                            Just (SomeServiceGlobalState (_ :: Proxy gs) gs))
+                            | Just (Refl :: s :~: gs) <- eqT -> do
                             let inp = ServiceInput
                                     { svcPeer = peerId
                                     , svcPrintOp = logd
                                     }
-                            (rsp, s') <- handleServicePacket storage inp s (wrappedLoad ref :: Stored s)
+                            (rsp, (s', gs')) <- handleServicePacket storage inp s gs (wrappedLoad ref :: Stored s)
                             identity <- readMVar midentity
                             runExceptT (sendToPeerList identity peer rsp) >>= \case
                                 Left err -> logd $ "failed to send response to peer: " ++ show err
                                 Right () -> return ()
-                            return $ M.insert svc (SomeServiceState proxy s') svcs
+                            return (M.insert svc (SomeServiceState proxy s') svcs,
+                                M.insert svc (SomeServiceGlobalState proxy gs') global)
+                        _ -> do
+                            logd $ "unhandled service '" ++ show (toUUID svc) ++ "'"
+                            return (svcs, global)
 
             | DatagramAddress paddr <- peerAddress peer -> do
                 logd $ "service packet from peer with incomplete identity " ++ show paddr
-- 
cgit v1.2.3