Initial application stub

modules/webapp/src/main/elm/Api.elm

@@ -0,0 +1,72 @@
+module Api exposing (..)
+
+import Http
+import Task
+import Util.Http as Http2
+import Data.Flags exposing (Flags)
+import Api.Model.UserPass exposing (UserPass)
+import Api.Model.AuthResult exposing (AuthResult)
+import Api.Model.VersionInfo exposing (VersionInfo)
+
+login: Flags -> UserPass -> ((Result Http.Error AuthResult) -> msg) -> Cmd msg
+login flags up receive =
+    Http.post
+        { url = flags.config.baseUrl ++ "/api/v1/open/auth/login"
+        , body = Http.jsonBody (Api.Model.UserPass.encode up)
+        , expect = Http.expectJson receive Api.Model.AuthResult.decoder
+        }
+
+logout: Flags -> ((Result Http.Error ()) -> msg) -> Cmd msg
+logout flags receive =
+    Http2.authPost
+        { url = flags.config.baseUrl ++ "/api/v1/sec/auth/logout"
+        , account = getAccount flags
+        , body = Http.emptyBody
+        , expect = Http.expectWhatever receive
+        }
+
+loginSession: Flags -> ((Result Http.Error AuthResult) -> msg) -> Cmd msg
+loginSession flags receive =
+    Http2.authPost
+        { url = flags.config.baseUrl ++ "/api/v1/sec/auth/session"
+        , account = getAccount flags
+        , body = Http.emptyBody
+        , expect = Http.expectJson receive Api.Model.AuthResult.decoder
+        }
+
+versionInfo: Flags -> ((Result Http.Error VersionInfo) -> msg) -> Cmd msg
+versionInfo flags receive =
+    Http.get
+        { url = flags.config.baseUrl ++ "/api/info/version"
+        , expect = Http.expectJson receive Api.Model.VersionInfo.decoder
+        }
+
+refreshSession: Flags -> ((Result Http.Error AuthResult) -> msg) -> Cmd msg
+refreshSession flags receive =
+    case flags.account of
+        Just acc ->
+            if acc.success && acc.validMs > 30000
+            then
+                let
+                    delay = acc.validMs - 30000 |> toFloat
+                in
+                    Http2.executeIn delay receive (refreshSessionTask flags)
+            else Cmd.none
+        Nothing ->
+            Cmd.none
+
+refreshSessionTask: Flags -> Task.Task Http.Error AuthResult
+refreshSessionTask flags =
+    Http2.authTask
+        { url = flags.config.baseUrl ++ "/api/v1/sec/auth/session"
+        , method = "POST"
+        , headers = []
+        , account = getAccount flags
+        , body = Http.emptyBody
+        , resolver = Http2.jsonResolver Api.Model.AuthResult.decoder
+        , timeout = Nothing
+        }
+
+getAccount: Flags -> AuthResult
+getAccount flags =
+    Maybe.withDefault Api.Model.AuthResult.empty flags.account

modules/webapp/src/main/elm/App/Data.elm

@@ -0,0 +1,45 @@
+module App.Data exposing (..)
+
+import Browser exposing (UrlRequest)
+import Browser.Navigation exposing (Key)
+import Url exposing (Url)
+import Http
+import Data.Flags exposing (Flags)
+import Api.Model.VersionInfo exposing (VersionInfo)
+import Api.Model.AuthResult exposing (AuthResult)
+import Page exposing (Page(..))
+import Page.Home.Data
+import Page.Login.Data
+
+type alias Model =
+    { flags: Flags
+    , key: Key
+    , page: Page
+    , version: VersionInfo
+    , homeModel: Page.Home.Data.Model
+    , loginModel: Page.Login.Data.Model
+    }
+
+init: Key -> Url -> Flags -> Model
+init key url flags =
+    let
+        page = Page.fromUrl url |> Maybe.withDefault HomePage
+    in
+        { flags = flags
+        , key = key
+        , page = page
+        , version = Api.Model.VersionInfo.empty
+        , homeModel = Page.Home.Data.emptyModel
+        , loginModel = Page.Login.Data.empty
+        }
+
+type Msg
+    = NavRequest UrlRequest
+    | NavChange Url
+    | VersionResp (Result Http.Error VersionInfo)
+    | HomeMsg Page.Home.Data.Msg
+    | LoginMsg Page.Login.Data.Msg
+    | Logout
+    | LogoutResp (Result Http.Error ())
+    | SessionCheckResp (Result Http.Error AuthResult)
+    | SetPage Page

modules/webapp/src/main/elm/App/Update.elm

