Discovery: search for owner identity

Changelog: Automatically search for other devices of the same owner when using the discovery service.

2 files changed, 97 insertions, 3 deletions

diff --git a/src/Erebos/Discovery.hs b/src/Erebos/Discovery.hs
index c28c3a9..71929e3 100644
--- a/src/Erebos/Discovery.hs
+++ b/src/Erebos/Discovery.hs
@@ -39,6 +39,7 @@ import Erebos.Network.Address
 import Erebos.Object
 import Erebos.Service
 import Erebos.Service.Stream
+import Erebos.State
 import Erebos.Storable
 
 
@@ -75,6 +76,7 @@ data DiscoveryAttributes = DiscoveryAttributes
     , discoveryTurnServer :: Maybe Text
     , discoveryProvideTunnel :: Peer -> PeerAddress -> Bool
     , discoveryDebugLog :: Bool
+    , discoverySearchForOwner :: Bool
     }
 
 defaultDiscoveryAttributes :: DiscoveryAttributes
@@ -85,6 +87,7 @@ defaultDiscoveryAttributes = DiscoveryAttributes
     , discoveryTurnServer = Nothing
     , discoveryProvideTunnel = \_ _ -> False
     , discoveryDebugLog = False
+    , discoverySearchForOwner = True
     }
 
 data DiscoveryConnection = DiscoveryConnection
@@ -662,15 +665,25 @@ instance Service DiscoveryService where
         let searchingFor = foldl' (flip S.delete) (dgsSearchingFor gs) (identityDigests pid)
         svcModifyGlobal $ \s -> s { dgsSearchingFor = searchingFor }
 
+        searchForOwner <- asks (discoverySearchForOwner . svcAttributes) >>= \case
+            True -> do
+                (lookupSharedValue . lsShared . fromStored <$> getLocalHead) >>= \case
+                    Just (self :: ComposedIdentity) -> do
+                        return $ S.fromList $ map (refDigest . storedRef) $ idDataF self
+                    Nothing -> do
+                        return S.empty
+            False -> return S.empty
+        let searchingFor' = searchingFor `S.union` searchForOwner
+
         when (not $ null addrs) $ do
             sendToPeer peer $ DiscoverySelf addrs Nothing
 
-        when (not $ null searchingFor) $ do
-            forM_ searchingFor $ \dgst -> do
+        when (not $ null searchingFor') $ do
+            forM_ searchingFor' $ \dgst -> do
                 sendToPeer peer $ DiscoverySearch (Right dgst)
 
             now <- liftIO $ getTime Monotonic
-            let weAskedFor' = M.fromAscList $ map (, SearchingSince now) $ S.toAscList searchingFor
+            let weAskedFor' = M.fromAscList $ map (, SearchingSince now) $ S.toAscList searchingFor'
             svcModify $ \s -> s { dpsWeAskedFor = weAskedFor' }
             debugLog $
                 "we asked new peer " <> show (refDigest $ storedRef $ idData pid) <>
diff --git a/test/attach.et b/test/attach.et
index e925116..ae00048 100644
--- a/test/attach.et
+++ b/test/attach.et
@@ -1,5 +1,7 @@
 module attach
 
+import common
+
 test Attach:
     let services = "attach,sync"
 
@@ -45,3 +47,82 @@ test Attach:
     expect /attach-response-done 1/ from p2
     expect /local-identity Device2 Owner/ from p2
     expect /peer 1 id Device2 Owner/ from p1
+
+
+test SyncAfterAttach:
+    let services_1 = "attach"
+    let services_2 = "discovery,sync"
+    let services_d = "discovery"
+
+    subnet sd
+    subnet s1
+    subnet s2
+    subnet s3
+
+    node nd on sd
+    node n1 on s1
+    node n2 on s2
+    node n3 on s3
+
+    local:
+        spawn as pd on nd
+        spawn as p1 on n1
+        spawn as p2 on n2
+        spawn as p3 on n3
+
+        send "create-identity Discovery" to pd
+        send "create-identity Device1 Owner" to p1
+        send "create-identity Device2" to p2
+        send "create-identity Device3" to p3
+
+        expect /create-identity-done ref $refpat.*/ from pd
+        expect /create-identity-done ref $refpat.*/ from p1
+        expect /create-identity-done ref $refpat.*/ from p2
+        expect /create-identity-done ref $refpat.*/ from p3
+
+        send "start-server services $services_1" to p1
+        for p in [ p2, p3 ]:
+            with p:
+                send "start-server services $services_1"
+                send "peer-add ${p1.node.ip}"
+                expect /peer 1 addr ${p1.node.ip} 29665/
+                expect /peer 1 id Device1 Owner/
+
+                expect /peer ([0-9]+) addr ${p.node.ip} 29665/ from p1 capture pidx
+                expect /peer $pidx id Device./ from p1
+
+                send "attach-to 1"
+                expect /attach-request $pidx ([0-9]*)/ from p1 capture code1
+                expect /attach-response 1 ([0-9]*)/ capture code2
+                guard (code1 == code2)
+
+                send "attach-accept $pidx" to p1
+                send "attach-accept 1"
+                expect /attach-request-done $pidx/ from p1
+                expect /attach-response-done 1/
+
+    spawn as pd on nd
+    spawn as p1 on n1
+    spawn as p2 on n2
+    spawn as p3 on n3
+
+    send "start-server services $services_d" to pd
+    for p in [ p1, p2, p3 ]:
+        send "start-server services $services_2" to p
+
+    # Shared identity sync after explicit direct connection
+
+    send "peer-add ${p1.node.ip}" to p2
+    expect /peer 1 addr ${p2.node.ip} 29665/ from p1
+    expect /peer 1 id Device. Owner/ from p1
+
+    # Shared identity sync after automatic discovery
+
+    for p in [ p1, p3 ]:
+        send "peer-add ${pd.node.ip}" to p
+
+    expect /peer 2 addr ${pd.node.ip} 29665/ from p1
+    expect /peer 2 id Discovery/ from p1
+
+    expect /peer 3 addr ${p3.node.ip} 29665/ from p1
+    expect /peer 3 id Device. Owner/ from p1