Automatic discovery of peers for pending messages

Changelog: Automatic discovery of peers for pending direct messages

1 files changed, 18 insertions, 5 deletions

diff --git a/src/Erebos/DirectMessage.hs b/src/Erebos/DirectMessage.hs
index 05da865..dc6724c 100644
--- a/src/Erebos/DirectMessage.hs
+++ b/src/Erebos/DirectMessage.hs
@@ -17,6 +17,7 @@ module Erebos.DirectMessage (
 ) where
 
 import Control.Monad
+import Control.Monad.Except
 import Control.Monad.Reader
 
 import Data.List
@@ -27,8 +28,10 @@ import qualified Data.Text as T
 import Data.Time.Format
 import Data.Time.LocalTime
 
+import Erebos.Discovery
 import Erebos.Identity
 import Erebos.Network
+import Erebos.Object
 import Erebos.Service
 import Erebos.State
 import Erebos.Storable
@@ -102,8 +105,10 @@ instance Service DirectMessage where
 
     serviceNewPeer = syncDirectMessageToPeer . lookupSharedValue . lsShared . fromStored =<< svcGetLocal
 
-    serviceStorageWatchers _ = (:[]) $
-        SomeStorageWatcher (lookupSharedValue . lsShared . fromStored) syncDirectMessageToPeer
+    serviceStorageWatchers _ =
+        [ SomeStorageWatcher (lookupSharedValue . lsShared . fromStored) syncDirectMessageToPeer
+        , GlobalStorageWatcher (lookupSharedValue . lsShared . fromStored) findMissingPeers
+        ]
 
 
 data MessageState = MessageState
@@ -209,12 +214,19 @@ syncDirectMessageToPeer (DirectMessageThreads mss _) = do
               else do
                 return unchanged
 
+findMissingPeers :: Server -> DirectMessageThreads -> ExceptT ErebosError IO ()
+findMissingPeers server threads = do
+    forM_ (toThreadList threads) $ \thread -> do
+        when (msgHead thread /= msgReceived thread) $ do
+            mapM_ (discoverySearch server) $ map (refDigest . storedRef) $ idDataF $ msgPeer thread
+
 
 data DirectMessageThread = DirectMessageThread
     { msgPeer :: ComposedIdentity
-    , msgHead :: [Stored DirectMessage]
-    , msgSent :: [Stored DirectMessage]
-    , msgSeen :: [Stored DirectMessage]
+    , msgHead :: [ Stored DirectMessage ]
+    , msgSent :: [ Stored DirectMessage ]
+    , msgSeen :: [ Stored DirectMessage ]
+    , msgReceived :: [ Stored DirectMessage ]
     }
 
 threadToList :: DirectMessageThread -> [DirectMessage]
@@ -248,6 +260,7 @@ messageThreadFor peer mss =
          , msgHead = filterAncestors $ ready ++ received
          , msgSent = filterAncestors $ sent ++ received
          , msgSeen = filterAncestors $ ready ++ seen
+         , msgReceived = filterAncestors $ received
          }