peersDiscovered

This commit is contained in:
dmitry 2020-11-23 15:44:45 +03:00
parent 02cc8d3d8c
commit 4eac7dc2ac
10 changed files with 153 additions and 45 deletions

View File

@ -22,9 +22,14 @@ call peerPart fnPart args res =
Air Dict.empty ("(call " ++ peerPart ++ " " ++ fnPart ++ " [" ++ String.join " " args ++ "]" ++ captureResult ++ ")\n")
callBI : String -> ( String, String ) -> List String -> Maybe String -> Air
callBI p ( s, f ) args cap =
call p ("(\"" ++ s ++ "\" \"" ++ f ++ "\")") args cap
event : String -> List String -> Air
event name args =
call "%init_peer_id%" ("(\"event\" \"" ++ name ++ "\")") args Nothing
callBI "%init_peer_id%" ( "event", name ) args Nothing
combine : String -> Air -> Air -> Air
@ -52,3 +57,20 @@ fold iter item (Air d s) =
next : String -> Air
next item =
Air Dict.empty ("(next " ++ item ++ ")\n")
set : String -> Value -> Air -> Air
set name value (Air d s) =
Air (Dict.insert name value d) s
-- Assumes that relay's id is set to relayId: moves execution to init peer, executes here
relayEvent : String -> List String -> Air
relayEvent name args =
seq
(callBI "relayId" ( "op", "identity" ) [] Nothing)
<|
event name args

View File

@ -17,14 +17,17 @@ limitations under the License.
-}
import Browser exposing (Document)
import Browser.Navigation as Navigation
import Config exposing (Flags)
import Model exposing (Model, emptyModel)
import Dict
import Model exposing (Model)
import Msg exposing (Msg(..))
import Subscriptions exposing (subscriptions)
import Update exposing (update)
import View exposing (view)
import Url
import Browser.Navigation as Navigation
import Utils.TaskExtras exposing (run)
import View exposing (view)
main =
Browser.application
@ -32,15 +35,20 @@ main =
, view = view
, update = update
, subscriptions = subscriptions
, onUrlChange = UrlChange
, onUrlRequest = Request
, onUrlChange = UrlChanged
, onUrlRequest = LinkClicked
}
init : Flags -> Url.Url -> Navigation.Key -> ( Model, Cmd Msg )
init flags _ _ =
init flags url key =
let
( em, initCmd ) =
emptyModel flags
emptyModel =
{ peerId = flags.peerId
, relayId = flags.relayId
, url = url
, key = key
, loadedPeers = Dict.empty
}
in
( em, initCmd )
( emptyModel, run <| UrlChanged url )

View File

@ -16,20 +16,19 @@ limitations under the License.
-}
import Config exposing (Config)
import Msg exposing (Msg(..))
import Browser.Navigation as Nav
import Dict exposing (Dict)
import Url
type alias PeerData =
{ interfaces : List String }
type alias Model =
{ peerId : String
, relayId : String
, key : Nav.Key
, url : Url.Url
, loadedPeers : Dict String PeerData
}
emptyModel : Config -> ( Model, Cmd Msg )
emptyModel config =
( { peerId = config.peerId
, relayId = config.relayId
}
, Cmd.none
)

View File

@ -1,12 +1,14 @@
module Msg exposing (..)
import Url
import Browser exposing (UrlRequest)
import Port
import Url
type Msg = NoOp
| UrlChange Url.Url
| Request UrlRequest
| Event Port.ReceiveEvent
type Msg
= NoOp
| UrlChanged Url.Url
| LinkClicked UrlRequest
| AquamarineEvent Port.ReceiveEvent
| RelayChanged String
| Click

View File

