Add lamassu-admin-elm to this repo (#185)

lamassu-admin-elm/src/SupportLogs/Rest.elm

@@ -0,0 +1,20 @@
+module SupportLogs.Rest exposing (..)
+
+import RemoteData exposing (..)
+import Http
+import Common.Logs.Decoder exposing (logsDecoder, supportLogDecoder, supportLogsDecoder)
+import SupportLogs.Types exposing (..)
+
+
+getAllLogs : Maybe String -> Cmd Msg
+getAllLogs maybeId =
+    Http.get ("/api/support_logs/logs?supportLogId=" ++ (Maybe.withDefault "" maybeId)) logsDecoder
+        |> RemoteData.sendRequest
+        |> Cmd.map LoadLogs
+
+
+getSupportLogs : Cmd Msg
+getSupportLogs =
+    Http.get "/api/support_logs/" supportLogsDecoder
+        |> RemoteData.sendRequest
+        |> Cmd.map LoadSupportLogs

lamassu-admin-elm/src/SupportLogs/State.elm

@@ -0,0 +1,34 @@
+module SupportLogs.State exposing (..)
+
+import RemoteData exposing (..)
+import SupportLogs.Rest exposing (..)
+import SupportLogs.Types exposing (..)
+
+
+init : Model
+init =
+    { logs = NotAsked, supportLogs = NotAsked }
+
+
+load : Maybe String -> ( Model, Cmd Msg )
+load maybeId =
+    ( { logs = Loading, supportLogs = Loading }, getSupportData maybeId )
+
+
+getSupportData : Maybe String -> Cmd Msg
+getSupportData maybeId =
+    Cmd.batch [ getAllLogs maybeId, getSupportLogs ]
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        LoadLogs response ->
+            ( { model | logs = response }
+            , Cmd.none
+            )
+
+        LoadSupportLogs response ->
+            ( { model | supportLogs = response }
+            , Cmd.none
+            )

lamassu-admin-elm/src/SupportLogs/Types.elm

@@ -0,0 +1,15 @@
+module SupportLogs.Types exposing (..)
+
+import RemoteData exposing (..)
+import Common.Logs.Types exposing (..)
+
+
+type alias Model =
+    { logs : WebData Logs
+    , supportLogs : WebData SupportLogs
+    }
+
+
+type Msg
+    = LoadLogs (WebData Logs)
+    | LoadSupportLogs (WebData SupportLogs)

lamassu-admin-elm/src/SupportLogs/View.elm

@@ -0,0 +1,123 @@
+module SupportLogs.View exposing (..)
+
+import Html exposing (..)
+import Html.Attributes exposing (href)
+import Css.Admin exposing (..)
+import Css.Classes as C
+import RemoteData exposing (..)
+import List
+import Common.Logs.Types exposing (..)
+import SupportLogs.Types exposing (..)
+import Date exposing (..)
+import Date.Extra exposing (toFormattedString)
+
+
+supportLogText : SupportLog -> Html Msg
+supportLogText supportLog =
+    text (supportLog.name ++ " " ++ (toFormattedString "yyyy-MM-dd HH:mm" supportLog.timestamp))
+
+
+supportLogLink : SupportLog -> Html Msg
+supportLogLink supportLog =
+    a [ href ("/#support_logs/" ++ supportLog.id) ] [ supportLogText supportLog ]
+
+
+formatDate : Date -> String
+formatDate date =
+    toFormattedString "yyyy-MM-dd HH:mm" date
+
+
+rowView : Log -> Html Msg
+rowView log =
+    tr [ class [] ]
+        [ td [] [ text (formatDate log.timestamp) ]
+        , td [] [ text log.logLevel ]
+        , td [] [ text log.message ]
+        ]
+
+
+supportLogItemView : SupportLog -> Html Msg
+supportLogItemView supportLog =
+    li [] [ supportLogLink supportLog ]
+
+
+supportLogsView : SupportLogs -> Html Msg
+supportLogsView supportLogs =
+    if List.isEmpty supportLogs then
+        div [ class [ C.EmptyTable ] ] [ text "No shared logs" ]
+    else
+        div []
+            [ div [ class [ C.TxTable ] ]
+                [ ul [] (List.map supportLogItemView supportLogs)
+                ]
+            ]
+
+
+supportLogs : Model -> Html Msg
+supportLogs model =
+    case model.supportLogs of
+        NotAsked ->
+            div [] []
+
+        Loading ->
+            div [] [ text "Loading snapshots ..." ]
+
+        Failure err ->
+            div [] [ text (toString err) ]
+
+        Success supportLogs ->
+            div [] [ supportLogsView supportLogs ]
+
+
+logsView : Logs -> Html Msg
+logsView logs =
+    if List.isEmpty logs.logs then
+        div [] [ text "No logs yet." ]
+    else
+        div []
+            [ table [ class [ C.TxTable ] ]
+                [ thead []
+                    [ tr []
+                        [ td [] [ text "Date" ]
+                        , td [] [ text "Level" ]
+                        , td [] [ text "Message" ]
+                        ]
+                    ]
+                , tbody [] (List.map rowView logs.logs)
+                ]
+            ]
+
+
+logs : Model -> Html Msg
+logs model =
+    case model.logs of
+        NotAsked ->
+            div [] []
+
+        Loading ->
+            div [] [ text "Loading logs..." ]
+
+        Failure err ->
+            div [] [ text "No logs yet." ]
+
+        Success logs ->
+            div []
+                [ logsView logs
+                ]
+
+
+view : Model -> Html Msg
+view model =
+    div []
+        [ h1 [] [ text "Lamassu support logs" ]
+        , div [ class [ C.PaneWrapper ] ]
+            [ div [ class [ C.LeftPane ] ]
+                [ h2 [] [ text "Shared snapshots" ]
+                , supportLogs model
+                ]
+            , div [ class [ C.ContentPane ] ]
+                [ h2 [] [ text "Logs" ]
+                , logs model
+                ]
+            ]
+        ]