@@ -0,0 +1,106 @@
+module App.Update exposing (update, initPage)
+
+import Api
+import Ports
+import Browser exposing (UrlRequest(..))
+import Browser.Navigation as Nav
+import Url
+import Data.Flags
+import App.Data exposing (..)
+import Page exposing (Page(..))
+import Page.Home.Data
+import Page.Home.Update
+import Page.Login.Data
+import Page.Login.Update
+
+update: Msg -> Model -> (Model, Cmd Msg)
+update msg model =
+    case msg of
+        HomeMsg lm ->
+            updateHome lm model
+
+        LoginMsg lm ->
+            updateLogin lm model
+
+        SetPage p ->
+            ( {model | page = p }
+            , Cmd.none
+            )
+
+        VersionResp (Ok info) ->
+            ({model|version = info}, Cmd.none)
+
+        VersionResp (Err err) ->
+            (model, Cmd.none)
+
+        Logout ->
+            (model, Api.logout model.flags LogoutResp)
+        LogoutResp _ ->
+            ({model|loginModel = Page.Login.Data.empty}, Ports.removeAccount (Page.pageToString HomePage))
+        SessionCheckResp res ->
+            case res of
+                Ok lr ->
+                    let
+                        newFlags = Data.Flags.withAccount model.flags lr
+                        refresh = Api.refreshSession newFlags SessionCheckResp
+                    in
+                        if (lr.success) then ({model|flags = newFlags}, refresh)
+                        else  (model, Ports.removeAccount (Page.pageToString LoginPage))
+                Err _ -> (model, Ports.removeAccount (Page.pageToString LoginPage))
+
+        NavRequest req ->
+            case req of
+                Internal url ->
+                    let
+                        isCurrent =
+                            Page.fromUrl url |>
+                            Maybe.map (\p -> p == model.page) |>
+                            Maybe.withDefault True
+                    in
+                        ( model
+                        , if isCurrent then Cmd.none else Nav.pushUrl model.key (Url.toString url)
+                        )
+
+                External url ->
+                    ( model
+                    , Nav.load url
+                    )
+
+        NavChange url ->
+            let
+                page = Page.fromUrl url |> Maybe.withDefault HomePage
+                (m, c) = initPage model page
+            in
+            ( { m | page = page }, c )
+
+
+updateLogin: Page.Login.Data.Msg -> Model -> (Model, Cmd Msg)
+updateLogin lmsg model =
+    let
+        (lm, lc, ar) = Page.Login.Update.update model.flags lmsg model.loginModel
+        newFlags = Maybe.map (Data.Flags.withAccount model.flags) ar
+                   |> Maybe.withDefault model.flags
+    in
+        ({model | loginModel = lm, flags = newFlags}
+        ,Cmd.map LoginMsg lc
+        )
+
+updateHome: Page.Home.Data.Msg -> Model -> (Model, Cmd Msg)
+updateHome lmsg model =
+    let
+        (lm, lc) = Page.Home.Update.update model.flags lmsg model.homeModel
+    in
+        ( {model | homeModel = lm }
+        , Cmd.map HomeMsg lc
+        )
+
+
+initPage: Model -> Page -> (Model, Cmd Msg)
+initPage model page =
+    case page of
+        HomePage ->
+            (model, Cmd.none)
+{--            updateHome Page.Home.Data.GetBasicStats model --}
+
+        LoginPage ->
+            (model, Cmd.none)

modules/webapp/src/main/elm/App/View.elm