@ -1,22 +1,31 @@
port module Port exposing (..)
import Air exposing (Air(..))
import Air exposing (Air(..))
import Dict exposing (Dict)
import Json.Encode exposing (Value)
type alias SendParticle = {script: String, data: Value}
type alias ReceiveEvent = {name: String, args: List Value}
type alias SendParticle =
{ script : String, data : Value }
port sendParticle: SendParticle -> Cmd msg
port eventReceiver: (ReceiveEvent -> msg) -> Sub msg
type alias ReceiveEvent =
{ name : String, args : List Value }
port relayChanged: (String -> msg) -> Sub msg
sendAir: Air -> Cmd msg
port sendParticle : SendParticle -> Cmd msg
port eventReceiver : (ReceiveEvent -> msg) -> Sub msg
port relayChanged : (String -> msg) -> Sub msg
sendAir : Air -> Cmd msg
sendAir (Air dataDict script) =
let
data = Json.Encode.object <| Dict.toList dataDict
data =
Json.Encode.object <| Dict.toList dataDict
in
sendParticle {script = script, data = data}
sendParticle { script = script, data = data }

49
src/Route.elm Normal file
View File

@ -0,0 +1,49 @@
module Route exposing (..)
import Air exposing (call, callBI, fold, next, par, relayEvent, seq, set)
import Json.Encode as Encode
import Model exposing (Model)
import Port exposing (sendAir)
import Url.Parser exposing ((</>), Parser, map, oneOf, s, string)
type Route
= Page String
| Peer String
routeParser : Parser (Route -> a) a
routeParser =
oneOf
[ map Peer (s "peer" </> string)
, map Page string
]
routeCommand : Model -> Route -> Cmd msg
routeCommand m r =
case r of
Page _ ->
let
clientId =
set "clientId" <| Encode.string m.peerId
relayId =
set "relayId" <| Encode.string m.relayId
air =
seq
(callBI "relayId" ( "dht", "neighborhood" ) [ "clientId" ] (Just "peers"))
(fold "peers" "p" <|
par
(seq
(callBI "p" ( "dht", "neighborhood" ) [ "clientId" ] (Just "morePeers"))
(relayEvent "peersDiscovered" [ "p", "morePeers" ])
)
(next "p")
)
in
sendAir (relayId <| clientId <| air)
Peer _ ->
Cmd.none

View File

@ -20,8 +20,9 @@ import Model exposing (Model)
import Msg exposing (Msg(..))
import Port exposing (eventReceiver)
subscriptions : Model -> Sub Msg
subscriptions model =
Sub.batch
[ eventReceiver Event
[ eventReceiver AquamarineEvent
]

View File

@ -17,9 +17,14 @@ limitations under the License.
-}
import Air
import Browser
import Browser.Navigation as Nav
import Model exposing (Model)
import Msg exposing (..)
import Port exposing (sendAir)
import Route
import Url
import Url.Parser
update : Msg -> Model -> ( Model, Cmd Msg )
@ -28,13 +33,25 @@ update msg model =
NoOp ->
( model, Cmd.none )
UrlChange u ->
( model, Cmd.none )
UrlChanged url ->
let
route =
Maybe.withDefault (Route.Page "") <| Url.Parser.parse Route.routeParser url
Request u ->
( model, Cmd.none )
cmd =
Route.routeCommand model route
in
( { model | url = url }, cmd )
Event { name, args } ->
LinkClicked urlRequest ->
case urlRequest of
Browser.Internal url ->
( model, Nav.pushUrl model.key (Url.toString url) )
Browser.External href ->
( model, Nav.load href )
AquamarineEvent { name, args } ->
let
a =
Debug.log "event in ELM" name

View File

@ -1,4 +1,4 @@
module TaskExtras exposing (..)
module Utils.TaskExtras exposing (..)
{-| Copyright 2020 Fluence Labs Limited

View File

@ -35,6 +35,10 @@ function genFlags(peerId: string): any {
let pid = await Fluence.generatePeerId()
let flags = genFlags(pid.toB58String())
// If the relay is ever changed, an event shall be sent to elm
let client = await Fluence.connect(relays[1].multiaddr, pid)
let app = Elm.Main.init({
node: document.getElementById('root'),
flags: flags
@ -49,9 +53,6 @@ function genFlags(peerId: string): any {
})
registerService(eventService)
// If the relay is ever changed, an event shall be sent to elm
let client = await Fluence.connect(relays[1].multiaddr, pid)
app.ports.sendParticle.subscribe(async(part: any) => {
console.log("Going to build particle", part)
let jsonData = part.data;