{-# LANGUAGE CPP #-}

module Erebos.Discovery (
    DiscoveryService(..),
    DiscoveryAttributes(..),
    DiscoveryConnection(..),

    discoverySearch,
) where

import Control.Concurrent
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader

import Data.IP qualified as IP
import Data.List
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as M
import Data.Maybe
import Data.Proxy
import Data.Set (Set)
import Data.Set qualified as S
import Data.Text (Text)
import Data.Text qualified as T
import Data.Word

import Network.Socket

#ifdef ENABLE_ICE_SUPPORT
import Erebos.ICE
#endif
import Erebos.Identity
import Erebos.Network
import Erebos.Service
import Erebos.Storage


#ifndef ENABLE_ICE_SUPPORT
type IceConfig = ()
type IceSession = ()
type IceRemoteInfo = Stored Object
#endif


data DiscoveryService
    = DiscoverySelf [ Text ] (Maybe Int)
    | DiscoveryAcknowledged [ Text ] (Maybe Text) (Maybe Word16) (Maybe Text) (Maybe Word16)
    | DiscoverySearch Ref
    | DiscoveryResult Ref [ Text ]
    | DiscoveryConnectionRequest DiscoveryConnection
    | DiscoveryConnectionResponse DiscoveryConnection

data DiscoveryAttributes = DiscoveryAttributes
    { DiscoveryAttributes -> Maybe Word16
discoveryStunPort :: Maybe Word16
    , DiscoveryAttributes -> Maybe Text
discoveryStunServer :: Maybe Text
    , DiscoveryAttributes -> Maybe Word16
discoveryTurnPort :: Maybe Word16
    , DiscoveryAttributes -> Maybe Text
discoveryTurnServer :: Maybe Text
    }

defaultDiscoveryAttributes :: DiscoveryAttributes
defaultDiscoveryAttributes :: DiscoveryAttributes
defaultDiscoveryAttributes = DiscoveryAttributes
    { discoveryStunPort :: Maybe Word16
discoveryStunPort = Maybe Word16
forall a. Maybe a
Nothing
    , discoveryStunServer :: Maybe Text
discoveryStunServer = Maybe Text
forall a. Maybe a
Nothing
    , discoveryTurnPort :: Maybe Word16
discoveryTurnPort = Maybe Word16
forall a. Maybe a
Nothing
    , discoveryTurnServer :: Maybe Text
discoveryTurnServer = Maybe Text
forall a. Maybe a
Nothing
    }

data DiscoveryConnection = DiscoveryConnection
    { DiscoveryConnection -> Ref
dconnSource :: Ref
    , DiscoveryConnection -> Ref
dconnTarget :: Ref
    , DiscoveryConnection -> Maybe Text
dconnAddress :: Maybe Text
    , DiscoveryConnection -> Maybe IceRemoteInfo
dconnIceInfo :: Maybe IceRemoteInfo
    }

emptyConnection :: Ref -> Ref -> DiscoveryConnection
emptyConnection :: Ref -> Ref -> DiscoveryConnection
emptyConnection Ref
dconnSource Ref
dconnTarget = DiscoveryConnection {Maybe Text
Maybe IceRemoteInfo
Ref
forall a. Maybe a
dconnSource :: Ref
dconnTarget :: Ref
dconnAddress :: Maybe Text
dconnIceInfo :: Maybe IceRemoteInfo
dconnSource :: Ref
dconnTarget :: Ref
dconnAddress :: forall a. Maybe a
dconnIceInfo :: forall a. Maybe a
..}
  where
    dconnAddress :: Maybe a
dconnAddress = Maybe a
forall a. Maybe a
Nothing
    dconnIceInfo :: Maybe a
dconnIceInfo = Maybe a
forall a. Maybe a
Nothing

instance Storable DiscoveryService where
    store' :: DiscoveryService -> Store
store' DiscoveryService
x = (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
storeRec ((forall (c :: * -> *). StorageCompleteness c => StoreRec c)
 -> Store)
-> (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
forall a b. (a -> b) -> a -> b
$ do
        case DiscoveryService
x of
            DiscoverySelf [Text]
addrs Maybe Int
priority -> do
                (Text -> StoreRec c) -> [Text] -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> Text -> StoreRec c
forall a (c :: * -> *). StorableText a => String -> a -> StoreRec c
storeText String
"self") [Text]
addrs
                (Int -> StoreRec c) -> Maybe Int -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> Int -> StoreRec c
forall a (c :: * -> *). Integral a => String -> a -> StoreRec c
storeInt String
"priority") Maybe Int
priority
            DiscoveryAcknowledged [Text]
addrs Maybe Text
stunServer Maybe Word16
stunPort Maybe Text
turnServer Maybe Word16
turnPort -> do
                if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
addrs then String -> StoreRec c
forall (c :: * -> *). String -> StoreRec c
storeEmpty String
"ack"
                              else (Text -> StoreRec c) -> [Text] -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> Text -> StoreRec c
forall a (c :: * -> *). StorableText a => String -> a -> StoreRec c
storeText String
"ack") [Text]
addrs
                String -> Maybe Text -> StoreRec c
forall a (c :: * -> *).
StorableText a =>
String -> Maybe a -> StoreRec c
storeMbText String
"stun-server" Maybe Text
stunServer
                String -> Maybe Word16 -> StoreRec c
forall a (c :: * -> *).
Integral a =>
String -> Maybe a -> StoreRec c
storeMbInt String
"stun-port" Maybe Word16
stunPort
                String -> Maybe Text -> StoreRec c
forall a (c :: * -> *).
StorableText a =>
String -> Maybe a -> StoreRec c
storeMbText String
"turn-server" Maybe Text
turnServer
                String -> Maybe Word16 -> StoreRec c
forall a (c :: * -> *).
Integral a =>
String -> Maybe a -> StoreRec c
storeMbInt String
"turn-port" Maybe Word16
turnPort
            DiscoverySearch Ref
ref -> String -> Ref -> StoreRec c
forall (c :: * -> *).
StorageCompleteness c =>
String -> Ref -> StoreRec c
storeRawRef String
"search" Ref
ref
            DiscoveryResult Ref
ref [Text]
addr -> do
                String -> Ref -> StoreRec c
forall (c :: * -> *).
StorageCompleteness c =>
String -> Ref -> StoreRec c
storeRawRef String
"result" Ref
ref
                (Text -> StoreRec c) -> [Text] -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> Text -> StoreRec c
forall a (c :: * -> *). StorableText a => String -> a -> StoreRec c
storeText String
"address") [Text]
addr
            DiscoveryConnectionRequest DiscoveryConnection
conn -> String -> DiscoveryConnection -> StoreRec c
forall {p} {c :: * -> *}.
(StorableText p, StorageCompleteness c) =>
p -> DiscoveryConnection -> StoreRecM c ()
storeConnection String
"request" DiscoveryConnection
conn
            DiscoveryConnectionResponse DiscoveryConnection
conn -> String -> DiscoveryConnection -> StoreRec c
forall {p} {c :: * -> *}.
(StorableText p, StorageCompleteness c) =>
p -> DiscoveryConnection -> StoreRecM c ()
storeConnection String
"response" DiscoveryConnection
conn

      where
        storeConnection :: p -> DiscoveryConnection -> StoreRecM c ()
storeConnection p
ctype DiscoveryConnection {Maybe Text
Maybe IceRemoteInfo
Ref
dconnSource :: DiscoveryConnection -> Ref
dconnTarget :: DiscoveryConnection -> Ref
dconnAddress :: DiscoveryConnection -> Maybe Text
dconnIceInfo :: DiscoveryConnection -> Maybe IceRemoteInfo
dconnSource :: Ref
dconnTarget :: Ref
dconnAddress :: Maybe Text
dconnIceInfo :: Maybe IceRemoteInfo
..} = do
            String -> p -> StoreRecM c ()