@@ -0,0 +1,101 @@
+module App.View exposing (view)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onClick)
+
+import App.Data exposing (..)
+import Page exposing (Page(..))
+import Page.Home.View
+import Page.Login.View
+
+view: Model -> Html Msg
+view model =
+    case model.page of
+        LoginPage ->
+            loginLayout model
+        _ ->
+            defaultLayout model
+
+loginLayout: Model -> Html Msg
+loginLayout model =
+    div [class "login-layout"]
+        [ (viewLogin model)
+        , (footer model)
+        ]
+
+defaultLayout: Model -> Html Msg
+defaultLayout model =
+    div [class "default-layout"]
+        [ div [class "ui fixed top sticky attached large menu black-bg"]
+              [div [class "ui fluid container"]
+                   [ a [class "header item narrow-item"
+                       ,Page.href HomePage
+                       ]
+                         [i [classList [("lemon outline icon", True)
+                                       ]]
+                              []
+                         ,text model.flags.config.appName]
+                   , (loginInfo model)
+                   ]
+              ]
+        , div [ class "ui fluid container main-content" ]
+            [ (case model.page of
+                   HomePage ->
+                       viewHome model
+                   LoginPage ->
+                       viewLogin model
+              )
+            ]
+        , (footer model)
+        ]
+
+viewLogin: Model -> Html Msg
+viewLogin model =
+    Html.map LoginMsg (Page.Login.View.view model.loginModel)
+
+viewHome: Model -> Html Msg
+viewHome model =
+    Html.map HomeMsg (Page.Home.View.view model.homeModel)
+
+
+loginInfo: Model -> Html Msg
+loginInfo model =
+    div [class "right menu"]
+        (case model.flags.account of
+            Just acc ->
+                [a [class "item"
+                   ]
+                     [text "Profile"
+                     ]
+                ,a [class "item"
+                   ,Page.href model.page
+                   ,onClick Logout
+                   ]
+                     [text "Logout "
+                     ,text (acc.collective ++ "/" ++ acc.user)
+                     ]
+                ]
+            Nothing ->
+                [a [class "item"
+                   ,Page.href LoginPage
+                   ]
+                     [text "Login"
+                     ]
+                ]
+        )
+
+footer: Model -> Html Msg
+footer model =
+    div [ class "ui footer" ]
+        [ a [href "https://github.com/eikek/docspell"]
+              [ i [class "ui github icon"][]
+              ]
+        , span []
+            [ text "Docspell "
+            , text model.version.version
+            , text " (#"
+            , String.left 8 model.version.gitCommit |> text
+            , text ")"
+            ]
+        ]

modules/webapp/src/main/elm/Data/Flags.elm

@@ -0,0 +1,22 @@
+module Data.Flags exposing (..)
+
+import Api.Model.AuthResult exposing (AuthResult)
+
+type alias Config =
+    { appName: String
+    , baseUrl: String
+    }
+
+type alias Flags =
+    { account: Maybe AuthResult
+    , config: Config
+    }
+
+getToken: Flags -> Maybe String
+getToken flags =
+    flags.account
+        |> Maybe.andThen (\a -> a.token)
+
+withAccount: Flags -> AuthResult -> Flags
+withAccount flags acc =
+    { flags | account = Just acc }

modules/webapp/src/main/elm/Main.elm

@@ -0,0 +1,58 @@
+module Main exposing (..)
+
+import Browser exposing (Document)
+import Browser.Navigation exposing (Key)
+import Url exposing (Url)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+
+import Api
+import Ports
+import Data.Flags exposing (Flags)
+import App.Data exposing (..)
+import App.Update exposing (..)
+import App.View exposing (..)
+
+
+-- MAIN
+
+
+main =
+  Browser.application
+    { init = init
+    , view = viewDoc
+    , update = update
+    , subscriptions = subscriptions
+    , onUrlRequest = NavRequest
+    , onUrlChange = NavChange
+    }
+
+
+-- MODEL
+
+
+init : Flags -> Url -> Key -> (Model, Cmd Msg)
+init flags url key =
+    let
+        im = App.Data.init key url flags
+        (m, cmd) = App.Update.initPage im im.page
+        sessionCheck =
+            case m.flags.account of
+                Just acc -> Api.loginSession flags SessionCheckResp
+                Nothing -> Cmd.none
+    in
+        (m, Cmd.batch [ cmd, Ports.initElements(), Api.versionInfo flags VersionResp, sessionCheck ])
+
+viewDoc: Model -> Document Msg
+viewDoc model =
+    { title = model.flags.config.appName
+    , body = [ (view model) ]
+    }
+
+-- SUBSCRIPTIONS
+
+
+subscriptions : Model -> Sub Msg
+subscriptions model =
+    Sub.none

modules/webapp/src/main/elm/Page.elm

@@ -0,0 +1,44 @@
+module Page exposing ( Page(..)
+                     , href
+                     , goto
+                     , pageToString
+                     , fromUrl
+                     )
+
+import Url exposing (Url)
+import Url.Parser as Parser exposing ((</>), Parser, oneOf, s, string)
+import Html exposing (Attribute)
+import Html.Attributes as Attr
+import Browser.Navigation as Nav
+
+type Page
+    = HomePage
+    | LoginPage
+
+
+pageToString: Page -> String
+pageToString page =
+    case page of
+        HomePage -> "#/home"
+        LoginPage -> "#/login"
+
+href: Page -> Attribute msg
+href page =
+    Attr.href (pageToString page)
+
+goto: Page -> Cmd msg
+goto page =
+    Nav.load (pageToString page)
+
+parser: Parser (Page -> a) a
+parser =
+    oneOf
+    [ Parser.map HomePage Parser.top
+    , Parser.map HomePage (s "home")
+    , Parser.map LoginPage (s "login")
+    ]
+
+fromUrl : Url -> Maybe Page
+fromUrl url =
+    { url | path = Maybe.withDefault "" url.fragment, fragment = Nothing }
+        |> Parser.parse parser

