diff --git a/src/BlueprintPage/View.elm b/src/BlueprintPage/View.elm index 3195bfb..d4f2d35 100644 --- a/src/BlueprintPage/View.elm +++ b/src/BlueprintPage/View.elm @@ -87,6 +87,11 @@ viewInfo blueprintInfo = ] +alwaysPreventDefault : msg -> { message : msg, stopPropagation : Bool, preventDefault : Bool } +alwaysPreventDefault msg = + { message = msg, stopPropagation = True, preventDefault = True } + + viewToggledInterface : Bool -> String -> Interface -> Html Msg viewToggledInterface isOpen name interface = let @@ -100,7 +105,7 @@ viewToggledInterface isOpen name interface = 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 ] - , img [ attribute "src" "/images/link.svg", attribute "href" ("/module/" ++ name), classes "dib v-mid mt1" ] [] + , 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 "▲" diff --git a/src/NodePage/View.elm b/src/NodePage/View.elm new file mode 100644 index 0000000..6a95cca --- /dev/null +++ b/src/NodePage/View.elm @@ -0,0 +1,66 @@ +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) + + +type alias Node = + { id : String + , ip : String + , servicesNumber : Int + } + + +view : Model -> Html msg +view model = + let + nodes = + modelToNodes model + in + 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 ] + ] + + +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 "IP" ] + , 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/Route.elm b/src/Route.elm index fc0036f..8632843 100644 --- a/src/Route.elm +++ b/src/Route.elm @@ -7,6 +7,7 @@ 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 (sendAir) import Url.Parser exposing ((), Parser, map, oneOf, s, string) @@ -36,6 +37,9 @@ routeView model route = "hub" -> HubPage.view model + "nodes" -> + NodePage.view model + _ -> text ("undefined page: " ++ page) diff --git a/src/View.elm b/src/View.elm index 13f5f20..196a690 100644 --- a/src/View.elm +++ b/src/View.elm @@ -59,6 +59,11 @@ body model = [ 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" ] + ] + ] ] ] ]