forall a (c :: * -> *). StorableText a => String -> a -> StoreRec c
storeText String
"connection" (p -> StoreRecM c ()) -> p -> StoreRecM c ()
forall a b. (a -> b) -> a -> b
$ p
ctype
            String -> Ref -> StoreRecM c ()
forall (c :: * -> *).
StorageCompleteness c =>
String -> Ref -> StoreRec c
storeRawRef String
"source" Ref
dconnSource
            String -> Ref -> StoreRecM c ()
forall (c :: * -> *).
StorageCompleteness c =>
String -> Ref -> StoreRec c
storeRawRef String
"target" Ref
dconnTarget
            String -> Maybe Text -> StoreRecM c ()
forall a (c :: * -> *).
StorableText a =>
String -> Maybe a -> StoreRec c
storeMbText String
"address" Maybe Text
dconnAddress
            String -> Maybe IceRemoteInfo -> StoreRecM c ()
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> Maybe a -> StoreRec c
storeMbRef String
"ice-info" Maybe IceRemoteInfo
dconnIceInfo

    load' :: Load DiscoveryService
load' = LoadRec DiscoveryService -> Load DiscoveryService
forall a. LoadRec a -> Load a
loadRec (LoadRec DiscoveryService -> Load DiscoveryService)
-> LoadRec DiscoveryService -> Load DiscoveryService
forall a b. (a -> b) -> a -> b
$ [LoadRec DiscoveryService] -> LoadRec DiscoveryService
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
            [ do
                [Text]
addrs <- String -> LoadRec [Text]
forall a. StorableText a => String -> LoadRec [a]
loadTexts String
"self"
                Bool -> LoadRec ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
addrs)
                [Text] -> Maybe Int -> DiscoveryService
DiscoverySelf [Text]
addrs
                    (Maybe Int -> DiscoveryService)
-> LoadRec (Maybe Int) -> LoadRec DiscoveryService
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> LoadRec (Maybe Int)
forall a. Num a => String -> LoadRec (Maybe a)
loadMbInt String
"priority"
            , do
                [Text]
addrs <- String -> LoadRec [Text]
forall a. StorableText a => String -> LoadRec [a]
loadTexts String
"ack"
                Maybe ()
mbEmpty <- String -> LoadRec (Maybe ())
loadMbEmpty String
"ack"
                Bool -> LoadRec ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
addrs) Bool -> Bool -> Bool
|| Maybe () -> Bool
forall a. Maybe a -> Bool
isJust Maybe ()
mbEmpty)
                [Text]
-> Maybe Text
-> Maybe Word16
-> Maybe Text
-> Maybe Word16
-> DiscoveryService
DiscoveryAcknowledged
                    ([Text]
 -> Maybe Text
 -> Maybe Word16
 -> Maybe Text
 -> Maybe Word16
 -> DiscoveryService)
-> LoadRec [Text]
-> LoadRec
     (Maybe Text
      -> Maybe Word16 -> Maybe Text -> Maybe Word16 -> DiscoveryService)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> LoadRec [Text]
forall a. a -> LoadRec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
addrs
                    LoadRec
  (Maybe Text
   -> Maybe Word16 -> Maybe Text -> Maybe Word16 -> DiscoveryService)
-> LoadRec (Maybe Text)
-> LoadRec
     (Maybe Word16 -> Maybe Text -> Maybe Word16 -> DiscoveryService)
forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> LoadRec (Maybe Text)
forall a. StorableText a => String -> LoadRec (Maybe a)
loadMbText String
"stun-server"
                    LoadRec
  (Maybe Word16 -> Maybe Text -> Maybe Word16 -> DiscoveryService)
-> LoadRec (Maybe Word16)
-> LoadRec (Maybe Text -> Maybe Word16 -> DiscoveryService)
forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> LoadRec (Maybe Word16)
forall a. Num a => String -> LoadRec (Maybe a)
loadMbInt String
"stun-port"
                    LoadRec (Maybe Text -> Maybe Word16 -> DiscoveryService)
-> LoadRec (Maybe Text)
-> LoadRec (Maybe Word16 -> DiscoveryService)
forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> LoadRec (Maybe Text)
forall a. StorableText a => String -> LoadRec (Maybe a)
loadMbText String
"turn-server"
                    LoadRec (Maybe Word16 -> DiscoveryService)
-> LoadRec (Maybe Word16) -> LoadRec DiscoveryService
forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> LoadRec (Maybe Word16)
forall a. Num a => String -> LoadRec (Maybe a)
loadMbInt String
"turn-port"
            , Ref -> DiscoveryService
DiscoverySearch (Ref -> DiscoveryService)
-> LoadRec Ref -> LoadRec DiscoveryService
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> LoadRec Ref
loadRawRef String
"search"
            , Ref -> [Text] -> DiscoveryService
DiscoveryResult
                (Ref -> [Text] -> DiscoveryService)
-> LoadRec Ref -> LoadRec ([Text] -> DiscoveryService)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> LoadRec Ref
loadRawRef String
"result"
                LoadRec ([Text] -> DiscoveryService)
-> LoadRec [Text] -> LoadRec DiscoveryService
forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> LoadRec [Text]
forall a. StorableText a => String -> LoadRec [a]
loadTexts String
"address"
            , String
-> (DiscoveryConnection -> DiscoveryService)
-> LoadRec DiscoveryService
forall {a} {b}.
(StorableText a, Eq a) =>
a -> (DiscoveryConnection -> b) -> LoadRec b
loadConnection String
"request" DiscoveryConnection -> DiscoveryService
DiscoveryConnectionRequest
            , String
-> (DiscoveryConnection -> DiscoveryService)
-> LoadRec DiscoveryService
forall {a} {b}.
(StorableText a, Eq a) =>
a -> (DiscoveryConnection -> b) -> LoadRec b
loadConnection String
"response" DiscoveryConnection -> DiscoveryService
DiscoveryConnectionResponse
            ]
      where
        loadConnection :: a -> (DiscoveryConnection -> b) -> LoadRec b
loadConnection a
ctype DiscoveryConnection -> b
ctor = do
            a
ctype' <- String -> LoadRec a
forall a. StorableText a => String -> LoadRec a
loadText String
"connection"
            Bool -> LoadRec ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> LoadRec ()) -> Bool -> LoadRec ()
forall a b. (a -> b) -> a -> b
$ a
ctype a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
ctype'
            Ref
dconnSource <- String -> LoadRec Ref
loadRawRef String
"source"
            Ref
dconnTarget <- String -> LoadRec Ref
loadRawRef String
"target"
            Maybe Text
dconnAddress <- String -> LoadRec (Maybe Text)
forall a. StorableText a => String -> LoadRec (Maybe a)
loadMbText String
"address"
            Maybe IceRemoteInfo
dconnIceInfo <- String -> LoadRec (Maybe IceRemoteInfo)
forall a. Storable a => String -> LoadRec (Maybe a)
loadMbRef String
"ice-info"
            b -> LoadRec b
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> LoadRec b) -> b -> LoadRec b
forall a b. (a -> b) -> a -> b
$ DiscoveryConnection -> b
ctor DiscoveryConnection {Maybe Text
Maybe IceRemoteInfo
Ref
dconnSource :: Ref
dconnTarget :: Ref
dconnAddress :: Maybe Text
dconnIceInfo :: Maybe IceRemoteInfo
dconnSource :: Ref
dconnTarget :: Ref
dconnAddress :: Maybe Text
dconnIceInfo :: Maybe IceRemoteInfo
..}