modules/webapp/src/main/elm/Page/Home/Data.elm

@@ -0,0 +1,15 @@
+module Page.Home.Data exposing (..)
+
+import Http
+
+type alias Model =
+    {
+    }
+
+emptyModel: Model
+emptyModel  =
+    {
+    }
+
+type Msg
+    = Dummy

modules/webapp/src/main/elm/Page/Home/Update.elm

@@ -0,0 +1,9 @@
+module Page.Home.Update exposing (update)
+
+import Api
+import Data.Flags exposing (Flags)
+import Page.Home.Data exposing (..)
+
+update: Flags -> Msg -> Model -> (Model, Cmd Msg)
+update flags msg model =
+    (model, Cmd.none)

modules/webapp/src/main/elm/Page/Home/View.elm

@@ -0,0 +1,23 @@
+module Page.Home.View exposing (view)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onClick)
+
+import Page exposing (Page(..))
+import Page.Home.Data exposing (..)
+import Data.Flags
+
+view: Model -> Html Msg
+view model =
+    div [class "home-page ui fluid grid"]
+        [div [class "three wide column"]
+             [h3 [][text "Menu"]
+             ]
+        ,div [class "seven wide column", style "border-left" "1px solid"]
+             [h3 [][text "List"]
+             ]
+        ,div [class "six wide column", style "border-left" "1px solid", style "height" "100vh"]
+             [h3 [][text "DocView"]
+             ]
+        ]

modules/webapp/src/main/elm/Page/Login/Data.elm

@@ -0,0 +1,23 @@
+module Page.Login.Data exposing (..)
+
+import Http
+import Api.Model.AuthResult exposing (AuthResult)
+
+type alias Model =
+    { username: String
+    , password: String
+    , result: Maybe AuthResult
+    }
+
+empty: Model
+empty =
+    { username = ""
+    , password = ""
+    , result = Nothing
+    }
+
+type Msg
+    = SetUsername String
+    | SetPassword String
+    | Authenticate
+    | AuthResp (Result Http.Error AuthResult)

modules/webapp/src/main/elm/Page/Login/Update.elm

@@ -0,0 +1,39 @@
+module Page.Login.Update exposing (update)
+
+import Api
+import Ports
+import Data.Flags exposing (Flags)
+import Page exposing (Page(..))
+import Page.Login.Data exposing (..)
+import Api.Model.UserPass exposing (UserPass)
+import Api.Model.AuthResult exposing (AuthResult)
+import Util.Http
+
+update: Flags -> Msg -> Model -> (Model, Cmd Msg, Maybe AuthResult)
+update flags msg model =
+    case msg of
+        SetUsername str ->
+            ({model | username = str}, Cmd.none, Nothing)
+        SetPassword str ->
+            ({model | password = str}, Cmd.none, Nothing)
+
+        Authenticate ->
+            (model, Api.login flags (UserPass model.username model.password) AuthResp, Nothing)
+
+        AuthResp (Ok lr) ->
+            if lr.success
+            then ({model|result = Just lr, password = ""}, setAccount lr, Just lr)
+            else ({model|result = Just lr, password = ""}, Ports.removeAccount "", Just lr)
+
+        AuthResp (Err err) ->
+            let
+                empty = Api.Model.AuthResult.empty
+                lr = {empty|message = Util.Http.errorToString err}
+            in
+                ({model|password = "", result = Just lr}, Ports.removeAccount "", Just empty)
+
+setAccount: AuthResult -> Cmd msg
+setAccount result =
+    if result.success
+    then Ports.setAccount result
+    else Ports.removeAccount ""

modules/webapp/src/main/elm/Page/Login/View.elm

