module Main exposing (..) import Browser import Browser.Navigation as Nav import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onInput) import Http import Json.Decode as D import SwitchData import Url import Url.Builder main : Program () Model Msg main = Browser.application { init = init , view = view , update = update , subscriptions = subscriptions , onUrlChange = UrlChanged , onUrlRequest = LinkClicked } type alias Model = { key : Nav.Key , url : Url.Url , token : Maybe String , token_data : Maybe TokenData , switch_cursor : ( Int, Int ) , switch_data : Maybe (List SwitchData.Switch) } init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) init flags url key = ( Model key url Nothing Nothing ( 40, 0 ) Nothing , Cmd.none ) type Msg = LinkClicked Browser.UrlRequest | UrlChanged Url.Url | TokenInput String | TokenValidate (Result Http.Error TokenData) | Logout | GetSwitchData ( Int, Int ) | GotSwitchData (Result Http.Error (List SwitchData.Switch)) type alias TokenData = { sub : String , jti : String } tokenDecoder : D.Decoder TokenData tokenDecoder = D.map2 TokenData (D.field "sub" D.string) (D.field "jti" D.string) request method token path body expect = Http.request { method = method , body = body , headers = [ Http.header "Authorization" token ] , url = path , expect = expect , timeout = Nothing , tracker = Nothing } update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of LinkClicked urlRequest -> case urlRequest of Browser.Internal url -> ( model, Nav.pushUrl model.key (Url.toString url) ) Browser.External href -> ( model, Nav.load href ) UrlChanged url -> case url.path of "/logout" -> ( model, Nav.load "/" ) default -> ( { model | url = url } , Cmd.none ) TokenInput token -> ( { model | token = Just token } , request "GET" token "/.within/tokeninfo" Http.emptyBody (expectJson TokenValidate tokenDecoder) ) TokenValidate result -> case result of Ok data -> ( { model | token_data = Just data } , Cmd.none ) Err _ -> ( { model | token = Nothing } , Cmd.none ) Logout -> ( { model | token = Nothing, token_data = Nothing } , Nav.load "/" ) GetSwitchData ( limit, page ) -> case model.token of Just token -> ( model , request "GET" token (SwitchData.dataURL limit page) Http.emptyBody (expectJson GotSwitchData (D.list SwitchData.decoder)) ) Nothing -> ( model, Cmd.none ) _ -> ( model, Cmd.none ) subscriptions : Model -> Sub Msg subscriptions _ = Sub.none view : Model -> Browser.Document Msg view model = case model.token_data of Nothing -> { title = "Login" , body = [ node "main" [ style "align" "center" ] [ h1 [] [ text "Login" ] , viewInput "password" "API Token" "" TokenInput ] ] } Just token_data -> case model.url.path of "/" -> template "Mi" [ h1 [] [ text "Mi" ] , h2 [] [ text "TODO" ] , ul [] [ li [] [ text "Switch CRUD" ] , li [] [ text "POSSE manual announcement" ] ] , h2 [] [ text "Token data" ] , p [] [ text "Token sub: " , text token_data.sub , Html.br [] [] , text "ID: " , text token_data.jti ] ] "/switch" -> case model.switch_data of Nothing -> template "Switch counter" [ h1 [] [ text "Switch counter" ] , p [] [ text "loading..." ] ] Just switches -> template "Switch counter" [ h1 [] [ text "TODO: table" ] ] other -> template "Not found" [ h1 [] [ text "Not found" ] , p [] [ text "The requested URL " , b [] [ text other ] , text " was not found." ] ] viewInput : String -> String -> String -> (String -> msg) -> Html msg viewInput t p v toMsg = input [ type_ t, placeholder p, value v, onInput toMsg ] [] viewLink : String -> String -> Html msg viewLink path title = a [ href path ] [ text title ] template : String -> List (Html msg) -> Browser.Document msg template title body = { title = title , body = [ node "main" [] [ navBar , div [] body , footer ] ] } navBar : Html msg navBar = node "nav" [] [ p [] [ viewLink "/" "Mi" , text " - " , viewLink "/switch" "Switch tracker" , text " - " , viewLink "/logout" "Logout" ] ] footer : Html msg footer = node "footer" [] [ p [] [ a [ href "https://within.website" ] [ text "From Within" ] , text " - " , a [ href "https://tulpa.dev/cadey/mi" ] [ text "Source code" ] ] ] expectJson : (Result Http.Error a -> msg) -> D.Decoder a -> Http.Expect msg expectJson toMsg decoder = Http.expectStringResponse toMsg <| \response -> case response of Http.BadUrl_ url -> Err (Http.BadUrl url) Http.Timeout_ -> Err Http.Timeout Http.NetworkError_ -> Err Http.NetworkError Http.BadStatus_ metadata body -> Err (Http.BadStatus metadata.statusCode) Http.GoodStatus_ metadata body -> case D.decodeString decoder body of Ok value -> Ok value Err err -> Err (Http.BadBody (D.errorToString err))