data DiscoveryPeer = DiscoveryPeer
    { DiscoveryPeer -> Int
dpPriority :: Int
    , DiscoveryPeer -> Maybe Peer
dpPeer :: Maybe Peer
    , DiscoveryPeer -> [Text]
dpAddress :: [ Text ]
    , DiscoveryPeer -> Maybe ()
dpIceSession :: Maybe IceSession
    }

emptyPeer :: DiscoveryPeer
emptyPeer :: DiscoveryPeer
emptyPeer = DiscoveryPeer
    { dpPriority :: Int
dpPriority = Int
0
    , dpPeer :: Maybe Peer
dpPeer = Maybe Peer
forall a. Maybe a
Nothing
    , dpAddress :: [Text]
dpAddress = []
    , dpIceSession :: Maybe ()
dpIceSession = Maybe ()
forall a. Maybe a
Nothing
    }

data DiscoveryPeerState = DiscoveryPeerState
    { DiscoveryPeerState -> Maybe (Text, Word16)
dpsStunServer :: Maybe ( Text, Word16 )
    , DiscoveryPeerState -> Maybe (Text, Word16)
dpsTurnServer :: Maybe ( Text, Word16 )
    , DiscoveryPeerState -> Maybe ()
dpsIceConfig :: Maybe IceConfig
    }

data DiscoveryGlobalState = DiscoveryGlobalState
    { DiscoveryGlobalState -> Map RefDigest DiscoveryPeer
dgsPeers :: Map RefDigest DiscoveryPeer
    , DiscoveryGlobalState -> Set RefDigest
dgsSearchingFor :: Set RefDigest
    }

instance Service DiscoveryService where
    serviceID :: forall (proxy :: * -> *). proxy DiscoveryService -> ServiceID
serviceID proxy DiscoveryService
_ = String -> ServiceID
mkServiceID String
"dd59c89c-69cc-4703-b75b-4ddcd4b3c23c"

    type ServiceAttributes DiscoveryService = DiscoveryAttributes
    defaultServiceAttributes :: forall (proxy :: * -> *).
proxy DiscoveryService -> ServiceAttributes DiscoveryService
defaultServiceAttributes proxy DiscoveryService
_ = ServiceAttributes DiscoveryService
DiscoveryAttributes
defaultDiscoveryAttributes

    type ServiceState DiscoveryService = DiscoveryPeerState
    emptyServiceState :: forall (proxy :: * -> *).
proxy DiscoveryService -> ServiceState DiscoveryService
emptyServiceState proxy DiscoveryService
_ = DiscoveryPeerState
        { dpsStunServer :: Maybe (Text, Word16)
dpsStunServer = Maybe (Text, Word16)
forall a. Maybe a
Nothing
        , dpsTurnServer :: Maybe (Text, Word16)
dpsTurnServer = Maybe (Text, Word16)
forall a. Maybe a
Nothing
        , dpsIceConfig :: Maybe ()
dpsIceConfig = Maybe ()
forall a. Maybe a
Nothing
        }

    type ServiceGlobalState DiscoveryService = DiscoveryGlobalState
    emptyServiceGlobalState :: forall (proxy :: * -> *).
proxy DiscoveryService -> ServiceGlobalState DiscoveryService
emptyServiceGlobalState proxy DiscoveryService
_ = DiscoveryGlobalState
        { dgsPeers :: Map RefDigest DiscoveryPeer
dgsPeers = Map RefDigest DiscoveryPeer
forall k a. Map k a
M.empty
        , dgsSearchingFor :: Set RefDigest
dgsSearchingFor = Set RefDigest
forall a. Set a
S.empty
        }

    serviceHandler :: Stored DiscoveryService -> ServiceHandler DiscoveryService ()
serviceHandler Stored DiscoveryService
msg = case Stored DiscoveryService -> DiscoveryService
forall a. Stored a -> a
fromStored Stored DiscoveryService
msg of
        DiscoverySelf [Text]
addrs Maybe Int
priority -> do
            UnifiedIdentity
pid <- (ServiceInput DiscoveryService -> UnifiedIdentity)
-> ServiceHandler DiscoveryService UnifiedIdentity
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ServiceInput DiscoveryService -> UnifiedIdentity
forall s. ServiceInput s -> UnifiedIdentity
svcPeerIdentity
            Peer
peer <- (ServiceInput DiscoveryService -> Peer)
-> ServiceHandler DiscoveryService Peer
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ServiceInput DiscoveryService -> Peer
forall s. ServiceInput s -> Peer
svcPeer
            let insertHelper :: DiscoveryPeer -> DiscoveryPeer -> DiscoveryPeer
insertHelper DiscoveryPeer
new DiscoveryPeer
old | DiscoveryPeer -> Int
dpPriority DiscoveryPeer
new Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> DiscoveryPeer -> Int
dpPriority DiscoveryPeer
old = DiscoveryPeer
new
                                     | Bool
otherwise                       = DiscoveryPeer
old
            [Text]
matchedAddrs <- ([Maybe Text] -> [Text])
-> ServiceHandler DiscoveryService [Maybe Text]
-> ServiceHandler DiscoveryService [Text]
forall a b.
(a -> b)
-> ServiceHandler DiscoveryService a
-> ServiceHandler DiscoveryService b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes (ServiceHandler DiscoveryService [Maybe Text]
 -> ServiceHandler DiscoveryService [Text])
-> ServiceHandler DiscoveryService [Maybe Text]
-> ServiceHandler DiscoveryService [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
-> (Text -> ServiceHandler DiscoveryService (Maybe Text))
-> ServiceHandler DiscoveryService [Maybe Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Text]
addrs ((Text -> ServiceHandler DiscoveryService (Maybe Text))
 -> ServiceHandler DiscoveryService [Maybe Text])
-> (Text -> ServiceHandler DiscoveryService (Maybe Text))
-> ServiceHandler DiscoveryService [Maybe Text]
forall a b. (a -> b) -> a -> b
$ \Text
addr -> if
                | Text
addr Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"ICE" -> do
                    Maybe Text -> ServiceHandler DiscoveryService (Maybe Text)
forall a. a -> ServiceHandler DiscoveryService a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ServiceHandler DiscoveryService (Maybe Text))
-> Maybe Text -> ServiceHandler DiscoveryService (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
addr

                | [ String
ipaddr, String
port ] <- String -> [String]
words (Text -> String
T.unpack Text
addr)
                , DatagramAddress SockAddr
paddr <- Peer -> PeerAddress
peerAddress Peer
peer -> do
                    AddrInfo
saddr <- IO AddrInfo -> ServiceHandler DiscoveryService AddrInfo
forall a. IO a -> ServiceHandler DiscoveryService a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AddrInfo -> ServiceHandler DiscoveryService AddrInfo)
-> IO AddrInfo -> ServiceHandler DiscoveryService AddrInfo
forall a b. (a -> b) -> a -> b
$ [AddrInfo] -> AddrInfo
forall a. HasCallStack => [a] -> a
head ([AddrInfo] -> AddrInfo) -> IO [AddrInfo] -> IO AddrInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
forall (t :: * -> *).
GetAddrInfo t =>
Maybe AddrInfo -> Maybe String -> Maybe String -> IO (t AddrInfo)
getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just (AddrInfo -> Maybe AddrInfo) -> AddrInfo -> Maybe AddrInfo
forall a b. (a -> b) -> a -> b
$ AddrInfo
defaultHints { addrSocketType = Datagram }) (String -> Maybe String
forall a. a -> Maybe a
Just String
ipaddr) (String -> Maybe String
forall a. a -> Maybe a
Just String
port)
                    Maybe Text -> ServiceHandler DiscoveryService (Maybe Text)