@@ -0,0 +1,59 @@
+module Page.Login.View exposing (view)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onClick, onInput, onSubmit)
+
+import Page.Login.Data exposing (..)
+
+view: Model -> Html Msg
+view model =
+    div [class "login-page"]
+        [div [class "ui centered grid"]
+             [div [class "row"]
+                  [div [class "eight wide column ui segment login-view"]
+                       [h1 [class "ui dividing header"][text "Sign in to Docspell"]
+                       ,Html.form [class "ui large error form", onSubmit Authenticate]
+                           [div [class "field"]
+                                [label [][text "Username"]
+                                ,input [type_ "text"
+                                       ,onInput SetUsername
+                                       ,value model.username
+                                       ][]
+                                ]
+                           ,div [class "field"]
+                               [label [][text "Password"]
+                               ,input [type_ "password"
+                                      ,onInput SetPassword
+                                      ,value model.password
+                                      ][]
+                               ]
+                           ,button [class "ui primary button"
+                                   ,type_ "submit"
+                                   ,onClick Authenticate
+                                   ]
+                                [text "Login"
+                                ]
+                           ]
+                       ,(resultMessage model)
+                       ]
+                  ]
+             ]
+        ]
+
+resultMessage: Model -> Html Msg
+resultMessage model =
+    case model.result of
+        Just r ->
+            if r.success
+            then
+                div [class "ui success message"]
+                    [text "Login successful."
+                    ]
+            else
+                div [class "ui error message"]
+                    [text r.message
+                    ]
+
+        Nothing ->
+            span [][]

modules/webapp/src/main/elm/Ports.elm

@@ -0,0 +1,8 @@
+port module Ports exposing (..)
+
+import Api.Model.AuthResult exposing (AuthResult)
+
+port initElements: () -> Cmd msg
+
+port setAccount: AuthResult -> Cmd msg
+port removeAccount: String -> Cmd msg

modules/webapp/src/main/elm/Util/Http.elm

@@ -0,0 +1,139 @@
+module Util.Http exposing (..)
+
+import Http
+import Process
+import Task exposing (Task)
+import Api.Model.AuthResult exposing (AuthResult)
+import Json.Decode as D
+
+-- Authenticated Requests
+
+authReq: {url: String
+         ,account: AuthResult
+         ,method: String
+         ,headers: List Http.Header
+         ,body: Http.Body
+         ,expect: Http.Expect msg
+         } -> Cmd msg
+authReq req =
+    Http.request
+        { url = req.url
+        , method = req.method
+        , headers = (Http.header "X-Docspell-Auth" (Maybe.withDefault "" req.account.token)) :: req.headers
+        , expect = req.expect
+        , body = req.body
+        , timeout = Nothing
+        , tracker = Nothing
+        }
+
+authPost: {url: String
+          ,account: AuthResult
+          ,body: Http.Body
+          ,expect: Http.Expect msg
+          } -> Cmd msg
+authPost req =
+    authReq
+        { url = req.url
+        , account = req.account
+        , body = req.body
+        , expect = req.expect
+        , method = "POST"
+        , headers = []
+        }
+
+authGet: {url: String
+          ,account: AuthResult
+          ,expect: Http.Expect msg
+          } -> Cmd msg
+authGet req =
+    authReq
+        { url = req.url
+        , account = req.account
+        , body = Http.emptyBody
+        , expect = req.expect
+        , method = "GET"
+        , headers = []
+        }
+
+
+
+-- Error Utilities
+
+errorToStringStatus: Http.Error -> (Int -> String) -> String
+errorToStringStatus error statusString =
+    case error of
+        Http.BadUrl url ->
+            "There is something wrong with this url: " ++ url
+        Http.Timeout ->
+            "There was a network timeout."
+        Http.NetworkError ->
+            "There was a network error."
+        Http.BadStatus status ->
+            statusString status
+        Http.BadBody str ->
+            "There was an error decoding the response: " ++ str
+
+errorToString: Http.Error -> String
+errorToString error =
+    let
+        f sc = case sc of
+                   404 ->
+                       "The requested resource doesn't exist."
+                   _ ->
+                       "There was an invalid response status: " ++ (String.fromInt sc)
+    in
+        errorToStringStatus error f
+
+
+-- Http.Task Utilities
+
+jsonResolver :  D.Decoder a -> Http.Resolver Http.Error a
+jsonResolver decoder =
+  Http.stringResolver <|
+    \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))
+
+executeIn: Float -> ((Result Http.Error a) -> msg) -> Task Http.Error a -> Cmd msg
+executeIn delay receive task =
+    Process.sleep delay
+        |> Task.andThen (\_ -> task)
+        |> Task.attempt receive
+
+authTask:
+    { method : String
+    , headers : List Http.Header
+    , account: AuthResult
+    , url : String
+    , body : Http.Body
+    , resolver : Http.Resolver x a
+    , timeout : Maybe Float
+    }
+    -> Task x a
+authTask req =
+    Http.task
+        { method = req.method
+        , headers = (Http.header "X-Docspell-Auth" (Maybe.withDefault "" req.account.token)) :: req.headers
+        , url = req.url
+        , body = req.body
+        , resolver = req.resolver
+        , timeout = req.timeout
+        }