diff --git a/.gitignore b/.gitignore index ff01139..0a54eec 100644 --- a/.gitignore +++ b/.gitignore @@ -4,3 +4,5 @@ node_modules dist bundle .cache + +.storybook/explorer.js \ No newline at end of file diff --git a/.storybook/index.html b/.storybook/index.html new file mode 100644 index 0000000..b2cfc27 --- /dev/null +++ b/.storybook/index.html @@ -0,0 +1,27 @@ + + + + + + + Elm Ui Explorer + + + + + + + +
+ + + + diff --git a/.storybook/main.css b/.storybook/main.css new file mode 100644 index 0000000..b119672 --- /dev/null +++ b/.storybook/main.css @@ -0,0 +1,72 @@ +/* + elm-hot creates an additional div wrapper around the app to make HMR possible. + This could break styling in development mode if you are using Elm UI. + + More context in the issue: + https://github.com/halfzebra/create-elm-app/issues/320 +*/ +[data-elm-hot="true"] { + height: inherit; +} + +html { font-size: 87.5%; } + +body { + font-family: 'Roboto Mono', monospace; + background-color: #F4F4F4; + font-size: 1rem; +} + +h1 { + font-family: 'Roboto Mono', monospace; +} + +.element-box { + border-width: 2px; +} + +.element-box:hover { + border-color: #E11E5A; +} + +.fluence-red { + color: #E11E5A; +} + +.table-red-row:hover { + background-color: #FFF8F8; +} + +.gray-font { + color: #7d7d7d; +} + +.gray-font2 { + color: #898989; +} + +.lucida { + font-family: 'Lucida Grande', Lucida, Tahoma, Verdana, Arial, sans-serif; +} + +.lucida-in { + font-family: 'Lucida Grande', Lucida, Tahoma, Verdana, Arial, sans-serif; + color: black; +} + +.welcome-text { + line-height: 20px; +} + +.medium-roboto { + font-weight: 500; + +} + +.light-shadow { + box-shadow: 0px 1px 3px 1px rgba( 0, 0, 0, 0.1 ); +} + +.one-edge-shadow { + box-shadow: 0px 1px 6px 1px rgba( 0, 0, 0, 0.1 ); +} \ No newline at end of file diff --git a/aqua/app.aqua b/aqua/app.aqua index c3a926d..896f810 100644 --- a/aqua/app.aqua +++ b/aqua/app.aqua @@ -1,31 +1,40 @@ import "@fluencelabs/aqua-lib/builtin.aqua" -service DashboardEvent("event"): - peers_discovered() - all_info(peer: PeerId, ident: Info, services: []Service, blueprints: []Blueprint, modules: []Module) +alias PeerInfoCb: PeerId, Info, []Service, []Blueprint, []Module -> () +alias ServiceInterfaceCb: PeerId, string, Interface -> () -func askAllAndSend(peer: PeerId): +func collectServiceInterfaces(peer: PeerId, services: []Service, collectServiceInterface: ServiceInterfaceCb): + for srv <- services par: + on peer: + iface <- Srv.get_interface(srv.id) + collectServiceInterface(peer, srv.id, iface) + +func askAllAndSend(peer: PeerId, collectPeerInfo: PeerInfoCb, collectServiceInterface: ServiceInterfaceCb): on peer: ident <- Peer.identify() blueprints <- Dist.list_blueprints() modules <- Dist.list_modules() services <- Srv.list() - DashboardEvent.all_info(peer, ident, services, blueprints, modules) + collectPeerInfo(peer, ident, services, blueprints, modules) + collectServiceInterfaces(peer, services, collectServiceInterface) -func findAndAskNeighboursSchema(relayPeerId: PeerId, clientId: PeerId): + +func findAndAskNeighboursSchema(relayPeerId: PeerId, clientId: PeerId, collectPeerInfo: PeerInfoCb, collectServiceInterface: ServiceInterfaceCb): on relayPeerId: neighbors <- Kademlia.neighborhood(clientId, false) for n <- neighbors par: on n: neighbors2 <- Kademlia.neighborhood(clientId, false) - for n2 <- neighbors2: - askAllAndSend(n2) + for n2 <- neighbors2 par: + askAllAndSend(n2, collectPeerInfo, collectServiceInterface) -func getAll(relayPeerId: PeerId, knownPeers: []PeerId): - askAllAndSend(relayPeerId) +func getAll(relayPeerId: PeerId, knownPeers: []PeerId, collectPeerInfo: PeerInfoCb, collectServiceInterface: ServiceInterfaceCb): + -- co askAllAndSend(relayPeerId, collectPeerInfo, collectServiceInterface) - par for peer <- knownPeers par: - askAllAndSend(peer) - - par findAndAskNeighboursSchema(relayPeerId, %init_peer_id%) + -- in order to temporarily reduce the number of particles sent to client + -- we gather data from the known peers only. + -- Known peers are explicitly represent the whole network atm + for peer <- knownPeers par: + askAllAndSend(peer, collectPeerInfo, collectServiceInterface) + -- co findAndAskNeighboursSchema(relayPeerId, %init_peer_id%, collectPeerInfo, collectServiceInterface) diff --git a/elm.json b/elm.json index 3eeb3de..4ac9d28 100644 --- a/elm.json +++ b/elm.json @@ -1,6 +1,9 @@ { "type": "application", - "source-directories": ["src"], + "source-directories": [ + "src", + "src_storybook" + ], "elm-version": "0.19.1", "dependencies": { "direct": { @@ -12,17 +15,30 @@ "elm/html": "1.0.0", "elm/json": "1.1.3", "elm/url": "1.0.0", + "elm-community/dict-extra": "2.4.0", "elm-community/intdict": "3.0.0", "elm-community/list-extra": "8.2.4", "elm-community/maybe-extra": "5.2.0", + "elm-community/string-extra": "4.0.1", + "kalutheo/elm-ui-explorer": "9.0.0", "lukewestby/elm-string-interpolate": "1.0.4" }, "indirect": { + "1602/elm-feather": "2.3.4", + "NoRedInk/datetimepicker-legacy": "1.0.4", + "avh4/elm-debug-controls": "2.2.1", + "elm/parser": "1.1.0", "elm/random": "1.0.0", "elm/regex": "1.0.0", + "elm/svg": "1.0.1", "elm/time": "1.0.0", "elm/virtual-dom": "1.0.2", - "elm-explorations/test": "1.2.2" + "elm-explorations/markdown": "1.0.0", + "elm-explorations/test": "1.2.2", + "justinmimbs/date": "3.2.1", + "justinmimbs/time-extra": "1.1.0", + "rtfeldman/elm-css": "16.1.1", + "rtfeldman/elm-hex": "1.0.0" } }, "test-dependencies": { diff --git a/index.html b/index.html index ac0dd34..c8913cc 100644 --- a/index.html +++ b/index.html @@ -24,7 +24,7 @@ gtag('js', new Date()); gtag('config', 'G-6ZTQKE1D4L'); - +
diff --git a/package-lock.json b/package-lock.json index 0cf75a3..7cc303d 100644 --- a/package-lock.json +++ b/package-lock.json @@ -998,15 +998,15 @@ } }, "@fluencelabs/aqua-cli": { - "version": "0.1.7-153", - "resolved": "https://registry.npmjs.org/@fluencelabs/aqua-cli/-/aqua-cli-0.1.7-153.tgz", - "integrity": "sha512-/4z8QbA9RJZMaRIjy+Q1ZAiT8HIHONUGOG87YWaRb9O1uBHY1o/Onorx/kIlSXAF8+0N0EI/CVkhWWIrYMy9HQ==", + "version": "0.1.8-161", + "resolved": "https://registry.npmjs.org/@fluencelabs/aqua-cli/-/aqua-cli-0.1.8-161.tgz", + "integrity": "sha512-uuzwmKLOB1HgfTOPRSWkpr8ZePRffG0utYxydz73mssDAEDOZcQXxso0X4mWMiQvBBCao4BTtRk3YFCQNmISEQ==", "dev": true }, "@fluencelabs/aqua-lib": { - "version": "0.1.5", - "resolved": "https://registry.npmjs.org/@fluencelabs/aqua-lib/-/aqua-lib-0.1.5.tgz", - "integrity": "sha512-0f5Lo9NT4ZvN+S/oGYiNxLUtpZsTfDy2qL0D4SFPVoj2+YPPK2PKSzZnja2clfM1KHHP6kT6Jd20sHVBIxBMtw==", + "version": "0.1.6", + "resolved": "https://registry.npmjs.org/@fluencelabs/aqua-lib/-/aqua-lib-0.1.6.tgz", + "integrity": "sha512-SMl6eFvI/6DIMu5RsLk5Uy3HIvy/CIkvbIhSYAba/UMVMc/Yszm6L6FvNXp5R/wogRXtFdZ3WCF7NVPgyiYmRA==", "dev": true }, "@fluencelabs/avm": { diff --git a/package.json b/package.json index f5e3373..f4e2936 100644 --- a/package.json +++ b/package.json @@ -11,7 +11,8 @@ "prod": "webpack -p --mode production", "analyse": "elm-analyse -s -p 3001 -o", "compile-aqua": "aqua-cli --js -i ./aqua/ -o ./src/_aqua", - "watch-aqua": "chokidar \"**/*.aqua\" -c \"npm run compile-aqua\"" + "watch-aqua": "chokidar \"**/*.aqua\" -c \"npm run compile-aqua\"", + "uie": "elm-live src_storybook/Explorer.elm --open --dir=.storybook --start-page=index.html -- --output=.storybook/explorer.js --debug" }, "nodemonConfig": { "watch": [ @@ -39,8 +40,8 @@ "devDependencies": { "@babel/core": "^7.11.6", "@babel/preset-env": "^7.11.5", - "@fluencelabs/aqua-cli": "^0.1.7-153", - "@fluencelabs/aqua-lib": "^0.1.5", + "@fluencelabs/aqua-cli": "^0.1.8-161", + "@fluencelabs/aqua-lib": "0.1.6", "@types/yup": "^0.29.11", "babel-loader": "^8.1.0", "chokidar-cli": "^2.1.0", @@ -52,6 +53,7 @@ "elm-analyse": "^0.16.5", "elm-format": "^0.8.4", "elm-hot-webpack-loader": "^1.1.7", + "elm-live": "^4.0.2", "elm-test": "^0.19.1-revision4", "elm-webpack-loader": "^6.0.1", "file-loader": "^6.1.0", diff --git a/src/AquaPorts/CollectPeerInfo.elm b/src/AquaPorts/CollectPeerInfo.elm new file mode 100644 index 0000000..e78af8d --- /dev/null +++ b/src/AquaPorts/CollectPeerInfo.elm @@ -0,0 +1,41 @@ +port module AquaPorts.CollectPeerInfo exposing (..) + + +type alias ServiceDto = + { id : String + , blueprint_id : String + , owner_id : String + } + + +type alias ModuleConfigDto = + { name : String + } + +type alias ModuleDto = + { name : String + , hash : String + } + + +type alias IdentifyDto = + { external_addresses : List String } + + +type alias BlueprintDto = + { id : String + , name : String + , dependencies : List String + } + + +type alias PeerDto = + { peerId : String + , identify : Maybe IdentifyDto + , services : Maybe (List ServiceDto) + , modules : Maybe (List ModuleDto) + , blueprints : Maybe (List BlueprintDto) + } + + +port collectPeerInfo : (PeerDto -> msg) -> Sub msg diff --git a/src/AquaPorts/CollectServiceInterface.elm b/src/AquaPorts/CollectServiceInterface.elm new file mode 100644 index 0000000..1605259 --- /dev/null +++ b/src/AquaPorts/CollectServiceInterface.elm @@ -0,0 +1,37 @@ +port module AquaPorts.CollectServiceInterface exposing (..) + + +type alias SignatureDto = + { arguments : List (List String) + , name : String + , output_types : List String + } + + +type alias FieldDto = + { name : String + , ty : String + } + + +type alias RecordDto = + { fields : List FieldDto + , id : Int + , name : String + } + + +type alias InterfaceDto = + { function_signatures : List SignatureDto + , record_types : List RecordDto + } + + +type alias ServiceInterfaceDto = + { peer_id : String + , service_id : String + , interface : InterfaceDto + } + + +port collectServiceInterface : (ServiceInterfaceDto -> msg) -> Sub msg diff --git a/src/BlueprintPage/Model.elm b/src/BlueprintPage/Model.elm deleted file mode 100644 index ed39587..0000000 --- a/src/BlueprintPage/Model.elm +++ /dev/null @@ -1,17 +0,0 @@ -module BlueprintPage.Model exposing (..) - -import Blueprints.Model exposing (Blueprint) -import Modules.Model exposing (Module) - - -type alias BlueprintViewInfo = - { name : String - , id : String - , author : String - , authorPeerId : String - , description : String - , website : String - , blueprint : Blueprint - , modules : List Module - , openedModule : Maybe String - } diff --git a/src/BlueprintPage/View.elm b/src/BlueprintPage/View.elm deleted file mode 100644 index 26cabdb..0000000 --- a/src/BlueprintPage/View.elm +++ /dev/null @@ -1,159 +0,0 @@ -module BlueprintPage.View exposing (..) - -import BlueprintPage.Model exposing (BlueprintViewInfo) -import Blueprints.Model exposing (Blueprint) -import Dict exposing (Dict) -import Html exposing (Html, a, article, div, img, span, strong, text) -import Html.Attributes exposing (attribute) -import Html.Events exposing (onClick) -import Info exposing (getBlueprintDescription) -import Instances.View -import List.Unique exposing (..) -import Model exposing (Model) -import Modules.Model exposing (Module) -import Msg exposing (Msg(..)) -import Palette exposing (classes, darkRed, redFont) -import Service.Model exposing (Interface) -import SpinnerView exposing (spinner) - - -view : Model -> String -> Html Msg -view model id = - let - blueprintInfo = - blueprintToInfo model id - in - case blueprintInfo of - Just bi -> - let - ( instanceNum, instanceView ) = - Instances.View.view model (\service -> service.blueprint_id == id) - in - div [ classes "fl w-100" ] - [ div [ classes "fl w-100 pb4 pt4" ] - [ div [ redFont, classes "f1 fw4 pt3 pb2" ] [ text ("Blueprint: " ++ bi.name) ] - , span [ classes "fl w-100", darkRed ] [ text ("ID: " ++ bi.id) ] - ] - , div [ classes "fl w-100 bg-white mt2 ph4 pt3 mb5 pb3 br3" ] [ viewInfo bi ] - , div [ classes "pt4 fw5 f3 pb4" ] [ text ("Services (" ++ String.fromInt instanceNum ++ ")") ] - , div [ classes "fl w-100 mt2 mb4 bg-white br3" ] - [ instanceView ] - ] - - Nothing -> - div [ classes "cf ph2-ns mt6" ] - (spinner model) - - -blueprintToInfo : Model -> String -> Maybe BlueprintViewInfo -blueprintToInfo model id = - case Dict.get id model.blueprints of - Just bp -> - let - hashes = - bp.dependencies - |> List.map (\d -> String.split ":" d) - |> List.map (\p -> Maybe.withDefault [] (List.tail p)) - |> List.map (\p -> Maybe.withDefault "" (List.head p)) - - modules = - bp.dependencies |> List.map (\d -> Dict.get d model.modules) |> List.filterMap identity - - modulesByHash = - hashes |> List.map (\d -> Dict.get d model.modulesByHash) |> List.filterMap identity - - m = - List.Unique.filterDuplicates (List.concat [ modules, modulesByHash ]) - in - Just - { name = bp.name - , id = id - , author = "Fluence Labs" - , authorPeerId = "fluence_labs_peer_id" - , description = getBlueprintDescription bp.name - , website = "https://github.com/fluencelabs/" - , blueprint = bp - , modules = m - , openedModule = model.toggledInterface - } - - Nothing -> - Nothing - - - --- TODO:: do this for all possible places which could be empty - - -textOrBsp : String -> String -textOrBsp text = - if text == "" then - String.fromChar (Char.fromCode 0xA0) - - else - text - - -viewInfo : BlueprintViewInfo -> Html Msg -viewInfo blueprintInfo = - let - checkToggle = - \id -> blueprintInfo.openedModule |> Maybe.map (\om -> om == id) |> Maybe.withDefault False - in - article [ classes "cf" ] - [ div [ classes "fl w-20-ns gray-font mv3" ] [ text "AUTHOR" ] - , div [ classes "fl w-80-ns mv3 lucida" ] - [ span [ classes "fl black b" ] [ text (textOrBsp blueprintInfo.author) ] ] - , div [ classes "fl w-20-ns gray-font mv3" ] [ text "DESCRIPTION" ] - , div [ classes "fl w-80-ns mv3 cf" ] - [ span [ classes "fl black lucida pv1" ] [ text (textOrBsp blueprintInfo.description) ] ] - , div [ classes "fl w-20-ns gray-font mv3" ] [ text "MODULES" ] - , div [ classes "fl w-80-ns mv3" ] - [ text - (textOrBsp - (String.join ", " (blueprintInfo.modules |> List.map (\m -> m.name))) - ) - ] - - --(blueprintInfo.modules - -- |> List.map (\m -> viewToggledInterface (checkToggle m.name) m.name) - --) - ] - - -alwaysPreventDefault : msg -> { message : msg, stopPropagation : Bool, preventDefault : Bool } -alwaysPreventDefault msg = - { message = msg, stopPropagation = True, preventDefault = True } - - - ---viewToggledInterface : Bool -> String -> Interface -> Html Msg - - -viewToggledInterface : Bool -> String -> Html Msg -viewToggledInterface isOpen name = - let - interfaceViewEl = - if isOpen then - --[ div [ classes "fl w-100 ph3" ] (interfaceView interface) ] - [] - - else - [] - in - div [] - ([ div [ classes "fl w-100 light-shadow bg-near-white pa2 mv2 pointer", onClick (ToggleInterface name) ] - [ span [ classes "fl mh2 pv1 tldib v-mid dib v-mid" ] [ text name ] - - --, a [ attribute "href" ("/module/" ++ name), classes "fl dib v-mid mt1" ] [ img [ attribute "src" "/images/link.svg" ] [] ] - --, div [ classes "fl o-40 f4 fr pr3 dib v-mid" ] - -- [ if isOpen then - -- text "▲" - -- - -- else - -- text "▼" - -- ] - ] - ] - --++ interfaceViewEl - ) diff --git a/src/Blueprints/BlueprintTile.elm b/src/Blueprints/BlueprintTile.elm new file mode 100644 index 0000000..d1753fd --- /dev/null +++ b/src/Blueprints/BlueprintTile.elm @@ -0,0 +1,49 @@ +module Blueprints.BlueprintTile exposing (Model, view) + +import Cache exposing (BlueprintId) +import Html exposing (Html, a, div, span, text) +import Html.Attributes exposing (attribute) +import Utils.Html exposing (classes) + + + +-- Model + + +type alias Model = + { name : String + , author : String + , numberOfInstances : Int + , id : BlueprintId + } + + + +-- View + + +view : Model -> Html msg +view model = + div [ classes "fl w-100 w-third-ns pr3 lucida" ] + [ a + [ attribute "href" ("/blueprint/" ++ model.id) + , classes "fl w-100 bg-white black mw6 mr3 mb3 hide-child pv3 pl4 br3 element-box ba b--white no-underline" + ] + [ div [ classes "w-100 mb3 pt1 b f3 overflow-hidden" ] [ text model.name ] + , div [ classes "w-100 mb4 fw4 gray-font" ] [ text "By ", span [ classes "lucida-in normal" ] [ text model.author ] ] + , div [ classes "w-100 mt1 lucida gray-font" ] [ servicesText model.numberOfInstances ] + ] + ] + + +servicesText : Int -> Html msg +servicesText num = + let + strNum = + String.fromInt num + in + if num == 1 then + Html.text (strNum ++ " service") + + else + Html.text (strNum ++ " services") diff --git a/src/Blueprints/BlueprintsList.elm b/src/Blueprints/BlueprintsList.elm new file mode 100644 index 0000000..57ad0da --- /dev/null +++ b/src/Blueprints/BlueprintsList.elm @@ -0,0 +1,53 @@ +module Blueprints.BlueprintsList exposing (Model, fromCache, view) + +import Array +import Blueprints.BlueprintTile +import Cache +import Components.Spinner +import Dict +import Html exposing (Html, div) +import Utils.Html exposing (classes) + + + +-- model + + +type alias Model = + List Blueprints.BlueprintTile.Model + + +fromCache : Cache.Model -> Model +fromCache cache = + cache.blueprintsById + |> Dict.values + |> List.map + (\x -> + { name = x.name + , author = "Fluence Labs" + , numberOfInstances = cache.servicesByBlueprintId |> Dict.get x.id |> Maybe.withDefault Array.empty |> Array.length + , id = x.id + } + ) + + + +-- view + + +view : Model -> Html msg +view model = + let + -- TODO HACK: this is a hack to filter bloat blueprints until we have a predefined list of good ones + res = + List.filter (\bp -> bp.numberOfInstances > 3) model + |> List.map Blueprints.BlueprintTile.view + + finalView = + if List.isEmpty res then + Components.Spinner.view + + else + res + in + div [ classes "cf" ] finalView diff --git a/src/Blueprints/Model.elm b/src/Blueprints/Model.elm deleted file mode 100644 index d5aaf9c..0000000 --- a/src/Blueprints/Model.elm +++ /dev/null @@ -1,16 +0,0 @@ -module Blueprints.Model exposing (..) - - -type alias Blueprint = - { dependencies : List String - , id : String - , name : String - } - - -type alias BlueprintInfo = - { name : String - , author : String - , instanceNumber : Int - , id : String - } diff --git a/src/Blueprints/View.elm b/src/Blueprints/View.elm deleted file mode 100644 index d40be8b..0000000 --- a/src/Blueprints/View.elm +++ /dev/null @@ -1,94 +0,0 @@ -module Blueprints.View exposing (..) - -import Blueprints.Model exposing (Blueprint, BlueprintInfo) -import Dict exposing (Dict) -import Html exposing (Html, a, div, span, text) -import Html.Attributes exposing (attribute) -import Model exposing (Model, PeerData) -import Palette exposing (classes) -import Service.Model exposing (Service) -import SpinnerView exposing (spinner) -import Utils.Utils exposing (servicesText) - - -view : Model -> Html msg -view model = - let - allBps = - getBlueprintsToServices model.blueprints model.discoveredPeers - - info = - List.map - (\( bp, servicesByPeers ) -> - { name = bp.name - , id = bp.id - , author = "Fluence Labs" - , instanceNumber = List.length (servicesByPeers |> List.map (\( _, s ) -> s) |> List.concat) - } - ) - (Dict.values allBps) - - -- TODO HACK: this is a hack to filter bloat blueprints until we have a predefined list of good ones - filtered = List.filter (\service -> service.instanceNumber > 3) info - - servicesView = - List.map viewService filtered - - finalView = - if List.isEmpty servicesView then - spinner model - - else - servicesView - in - div [ classes "cf" ] finalView - - -viewService : BlueprintInfo -> Html msg -viewService blueprint = - div [ classes "fl w-100 w-third-ns pr3 lucida" ] - [ a - [ attribute "href" ("/blueprint/" ++ blueprint.id) - , classes "fl w-100 bg-white black mw6 mr3 mb3 hide-child pv3 pl4 br3 element-box ba b--white no-underline" - ] - [ div [ classes "w-100 mb3 pt1 b f3 overflow-hidden" ] [ text blueprint.name ] - , div [ classes "w-100 mb4 fw4 gray-font" ] [ text "By ", span [ classes "lucida-in normal" ] [ text blueprint.author ] ] - , div [ classes "w-100 mt1 lucida gray-font" ] [ servicesText blueprint.instanceNumber ] - ] - ] - - - --- bpId peerId - - -getBlueprintsToServices : Dict String Blueprint -> Dict String PeerData -> Dict String ( Blueprint, List ( String, List Service ) ) -getBlueprintsToServices blueprints peerData = - let - allBlueprints = - Dict.values blueprints - - bpsToServices = - allBlueprints |> List.map (\bp -> ( bp.id, ( bp, getServicesByBlueprintId peerData bp.id ) )) |> Dict.fromList - in - bpsToServices - - -getServicesByBlueprintId : Dict String PeerData -> String -> List ( String, List Service ) -getServicesByBlueprintId peerData bpId = - let - list = - Dict.toList peerData - - found = - list |> List.map (\( peer, pd ) -> ( peer, filterServicesByBlueprintId bpId pd )) - - filtered = - found |> List.filter (\( _, services ) -> not (List.isEmpty services)) - in - filtered - - -filterServicesByBlueprintId : String -> PeerData -> List Service -filterServicesByBlueprintId blueprintId peerData = - peerData.services |> List.filter (\s -> s.blueprint_id == blueprintId) diff --git a/src/Cache.elm b/src/Cache.elm new file mode 100644 index 0000000..65a7448 --- /dev/null +++ b/src/Cache.elm @@ -0,0 +1,245 @@ +module Cache exposing (..) + +import AquaPorts.CollectPeerInfo exposing (BlueprintDto, ModuleDto, PeerDto, ServiceDto) +import AquaPorts.CollectServiceInterface exposing (InterfaceDto, ServiceInterfaceDto) +import Array exposing (Array) +import Dict exposing (Dict) +import Dict.Extra as Dict +import Set exposing (Set) + + + +-- model + + +type alias BlueprintId = + String + + +type alias ServiceId = + String + + +type alias Hash = + String + + +extractHash : String -> Hash +extractHash str = + str + |> String.split ":" + |> Array.fromList + |> Array.get 1 + |> Maybe.withDefault "" + + +type alias Module = + { hash : Hash + , name : String + } + + +moduleFromDto : ModuleDto -> Module +moduleFromDto dto = + { name = dto.name + , hash = dto.hash + } + + +type alias Blueprint = + { id : BlueprintId + , name : String + , dependencies : Set Hash + , interface : Maybe InterfaceDto + } + + +blueprintFromDto : BlueprintDto -> Blueprint +blueprintFromDto bp = + { id = bp.id + , dependencies = bp.dependencies |> List.map extractHash |> Set.fromList + , name = bp.name + , interface = Nothing + } + + +type alias Service = + { id : String + , blueprintId : BlueprintId + , ownerId : String + } + + +serviceFromDto : ServiceDto -> Service +serviceFromDto s = + { id = s.id + , blueprintId = s.blueprint_id + , ownerId = s.owner_id + } + + +type alias PeerId = + String + + +type alias Multiaddress = + String + + +type alias Node = + { peerId : PeerId + , externalAddresses : Array Multiaddress + , services : Array ServiceId + , blueprints : Array BlueprintId + } + + +firstExternalAddress : Node -> Maybe Multiaddress +firstExternalAddress node = + Array.get 0 node.externalAddresses + + +getServicesThatUseModule : Model -> Hash -> List ServiceId +getServicesThatUseModule model hash = + Dict.get hash model.blueprintsByModuleHash + |> Maybe.map Array.toList + |> Maybe.withDefault [] + |> List.concatMap + (\x -> + Dict.get x model.servicesByBlueprintId + |> Maybe.withDefault Array.empty + |> Array.toList + ) + + +type alias Model = + { blueprintsById : Dict BlueprintId Blueprint + , servicesById : Dict ServiceId Service + , modulesByHash : Dict Hash Module + , modulesByName : Dict String Hash + , blueprintsByModuleHash : Dict Hash (Array BlueprintId) + , servicesByBlueprintId : Dict BlueprintId (Array ServiceId) + , nodeByServiceId : Dict ServiceId PeerId + , nodeByBlueprintId : Dict BlueprintId PeerId + , nodes : Dict PeerId Node + } + + +init : Model +init = + { blueprintsById = Dict.empty + , servicesById = Dict.empty + , modulesByHash = Dict.empty + , modulesByName = Dict.empty + , blueprintsByModuleHash = Dict.empty + , servicesByBlueprintId = Dict.empty + , nodeByServiceId = Dict.empty + , nodeByBlueprintId = Dict.empty + , nodes = Dict.empty + } + + + +-- msg + + +type Msg + = CollectPeerInfo PeerDto + | CollectServiceInterface ServiceInterfaceDto + + + +-- update + + +update : Model -> Msg -> Model +update model msg = + case msg of + CollectPeerInfo { peerId, blueprints, services, identify, modules } -> + let + newBlueprints = + blueprints |> Maybe.withDefault [] |> List.map blueprintFromDto |> Dict.fromListBy (\x -> x.id) + + newServices = + services |> Maybe.withDefault [] |> List.map serviceFromDto |> Dict.fromListBy (\x -> x.id) + + newModules = + modules |> Maybe.withDefault [] |> List.map moduleFromDto |> Dict.fromListBy (\x -> x.hash) + + resultBlueprints = + Dict.union newBlueprints model.blueprintsById + + resultServices = + Dict.union newServices model.servicesById + + resultServicesByBlueprintId = + resultServices + |> Dict.values + |> Dict.groupBy (\x -> x.blueprintId) + |> Dict.map (\_ -> \v -> v |> List.map (\listVal -> listVal.id) |> Array.fromList) + + externalAddresses = + identify + |> Maybe.map (\x -> x.external_addresses) + |> Maybe.withDefault [] + |> Array.fromList + + newNode = + { peerId = peerId + , externalAddresses = externalAddresses + , services = Dict.keys newServices |> Array.fromList + , blueprints = Dict.keys newBlueprints |> Array.fromList + } + + bpMyModuleHash = + Dict.values resultBlueprints + |> List.foldl + (\bp -> + \acc -> + bp.dependencies + |> Set.foldl + (\hash -> + Dict.insertDedupe (\l1 -> \l2 -> l1 ++ l2) hash [ bp.id ] + ) + acc + ) + Dict.empty + |> Dict.map (\_ -> \v -> Array.fromList v) + + newModulesByName = + newModules |> Dict.map (\_ -> \x -> x.name) |> Dict.invert + in + { model + | blueprintsById = resultBlueprints + , servicesById = resultServices + , servicesByBlueprintId = resultServicesByBlueprintId + , modulesByHash = Dict.union model.modulesByHash newModules + , modulesByName = Dict.union newModulesByName model.modulesByName + , blueprintsByModuleHash = bpMyModuleHash + , nodes = Dict.insert newNode.peerId newNode model.nodes + , nodeByServiceId = Dict.union model.nodeByServiceId (Dict.map (\_ -> \_ -> peerId) newServices) + , nodeByBlueprintId = Dict.union model.nodeByBlueprintId (Dict.map (\_ -> \_ -> peerId) newBlueprints) + } + + CollectServiceInterface { service_id, interface } -> + let + bp = + Dict.get service_id model.servicesById + |> Maybe.map .blueprintId + |> Maybe.andThen (\x -> Dict.get x model.blueprintsById) + + newModel = + case bp of + Just justBp -> + { model + | blueprintsById = + Dict.insert + justBp.id + { justBp | interface = Just interface } + model.blueprintsById + } + + Nothing -> + model + in + newModel diff --git a/src/Components/Spinner.elm b/src/Components/Spinner.elm new file mode 100644 index 0000000..db6af7b --- /dev/null +++ b/src/Components/Spinner.elm @@ -0,0 +1,15 @@ +module Components.Spinner exposing (..) + +import Html exposing (Html, div) +import Utils.Html exposing (classes) + + + +-- view + + +view : List (Html msg) +view = + [ div [ classes "p3 relative" ] + [ div [ classes "spin" ] [] ] + ] diff --git a/src/Config.elm b/src/Config.elm deleted file mode 100644 index 358e4b9..0000000 --- a/src/Config.elm +++ /dev/null @@ -1,12 +0,0 @@ -module Config exposing (..) - - -type alias Config = - { peerId : String - , relayId : String - , knownPeers : List String - } - - -type alias Flags = - Config diff --git a/src/HubPage/View.elm b/src/HubPage/View.elm deleted file mode 100644 index 896fc64..0000000 --- a/src/HubPage/View.elm +++ /dev/null @@ -1,37 +0,0 @@ -module HubPage.View exposing (..) - -import Blueprints.View -import Html exposing (Html, a, div, span, text) -import Html.Attributes exposing (attribute) -import Instances.View -import Model exposing (Model) -import Modules.View -import Palette exposing (classes, redFont) - - -view : Model -> Html msg -view model = - div [ classes "fl w-100 pt4" ] - [ div [ redFont, classes "f1 fw4 pt3 pb3" ] [ text "Developer Hub" ] - , welcomeText - , div [ classes "pt4 f3 fw5 pb4" ] [ text "Featured Service Blueprints" ] - , Blueprints.View.view model - , div [ classes "pt4 f3 fw5 pb4" ] [ text "Featured Modules" ] - , Modules.View.view model - , div [ classes "pt4 f3 fw5 pb4" ] [ text "Services" ] - , Tuple.second (Instances.View.view model (\_ -> True)) - ] - - -welcomeText : Html msg -welcomeText = - div [ classes "w-two-thirds-ns lucida welcome-text pt2 pb3" ] - [ span [] - [ text "Welcome to the Fluence Developer Hub! Start building with composing existing services or explore featured modules to create your custom services. Learn more about how to build applications in " - , a [ attribute "href" "https://fluence-labs.readme.io/docs" ] [ text "Documentation" ] - - --, text " and " - --, a [ attribute "href" "/" ] [ text "Tutorials" ] - , text "." - ] - ] diff --git a/src/Instances/Model.elm b/src/Instances/Model.elm deleted file mode 100644 index 2be11da..0000000 --- a/src/Instances/Model.elm +++ /dev/null @@ -1,10 +0,0 @@ -module Instances.Model exposing (..) - - -type alias Instance = - { name : String - , blueprintId : String - , instance : String - , peerId : String - , ip : String - } diff --git a/src/Instances/View.elm b/src/Instances/View.elm deleted file mode 100644 index 1632663..0000000 --- a/src/Instances/View.elm +++ /dev/null @@ -1,86 +0,0 @@ -module Instances.View exposing (..) - -import Blueprints.Model exposing (Blueprint) -import Dict exposing (Dict) -import Html exposing (Html, a, div, p, table, tbody, td, text, th, thead, tr) -import Html.Attributes exposing (attribute) -import Instances.Model exposing (Instance) -import Model exposing (Model) -import Nodes.Model exposing (Identify) -import Palette exposing (classes, shortHashRaw) -import Service.Model exposing (Service) -import SpinnerView exposing (spinner) - - -toInstance : String -> Identify -> Dict String Blueprint -> Service -> Instance -toInstance peerId identify blueprints service = - let - bp = - blueprints |> Dict.get service.blueprint_id - - name = - bp |> Maybe.map .name |> Maybe.withDefault "unknown" - - blueprintId = - bp |> Maybe.map .id |> Maybe.withDefault "#" - - ip = - List.head identify.external_addresses - --|> Maybe.map (String.split "/") - --|> Maybe.map (List.drop 2) - --|> Maybe.andThen List.head - |> Maybe.withDefault "unknown" - in - { name = name, blueprintId = blueprintId, instance = service.id, peerId = peerId, ip = ip } - - -view : Model -> (Service -> Bool) -> ( Int, Html msg ) -view model filter = - let - instances = - Dict.toList model.discoveredPeers - |> List.map - (\( peer, data ) -> - data.services - |> List.filter filter - |> List.map (toInstance peer data.identify model.blueprints) - ) - |> List.concat - - finalView = - if List.isEmpty instances then - Html.div [] (spinner model) - - else - viewTable instances - in - ( List.length instances, finalView ) - - -viewTable : List Instance -> Html msg -viewTable instances = - div [ classes "pa1 bg-white br3 overflow-auto" ] - [ div [ classes "mw8-ns pa2 " ] - [ table [ classes "f6 w-100 center ws-normal-ns", attribute "cellspacing" "0" ] - [ thead [] - [ tr [ classes "" ] - [ th [ classes "fw5 tl pa3 gray-font" ] [ text "BLUEPRINT" ] - , th [ classes "fw5 tl pa3 gray-font" ] [ text "SERVICE ID" ] - , th [ classes "fw5 tl pa3 gray-font dn dtc-ns" ] [ text "NODE" ] - , th [ classes "fw5 tl pa3 gray-font dn dtc-ns" ] [ text "MULTIADDR" ] - ] - ] - , tbody [ classes "lucida" ] (instances |> List.map viewInstance) - ] - ] - ] - - -viewInstance : Instance -> Html msg -viewInstance instance = - tr [ classes "table-red-row" ] - [ td [ classes "ph3" ] [ p [ classes "ws-normal" ] [ a [ attribute "href" ("/blueprint/" ++ instance.blueprintId), classes "black" ] [ text instance.name ] ] ] - , td [ classes "ph3" ] [ p [ classes "ws-normal" ] [ text instance.instance ] ] - , td [ classes "ph3 dn dtc-ns" ] [ p [ classes "ws-normal" ] [ text (shortHashRaw 8 instance.peerId) ] ] - , td [ classes "ph3 dn dtc-ns" ] [ p [ classes "ws-normal" ] [ text instance.ip ] ] - ] diff --git a/src/Interface/View.elm b/src/Interface/View.elm deleted file mode 100644 index c61c906..0000000 --- a/src/Interface/View.elm +++ /dev/null @@ -1,54 +0,0 @@ -module Interface.View exposing (..) - -import Html exposing (Html, div, span, text) -import Palette exposing (classes) -import Service.Model exposing (Interface, Record, Signature) -import String.Interpolate exposing (interpolate) - - -interfaceView : Interface -> List (Html msg) -interfaceView interface = - recordsView interface.record_types ++ signaturesView interface.function_signatures - - -recordsView : List Record -> List (Html msg) -recordsView record = - record |> List.sortBy .name |> List.map recordView - - -recordView : Record -> Html msg -recordView record = - div [ classes "i f6" ] - ([ span [ classes "fl w-100 mt2" ] [ text (record.name ++ " {") ] ] - ++ fieldsView record.fields - ++ [ span [ classes "fl w-100 mb2" ] [ text "}" ] ] - ) - - -fieldsView : List (List String) -> List (Html msg) -fieldsView fields = - fields |> List.map (\f -> span [ classes "fl w-100 ml2" ] [ text (String.join ": " f) ]) - - -signaturesView : List Signature -> List (Html msg) -signaturesView signatures = - signatures |> List.sortBy .name |> List.map signatureView - - -signatureView : Signature -> Html msg -signatureView signature = - div [ classes "i f6 fl w-100 mv2" ] - [ text "fn " - , span [ classes "fw5" ] [ text signature.name ] - , text (interpolate "({0}) -> {1}" [ argumentsToString signature.arguments, outputToString signature.output_types ]) - ] - - -argumentsToString : List (List String) -> String -argumentsToString arguments = - String.join ", " (arguments |> List.map (String.join ": ")) - - -outputToString : List String -> String -outputToString output = - output |> List.head |> Maybe.withDefault "void" diff --git a/src/Main.elm b/src/Main.elm index f108db9..d81b196 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -16,17 +16,24 @@ limitations under the License. -} -import Browser exposing (Document) +import Browser import Browser.Navigation as Navigation -import Config exposing (Flags) -import Dict -import Model exposing (Model) -import Msg exposing (Msg(..)) +import Cache +import MainPage exposing (..) import Route -import Subscriptions exposing (subscriptions) -import Update exposing (update) +import RoutePage import Url -import View exposing (view) + + +type alias Config = + { peerId : String + , relayId : String + , knownPeers : List String + } + + +type alias Flags = + Config main = @@ -46,19 +53,23 @@ init flags url key = r = Route.parse url + c = + Cache.init + + page = + RoutePage.fromCache r c + emptyModel = { peerId = flags.peerId , relayId = flags.relayId , url = url , key = key - , page = r - , discoveredPeers = Dict.empty - , modules = Dict.empty - , modulesByHash = Dict.empty - , blueprints = Dict.empty + , route = r + , page = page + , cache = c , toggledInterface = Nothing , knownPeers = flags.knownPeers , isInitialized = False } in - ( emptyModel, Route.routeCommand emptyModel r ) + ( emptyModel, routeCommand emptyModel r ) diff --git a/src/MainPage.elm b/src/MainPage.elm new file mode 100644 index 0000000..e257aa2 --- /dev/null +++ b/src/MainPage.elm @@ -0,0 +1,243 @@ +port module MainPage exposing (..) + +import AquaPorts.CollectPeerInfo exposing (collectPeerInfo) +import AquaPorts.CollectServiceInterface exposing (collectServiceInterface) +import Browser exposing (Document, UrlRequest) +import Browser.Navigation as Nav +import Cache exposing (Blueprint) +import Components.Spinner +import Dict +import Html exposing (Html, a, div, header, img, p, text) +import Html.Attributes exposing (attribute, style) +import Html.Events exposing (onClick) +import Pages.BlueprintPage +import Pages.Hub +import Pages.ModulePage +import Pages.NodesPage +import Route +import RoutePage +import Url +import Utils.Html exposing (classes) + + + +-- model + + +type alias Model = + { peerId : String + , relayId : String + , key : Nav.Key + , url : Url.Url + , route : Route.Route + , page : RoutePage.Model + , cache : Cache.Model + , toggledInterface : Maybe String + , knownPeers : List String + , isInitialized : Bool + } + + + +-- view + + +view : Model -> Document Msg +view model = + { title = title model, body = [ body model ] } + + +title : Model -> String +title _ = + "Fluence Network Dashboard" + + +body : Model -> Html Msg +body model = + layout <| + [ header [ classes "w-100" ] + [ div [ classes "w-100 fl pv2 bg-white one-edge-shadow" ] + [ div [ classes "mw8-ns center ph3" ] + [ div [ classes "fl mv1 pl3" ] + [ a [ attribute "href" "/" ] + [ img + [ classes "mw-100" + , style "height" "30px" + , attribute "src" "/images/logo_new.svg" + , style "position" "relative" + , style "top" "0.16rem" + ] + [] + ] + ] + , div [ classes "fl pl5 h-auto" ] + [ p [ classes "h-100 m-auto fw4" ] + [ a [ attribute "href" "/", classes "link black" ] [ text "Developer Hub" ] + ] + ] + , div [ classes "fl pl5 h-auto" ] + [ p [ classes "h-100 m-auto fw4" ] + [ a [ attribute "href" "/nodes", classes "link black" ] [ text "Nodes" ] + ] + ] + , div [ classes "fl fr" ] + [ a [ attribute "href" "/" ] + [ img + [ classes "mw-100" + , style "height" "20px" + , attribute "src" "/images/reload.svg" + , style "position" "relative" + , style "top" "0.85rem" + , onClick Reload + ] + [] + ] + ] + ] + ] + ] + , div [ classes "mw8-ns center w-100 pa4 pt3 mt4" ] [ RoutePage.view model.page ] + ] + + +layout : List (Html Msg) -> Html Msg +layout elms = + div [ classes "center w-100" ] + [ div [ classes "fl w-100" ] + ([] + ++ elms + ) + ] + + + +-- msg + + +type Msg + = NoOp + | UrlChanged Url.Url + | LinkClicked UrlRequest + | RelayChanged String + | ToggleInterface String + | Reload + | Cache Cache.Msg + + + +-- update + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + NoOp -> + ( model, Cmd.none ) + + UrlChanged url -> + let + route = + Route.parse url + + page = + RoutePage.fromCache route model.cache + + cmd = + routeCommand model route + in + ( { model | url = url, isInitialized = True, route = route, page = page, toggledInterface = Nothing }, cmd ) + + LinkClicked urlRequest -> + case urlRequest of + Browser.Internal url -> + ( model, Nav.pushUrl model.key (Url.toString url) ) + + Browser.External href -> + ( model, Nav.load href ) + + Cache cacheMsg -> + let + newCache = + Cache.update model.cache cacheMsg + + newPagesModel = + RoutePage.fromCache model.route model.cache + in + ( { model + | cache = newCache + , page = newPagesModel + } + , Cmd.none + ) + + ToggleInterface id -> + case model.toggledInterface of + Just ti -> + ( { model + | toggledInterface = + if id == ti then + Nothing + + else + Just id + } + , Cmd.none + ) + + Nothing -> + ( { model | toggledInterface = Just id }, Cmd.none ) + + RelayChanged relayId -> + ( { model | relayId = relayId }, Cmd.none ) + + Reload -> + ( model, getAll { relayPeerId = model.relayId, knownPeers = model.knownPeers } ) + + + +-- subscriptions + + +subscriptions : Model -> Sub Msg +subscriptions model = + Sub.batch + [ collectServiceInterface (\si -> si |> Cache.CollectServiceInterface |> Cache) + , collectPeerInfo (\si -> si |> Cache.CollectPeerInfo |> Cache) + , relayChanged RelayChanged + ] + + + +-- ports + + +port relayChanged : (String -> msg) -> Sub msg + + +type alias GetAll = + { relayPeerId : String + , knownPeers : List String + } + + +port getAll : GetAll -> Cmd msg + + + +-- commands + + +getAllCmd : String -> String -> List String -> Cmd msg +getAllCmd peerId relayId knownPeers = + Cmd.batch + [ getAll { relayPeerId = relayId, knownPeers = knownPeers } + ] + + +routeCommand : Model -> Route.Route -> Cmd msg +routeCommand m _ = + if m.isInitialized then + Cmd.none + + else + getAllCmd m.peerId m.relayId m.knownPeers diff --git a/src/Model.elm b/src/Model.elm deleted file mode 100644 index 092233c..0000000 --- a/src/Model.elm +++ /dev/null @@ -1,61 +0,0 @@ -module Model exposing (..) - -{-| Copyright 2020 Fluence Labs Limited - -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. - --} - -import Blueprints.Model exposing (Blueprint) -import Browser.Navigation as Nav -import Dict exposing (Dict) -import Modules.Model exposing (Module) -import Nodes.Model exposing (Identify, emptyIdentify) -import Service.Model exposing (Service) -import Url - - -type Route - = Page String - | Blueprint String - | Module String - | Peer String - - -type alias PeerData = - { identify : Identify - , services : List Service - , modules : List String - , blueprints : List String - } - - -emptyPeerData : PeerData -emptyPeerData = - { identify = emptyIdentify, services = [], modules = [], blueprints = [] } - - -type alias Model = - { peerId : String - , relayId : String - , key : Nav.Key - , url : Url.Url - , page : Route - , discoveredPeers : Dict String PeerData - , modules : Dict String Module - , modulesByHash : Dict String Module - , blueprints : Dict String Blueprint - , toggledInterface : Maybe String - , knownPeers : List String - , isInitialized : Bool - } diff --git a/src/ModulePage/Model.elm b/src/ModulePage/Model.elm deleted file mode 100644 index 3203d26..0000000 --- a/src/ModulePage/Model.elm +++ /dev/null @@ -1,14 +0,0 @@ -module ModulePage.Model exposing (..) - -import Modules.Model exposing (Module) - - -type alias ModuleViewInfo = - { name : String - , id : String - , author : String - , authorPeerId : String - , description : String - , website : String - , moduleInfo : Module - } diff --git a/src/ModulePage/View.elm b/src/ModulePage/View.elm deleted file mode 100644 index 3ca71ce..0000000 --- a/src/ModulePage/View.elm +++ /dev/null @@ -1,109 +0,0 @@ -module ModulePage.View exposing (..) - -import Debug exposing (toString) -import Dict exposing (Dict) -import Html exposing (Html, a, article, div, span, text) -import Html.Attributes exposing (attribute, property) -import Info exposing (getModuleDescription, getSite) -import Instances.View -import Interface.View exposing (interfaceView) -import Json.Encode exposing (string) -import Model exposing (Model) -import ModulePage.Model exposing (ModuleViewInfo) -import Modules.Model exposing (Module) -import Palette exposing (classes, redFont) -import SpinnerView exposing (spinner) -import Utils.Utils exposing (hashValueFromString) - - -view : Model -> String -> Html msg -view model id = - let - moduleInfo = - moduleToInfo model.modules id - in - case moduleInfo of - Just mi -> - let - hash = - mi.moduleInfo.hash - - check = - Maybe.map (\bp -> bp.dependencies |> List.map hashValueFromString |> List.member hash) - - filter = - \s -> model.blueprints |> Dict.get s.blueprint_id |> check |> Maybe.withDefault False - - ( instanceNum, instanceView ) = - Instances.View.view model filter - in - div [ classes "fl w-100 cf ph2-ns" ] - [ div [ classes "fl w-100 mb2 pt4 pb4" ] - [ div [ redFont, classes "f1 fw4 pt3" ] [ text ("Module: " ++ mi.name) ] - ] - , div [ classes "fl w-100 bg-white mt2 ph4 pt3 mb4 pb2 br3" ] [ viewInfo mi ] - , div [ classes "pt4 fw5 f3 pb4" ] [ text ("Services (" ++ String.fromInt instanceNum ++ ")") ] - , div [ classes "fl w-100 mt2 mb4 bg-white br3" ] [ instanceView ] - ] - - Nothing -> - div [ classes "cf ph2-ns mt6" ] - (spinner model) - - -moduleToInfo : Dict String Module -> String -> Maybe ModuleViewInfo -moduleToInfo modules id = - let - moduleInfo = - Dict.get id modules - - name = - moduleInfo |> Maybe.map .name |> Maybe.withDefault "unknown" - - info = - moduleInfo - |> Maybe.map - (\m -> - { name = name - , id = id - , author = "Fluence Labs" - , authorPeerId = "" - , description = getModuleDescription m.name - , website = getSite m.name - , moduleInfo = m - } - ) - in - info - - -resString = - String.fromChar (Char.fromCode 160) - - -empty = - span [] [ text resString ] - - -viewInfo : ModuleViewInfo -> Html msg -viewInfo moduleInfo = - article [ classes "cf" ] - [ div [ classes "fl w-100 w-20-ns gray mv3" ] [ text "AUTHOR" ] - , div [ classes "fl w-100 w-80-ns mv3" ] - [ span [ classes "fl w-100 black b lucida" ] [ text moduleInfo.author ] ] - , div [ classes "fl w-100 w-20-ns gray mv3" ] [ text "WEBSITE" ] - , div [ classes "fl w-100 w-80-ns mv3 lucida" ] - [ if moduleInfo.website == "" then - empty - - else - a [ attribute "href" moduleInfo.website, classes "fl w-100 fluence-red" ] [ text moduleInfo.website ] - ] - , div [ classes "fl w-100 w-20-ns gray mv3" ] [ text "DESCRIPTION" ] - , div [ classes "fl w-100 w-80-ns mv3 lucida" ] - [ span [ classes "fl w-100 black", property "innerHTML" (string " 123") ] [ text moduleInfo.description ] ] - - --, div [ classes "fl w-100 w-20-ns gray mv3" ] [ text "INTERFACE" ] - --, div [ classes "fl w-100 w-80-ns mv3" ] - -- [ span [ classes "fl w-100 black" ] (interfaceView moduleInfo.moduleInfo.interface) ] - ] diff --git a/src/Modules/Interface.elm b/src/Modules/Interface.elm new file mode 100644 index 0000000..bdd7a8e --- /dev/null +++ b/src/Modules/Interface.elm @@ -0,0 +1,99 @@ +module Modules.Interface exposing (Model, view) + +import Html exposing (Html, pre, text) +import String.Extra as String +import String.Interpolate exposing (interpolate) +import Utils.Html exposing (classes) + + + +-- model + + +type alias Signature = + { arguments : List (List String) + , name : String + , output_types : List String + } + + +type alias Field = + { name : String + , ty : String + } + + +type alias Record = + { fields : List Field + , id : Int + , name : String + } + + +type alias Model = + { function_signatures : List Signature + , record_types : List Record + , name : String + } + + + +-- view + + +view : Model -> Html msg +view model = + pre [ classes "i f6 ma0" ] [ text <| interfaceView model ] + + +tab : String +tab = + " " + + +interfaceView : Model -> String +interfaceView model = + recordsView model.record_types ++ "\n\n" ++ signaturesView model + + +recordsView : List Record -> String +recordsView records = + String.join "\n\n" (List.map recordView records) + + +recordView : Record -> String +recordView record = + "data " + ++ record.name + ++ ":\n" + ++ fieldsView record.fields + + +fieldsView : List Field -> String +fieldsView fields = + String.join "\n" (List.map (\x -> tab ++ String.join ": " [ x.name, x.ty ]) fields) + + +signaturesView : Model -> String +signaturesView model = + "service " + ++ String.toTitleCase model.name + ++ ":\n" + ++ String.join "\n" (List.map signatureView model.function_signatures) + + +signatureView : Signature -> String +signatureView signature = + tab + ++ signature.name + ++ interpolate "({0}) -> {1}" [ argumentsToString signature.arguments, outputToString signature.output_types ] + + +argumentsToString : List (List String) -> String +argumentsToString arguments = + String.join ", " (arguments |> List.map (String.join ": ")) + + +outputToString : List String -> String +outputToString output = + output |> List.head |> Maybe.withDefault "void" diff --git a/src/Modules/Model.elm b/src/Modules/Model.elm deleted file mode 100644 index f6266e2..0000000 --- a/src/Modules/Model.elm +++ /dev/null @@ -1,17 +0,0 @@ -module Modules.Model exposing (..) - -import Service.Model exposing (Interface) - - -type alias Module = - { name : String - , hash : String - - --, interface : Interface - } - - -type alias ModuleShortInfo = - { moduleInfo : Module - , instanceNumber : Int - } diff --git a/src/Modules/ModuleTile.elm b/src/Modules/ModuleTile.elm new file mode 100644 index 0000000..5471ccc --- /dev/null +++ b/src/Modules/ModuleTile.elm @@ -0,0 +1,40 @@ +module Modules.ModuleTile exposing (Model, view) + +import Html exposing (Html, a, div, p, text) +import Html.Attributes exposing (attribute) +import Utils.Html exposing (classes) + + + +-- model + + +type alias Model = + { hash : String + , name : String + , numberOfUsages : Int + } + + + +-- view + + +view : Model -> Html msg +view model = + let + usages = + [ text <| String.fromInt model.numberOfUsages ++ " instance(s)" ] + in + div [ classes "fl w-100 w-third-ns pr3" ] + [ a + [ attribute "href" ("/module/" ++ model.name) + , classes "fl w-100 bg-white black mw6 mr2 mb3 hide-child pa2 element-box ba b--white pl3" + ] + [ p [ classes "tl di" ] + [ div [ classes "fl b w-100 mb1 fw5 overflow-hidden" ] + [ text model.name ] + , div [ classes "fl w-100 mt1 lucida gray-font2" ] usages + ] + ] + ] diff --git a/src/Modules/ModulesList.elm b/src/Modules/ModulesList.elm new file mode 100644 index 0000000..ab95b71 --- /dev/null +++ b/src/Modules/ModulesList.elm @@ -0,0 +1,46 @@ +module Modules.ModulesList exposing (..) + +import Cache +import Components.Spinner +import Dict +import Html exposing (Html, div) +import Modules.ModuleTile +import Utils.Html exposing (classes) + + + +-- model + + +type alias Model = + List Modules.ModuleTile.Model + + +fromCache : Cache.Model -> Model +fromCache cache = + cache.modulesByHash + |> Dict.values + |> List.map + (\x -> + { hash = x.hash + , name = x.name + , numberOfUsages = Cache.getServicesThatUseModule cache x.hash |> List.length + } + ) + + + +-- view + + +view : Model -> Html msg +view model = + let + finalView = + if List.isEmpty model then + Components.Spinner.view + + else + List.map Modules.ModuleTile.view model + in + div [ classes "cf" ] finalView diff --git a/src/Modules/View.elm b/src/Modules/View.elm deleted file mode 100644 index 18e9fa3..0000000 --- a/src/Modules/View.elm +++ /dev/null @@ -1,139 +0,0 @@ -module Modules.View exposing (..) - -import Blueprints.Model exposing (Blueprint) -import Dict exposing (Dict) -import Html exposing (Html, a, div, p, text) -import Html.Attributes exposing (attribute) -import Maybe.Extra -import Model exposing (Model, PeerData) -import Modules.Model exposing (Module, ModuleShortInfo) -import Palette exposing (classes) -import Service.Model exposing (Service) -import SpinnerView exposing (spinner) -import Utils.Utils exposing (instancesText) - - -getModuleShortInfo : Model -> List ModuleShortInfo -getModuleShortInfo model = - let - all = - getAllModules model.blueprints model.modules model.modulesByHash model.discoveredPeers - - res = - all - |> Dict.toList - |> List.map (\( _, ( moduleInfo, services ) ) -> { moduleInfo = moduleInfo, instanceNumber = List.length services }) - in - res - - -getAllModules : Dict String Blueprint -> Dict String Module -> Dict String Module -> Dict String PeerData -> Dict String ( Module, List Service ) -getAllModules blueprints modules modulesByHash peerData = - let - peerDatas = - Dict.toList peerData - - allModulesByPeers = - peerDatas |> List.map (\( _, pd ) -> pd.modules |> List.map (\ms -> ( pd, ms, Maybe.withDefault "" (Maybe.map .hash (modules |> Dict.get ms)) ))) |> List.concat - - peersByModuleName = - allModulesByPeers |> List.foldr (updateDict blueprints modules modulesByHash) Dict.empty - in - peersByModuleName - - - --- group by module name and append peers - - -updateDict : Dict String Blueprint -> Dict String Module -> Dict String Module -> ( PeerData, String, String ) -> Dict String ( Module, List Service ) -> Dict String ( Module, List Service ) -updateDict blueprints modules modulesByHash ( peerData, moduleName, moduleHash ) dict = - let - filterByHash = - \hash -> \list -> list |> List.filter (filterByModuleHash blueprints hash) - - filterByName = - \name -> \list -> list |> List.filter (filterByModuleName blueprints name) - - allModules = - Dict.union modules modulesByHash - - dictNames = - dict - |> Dict.update moduleName - (\oldM -> - Maybe.Extra.or - (oldM |> Maybe.map (\( info, services ) -> ( info, List.concat [ filterByHash moduleHash peerData.services, filterByName info.name peerData.services, services ] ))) - (Dict.get moduleName allModules |> Maybe.map (\m -> ( m, List.append (filterByHash moduleHash peerData.services) (filterByName m.name peerData.services) ))) - ) - in - dictNames - - -filterByModuleName : Dict String Blueprint -> String -> (Service -> Bool) -filterByModuleName bps moduleName = - let - names = - \bp -> - bp.dependencies - |> List.map Utils.Utils.hashValueFromString - - check = - Maybe.map (\bp -> names bp |> List.member moduleName) - - filter = - \s -> bps |> Dict.get s.blueprint_id |> check |> Maybe.withDefault False - in - filter - - -filterByModuleHash : Dict String Blueprint -> String -> (Service -> Bool) -filterByModuleHash bps moduleHash = - let - hashes = - \bp -> - bp.dependencies - |> List.map Utils.Utils.hashValueFromString - - check = - Maybe.map (\bp -> hashes bp |> List.member moduleHash) - - filter = - \s -> bps |> Dict.get s.blueprint_id |> check |> Maybe.withDefault False - in - filter - - -view : Model -> Html msg -view model = - let - info = - getModuleShortInfo model - - modulesView = - List.map viewService info - - finalView = - if List.isEmpty modulesView then - spinner model - - else - modulesView - in - div [ classes "cf" ] finalView - - -viewService : ModuleShortInfo -> Html msg -viewService moduleInfo = - div [ classes "fl w-100 w-third-ns pr3" ] - [ a - [ attribute "href" ("/module/" ++ moduleInfo.moduleInfo.name) - , classes "fl w-100 bg-white black mw6 mr2 mb3 hide-child pa2 element-box ba b--white pl3" - ] - [ p [ classes "tl di" ] - [ div [ classes "fl b w-100 mb1 fw5 overflow-hidden" ] - [ text moduleInfo.moduleInfo.name ] - , div [ classes "fl w-100 mt1 lucida gray-font2" ] [ instancesText moduleInfo.instanceNumber ] - ] - ] - ] diff --git a/src/Msg.elm b/src/Msg.elm deleted file mode 100644 index aaf349c..0000000 --- a/src/Msg.elm +++ /dev/null @@ -1,15 +0,0 @@ -module Msg exposing (..) - -import Browser exposing (UrlRequest) -import Port -import Url - - -type Msg - = NoOp - | UrlChanged Url.Url - | LinkClicked UrlRequest - | AquamarineEvent Port.ReceiveEvent - | RelayChanged String - | ToggleInterface String - | Reload diff --git a/src/NodePage/View.elm b/src/NodePage/View.elm deleted file mode 100644 index 8b9bcab..0000000 --- a/src/NodePage/View.elm +++ /dev/null @@ -1,75 +0,0 @@ -module NodePage.View exposing (..) - -import Dict exposing (Dict) -import Html exposing (Html, div, p, table, tbody, td, text, th, thead, tr) -import Html.Attributes exposing (attribute) -import Model exposing (Model) -import Palette exposing (classes, redFont) -import SpinnerView exposing (spinner) - - -type alias Node = - { id : String - , ip : String - , servicesNumber : Int - } - - -view : Model -> Html msg -view model = - let - nodes = - modelToNodes model - - finalView = - if List.isEmpty nodes then - spinner model - - else - [ div [ classes "fl w-100 cf ph2-ns" ] - [ div [ classes "fl w-100 mb2 pt4 pb4" ] - [ div [ redFont, classes "f1 fw4 pt3" ] [ text "Network Nodes" ] - ] - , div [ classes "fl w-100 mt2 mb4 bg-white br3" ] [ nodesView nodes ] - ] - ] - in - div [] finalView - - -modelToNodes : Model -> List Node -modelToNodes model = - let - getIp = - \data -> data.identify.external_addresses |> List.head |> Maybe.withDefault "unknown" - in - model.discoveredPeers - |> Dict.toList - |> List.map (\( peer, data ) -> { id = peer, ip = getIp data, servicesNumber = List.length data.services }) - - -nodesView : List Node -> Html msg -nodesView nodes = - div [ classes "pa1 bg-white br3 overflow-auto" ] - [ div [ classes "mw8-ns pa2 " ] - [ table [ classes "f6 w-100 center ws-normal-ns", attribute "cellspacing" "0" ] - [ thead [] - [ tr [ classes "" ] - [ th [ classes "fw5 tl pa3 gray-font" ] [ text "NODE ID" ] - , th [ classes "fw5 tl pa3 gray-font" ] [ text "MULTIADDR" ] - , th [ classes "fw5 tl pa3 gray-font dn dtc-ns" ] [ text "SERVICES" ] - ] - ] - , tbody [ classes "lucida" ] (nodes |> List.map viewNode) - ] - ] - ] - - -viewNode : Node -> Html msg -viewNode node = - tr [ classes "table-red-row" ] - [ td [ classes "ph3" ] [ p [ classes "ws-normal" ] [ text node.id ] ] - , td [ classes "ph3" ] [ p [ classes "ws-normal" ] [ text node.ip ] ] - , td [ classes "ph3 dn dtc-ns" ] [ p [ classes "ws-normal" ] [ text (String.fromInt node.servicesNumber) ] ] - ] diff --git a/src/Nodes/Model.elm b/src/Nodes/Model.elm deleted file mode 100644 index 348bc32..0000000 --- a/src/Nodes/Model.elm +++ /dev/null @@ -1,10 +0,0 @@ -module Nodes.Model exposing (..) - - -type alias Identify = - { external_addresses : List String } - - -emptyIdentify : Identify -emptyIdentify = - { external_addresses = [] } diff --git a/src/Nodes/NodeRow.elm b/src/Nodes/NodeRow.elm new file mode 100644 index 0000000..978f017 --- /dev/null +++ b/src/Nodes/NodeRow.elm @@ -0,0 +1,30 @@ +module Nodes.NodeRow exposing (Model, view) + +import Cache exposing (PeerId) +import Html exposing (Html, p, td, text, tr) +import Palette exposing (..) +import Utils.Html exposing (classes) + + + +-- model + + +type alias Model = + { peerId : PeerId + , addr : String + , numberOfServices : Int + } + + + +-- view + + +view : Model -> Html msg +view model = + tr [ classes "table-red-row" ] + [ td [ classes "ph3" ] [ p [ classes "ws-normal" ] [ text model.peerId ] ] + , td [ classes "ph3" ] [ p [ classes "ws-normal" ] [ text model.addr ] ] + , td [ classes "ph3 dn dtc-ns" ] [ p [ classes "ws-normal" ] [ text (String.fromInt model.numberOfServices) ] ] + ] diff --git a/src/Nodes/NodesTable.elm b/src/Nodes/NodesTable.elm new file mode 100644 index 0000000..563a9c7 --- /dev/null +++ b/src/Nodes/NodesTable.elm @@ -0,0 +1,54 @@ +module Nodes.NodesTable exposing (Model, fromCache, view) + +import Array exposing (Array) +import Cache exposing (PeerId) +import Dict exposing (Dict) +import Html exposing (Html, div, p, table, tbody, td, text, th, thead, tr) +import Html.Attributes exposing (attribute) +import List +import Nodes.NodeRow +import Palette exposing (..) +import Utils.Html exposing (classes) + + + +-- model + + +type alias Model = + List Nodes.NodeRow.Model + + +fromCache : Cache.Model -> Model +fromCache cache = + cache.nodes + |> Dict.values + |> List.map + (\x -> + { peerId = x.peerId + , addr = Cache.firstExternalAddress x |> Maybe.withDefault "unknown" + , numberOfServices = Array.length x.services + } + ) + + + +-- view + + +view : Model -> Html msg +view model = + div [ classes "pa1 bg-white br3 overflow-auto" ] + [ div [ classes "mw8-ns pa2 " ] + [ table [ classes "f6 w-100 center ws-normal-ns", attribute "cellspacing" "0" ] + [ thead [] + [ tr [ classes "" ] + [ th [ classes "fw5 tl pa3 gray-font" ] [ text "NODE ID" ] + , th [ classes "fw5 tl pa3 gray-font" ] [ text "MULTIADDR" ] + , th [ classes "fw5 tl pa3 gray-font dn dtc-ns" ] [ text "SERVICES" ] + ] + ] + , tbody [ classes "lucida" ] (List.map Nodes.NodeRow.view model) + ] + ] + ] diff --git a/src/Pages/BlueprintPage.elm b/src/Pages/BlueprintPage.elm new file mode 100644 index 0000000..f460aa4 --- /dev/null +++ b/src/Pages/BlueprintPage.elm @@ -0,0 +1,158 @@ +module Pages.BlueprintPage exposing (Model, fromCache, view) + +import Array exposing (Array) +import Cache exposing (BlueprintId) +import Dict exposing (Dict) +import Html exposing (Html, article, div, pre, span, text) +import Html.Events exposing (onClick) +import Info exposing (..) +import List.Unique exposing (..) +import Maybe.Extra as Maybe +import Modules.Interface +import Palette exposing (darkRed, redFont) +import Services.ServiceRow +import Services.ServicesTable +import Utils.Html exposing (..) + + + +-- model + + +type alias Model = + { name : String + , id : String + , author : String + , authorPeerId : String + , description : String + , website : String + , interface : Maybe Modules.Interface.Model + , moduleNames : List String + , services : Services.ServicesTable.Model + , openedModule : Maybe String + } + + +fromCache : Cache.Model -> BlueprintId -> Maybe Model +fromCache cache id = + let + bp = + Dict.get id cache.blueprintsById + + services = + Dict.get id cache.servicesByBlueprintId + |> Maybe.withDefault Array.empty + |> Array.toList + |> Services.ServicesTable.fromCache cache + + res : Maybe Model + res = + Maybe.map + (\x -> + { name = x.name + , id = x.id + , author = "Fluence Labs" + , authorPeerId = "fluence_labs_peer_id" + , description = getBlueprintDescription x.id + , website = "https://github.com/fluencelabs/" + , interface = + x.interface + |> Maybe.map + (\i -> + { function_signatures = i.function_signatures + , record_types = i.record_types + , name = x.name + } + ) + , moduleNames = [] + , services = services + , openedModule = Nothing + } + ) + bp + in + res + + + +-- view + + +view : Model -> Html msg +view model = + let + instancesCount = + model.services + |> List.length + |> String.fromInt + in + div [ classes "fl w-100" ] + [ div [ classes "fl w-100 pb4 pt4" ] + [ div [ redFont, classes "f1 fw4 pt3 pb2" ] [ text ("Blueprint: " ++ model.name) ] + , span [ classes "fl w-100", darkRed ] [ text ("ID: " ++ model.id) ] + ] + , div [ classes "fl w-100 bg-white mt2 ph4 pt3 mb5 pb3 br3" ] + [ article [ classes "cf" ] + [ div [ classes "fl w-20-ns gray-font mv3" ] [ text "AUTHOR" ] + , div [ classes "fl w-80-ns mv3 lucida" ] + [ span [ classes "fl black b" ] [ text (textOrBsp model.author) ] ] + , div [ classes "fl w-20-ns gray-font mv3" ] [ text "DESCRIPTION" ] + , div [ classes "fl w-80-ns mv3 cf" ] + [ span [ classes "fl black lucida pv1" ] [ text (textOrBsp model.description) ] ] + , div [ classes "fl w-20-ns gray-font mv3" ] [ text "MODULES" ] + , div [ classes "fl w-80-ns mv3" ] + [ text + (textOrBsp + (String.join ", " model.moduleNames) + ) + ] + , div [ classes "fl w-100 w-20-ns gray mv3" ] [ text "INTERFACE" ] + , div [ classes "fl w-100 w-80-ns mv3" ] + [ model.interface |> Maybe.map Modules.Interface.view |> Maybe.withDefault (text (Utils.Html.textOrBsp "")) + ] + + --[ span [ classes "fl w-100 black" ] + -- [ + --] + --] + ] + ] + , div [ classes "pt4 fw5 f3 pb4" ] + [ text + ("Services (" ++ instancesCount ++ ")") + ] + , div [ classes "fl w-100 mt2 mb4 bg-white br3" ] + [ Services.ServicesTable.view model.services + ] + ] + + +viewToggledInterface : Bool -> String -> Html msg +viewToggledInterface isOpen name = + let + interfaceViewEl = + if isOpen then + --[ div [ classes "fl w-100 ph3" ] (interfaceView interface) ] + [] + + else + [] + in + div [] + ([ div + [ classes "fl w-100 light-shadow bg-near-white pa2 mv2 pointer" --, onClick (ToggleInterface name) + ] + [ span [ classes "fl mh2 pv1 tldib v-mid dib v-mid" ] [ text name ] + + --, a [ attribute "href" ("/module/" ++ name), classes "fl dib v-mid mt1" ] [ img [ attribute "src" "/images/link.svg" ] [] ] + --, div [ classes "fl o-40 f4 fr pr3 dib v-mid" ] + -- [ if isOpen then + -- text "▲" + -- + -- else + -- text "▼" + -- ] + ] + ] + --++ interfaceViewEl + ) diff --git a/src/Pages/Hub.elm b/src/Pages/Hub.elm new file mode 100644 index 0000000..1672e99 --- /dev/null +++ b/src/Pages/Hub.elm @@ -0,0 +1,80 @@ +module Pages.Hub exposing (Model, fromCache, init, view) + +import Blueprints.BlueprintsList +import Cache +import Dict +import Html exposing (Html, a, div, span, text) +import Html.Attributes exposing (attribute) +import Maybe.Extra as Maybe +import Modules.ModulesList +import Palette exposing (redFont) +import Services.ServiceRow +import Services.ServicesTable +import Utils.Html exposing (classes) + + + +-- model + + +type alias FmModel = + {} + + +type alias Model = + { featuredBlueprints : Blueprints.BlueprintsList.Model + , featuredModules : Modules.ModulesList.Model + , services : Services.ServicesTable.Model + } + + +init : Model +init = + { featuredBlueprints = [] + , featuredModules = [] + , services = [] + } + + +fromCache : Cache.Model -> Model +fromCache cache = + { featuredBlueprints = Blueprints.BlueprintsList.fromCache cache + , featuredModules = Modules.ModulesList.fromCache cache + , services = + cache.servicesById + |> Dict.keys + |> Services.ServicesTable.fromCache cache + } + + + +-- view + + +view : Model -> Html msg +view model = + div [ classes "fl w-100 pt4" ] + [ div [ redFont, classes "f1 fw4 pt3 pb3" ] [ text "Developer Hub" ] + , welcomeText + , div [ classes "pt4 f3 fw5 pb4" ] [ text "Featured Service Blueprints" ] + , Blueprints.BlueprintsList.view model.featuredBlueprints + , div [ classes "pt4 f3 fw5 pb4" ] [ text "Featured Modules" ] + , Modules.ModulesList.view model.featuredModules + , div [ classes "pt4 f3 fw5 pb4" ] + [ text "Services" ] + , Services.ServicesTable.view model.services + ] + + +welcomeText : Html msg +welcomeText = + div [ classes "w-two-thirds-ns lucida welcome-text pt2 pb3" ] + [ span [] + [ text "Welcome to the Fluence Developer Hub! Start building with composing existing services or explore featured modules to create your custom services. Learn more about how to build applications in " + , a [ attribute "href" "https://fluence-labs.readme.io/docs" ] [ text "Documentation" ] + + --, text " and " + --, a [ attribute "href" "/" ] [ text "Tutorials" ] + , text "." + ] + ] diff --git a/src/Pages/ModulePage.elm b/src/Pages/ModulePage.elm new file mode 100644 index 0000000..9bca28c --- /dev/null +++ b/src/Pages/ModulePage.elm @@ -0,0 +1,94 @@ +module Pages.ModulePage exposing (Model, fromCache, view) + +import AquaPorts.CollectServiceInterface exposing (InterfaceDto) +import Cache exposing (Hash) +import Dict +import Html exposing (Html, a, article, div, span, text) +import Html.Attributes exposing (attribute) +import Info exposing (getModuleDescription) +import Modules.Interface +import Palette exposing (redFont) +import Services.ServicesTable +import Utils.Html exposing (classes, textOrBsp) + + + +-- model + + +type alias Model = + { name : String + , hash : String + , author : String + , authorPeerId : String + , description : String + , website : String + , services : Services.ServicesTable.Model + , interface : Maybe InterfaceDto + } + + +fromCache : Cache.Model -> Hash -> Maybe Model +fromCache cache hash = + let + m = + Dict.get hash cache.modulesByHash + + services = + Cache.getServicesThatUseModule cache hash + + res = + Maybe.map + (\x -> + { name = x.name + , hash = x.hash + , author = "Fluence Labs" + , authorPeerId = "fluence_labs_peer_id" + , description = getModuleDescription x.name + , website = "https://github.com/fluencelabs/" + , services = Services.ServicesTable.fromCache cache services + , interface = Nothing + } + ) + m + in + res + + + +-- view + + +view : Model -> Html msg +view model = + let + numberOfInstances = + List.length model.services + in + div [ classes "fl w-100 cf ph2-ns" ] + [ div [ classes "fl w-100 mb2 pt4 pb4" ] + [ div [ redFont, classes "f1 fw4 pt3" ] [ text ("Module: " ++ model.name) ] + ] + , div [ classes "fl w-100 bg-white mt2 ph4 pt3 mb4 pb2 br3" ] + [ article [ classes "cf" ] + [ div [ classes "fl w-100 w-20-ns gray mv3" ] [ text "AUTHOR" ] + , div [ classes "fl w-100 w-80-ns mv3" ] + [ span [ classes "fl w-100 black b lucida" ] [ text model.author ] ] + , div [ classes "fl w-100 w-20-ns gray mv3" ] [ text "WEBSITE" ] + , div [ classes "fl w-100 w-80-ns mv3 lucida" ] + [ a [ attribute "href" model.website, classes "fl w-100 fluence-red" ] [ text (textOrBsp model.website) ] + ] + , div [ classes "fl w-100 w-20-ns gray mv3" ] [ text "DESCRIPTION" ] + , div [ classes "fl w-100 w-80-ns mv3 lucida" ] + [ span [ classes "fl w-100 black" ] [ text (textOrBsp model.description) ] ] + + -- , div [ classes "fl w-100 w-20-ns gray mv3" ] [ text "INTERFACE" ] + -- , div [ classes "fl w-100 w-80-ns mv3" ] + -- [ span [ classes "fl w-100 black" ] + -- (Modules.Interface.view model.interface) + -- ] + ] + ] + , div [ classes "pt4 fw5 f3 pb4" ] [ text ("Services (" ++ String.fromInt numberOfInstances ++ ")") ] + , div [ classes "fl w-100 mt2 mb4 bg-white br3" ] [ Services.ServicesTable.view model.services ] + ] diff --git a/src/Pages/NodesPage.elm b/src/Pages/NodesPage.elm new file mode 100644 index 0000000..806c742 --- /dev/null +++ b/src/Pages/NodesPage.elm @@ -0,0 +1,39 @@ +module Pages.NodesPage exposing (Model, fromCache, init, view) + +import Cache +import Html exposing (..) +import Nodes.NodesTable +import Palette exposing (..) +import Utils.Html exposing (classes) + + + +-- model + + +type alias Model = + Nodes.NodesTable.Model + + +fromCache : Cache.Model -> Model +fromCache cache = + Nodes.NodesTable.fromCache cache + + +init : Model +init = + [] + + + +-- view + + +view : Model -> Html msg +view model = + div [ classes "fl w-100 cf ph2-ns" ] + [ div [ classes "fl w-100 mb2 pt4 pb4" ] + [ div [ redFont, classes "f1 fw4 pt3" ] [ text "Network Nodes" ] + ] + , div [ classes "fl w-100 mt2 mb4 bg-white br3" ] [ Nodes.NodesTable.view model ] + ] diff --git a/src/Palette.elm b/src/Palette.elm index 749b834..19c64d7 100644 --- a/src/Palette.elm +++ b/src/Palette.elm @@ -17,14 +17,7 @@ limitations under the License. -} import Html exposing (Html) -import Html.Attributes exposing (classList, style) - - -classes : String -> Html.Attribute msg -classes cls = - classList <| - List.map (\s -> ( s, True )) <| - String.split " " cls +import Html.Attributes exposing (style) shortHashRaw size hash = diff --git a/src/Port.elm b/src/Port.elm deleted file mode 100644 index f71d627..0000000 --- a/src/Port.elm +++ /dev/null @@ -1,27 +0,0 @@ -port module Port exposing (..) - -import Blueprints.Model exposing (Blueprint) -import Dict exposing (Dict) -import Json.Encode exposing (Value) -import Modules.Model exposing (Module) -import Nodes.Model exposing (Identify) -import Service.Model exposing (Service) - - -type alias ReceiveEvent = - { name : String, peer : String, peers : Maybe (List String), identify : Maybe Identify, services : Maybe (List Service), modules : Maybe (List Module), blueprints : Maybe (List Blueprint) } - - -port eventReceiver : (ReceiveEvent -> msg) -> Sub msg - - -port relayChanged : (String -> msg) -> Sub msg - - -type alias GetAll = - { relayPeerId : String - , knownPeers : List String - } - - -port getAll : GetAll -> Cmd msg diff --git a/src/Route.elm b/src/Route.elm index 6e28358..d131650 100644 --- a/src/Route.elm +++ b/src/Route.elm @@ -1,68 +1,30 @@ module Route exposing (..) -import BlueprintPage.View as BlueprintPage -import Html exposing (Html, text) -import HubPage.View as HubPage -import Model exposing (Model, Route(..)) -import ModulePage.View as ModulePage -import Msg exposing (Msg) -import NodePage.View as NodePage -import Port exposing (getAll) -import Url.Parser exposing ((), Parser, map, oneOf, s, string) +import Url.Parser exposing ((), Parser, map, oneOf, s, string, top) + + +type Route + = Home + | Hub + | Nodes + | Blueprint String + | Module String + | Peer String + | Unknown String routeParser : Parser (Route -> a) a routeParser = oneOf - [ map Peer (s "peer" string) - , map Module (s "module" string) + [ map Home top + , map Hub (s "hub") + , map Nodes (s "nodes") , map Blueprint (s "blueprint" string) - , map Page string + , map Module (s "module" string) + , map Peer (s "peer" string) + , map Unknown string ] parse url = - Maybe.withDefault (Page "") <| Url.Parser.parse routeParser url - - -routeView : Model -> Route -> Html Msg -routeView model route = - case route of - Page page -> - case page of - "" -> - HubPage.view model - - "hub" -> - HubPage.view model - - "nodes" -> - NodePage.view model - - _ -> - text ("undefined page: " ++ page) - - Peer peer -> - text peer - - Blueprint id -> - BlueprintPage.view model id - - Module moduleName -> - ModulePage.view model moduleName - - -getAllCmd : String -> String -> List String -> Cmd msg -getAllCmd peerId relayId knownPeers = - Cmd.batch - [ getAll { relayPeerId = relayId, knownPeers = knownPeers } - ] - - -routeCommand : Model -> Route -> Cmd msg -routeCommand m _ = - if m.isInitialized then - Cmd.none - - else - getAllCmd m.peerId m.relayId m.knownPeers + Maybe.withDefault Home <| Url.Parser.parse routeParser url diff --git a/src/RoutePage.elm b/src/RoutePage.elm new file mode 100644 index 0000000..cfc0a34 --- /dev/null +++ b/src/RoutePage.elm @@ -0,0 +1,90 @@ +module RoutePage exposing (Model, fromCache, view) + +import Cache +import Components.Spinner +import Dict +import Html exposing (Html, div, text) +import Pages.BlueprintPage +import Pages.Hub +import Pages.ModulePage +import Pages.NodesPage +import Route exposing (Route(..)) + + + +-- model + + +type Model + = Hub Pages.Hub.Model + | Nodes Pages.NodesPage.Model + | Blueprint (Maybe Pages.BlueprintPage.Model) + | Module (Maybe Pages.ModulePage.Model) + | Unknown String + + +fromCache : Route.Route -> Cache.Model -> Model +fromCache route cache = + case route of + Route.Home -> + Hub (Pages.Hub.fromCache cache) + + Route.Hub -> + Hub (Pages.Hub.fromCache cache) + + Route.Nodes -> + Nodes (Pages.NodesPage.fromCache cache) + + Route.Blueprint id -> + Blueprint (Pages.BlueprintPage.fromCache cache id) + + Route.Module moduleName -> + let + hash = + Dict.get moduleName cache.modulesByName + + m = + Maybe.andThen (Pages.ModulePage.fromCache cache) hash + in + Module m + + Route.Peer peer -> + Unknown peer + + Route.Unknown s -> + Unknown s + + + +-- view + + +view : Model -> Html msg +view model = + case model of + Hub m -> + Pages.Hub.view m + + Nodes m -> + Pages.NodesPage.view m + + Blueprint m -> + case m of + Just mm -> + Pages.BlueprintPage.view mm + + Nothing -> + div [] + Components.Spinner.view + + Module m -> + case m of + Just mm -> + Pages.ModulePage.view mm + + Nothing -> + div [] + Components.Spinner.view + + Unknown s -> + text ("Not found: " ++ s) diff --git a/src/Service/Model.elm b/src/Service/Model.elm deleted file mode 100644 index 44a0c5b..0000000 --- a/src/Service/Model.elm +++ /dev/null @@ -1,30 +0,0 @@ -module Service.Model exposing (..) - - -type alias Signature = - { arguments : List (List String) - , name : String - , output_types : List String - } - - -type alias Record = - { fields : List (List String) - , id : Int - , name : String - } - - -type alias Interface = - { function_signatures : List Signature - , record_types : List Record - } - - -type alias Service = - { id : String - , blueprint_id : String - - --, interface : Interface - , owner_id : String - } diff --git a/src/Services/ServiceRow.elm b/src/Services/ServiceRow.elm new file mode 100644 index 0000000..04cf9b0 --- /dev/null +++ b/src/Services/ServiceRow.elm @@ -0,0 +1,67 @@ +module Services.ServiceRow exposing (Model, fromCache, view) + +import Array exposing (Array) +import Cache exposing (BlueprintId, ServiceId) +import Dict exposing (Dict) +import Html exposing (..) +import Html.Attributes exposing (..) +import Palette exposing (shortHashRaw) +import Utils.Html exposing (classes) + + + +-- module + + +type alias Model = + { blueprintName : String + , blueprintId : BlueprintId + , serviceId : String + , peerId : String + , ip : String + } + + +fromCache : Cache.Model -> ServiceId -> Maybe Model +fromCache cache id = + let + srv = + Dict.get id cache.servicesById + + bp = + srv |> Maybe.andThen (\x -> Dict.get x.blueprintId cache.blueprintsById) + + node = + Dict.get id cache.nodeByServiceId + |> Maybe.andThen (\x -> Dict.get x cache.nodes) + + res = + srv + |> Maybe.map + (\x -> + { blueprintName = bp |> Maybe.map .name |> Maybe.withDefault "unkown" + , blueprintId = bp |> Maybe.map .id |> Maybe.withDefault "unkown" + , serviceId = id + , peerId = node |> Maybe.map .peerId |> Maybe.withDefault "unkown" + , ip = + node + |> Maybe.andThen Cache.firstExternalAddress + |> Maybe.withDefault "unkown" + } + ) + in + res + + + +-- view + + +view : Model -> Html msg +view model = + tr [ classes "table-red-row" ] + [ td [ classes "ph3" ] [ p [ classes "ws-normal" ] [ a [ attribute "href" ("/blueprint/" ++ model.blueprintId), classes "black" ] [ text model.blueprintName ] ] ] + , td [ classes "ph3" ] [ p [ classes "ws-normal" ] [ text model.serviceId ] ] + , td [ classes "ph3 dn dtc-ns" ] [ p [ classes "ws-normal" ] [ text (shortHashRaw 8 model.peerId) ] ] + , td [ classes "ph3 dn dtc-ns" ] [ p [ classes "ws-normal" ] [ text model.ip ] ] + ] diff --git a/src/Services/ServicesTable.elm b/src/Services/ServicesTable.elm new file mode 100644 index 0000000..aa9ae96 --- /dev/null +++ b/src/Services/ServicesTable.elm @@ -0,0 +1,46 @@ +module Services.ServicesTable exposing (Model, fromCache, view) + +import Cache exposing (ServiceId) +import Html exposing (..) +import Html.Attributes exposing (..) +import Maybe.Extra as Maybe +import Services.ServiceRow +import Utils.Html exposing (classes) + + + +-- model + + +type alias Model = + List Services.ServiceRow.Model + + +fromCache : Cache.Model -> List ServiceId -> Model +fromCache cache services = + services + |> List.map (Services.ServiceRow.fromCache cache) + |> Maybe.values + + + +-- view + + +view : Model -> Html msg +view model = + div [ classes "pa1 bg-white br3 overflow-auto" ] + [ div [ classes "mw8-ns pa2 " ] + [ table [ classes "f6 w-100 center ws-normal-ns", attribute "cellspacing" "0" ] + [ thead [] + [ tr [ classes "" ] + [ th [ classes "fw5 tl pa3 gray-font" ] [ text "BLUEPRINT" ] + , th [ classes "fw5 tl pa3 gray-font" ] [ text "SERVICE ID" ] + , th [ classes "fw5 tl pa3 gray-font dn dtc-ns" ] [ text "NODE" ] + , th [ classes "fw5 tl pa3 gray-font dn dtc-ns" ] [ text "MULTIADDR" ] + ] + ] + , tbody [ classes "lucida" ] (model |> List.map Services.ServiceRow.view) + ] + ] + ] diff --git a/src/SpinnerView.elm b/src/SpinnerView.elm deleted file mode 100644 index 0cbed23..0000000 --- a/src/SpinnerView.elm +++ /dev/null @@ -1,13 +0,0 @@ -module SpinnerView exposing (..) - -import Html exposing (Html) -import Html.Attributes exposing (height, width) -import Model exposing (Model) -import Palette exposing (classes) - - -spinner : Model -> List (Html msg) -spinner model = - [ Html.div [ classes "p3 relative" ] - [ Html.div [ classes "spin" ] [] ] - ] diff --git a/src/Subscriptions.elm b/src/Subscriptions.elm deleted file mode 100644 index 801aceb..0000000 --- a/src/Subscriptions.elm +++ /dev/null @@ -1,28 +0,0 @@ -module Subscriptions exposing (subscriptions) - -{-| Copyright 2020 Fluence Labs Limited - -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. - --} - -import Model exposing (Model) -import Msg exposing (Msg(..)) -import Port exposing (eventReceiver) - - -subscriptions : Model -> Sub Msg -subscriptions model = - Sub.batch - [ eventReceiver AquamarineEvent - ] diff --git a/src/Update.elm b/src/Update.elm deleted file mode 100644 index 431c79a..0000000 --- a/src/Update.elm +++ /dev/null @@ -1,140 +0,0 @@ -module Update exposing (update) - -{-| Copyright 2020 Fluence Labs Limited - -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. - --} - -import Blueprints.Model exposing (Blueprint) -import Browser -import Browser.Navigation as Nav -import Dict exposing (Dict) -import Maybe exposing (withDefault) -import Model exposing (Model, PeerData, emptyPeerData) -import Modules.Model exposing (Module) -import Msg exposing (..) -import Nodes.Model exposing (Identify) -import Port exposing (getAll) -import Route exposing (getAllCmd) -import Service.Model exposing (Service) -import Url - - -update : Msg -> Model -> ( Model, Cmd Msg ) -update msg model = - case msg of - NoOp -> - ( model, Cmd.none ) - - UrlChanged url -> - let - route = - Route.parse url - - cmd = - Route.routeCommand model route - in - ( { model | url = url, isInitialized = True, page = route, toggledInterface = Nothing }, cmd ) - - 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, peer, peers, identify, services, modules, blueprints } -> - case name of - "peers_discovered" -> - let - peersMap = - List.map (\p -> Tuple.pair p emptyPeerData) (withDefault [] peers) - - newDict = - Dict.fromList peersMap - - updatedDict = - Dict.union model.discoveredPeers newDict - in - ( { model | discoveredPeers = updatedDict }, getAllCmd model.peerId model.relayId [] ) - - "all_info" -> - let - updated = - Maybe.map4 (updateModel model peer) identify services modules blueprints - - updatedModel = - withDefault model updated - in - ( updatedModel, Cmd.none ) - - _ -> - ( model, Cmd.none ) - - ToggleInterface id -> - case model.toggledInterface of - Just ti -> - ( { model - | toggledInterface = - if id == ti then - Nothing - - else - Just id - } - , Cmd.none - ) - - Nothing -> - ( { model | toggledInterface = Just id }, Cmd.none ) - - RelayChanged relayId -> - ( { model | relayId = relayId }, Cmd.none ) - - Reload -> - ( model, getAll { relayPeerId = model.relayId, knownPeers = model.knownPeers } ) - - -updateModel : Model -> String -> Identify -> List Service -> List Module -> List Blueprint -> Model -updateModel model peer identify services modules blueprints = - let - data = - Maybe.withDefault emptyPeerData (Dict.get peer model.discoveredPeers) - - moduleDict = - modules |> List.map (\m -> ( m.name, m )) |> Dict.fromList - - moduleDictByHash = - modules |> List.map (\m -> ( m.hash, m )) |> Dict.fromList - - blueprintDict = - blueprints |> List.map (\b -> ( b.id, b )) |> Dict.fromList - - updatedModules = - Dict.union moduleDict model.modules - - updatedModulesByHash = - Dict.union moduleDictByHash model.modulesByHash - - updatedBlueprints = - Dict.union blueprintDict model.blueprints - - newData = - { data | identify = identify, services = services, modules = Dict.keys moduleDict, blueprints = Dict.keys blueprintDict } - - updated = - Dict.insert peer newData model.discoveredPeers - in - { model | discoveredPeers = updated, modules = updatedModules, modulesByHash = updatedModulesByHash, blueprints = updatedBlueprints } diff --git a/src/Utils/Html.elm b/src/Utils/Html.elm new file mode 100644 index 0000000..b5a0d7a --- /dev/null +++ b/src/Utils/Html.elm @@ -0,0 +1,20 @@ +module Utils.Html exposing (..) + +import Html +import Html.Attributes exposing (classList) + + +textOrBsp : String -> String +textOrBsp text = + if text == "" then + String.fromChar (Char.fromCode 0xA0) + + else + text + + +classes : String -> Html.Attribute msg +classes cls = + classList <| + List.map (\s -> ( s, True )) <| + String.split " " cls diff --git a/src/View.elm b/src/View.elm deleted file mode 100644 index 3629888..0000000 --- a/src/View.elm +++ /dev/null @@ -1,96 +0,0 @@ -module View exposing (view) - -{-| Copyright 2020 Fluence Labs Limited - -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. - --} - -import Browser exposing (Document, UrlRequest(..)) -import Html exposing (Html, a, div, header, img, p, text) -import Html.Attributes exposing (attribute, style) -import Html.Events exposing (onClick) -import Model exposing (Model, Route(..)) -import Msg exposing (..) -import Palette exposing (classes) -import Route exposing (routeView) - - -view : Model -> Document Msg -view model = - { title = title model, body = [ body model ] } - - -title : Model -> String -title _ = - "Fluence Network Dashboard" - - -body : Model -> Html Msg -body model = - layout <| - List.concat - [ [ header [ classes "w-100" ] - [ div [ classes "w-100 fl pv2 bg-white one-edge-shadow" ] - [ div [ classes "mw8-ns center ph3" ] - [ div [ classes "fl mv1 pl3" ] - [ a [ attribute "href" "/" ] - [ img - [ classes "mw-100" - , style "height" "30px" - , attribute "src" "/images/logo_new.svg" - , style "position" "relative" - , style "top" "0.16rem" - ] - [] - ] - ] - , div [ classes "fl pl5 h-auto" ] - [ p [ classes "h-100 m-auto fw4" ] - [ a [ attribute "href" "/", classes "link black" ] [ text "Developer Hub" ] - ] - ] - , div [ classes "fl pl5 h-auto" ] - [ p [ classes "h-100 m-auto fw4" ] - [ a [ attribute "href" "/nodes", classes "link black" ] [ text "Nodes" ] - ] - ] - , div [ classes "fl fr" ] - [ a [ attribute "href" "/" ] - [ img - [ classes "mw-100" - , style "height" "20px" - , attribute "src" "/images/reload.svg" - , style "position" "relative" - , style "top" "0.85rem" - , onClick Reload - ] - [] - ] - ] - ] - ] - ] - ] - , [ div [ classes "mw8-ns center w-100 pa4 pt3 mt4" ] [ routeView model model.page ] ] - ] - - -layout : List (Html Msg) -> Html Msg -layout elms = - div [ classes "center w-100" ] - [ div [ classes "fl w-100" ] - ([] - ++ elms - ) - ] diff --git a/src/_aqua/app.js b/src/_aqua/app.js index 6af7308..2b2a1c2 100644 --- a/src/_aqua/app.js +++ b/src/_aqua/app.js @@ -3,17 +3,18 @@ * This file is auto-generated. Do not edit manually: changes may be erased. * Generated by Aqua compiler: https://github.com/fluencelabs/aqua/. * If you find any bugs, please write an issue on GitHub: https://github.com/fluencelabs/aqua/issues - * Aqua version: 0.1.7-153 + * Aqua version: 0.1.8-161 * */ import { RequestFlowBuilder } from '@fluencelabs/fluence/dist/api.unstable'; -export async function askAllAndSend(client, peer) { +export async function collectServiceInterfaces(client, peer, services, collectServiceInterface, config) { let request; + config = config || {}; const promise = new Promise((resolve, reject) => { - request = new RequestFlowBuilder() + var r = new RequestFlowBuilder() .disableInjections() .withRawScript( ` @@ -21,35 +22,34 @@ export async function askAllAndSend(client, peer) { (seq (seq (seq + (call %init_peer_id% ("getDataSrv" "-relay-") [] -relay-) + (call %init_peer_id% ("getDataSrv" "peer") [] peer) + ) + (call %init_peer_id% ("getDataSrv" "services") [] services) + ) + (fold services srv + (par (seq - (seq - (call %init_peer_id% ("getDataSrv" "-relay-") [] -relay-) - (call %init_peer_id% ("getDataSrv" "peer") [] peer) - ) (call -relay- ("op" "noop") []) - ) - (xor - (seq + (xor (seq (seq - (call peer ("peer" "identify") [] ident) - (call peer ("dist" "list_blueprints") [] blueprints) + (call peer ("srv" "get_interface") [srv.$.id!] iface) + (call -relay- ("op" "noop") []) + ) + (xor + (call %init_peer_id% ("callbackSrv" "collectServiceInterface") [peer srv.$.id! iface]) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 1]) ) - (call peer ("dist" "list_modules") [] modules) ) - (call peer ("srv" "list") [] services) - ) - (seq - (call -relay- ("op" "noop") []) - (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 1]) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 2]) ) ) + (next srv) ) - (call -relay- ("op" "noop") []) ) - (call %init_peer_id% ("event" "all_info") [peer ident services blueprints modules]) ) - (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 2]) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 3]) ) `, @@ -59,6 +59,111 @@ export async function askAllAndSend(client, peer) { return client.relayPeerId; }); h.on('getDataSrv', 'peer', () => {return peer;}); +h.on('getDataSrv', 'services', () => {return services;}); +h.on('callbackSrv', 'collectServiceInterface', (args) => {collectServiceInterface(args[0], args[1], args[2]); return {};}); + + h.onEvent('errorHandlingSrv', 'error', (args) => { + // assuming error is the single argument + const [err] = args; + reject(err); + }); + }) + .handleScriptError(reject) + .handleTimeout(() => { + reject('Request timed out for collectServiceInterfaces'); + }) + if(config.ttl) { + r.withTTL(config.ttl) + } + request = r.build(); + }); + await client.initiateFlow(request); + return Promise.race([promise, Promise.resolve()]); +} + + + +export async function askAllAndSend(client, peer, collectPeerInfo, collectServiceInterface, config) { + let request; + config = config || {}; + const promise = new Promise((resolve, reject) => { + var r = new RequestFlowBuilder() + .disableInjections() + .withRawScript( + ` +(xor + (seq + (seq + (seq + (call %init_peer_id% ("getDataSrv" "-relay-") [] -relay-) + (call %init_peer_id% ("getDataSrv" "peer") [] peer) + ) + (call -relay- ("op" "noop") []) + ) + (xor + (seq + (seq + (seq + (seq + (seq + (seq + (seq + (call peer ("peer" "identify") [] ident) + (call peer ("dist" "list_blueprints") [] blueprints) + ) + (call peer ("dist" "list_modules") [] modules) + ) + (call peer ("srv" "list") [] services) + ) + (call -relay- ("op" "noop") []) + ) + (xor + (call %init_peer_id% ("callbackSrv" "collectPeerInfo") [peer ident services blueprints modules]) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 1]) + ) + ) + (call -relay- ("op" "noop") []) + ) + (fold services srv + (par + (seq + (call -relay- ("op" "noop") []) + (xor + (seq + (seq + (call peer ("srv" "get_interface") [srv.$.id!] iface) + (call -relay- ("op" "noop") []) + ) + (xor + (call %init_peer_id% ("callbackSrv" "collectServiceInterface") [peer srv.$.id! iface]) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 2]) + ) + ) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 3]) + ) + ) + (seq + (call -relay- ("op" "noop") []) + (next srv) + ) + ) + ) + ) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 4]) + ) + ) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 5]) +) + + `, + ) + .configHandler((h) => { + h.on('getDataSrv', '-relay-', () => { + return client.relayPeerId; + }); + h.on('getDataSrv', 'peer', () => {return peer;}); +h.on('callbackSrv', 'collectPeerInfo', (args) => {collectPeerInfo(args[0], args[1], args[2], args[3], args[4]); return {};}); +h.on('callbackSrv', 'collectServiceInterface', (args) => {collectServiceInterface(args[0], args[1], args[2]); return {};}); h.onEvent('errorHandlingSrv', 'error', (args) => { // assuming error is the single argument @@ -70,7 +175,10 @@ export async function askAllAndSend(client, peer) { .handleTimeout(() => { reject('Request timed out for askAllAndSend'); }) - .build(); + if(config.ttl) { + r.withTTL(config.ttl) + } + request = r.build(); }); await client.initiateFlow(request); return Promise.race([promise, Promise.resolve()]); @@ -78,10 +186,11 @@ export async function askAllAndSend(client, peer) { -export async function findAndAskNeighboursSchema(client, relayPeerId, clientId) { +export async function findAndAskNeighboursSchema(client, relayPeerId, clientId, collectPeerInfo, collectServiceInterface, config) { let request; + config = config || {}; const promise = new Promise((resolve, reject) => { - request = new RequestFlowBuilder() + var r = new RequestFlowBuilder() .disableInjections() .withRawScript( ` @@ -106,28 +215,60 @@ export async function findAndAskNeighboursSchema(client, relayPeerId, clientId) (seq (call n ("kad" "neighborhood") [clientId false] neighbors2) (fold neighbors2 n2 - (seq - (seq - (xor + (par + (xor + (seq (seq (seq (seq - (call n2 ("peer" "identify") [] ident) - (call n2 ("dist" "list_blueprints") [] blueprints) + (seq + (seq + (seq + (call n2 ("peer" "identify") [] ident) + (call n2 ("dist" "list_blueprints") [] blueprints) + ) + (call n2 ("dist" "list_modules") [] modules) + ) + (call n2 ("srv" "list") [] services) + ) + (call -relay- ("op" "noop") []) + ) + (xor + (call %init_peer_id% ("callbackSrv" "collectPeerInfo") [n2 ident services blueprints modules]) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 1]) ) - (call n2 ("dist" "list_modules") [] modules) - ) - (call n2 ("srv" "list") [] services) - ) - (seq - (seq - (call -relay- ("op" "noop") []) - (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 1]) ) (call -relay- ("op" "noop") []) ) + (fold services srv + (par + (seq + (call -relay- ("op" "noop") []) + (xor + (seq + (seq + (call n2 ("srv" "get_interface") [srv.$.id!] iface) + (call -relay- ("op" "noop") []) + ) + (xor + (call %init_peer_id% ("callbackSrv" "collectServiceInterface") [n2 srv.$.id! iface]) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 2]) + ) + ) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 3]) + ) + ) + (seq + (call -relay- ("op" "noop") []) + (next srv) + ) + ) + ) + ) + (seq + (call -relay- ("op" "noop") []) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 4]) ) - (call n ("event" "all_info") [n2 ident services blueprints modules]) ) (next n2) ) @@ -135,17 +276,17 @@ export async function findAndAskNeighboursSchema(client, relayPeerId, clientId) ) (seq (call -relay- ("op" "noop") []) - (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 2]) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 5]) ) ) (next n) ) ) ) - (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 3]) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 6]) ) ) - (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 4]) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 7]) ) `, @@ -156,6 +297,8 @@ export async function findAndAskNeighboursSchema(client, relayPeerId, clientId) }); h.on('getDataSrv', 'relayPeerId', () => {return relayPeerId;}); h.on('getDataSrv', 'clientId', () => {return clientId;}); +h.on('callbackSrv', 'collectPeerInfo', (args) => {collectPeerInfo(args[0], args[1], args[2], args[3], args[4]); return {};}); +h.on('callbackSrv', 'collectServiceInterface', (args) => {collectServiceInterface(args[0], args[1], args[2]); return {};}); h.onEvent('errorHandlingSrv', 'error', (args) => { // assuming error is the single argument @@ -167,7 +310,10 @@ h.on('getDataSrv', 'clientId', () => {return clientId;}); .handleTimeout(() => { reject('Request timed out for findAndAskNeighboursSchema'); }) - .build(); + if(config.ttl) { + r.withTTL(config.ttl) + } + request = r.build(); }); await client.initiateFlow(request); return Promise.race([promise, Promise.resolve()]); @@ -175,10 +321,11 @@ h.on('getDataSrv', 'clientId', () => {return clientId;}); -export async function getAll(client, relayPeerId, knownPeers) { +export async function getAll(client, relayPeerId, knownPeers, collectPeerInfo, collectServiceInterface, config) { let request; + config = config || {}; const promise = new Promise((resolve, reject) => { - request = new RequestFlowBuilder() + var r = new RequestFlowBuilder() .disableInjections() .withRawScript( ` @@ -191,117 +338,67 @@ export async function getAll(client, relayPeerId, knownPeers) { ) (call %init_peer_id% ("getDataSrv" "knownPeers") [] knownPeers) ) - (par + (fold knownPeers peer (par (seq - (seq - (seq - (call -relay- ("op" "noop") []) - (xor - (seq - (seq - (seq - (call relayPeerId ("peer" "identify") [] ident) - (call relayPeerId ("dist" "list_blueprints") [] blueprints) - ) - (call relayPeerId ("dist" "list_modules") [] modules) - ) - (call relayPeerId ("srv" "list") [] services) - ) - (seq - (call -relay- ("op" "noop") []) - (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 1]) - ) - ) - ) - (call -relay- ("op" "noop") []) - ) - (call %init_peer_id% ("event" "all_info") [relayPeerId ident services blueprints modules]) - ) - (fold knownPeers peer - (par + (call -relay- ("op" "noop") []) + (xor (seq (seq (seq - (call -relay- ("op" "noop") []) - (xor + (seq (seq (seq (seq - (call peer ("peer" "identify") [] ident0) - (call peer ("dist" "list_blueprints") [] blueprints0) + (call peer ("peer" "identify") [] ident) + (call peer ("dist" "list_blueprints") [] blueprints) ) - (call peer ("dist" "list_modules") [] modules0) + (call peer ("dist" "list_modules") [] modules) ) - (call peer ("srv" "list") [] services0) - ) - (seq - (call -relay- ("op" "noop") []) - (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 2]) + (call peer ("srv" "list") [] services) ) + (call -relay- ("op" "noop") []) + ) + (xor + (call %init_peer_id% ("callbackSrv" "collectPeerInfo") [peer ident services blueprints modules]) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 1]) ) ) (call -relay- ("op" "noop") []) ) - (call %init_peer_id% ("event" "all_info") [peer ident0 services0 blueprints0 modules0]) - ) - (next peer) - ) - ) - ) - (seq - (call -relay- ("op" "noop") []) - (xor - (seq - (call relayPeerId ("kad" "neighborhood") [%init_peer_id% false] neighbors) - (fold neighbors n - (par - (xor + (fold services srv + (par (seq - (call n ("kad" "neighborhood") [%init_peer_id% false] neighbors2) - (fold neighbors2 n2 + (call -relay- ("op" "noop") []) + (xor (seq (seq - (xor - (seq - (seq - (seq - (call n2 ("peer" "identify") [] ident1) - (call n2 ("dist" "list_blueprints") [] blueprints1) - ) - (call n2 ("dist" "list_modules") [] modules1) - ) - (call n2 ("srv" "list") [] services1) - ) - (seq - (seq - (call -relay- ("op" "noop") []) - (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 3]) - ) - (call -relay- ("op" "noop") []) - ) - ) - (call n ("event" "all_info") [n2 ident1 services1 blueprints1 modules1]) + (call peer ("srv" "get_interface") [srv.$.id!] iface) + (call -relay- ("op" "noop") []) + ) + (xor + (call %init_peer_id% ("callbackSrv" "collectServiceInterface") [peer srv.$.id! iface]) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 2]) ) - (next n2) ) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 3]) ) ) (seq (call -relay- ("op" "noop") []) - (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 4]) + (next srv) ) ) - (next n) ) ) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 4]) ) - (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 5]) ) + (next peer) ) ) ) - (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 6]) + (call %init_peer_id% ("errorHandlingSrv" "error") [%last_error% 5]) ) `, @@ -312,6 +409,8 @@ export async function getAll(client, relayPeerId, knownPeers) { }); h.on('getDataSrv', 'relayPeerId', () => {return relayPeerId;}); h.on('getDataSrv', 'knownPeers', () => {return knownPeers;}); +h.on('callbackSrv', 'collectPeerInfo', (args) => {collectPeerInfo(args[0], args[1], args[2], args[3], args[4]); return {};}); +h.on('callbackSrv', 'collectServiceInterface', (args) => {collectServiceInterface(args[0], args[1], args[2]); return {};}); h.onEvent('errorHandlingSrv', 'error', (args) => { // assuming error is the single argument @@ -323,7 +422,10 @@ h.on('getDataSrv', 'knownPeers', () => {return knownPeers;}); .handleTimeout(() => { reject('Request timed out for getAll'); }) - .build(); + if(config.ttl) { + r.withTTL(config.ttl) + } + request = r.build(); }); await client.initiateFlow(request); return Promise.race([promise, Promise.resolve()]); diff --git a/src/index.js b/src/index.js index caa1f20..61ceb49 100644 --- a/src/index.js +++ b/src/index.js @@ -31,7 +31,7 @@ import { } from '@fluencelabs/fluence'; import { Elm } from './Main.elm'; import * as serviceWorker from './serviceWorker'; -import { eventType } from './types'; +import { interfaceInfo, peerInfo } from './types'; import { getAll } from './_aqua/app'; const defaultNetworkName = 'krasnodar'; @@ -118,28 +118,6 @@ function genFlags(peerId, relays, relayIdx) { }; } -/* eslint-disable */ -function event(name, peer, peers, identify, services, modules, blueprints) { - if (!peers) { - peers = null; - } - if (!services) { - services = null; - } - if (!modules) { - modules = null; - } - if (!identify) { - identify = null; - } - if (!blueprints) { - blueprints = null; - } - - return { name, peer, peers, identify, services, modules, blueprints }; -} -/* eslint-enable */ - (async () => { const { relays, relayIdx, logLevel } = await initEnvironment(); setLogLevel(logLevel); @@ -155,21 +133,14 @@ function event(name, peer, peers, identify, services, modules, blueprints) { flags: flags, }); - subscribeToEvent(client, 'event', 'peers_discovered', (args, _tetraplets) => { - try { - app.ports.eventReceiver.send(event('peers_discovered', args[0], args[1])); - } catch (err) { - log.error('Elm eventreceiver failed: ', err); - } - }); - - subscribeToEvent(client, 'event', 'all_info', (args, _tetraplets) => { + subscribeToEvent(client, 'event', 'collectPeerInfo', (args, _tetraplets) => { try { const peerId = args[0]; const identify = args[1]; const services = args[2]; const blueprints = args[3]; const modules = args[4]; + const interfaces = args[5]; const eventRaw = { peerId, identify, @@ -178,26 +149,64 @@ function event(name, peer, peers, identify, services, modules, blueprints) { modules, }; - const inputEvent = eventType.cast(eventRaw); - - app.ports.eventReceiver.send( - event( - 'all_info', - inputEvent.peerId, - undefined, - inputEvent.identify, - inputEvent.services, - inputEvent.modules, - inputEvent.blueprints, - ), - ); + app.ports.collectPeerInfo.send(eventRaw); } catch (err) { log.error('Elm eventreceiver failed: ', err); } }); + subscribeToEvent(client, 'event', 'collectServiceInterface', (args, _tetraplets) => { + try { + const eventRaw = { + peer_id: args[0], + service_id: args[1], + interface: args[2], + }; + + app.ports.collectServiceInterface.send(eventRaw); + } catch (err) { + log.error('Elm eventreceiver failed: ', err); + } + }); + + // alias ServiceInterfaceCb: PeerId, string, Interface -> () + function collectServiceInterface(peer_id, service_id, iface) { + // console.count(`service interface from ${peer_id}`); + try { + const eventRaw = { + peer_id, + service_id, + interface: iface, + }; + + app.ports.collectServiceInterface.send(eventRaw); + } catch (err) { + log.error('Elm eventreceiver failed: ', err); + } + } + + // alias PeerInfoCb: PeerId, Info, []Service, []Blueprint, []Module -> () + function collectPeerInfo(peerId, identify, services, blueprints, modules, interfaces) { + // console.log('peer info from %s, %s services', peerId, services.length); + try { + const eventRaw = { + peerId, + identify, + services, + blueprints, + modules, + }; + + app.ports.collectPeerInfo.send(eventRaw); + } catch (err) { + log.error('Elm eventreceiver failed: ', err); + } + } + app.ports.getAll.subscribe(async (data) => { - await getAll(client, data.relayPeerId, data.knownPeers); + await getAll(client, data.relayPeerId, data.knownPeers, collectPeerInfo, collectServiceInterface, { + ttl: 1000000, + }); }); })(); diff --git a/src/types.js b/src/types.js index ca24d78..5d55047 100644 --- a/src/types.js +++ b/src/types.js @@ -37,10 +37,16 @@ export const module = object({ name: string().required(), }); -export const eventType = object({ +export const peerInfo = object({ peerId: string().required(), identify: identify.required(), services: array(service).required(), blueprints: array(blueprint).required(), modules: array(module).required(), }); + +export const interfaceInfo = object({ + peer_id: string().required(), + service_id: string().required(), + interface: object().required(), +}); diff --git a/src_storybook/Explorer.elm b/src_storybook/Explorer.elm new file mode 100644 index 0000000..59ded05 --- /dev/null +++ b/src_storybook/Explorer.elm @@ -0,0 +1,55 @@ +module Explorer exposing (main) + +import Blueprints.BlueprintTile +import Html exposing (div) +import Html.Attributes exposing (attribute, style) +import UIExplorer + exposing + ( UIExplorerProgram + , category + , createCategories + , defaultConfig + , explore + , exploreWithCategories + , storiesOf + ) + + +config = + defaultConfig + + +main : UIExplorerProgram {} () {} {} +main = + exploreWithCategories + config + (createCategories + |> category + "Hub" + [] + |> category + "Blueprints" + [ storiesOf + "Tile" + [ let + model = + { name = "String" + , author = "String" + , numberOfInstances = 10 + , id = "String" + } + in + ( "Blueprint tile", \_ -> wrapper {} (Blueprints.BlueprintTile.view model), {} ) + ] + ] + ) + + +wrapper opts x = + div + [ style "height" "500px" + , style "width" "500px" + , style "background" "#F4F4F4" + , style "padding" "50px" + ] + [ x ]