forall a. a -> ServiceHandler DiscoveryService a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ServiceHandler DiscoveryService (Maybe Text))
-> Maybe Text -> ServiceHandler DiscoveryService (Maybe Text)
forall a b. (a -> b) -> a -> b
$ if SockAddr
paddr SockAddr -> SockAddr -> Bool
forall a. Eq a => a -> a -> Bool
== AddrInfo -> SockAddr
addrAddress AddrInfo
saddr
                                then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
addr
                                else Maybe Text
forall a. Maybe a
Nothing

                | Bool
otherwise -> Maybe Text -> ServiceHandler DiscoveryService (Maybe Text)
forall a. a -> ServiceHandler DiscoveryService a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing

            [Stored (Signed IdentityData)]
-> (Stored (Signed IdentityData)
    -> ServiceHandler DiscoveryService ())
-> ServiceHandler DiscoveryService ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Identity [] -> [Stored (Signed IdentityData)]
forall (m :: * -> *).
Identity m -> m (Stored (Signed IdentityData))
idDataF (Identity [] -> [Stored (Signed IdentityData)])
-> [Identity []] -> [Stored (Signed IdentityData)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UnifiedIdentity -> [Identity []]
forall (m :: * -> *). Foldable m => Identity m -> [Identity []]
unfoldOwners UnifiedIdentity
pid) ((Stored (Signed IdentityData)
  -> ServiceHandler DiscoveryService ())
 -> ServiceHandler DiscoveryService ())
-> (Stored (Signed IdentityData)
    -> ServiceHandler DiscoveryService ())
-> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ \Stored (Signed IdentityData)
sdata -> do
                let dp :: DiscoveryPeer
dp = DiscoveryPeer
                        { dpPriority :: Int
dpPriority = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
priority
                        , dpPeer :: Maybe Peer
dpPeer = Peer -> Maybe Peer
forall a. a -> Maybe a
Just Peer
peer
                        , dpAddress :: [Text]
dpAddress = [Text]
addrs
                        , dpIceSession :: Maybe ()
dpIceSession = Maybe ()
forall a. Maybe a
Nothing
                        }
                (ServiceGlobalState DiscoveryService
 -> ServiceGlobalState DiscoveryService)
-> ServiceHandler DiscoveryService ()
forall s.
(ServiceGlobalState s -> ServiceGlobalState s)
-> ServiceHandler s ()
svcModifyGlobal ((ServiceGlobalState DiscoveryService
  -> ServiceGlobalState DiscoveryService)
 -> ServiceHandler DiscoveryService ())
-> (ServiceGlobalState DiscoveryService
    -> ServiceGlobalState DiscoveryService)
-> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ \ServiceGlobalState DiscoveryService
s -> ServiceGlobalState DiscoveryService
s { dgsPeers = M.insertWith insertHelper (refDigest $ storedRef sdata) dp $ dgsPeers s }
            DiscoveryAttributes
attrs <- (ServiceInput DiscoveryService -> DiscoveryAttributes)
-> ServiceHandler DiscoveryService DiscoveryAttributes
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ServiceInput DiscoveryService -> ServiceAttributes DiscoveryService
ServiceInput DiscoveryService -> DiscoveryAttributes
forall s. ServiceInput s -> ServiceAttributes s
svcAttributes
            DiscoveryService -> ServiceHandler DiscoveryService ()
forall s. Service s => s -> ServiceHandler s ()
replyPacket (DiscoveryService -> ServiceHandler DiscoveryService ())
-> DiscoveryService -> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ [Text]
-> Maybe Text
-> Maybe Word16
-> Maybe Text
-> Maybe Word16
-> DiscoveryService
DiscoveryAcknowledged [Text]
matchedAddrs
                (DiscoveryAttributes -> Maybe Text
discoveryStunServer DiscoveryAttributes
attrs)
                (DiscoveryAttributes -> Maybe Word16
discoveryStunPort DiscoveryAttributes
attrs)
                (DiscoveryAttributes -> Maybe Text
discoveryTurnServer DiscoveryAttributes
attrs)
                (DiscoveryAttributes -> Maybe Word16
discoveryTurnPort DiscoveryAttributes
attrs)

        DiscoveryAcknowledged [Text]
_ Maybe Text
stunServer Maybe Word16
stunPort Maybe Text
turnServer Maybe Word16
turnPort -> do
            Maybe Text
paddr <- (ServiceInput DiscoveryService -> PeerAddress)
-> ServiceHandler DiscoveryService PeerAddress
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Peer -> PeerAddress
peerAddress (Peer -> PeerAddress)
-> (ServiceInput DiscoveryService -> Peer)
-> ServiceInput DiscoveryService
-> PeerAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceInput DiscoveryService -> Peer
forall s. ServiceInput s -> Peer
svcPeer) ServiceHandler DiscoveryService PeerAddress
-> (PeerAddress -> ServiceHandler DiscoveryService (Maybe Text))
-> ServiceHandler DiscoveryService (Maybe Text)
forall a b.
ServiceHandler DiscoveryService a
-> (a -> ServiceHandler DiscoveryService b)
-> ServiceHandler DiscoveryService b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Text -> ServiceHandler DiscoveryService (Maybe Text)
forall a. a -> ServiceHandler DiscoveryService a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ServiceHandler DiscoveryService (Maybe Text))
-> (PeerAddress -> Maybe Text)
-> PeerAddress
-> ServiceHandler DiscoveryService (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
                (DatagramAddress SockAddr
saddr) -> case SockAddr -> Maybe (IP, PortNumber)
IP.fromSockAddr SockAddr
saddr of
                    Just (IP.IPv6 IPv6
ipv6, PortNumber
_)
                        | (Word32
0, Word32
0, Word32
0xffff, Word32
ipv4) <- IPv6 -> (Word32, Word32, Word32, Word32)
IP.fromIPv6w IPv6
ipv6
                        -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ IPv4 -> String
forall a. Show a => a -> String
show (Word32 -> IPv4
IP.toIPv4w Word32
ipv4)
                    Just (IP
addr, PortNumber
_)
                        -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ IP -> String
forall a. Show a => a -> String
show IP
addr
                    Maybe (IP, PortNumber)
_ -> Maybe Text
forall a. Maybe a
Nothing
                PeerAddress
_ -> Maybe Text
forall a. Maybe a
Nothing

            let toIceServer :: Maybe Text -> Maybe Word16 -> Maybe (Text, Word16)
toIceServer Maybe Text
Nothing Maybe Word16
Nothing = Maybe (Text, Word16)
forall a. Maybe a
Nothing
                toIceServer Maybe Text
Nothing (Just Word16
port) = ( , Word16
port) (Text -> (Text, Word16)) -> Maybe Text -> Maybe (Text, Word16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
paddr
                toIceServer (Just Text
server) Maybe Word16
Nothing = (Text, Word16) -> Maybe (Text, Word16)
forall a. a -> Maybe a
Just ( Text
server, Word16
0 )
                toIceServer (Just Text
server) (Just Word16
port) = (Text, Word16) -> Maybe (Text, Word16)
forall a. a -> Maybe a
Just ( Text
server, Word16
port )

            (ServiceState DiscoveryService -> ServiceState DiscoveryService)
-> ServiceHandler DiscoveryService ()
forall s. (ServiceState s -> ServiceState s) -> ServiceHandler s ()
svcModify ((ServiceState DiscoveryService -> ServiceState DiscoveryService)
 -> ServiceHandler DiscoveryService ())
-> (ServiceState DiscoveryService -> ServiceState DiscoveryService)
-> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ \ServiceState DiscoveryService
s -> ServiceState DiscoveryService
s
                { dpsStunServer = toIceServer stunServer stunPort
                , dpsTurnServer = toIceServer turnServer turnPort
                }

        DiscoverySearch Ref
ref -> do
            Maybe DiscoveryPeer
dpeer <- RefDigest -> Map RefDigest DiscoveryPeer -> Maybe DiscoveryPeer
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Ref -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest Ref
ref) (Map RefDigest DiscoveryPeer -> Maybe DiscoveryPeer)
-> (DiscoveryGlobalState -> Map RefDigest DiscoveryPeer)
-> DiscoveryGlobalState
-> Maybe DiscoveryPeer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiscoveryGlobalState -> Map RefDigest DiscoveryPeer
dgsPeers (DiscoveryGlobalState -> Maybe DiscoveryPeer)
-> ServiceHandler DiscoveryService DiscoveryGlobalState
-> ServiceHandler DiscoveryService (Maybe DiscoveryPeer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceHandler
  DiscoveryService (ServiceGlobalState DiscoveryService)
ServiceHandler DiscoveryService DiscoveryGlobalState
forall s. ServiceHandler s (ServiceGlobalState s)
svcGetGlobal
            DiscoveryService -> ServiceHandler DiscoveryService ()
forall s. Service s => s -> ServiceHandler s ()
replyPacket (DiscoveryService -> ServiceHandler DiscoveryService ())
-> DiscoveryService -> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ Ref -> [Text] -> DiscoveryService
DiscoveryResult Ref
ref ([Text] -> DiscoveryService) -> [Text] -> DiscoveryService
forall a b. (a -> b) -> a -> b
$ [Text]
-> (DiscoveryPeer -> [Text]) -> Maybe DiscoveryPeer -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] DiscoveryPeer -> [Text]
dpAddress Maybe DiscoveryPeer
dpeer

        DiscoveryResult Ref
_ [] -> do
            -- not found
            () -> ServiceHandler DiscoveryService ()
forall a. a -> ServiceHandler DiscoveryService a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        DiscoveryResult Ref
ref [Text]
addrs -> do
            let dgst :: RefDigest
dgst = Ref -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest Ref
ref
            -- TODO: check if we really requested that
            Server
server <- (ServiceInput DiscoveryService -> Server)
-> ServiceHandler DiscoveryService Server
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ServiceInput DiscoveryService -> Server
forall s. ServiceInput s -> Server
svcServer
            UnifiedIdentity
self <- ServiceHandler DiscoveryService UnifiedIdentity
forall s. ServiceHandler s UnifiedIdentity
svcSelf
            Peer
discoveryPeer <- (ServiceInput DiscoveryService -> Peer)
-> ServiceHandler DiscoveryService Peer
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ServiceInput DiscoveryService -> Peer
forall s. ServiceInput s -> Peer
svcPeer
            let runAsService :: ServiceHandler DiscoveryService () -> IO ()
runAsService = forall s (m :: * -> *).
(Service s, MonadIO m) =>
Peer -> ServiceHandler s () -> m ()
runPeerService @DiscoveryService Peer
discoveryPeer

            [Text]
-> (Text -> ServiceHandler DiscoveryService ())
-> ServiceHandler DiscoveryService ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
addrs ((Text -> ServiceHandler DiscoveryService ())
 -> ServiceHandler DiscoveryService ())
-> (Text -> ServiceHandler DiscoveryService ())
-> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ \Text
addr -> if
                | Text
addr Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"ICE"
                -> do
#ifdef ENABLE_ICE_SUPPORT
                    getIceConfig >>= \case
                        Just config -> void $ liftIO $ forkIO $ do
                            ice <- iceCreateSession config PjIceSessRoleControlling $ \ice -> do
                                rinfo <- iceRemoteInfo ice

                                res <- runExceptT $ sendToPeer discoveryPeer $
                                    DiscoveryConnectionRequest (emptyConnection (storedRef $ idData self) ref) { dconnIceInfo = Just rinfo }
                                case res of
                                    Right _ -> return ()
                                    Left err -> putStrLn $ "Discovery: failed to send connection request: " ++ err

                            runAsService $ do
                                let upd dp = dp { dpIceSession = Just ice }
                                svcModifyGlobal $ \s -> s { dgsPeers = M.alter (Just . upd . fromMaybe emptyPeer) dgst $ dgsPeers s }

                        Nothing -> do
                            return ()
#endif
                    () -> ServiceHandler DiscoveryService ()
forall a. a -> ServiceHandler DiscoveryService a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

                | [ String
ipaddr, String
port ] <- String -> [String]
words (Text -> String
T.unpack Text
addr) -> do
                    ServiceHandler DiscoveryService ThreadId
-> ServiceHandler DiscoveryService ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ServiceHandler DiscoveryService ThreadId
 -> ServiceHandler DiscoveryService ())
-> ServiceHandler DiscoveryService ThreadId
-> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ IO ThreadId -> ServiceHandler DiscoveryService ThreadId
forall a. IO a -> ServiceHandler DiscoveryService a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> ServiceHandler DiscoveryService ThreadId)
-> IO ThreadId -> ServiceHandler DiscoveryService ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
                        AddrInfo
saddr <- [AddrInfo] -> AddrInfo
forall a. HasCallStack => [a] -> a
head ([AddrInfo] -> AddrInfo) -> IO [AddrInfo] -> IO AddrInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                            Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
forall (t :: * -> *).
GetAddrInfo t =>
Maybe AddrInfo -> Maybe String -> Maybe String -> IO (t AddrInfo)
getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just (AddrInfo -> Maybe AddrInfo) -> AddrInfo -> Maybe AddrInfo
forall a b. (a -> b) -> a -> b
$ AddrInfo
defaultHints { addrSocketType = Datagram }) (String -> Maybe String
forall a. a -> Maybe a
Just String
ipaddr) (String -> Maybe String
forall a. a -> Maybe a
Just String
port)
                        Peer
peer <- Server -> SockAddr -> IO Peer
serverPeer Server
server (AddrInfo -> SockAddr
addrAddress AddrInfo
saddr)
                        ServiceHandler DiscoveryService () -> IO ()
runAsService (ServiceHandler DiscoveryService () -> IO ())
-> ServiceHandler DiscoveryService () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                            let upd :: DiscoveryPeer -> DiscoveryPeer
upd DiscoveryPeer
dp = DiscoveryPeer
dp { dpPeer = Just peer }
                            (ServiceGlobalState DiscoveryService
 -> ServiceGlobalState DiscoveryService)
-> ServiceHandler DiscoveryService ()
forall s.
(ServiceGlobalState s -> ServiceGlobalState s)
-> ServiceHandler s ()
svcModifyGlobal ((ServiceGlobalState DiscoveryService
  -> ServiceGlobalState DiscoveryService)
 -> ServiceHandler DiscoveryService ())
-> (ServiceGlobalState DiscoveryService
    -> ServiceGlobalState DiscoveryService)
-> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ \ServiceGlobalState DiscoveryService
s -> ServiceGlobalState DiscoveryService
s { dgsPeers = M.alter (Just . upd . fromMaybe emptyPeer) dgst $ dgsPeers s }

                | Bool
otherwise -> do
                    String -> ServiceHandler DiscoveryService ()
forall s. String -> ServiceHandler s ()
svcPrint (String -> ServiceHandler DiscoveryService ())
-> String -> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ String
"Discovery: invalid address in result: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
addr

        DiscoveryConnectionRequest DiscoveryConnection
conn -> do
            UnifiedIdentity
self <- ServiceHandler DiscoveryService UnifiedIdentity
forall s. ServiceHandler s UnifiedIdentity
svcSelf
            let rconn :: DiscoveryConnection
rconn = Ref -> Ref -> DiscoveryConnection
emptyConnection (DiscoveryConnection -> Ref
dconnSource DiscoveryConnection
conn) (DiscoveryConnection -> Ref
dconnTarget DiscoveryConnection
conn)
            if Ref -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest (DiscoveryConnection -> Ref
dconnTarget DiscoveryConnection
conn) RefDigest -> [RefDigest] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` UnifiedIdentity -> [RefDigest]
forall (f :: * -> *). Foldable f => Identity f -> [RefDigest]
identityDigests UnifiedIdentity
self
              then if
#ifdef ENABLE_ICE_SUPPORT
                -- request for us, create ICE sesssion
                | Just prinfo <- dconnIceInfo conn -> do
                    server <- asks svcServer
                    peer <- asks svcPeer
                    getIceConfig >>= \case
                        Just config -> do
                            liftIO $ void $ iceCreateSession config PjIceSessRoleControlled $ \ice -> do
                                rinfo <- iceRemoteInfo ice
                                res <- runExceptT $ sendToPeer peer $ DiscoveryConnectionResponse rconn { dconnIceInfo = Just rinfo }
                                case res of
                                    Right _ -> iceConnect ice prinfo $ void $ serverPeerIce server ice
                                    Left err -> putStrLn $ "Discovery: failed to send connection response: " ++ err
                        Nothing -> do
                            return ()
#endif

                | Bool
otherwise -> do
                    String -> ServiceHandler DiscoveryService ()
forall s. String -> ServiceHandler s ()
svcPrint (String -> ServiceHandler DiscoveryService ())
-> String -> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ String
"Discovery: unsupported connection request"

              else do
                    -- request to some of our peers, relay
                    Maybe DiscoveryPeer
mbdp <- RefDigest -> Map RefDigest DiscoveryPeer -> Maybe DiscoveryPeer
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Ref -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest (Ref -> RefDigest) -> Ref -> RefDigest
forall a b. (a -> b) -> a -> b
$ DiscoveryConnection -> Ref
dconnTarget DiscoveryConnection
conn) (Map RefDigest DiscoveryPeer -> Maybe DiscoveryPeer)
-> (DiscoveryGlobalState -> Map RefDigest DiscoveryPeer)
-> DiscoveryGlobalState
-> Maybe DiscoveryPeer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiscoveryGlobalState -> Map RefDigest DiscoveryPeer
dgsPeers (DiscoveryGlobalState -> Maybe DiscoveryPeer)
-> ServiceHandler DiscoveryService DiscoveryGlobalState
-> ServiceHandler DiscoveryService (Maybe DiscoveryPeer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceHandler
  DiscoveryService (ServiceGlobalState DiscoveryService)
ServiceHandler DiscoveryService DiscoveryGlobalState
forall s. ServiceHandler s (ServiceGlobalState s)
svcGetGlobal
                    case Maybe DiscoveryPeer
mbdp of
                        Maybe DiscoveryPeer
Nothing -> DiscoveryService -> ServiceHandler DiscoveryService ()
forall s. Service s => s -> ServiceHandler s ()
replyPacket (DiscoveryService -> ServiceHandler DiscoveryService ())
-> DiscoveryService -> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ DiscoveryConnection -> DiscoveryService
DiscoveryConnectionResponse DiscoveryConnection
rconn
                        Just DiscoveryPeer
dp
                            | Just Peer
dpeer <- DiscoveryPeer -> Maybe Peer
dpPeer DiscoveryPeer
dp -> do
                                Peer -> DiscoveryService -> ServiceHandler DiscoveryService ()
forall s (m :: * -> *). (Service s, MonadIO m) => Peer -> s -> m ()
sendToPeer Peer
dpeer (DiscoveryService -> ServiceHandler DiscoveryService ())
-> DiscoveryService -> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ DiscoveryConnection -> DiscoveryService
DiscoveryConnectionRequest DiscoveryConnection
conn
                            | Bool
otherwise -> String -> ServiceHandler DiscoveryService ()
forall s. String -> ServiceHandler s ()
svcPrint (String -> ServiceHandler DiscoveryService ())
-> String -> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ String
"Discovery: failed to relay connection request"

        DiscoveryConnectionResponse DiscoveryConnection
conn -> do
            UnifiedIdentity
self <- ServiceHandler DiscoveryService UnifiedIdentity
forall s. ServiceHandler s UnifiedIdentity
svcSelf
            Map RefDigest DiscoveryPeer
dpeers <- DiscoveryGlobalState -> Map RefDigest DiscoveryPeer
dgsPeers (DiscoveryGlobalState -> Map RefDigest DiscoveryPeer)
-> ServiceHandler DiscoveryService DiscoveryGlobalState
-> ServiceHandler DiscoveryService (Map RefDigest DiscoveryPeer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceHandler
  DiscoveryService (ServiceGlobalState DiscoveryService)
ServiceHandler DiscoveryService DiscoveryGlobalState
forall s. ServiceHandler s (ServiceGlobalState s)
svcGetGlobal
            if Ref -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest (DiscoveryConnection -> Ref
dconnSource DiscoveryConnection
conn) RefDigest -> [RefDigest] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` UnifiedIdentity -> [RefDigest]
forall (f :: * -> *). Foldable f => Identity f -> [RefDigest]
identityDigests UnifiedIdentity
self
               then do
                    -- response to our request, try to connect to the peer
                    Server
server <- (ServiceInput DiscoveryService -> Server)
-> ServiceHandler DiscoveryService Server
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ServiceInput DiscoveryService -> Server
forall s. ServiceInput s -> Server
svcServer
                    if  | Just Text
addr <- DiscoveryConnection -> Maybe Text
dconnAddress DiscoveryConnection
conn
                        , [String
ipaddr, String
port] <- String -> [String]
words (Text -> String
T.unpack Text
addr) -> do
                            AddrInfo
saddr <- IO AddrInfo -> ServiceHandler DiscoveryService AddrInfo
forall a. IO a -> ServiceHandler DiscoveryService a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AddrInfo -> ServiceHandler DiscoveryService AddrInfo)
-> IO AddrInfo -> ServiceHandler DiscoveryService AddrInfo
forall a b. (a -> b) -> a -> b
$ [AddrInfo] -> AddrInfo
forall a. HasCallStack => [a] -> a
head ([AddrInfo] -> AddrInfo) -> IO [AddrInfo] -> IO AddrInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
forall (t :: * -> *).
GetAddrInfo t =>
Maybe AddrInfo -> Maybe String -> Maybe String -> IO (t AddrInfo)
getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just (AddrInfo -> Maybe AddrInfo) -> AddrInfo -> Maybe AddrInfo
forall a b. (a -> b) -> a -> b
$ AddrInfo
defaultHints { addrSocketType = Datagram }) (String -> Maybe String
forall a. a -> Maybe a
Just String
ipaddr) (String -> Maybe String
forall a. a -> Maybe a
Just String
port)
                            Peer
peer <- IO Peer -> ServiceHandler DiscoveryService Peer
forall a. IO a -> ServiceHandler DiscoveryService a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Peer -> ServiceHandler DiscoveryService Peer)
-> IO Peer -> ServiceHandler DiscoveryService Peer
forall a b. (a -> b) -> a -> b
$ Server -> SockAddr -> IO Peer
serverPeer Server
server (AddrInfo -> SockAddr
addrAddress AddrInfo
saddr)
                            let upd :: DiscoveryPeer -> DiscoveryPeer
upd DiscoveryPeer
dp = DiscoveryPeer
dp { dpPeer = Just peer }
                            (ServiceGlobalState DiscoveryService
 -> ServiceGlobalState DiscoveryService)
-> ServiceHandler DiscoveryService ()
forall s.
(ServiceGlobalState s -> ServiceGlobalState s)
-> ServiceHandler s ()
svcModifyGlobal ((ServiceGlobalState DiscoveryService
  -> ServiceGlobalState DiscoveryService)
 -> ServiceHandler DiscoveryService ())
-> (ServiceGlobalState DiscoveryService
    -> ServiceGlobalState DiscoveryService)
-> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ \ServiceGlobalState DiscoveryService
s -> ServiceGlobalState DiscoveryService
s
                                { dgsPeers = M.alter (Just . upd . fromMaybe emptyPeer) (refDigest $ dconnTarget conn) $ dgsPeers s }

#ifdef ENABLE_ICE_SUPPORT
                        | Just dp <- M.lookup (refDigest $ dconnTarget conn) dpeers
                        , Just ice <- dpIceSession dp
                        , Just rinfo <- dconnIceInfo conn -> do
                            liftIO $ iceConnect ice rinfo $ void $ serverPeerIce server ice
#endif

                        | Bool
otherwise -> String -> ServiceHandler DiscoveryService ()
forall s. String -> ServiceHandler s ()
svcPrint (String -> ServiceHandler DiscoveryService ())
-> String -> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ String
"Discovery: connection request failed"
               else do
                    -- response to relayed request
                    case RefDigest -> Map RefDigest DiscoveryPeer -> Maybe DiscoveryPeer
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Ref -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest (Ref -> RefDigest) -> Ref -> RefDigest
forall a b. (a -> b) -> a -> b
$ DiscoveryConnection -> Ref
dconnSource DiscoveryConnection
conn) Map RefDigest DiscoveryPeer
dpeers of
                        Just DiscoveryPeer
dp | Just Peer
dpeer <- DiscoveryPeer -> Maybe Peer
dpPeer DiscoveryPeer
dp -> do
                            Peer -> DiscoveryService -> ServiceHandler DiscoveryService ()
forall s (m :: * -> *). (Service s, MonadIO m) => Peer -> s -> m ()
sendToPeer Peer
dpeer (DiscoveryService -> ServiceHandler DiscoveryService ())
-> DiscoveryService -> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ DiscoveryConnection -> DiscoveryService
DiscoveryConnectionResponse DiscoveryConnection
conn
                        Maybe DiscoveryPeer
_ -> String -> ServiceHandler DiscoveryService ()
forall s. String -> ServiceHandler s ()
svcPrint (String -> ServiceHandler DiscoveryService ())
-> String -> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ String
"Discovery: failed to relay connection response"

    serviceNewPeer :: ServiceHandler DiscoveryService ()
serviceNewPeer = do
        Server
server <- (ServiceInput DiscoveryService -> Server)
-> ServiceHandler DiscoveryService Server
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ServiceInput DiscoveryService -> Server
forall s. ServiceInput s -> Server
svcServer
        Peer
peer <- (ServiceInput DiscoveryService -> Peer)
-> ServiceHandler DiscoveryService Peer
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ServiceInput DiscoveryService -> Peer
forall s. ServiceInput s -> Peer
svcPeer
        Storage
st <- ServiceHandler DiscoveryService Storage
forall (m :: * -> *). MonadStorage m => m Storage
getStorage

        let addrToText :: SockAddr -> Maybe Text
addrToText SockAddr
saddr = do
                ( IP
addr, PortNumber
port ) <- SockAddr -> Maybe (IP, PortNumber)
IP.fromSockAddr SockAddr
saddr
                Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ IP -> String
forall a. Show a => a -> String
show IP
addr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> PortNumber -> String
forall a. Show a => a -> String
show PortNumber
port
        [Text]
addrs <- [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text])
-> ServiceHandler DiscoveryService [[Text]]
-> ServiceHandler DiscoveryService [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ServiceHandler DiscoveryService [Text]]
-> ServiceHandler DiscoveryService [[Text]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
            [ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Text] -> [Text])
-> ([SockAddr] -> [Maybe Text]) -> [SockAddr] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SockAddr -> Maybe Text) -> [SockAddr] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map SockAddr -> Maybe Text
addrToText ([SockAddr] -> [Text])
-> ServiceHandler DiscoveryService [SockAddr]
-> ServiceHandler DiscoveryService [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [SockAddr] -> ServiceHandler DiscoveryService [SockAddr]
forall a. IO a -> ServiceHandler DiscoveryService a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Server -> IO [SockAddr]
getServerAddresses Server
server)
#ifdef ENABLE_ICE_SUPPORT
            , return [ T.pack "ICE" ]
#endif
            ]

        UnifiedIdentity
pid <- (ServiceInput DiscoveryService -> UnifiedIdentity)
-> ServiceHandler DiscoveryService UnifiedIdentity
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ServiceInput DiscoveryService -> UnifiedIdentity
forall s. ServiceInput s -> UnifiedIdentity
svcPeerIdentity
        DiscoveryGlobalState
gs <- ServiceHandler
  DiscoveryService (ServiceGlobalState DiscoveryService)
ServiceHandler DiscoveryService DiscoveryGlobalState
forall s. ServiceHandler s (ServiceGlobalState s)
svcGetGlobal
        let searchingFor :: Set RefDigest
searchingFor = (Set RefDigest -> RefDigest -> Set RefDigest)
-> Set RefDigest -> [RefDigest] -> Set RefDigest
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((RefDigest -> Set RefDigest -> Set RefDigest)
-> Set RefDigest -> RefDigest -> Set RefDigest
forall a b c. (a -> b -> c) -> b -> a -> c
flip RefDigest -> Set RefDigest -> Set RefDigest
forall a. Ord a => a -> Set a -> Set a
S.delete) (DiscoveryGlobalState -> Set RefDigest
dgsSearchingFor DiscoveryGlobalState
gs) (UnifiedIdentity -> [RefDigest]
forall (f :: * -> *). Foldable f => Identity f -> [RefDigest]
identityDigests UnifiedIdentity
pid)
        (ServiceGlobalState DiscoveryService
 -> ServiceGlobalState DiscoveryService)
-> ServiceHandler DiscoveryService ()
forall s.
(ServiceGlobalState s -> ServiceGlobalState s)
-> ServiceHandler s ()
svcModifyGlobal ((ServiceGlobalState DiscoveryService
  -> ServiceGlobalState DiscoveryService)
 -> ServiceHandler DiscoveryService ())
-> (ServiceGlobalState DiscoveryService
    -> ServiceGlobalState DiscoveryService)
-> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ \ServiceGlobalState DiscoveryService
s -> ServiceGlobalState DiscoveryService
s { dgsSearchingFor = searchingFor }

        Bool
-> ServiceHandler DiscoveryService ()
-> ServiceHandler DiscoveryService ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
addrs) (ServiceHandler DiscoveryService ()
 -> ServiceHandler DiscoveryService ())
-> ServiceHandler DiscoveryService ()
-> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ do
            Peer -> DiscoveryService -> ServiceHandler DiscoveryService ()
forall s (m :: * -> *). (Service s, MonadIO m) => Peer -> s -> m ()
sendToPeer Peer
peer (DiscoveryService -> ServiceHandler DiscoveryService ())
-> DiscoveryService -> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe Int -> DiscoveryService
DiscoverySelf [Text]
addrs Maybe Int
forall a. Maybe a
Nothing
        Set RefDigest
-> (RefDigest -> ServiceHandler DiscoveryService ())
-> ServiceHandler DiscoveryService ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set RefDigest
searchingFor ((RefDigest -> ServiceHandler DiscoveryService ())
 -> ServiceHandler DiscoveryService ())
-> (RefDigest -> ServiceHandler DiscoveryService ())
-> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ \RefDigest
dgst -> do
            IO (Maybe Ref) -> ServiceHandler DiscoveryService (Maybe Ref)
forall a. IO a -> ServiceHandler DiscoveryService a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Storage -> RefDigest -> IO (Maybe Ref)
forall (c :: * -> *).
Storage' c -> RefDigest -> IO (Maybe (Ref' c))
refFromDigest Storage
st RefDigest
dgst) ServiceHandler DiscoveryService (Maybe Ref)
-> (Maybe Ref -> ServiceHandler DiscoveryService ())
-> ServiceHandler DiscoveryService ()
forall a b.
ServiceHandler DiscoveryService a
-> (a -> ServiceHandler DiscoveryService b)
-> ServiceHandler DiscoveryService b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just Ref
ref -> Peer -> DiscoveryService -> ServiceHandler DiscoveryService ()
forall s (m :: * -> *). (Service s, MonadIO m) => Peer -> s -> m ()
sendToPeer Peer
peer (DiscoveryService -> ServiceHandler DiscoveryService ())
-> DiscoveryService -> ServiceHandler DiscoveryService ()
forall a b. (a -> b) -> a -> b
$ Ref -> DiscoveryService
DiscoverySearch Ref
ref
                Maybe Ref
Nothing -> () -> ServiceHandler DiscoveryService ()
forall a. a -> ServiceHandler DiscoveryService a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#ifdef ENABLE_ICE_SUPPORT
    serviceStopServer _ _ _ pstates = do
        forM_ pstates $ \( _, DiscoveryPeerState {..} ) -> do
            mapM_ iceStopThread dpsIceConfig
#endif


identityDigests :: Foldable f => Identity f -> [ RefDigest ]
identityDigests :: forall (f :: * -> *). Foldable f => Identity f -> [RefDigest]
identityDigests Identity f
pid = (Stored (Signed IdentityData) -> RefDigest)
-> [Stored (Signed IdentityData)] -> [RefDigest]
forall a b. (a -> b) -> [a] -> [b]
map (Ref -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest (Ref -> RefDigest)
-> (Stored (Signed IdentityData) -> Ref)
-> Stored (Signed IdentityData)
-> RefDigest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored (Signed IdentityData) -> Ref
forall a. Stored a -> Ref
storedRef) ([Stored (Signed IdentityData)] -> [RefDigest])
-> [Stored (Signed IdentityData)] -> [RefDigest]
forall a b. (a -> b) -> a -> b
$ Identity [] -> [Stored (Signed IdentityData)]
forall (m :: * -> *).
Identity m -> m (Stored (Signed IdentityData))
idDataF (Identity [] -> [Stored (Signed IdentityData)])
-> [Identity []] -> [Stored (Signed IdentityData)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Identity f -> [Identity []]
forall (m :: * -> *). Foldable m => Identity m -> [Identity []]
unfoldOwners Identity f
pid


getIceConfig :: ServiceHandler DiscoveryService (Maybe IceConfig)
getIceConfig :: ServiceHandler DiscoveryService (Maybe ())
getIceConfig = do
    DiscoveryPeerState -> Maybe ()
dpsIceConfig (DiscoveryPeerState -> Maybe ())
-> ServiceHandler DiscoveryService DiscoveryPeerState
-> ServiceHandler DiscoveryService (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceHandler DiscoveryService (ServiceState DiscoveryService)
ServiceHandler DiscoveryService DiscoveryPeerState
forall s. ServiceHandler s (ServiceState s)
svcGet ServiceHandler DiscoveryService (Maybe ())
-> (Maybe () -> ServiceHandler DiscoveryService (Maybe ()))
-> ServiceHandler DiscoveryService (Maybe ())
forall a b.
ServiceHandler DiscoveryService a
-> (a -> ServiceHandler DiscoveryService b)
-> ServiceHandler DiscoveryService b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just ()
cfg -> Maybe () -> ServiceHandler DiscoveryService (Maybe ())
forall a. a -> ServiceHandler DiscoveryService a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe () -> ServiceHandler DiscoveryService (Maybe ()))
-> Maybe () -> ServiceHandler DiscoveryService (Maybe ())
forall a b. (a -> b) -> a -> b
$ () -> Maybe ()
forall a. a -> Maybe a
Just ()
cfg
        Maybe ()
Nothing -> do
#ifdef ENABLE_ICE_SUPPORT
            stun <- dpsStunServer <$> svcGet
            turn <- dpsTurnServer <$> svcGet
            liftIO (iceCreateConfig stun turn) >>= \case
                Just cfg -> do
                    svcModify $ \s -> s { dpsIceConfig = Just cfg }
                    return $ Just cfg
                Nothing -> do
                    svcPrint $ "Discovery: failed to create ICE config"
                    return Nothing
#else
            Maybe () -> ServiceHandler DiscoveryService (Maybe ())
forall a. a -> ServiceHandler DiscoveryService a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ()
forall a. Maybe a
Nothing
#endif


discoverySearch :: (MonadIO m, MonadError String m) => Server -> Ref -> m ()
discoverySearch :: forall (m :: * -> *).
(MonadIO m, MonadError String m) =>
Server -> Ref -> m ()
discoverySearch Server
server Ref
ref = do
    [Peer]
peers <- IO [Peer] -> m [Peer]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Peer] -> m [Peer]) -> IO [Peer] -> m [Peer]
forall a b. (a -> b) -> a -> b
$ Server -> IO [Peer]
getCurrentPeerList Server
server
    [Bool]
match <- [Peer] -> (Peer -> m Bool) -> m [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Peer]
peers ((Peer -> m Bool) -> m [Bool]) -> (Peer -> m Bool) -> m [Bool]
forall a b. (a -> b) -> a -> b
$ \Peer
peer -> do
        Peer -> m PeerIdentity
forall (m :: * -> *). MonadIO m => Peer -> m PeerIdentity
peerIdentity Peer
peer m PeerIdentity -> (PeerIdentity -> m Bool) -> m Bool
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            PeerIdentityFull UnifiedIdentity
pid -> do
                Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ref -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest Ref
ref RefDigest -> [RefDigest] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` UnifiedIdentity -> [RefDigest]
forall (f :: * -> *). Foldable f => Identity f -> [RefDigest]
identityDigests UnifiedIdentity
pid
            PeerIdentity
_ -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool]
match) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Server
-> Proxy DiscoveryService
-> (ServiceGlobalState DiscoveryService
    -> (ServiceGlobalState DiscoveryService, ()))
-> m ()
forall s a (m :: * -> *) (proxy :: * -> *).
(Service s, MonadIO m, MonadError String m) =>
Server
-> proxy s
-> (ServiceGlobalState s -> (ServiceGlobalState s, a))
-> m a
modifyServiceGlobalState Server
server (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @DiscoveryService) ((ServiceGlobalState DiscoveryService
  -> (ServiceGlobalState DiscoveryService, ()))
 -> m ())
-> (ServiceGlobalState DiscoveryService
    -> (ServiceGlobalState DiscoveryService, ()))
-> m ()
forall a b. (a -> b) -> a -> b
$ \ServiceGlobalState DiscoveryService
s -> (, ()) ServiceGlobalState DiscoveryService
s
            { dgsSearchingFor = S.insert (refDigest ref) $ dgsSearchingFor s
            }
        [Peer] -> (Peer -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Peer]
peers ((Peer -> m ()) -> m ()) -> (Peer -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Peer
peer -> do
            Peer -> DiscoveryService -> m ()
forall s (m :: * -> *). (Service s, MonadIO m) => Peer -> s -> m ()
sendToPeer Peer
peer (DiscoveryService -> m ()) -> DiscoveryService -> m ()
forall a b. (a -> b) -> a -> b
$ Ref -> DiscoveryService
DiscoverySearch Ref
ref