diff --git a/.vscode/settings.json b/.vscode/settings.json index 4619a0fb..d55f5104 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -1,7 +1,7 @@ // Place your settings in this file to overwrite default and user settings. { "files.exclude": { - "*.suo":true, + "*.suo":true, "*.user":true, "*.sln.docstates":true, "*.userprefs":true, @@ -25,4 +25,4 @@ "src/**/obj":true, "src/Client/out":true } -} \ No newline at end of file +} diff --git a/BookStore.sln b/BookStore.sln index d1dc19b0..cc909be6 100644 --- a/BookStore.sln +++ b/BookStore.sln @@ -29,6 +29,10 @@ Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU Release|Any CPU = Release|Any CPU + Debug|x64 = Debug|x64 + Debug|x86 = Debug|x86 + Release|x64 = Release|x64 + Release|x86 = Release|x86 EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution {95D2789C-8B80-49E7-915A-AC670C36D3FB}.Debug|Any CPU.ActiveCfg = Debug|Any CPU diff --git a/README.md b/README.md index 847b8725..5ad3dfa1 100644 --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ The following document describes the [SAFE-Stack](https://safe-stack.github.io/) SAFE is a technology stack that brings together several technologies into a single, coherent stack for typesafe, flexible end-to-end web-enabled applications that are written entirely in F#. -![SAFE-Stack](src/Client/images/safe_logo.png "SAFE-Stack") +![SAFE-Stack](src/Client/Images/safe_logo.png "SAFE-Stack") You can see it running on Microsoft Azure at http://fable-suave.azurewebsites.net. @@ -206,7 +206,7 @@ Add the `src/Client/pages/Tomato.fs` to your .fsproj file and move it above `App 4. Change the `Tomato.view` function (and add in required packages): ```fsharp - + open Fable.Helpers.React open Fable.Helpers.React.Props //... diff --git a/build.fsx b/build.fsx index 6fd49336..ec2d4c0c 100644 --- a/build.fsx +++ b/build.fsx @@ -138,7 +138,7 @@ Target "InstallClient" (fun _ -> Target "BuildClient" (fun _ -> runDotnet clientPath "restore" - runDotnet clientPath "fable webpack --port free -- -p" + runDotnet clientPath "fable webpack --port free -- -p --mode production" ) // -------------------------------------------------------------------------------------- @@ -146,7 +146,7 @@ Target "BuildClient" (fun _ -> Target "RenameDrivers" (fun _ -> if not isWindows then - run npmTool "install phantomjs-prebuilt" "" + run yarnTool "add phantomjs-prebuilt" "" try if isMacOS && not <| File.Exists "test/UITests/bin/Debug/net461/chromedriver" then Fake.FileHelper.Rename "test/UITests/bin/Debug/net461/chromedriver" "test/UITests/bin/Debug/net461/chromedriver_macOS" @@ -185,6 +185,7 @@ Target "RunClientTests" (fun _ -> let ipAddress = "localhost" let port = 8080 +let serverPort = 8085 FinalTarget "KillProcess" (fun _ -> killProcess "dotnet" @@ -205,7 +206,7 @@ Target "Run" (fun _ -> if result <> 0 then failwith "Website shut down." } - let fablewatch = async { runDotnet clientPath "fable webpack-dev-server --port free" } + let fablewatch = async { runDotnet clientPath "fable webpack-dev-server --port free -- --mode development" } let openBrowser = async { System.Threading.Thread.Sleep(5000) Diagnostics.Process.Start("http://"+ ipAddress + sprintf ":%d" port) |> ignore } @@ -216,6 +217,30 @@ Target "Run" (fun _ -> ) +Target "RunSSR" (fun _ -> + runDotnet clientPath "restore" + runDotnet serverTestsPath "restore" + + let unitTestsWatch = async { + let result = + ExecProcess (fun info -> + info.FileName <- dotnetExePath + info.WorkingDirectory <- serverTestsPath + info.Arguments <- sprintf "watch msbuild /t:TestAndRun /p:DotNetHost=%s /p:DebugSSR=true" dotnetExePath) TimeSpan.MaxValue + + if result <> 0 then failwith "Website shut down." } + + let fablewatch = async { runDotnet clientPath "fable webpack --port free -- -w --mode development" } + let openBrowser = async { + System.Threading.Thread.Sleep(10000) + Diagnostics.Process.Start("http://"+ ipAddress + sprintf ":%d" serverPort) |> ignore } + + Async.Parallel [| unitTestsWatch; fablewatch; openBrowser |] + |> Async.RunSynchronously + |> ignore +) + + // -------------------------------------------------------------------------------------- // Release Scripts @@ -354,4 +379,7 @@ Target "All" DoNothing "InstallClient" ==> "Run" +"InstallClient" + ==> "RunSSR" + RunTargetOrDefault "All" diff --git a/paket.dependencies b/paket.dependencies index bcceed29..90dbe9f1 100644 --- a/paket.dependencies +++ b/paket.dependencies @@ -13,9 +13,11 @@ nuget System.Net.NetworkInformation nuget jose-jwt nuget Fable.Core +nuget Fable.React 3.0.0 +nuget Fable.Elmish +nuget Fable.Elmish.React nuget Fable.Elmish.Browser nuget Fable.Elmish.Debugger -nuget Fable.Elmish.React nuget Fable.Elmish.HMR nuget Microsoft.Azure.WebJobs prerelease nuget Microsoft.Azure.WebJobs.Extensions prerelease @@ -41,4 +43,4 @@ group UITests group Build source https://nuget.org/api/v2 framework >= net461 - nuget FAKE \ No newline at end of file + nuget FAKE diff --git a/paket.lock b/paket.lock index ab0b53c9..93f2737b 100644 --- a/paket.lock +++ b/paket.lock @@ -17,10 +17,10 @@ NUGET System.Collections.Immutable (>= 1.4) - restriction: >= netstandard1.6 System.Reflection.Metadata (>= 1.5) - restriction: >= netstandard1.6 System.Runtime.Loader (>= 4.3) - restriction: >= netstandard1.6 - Fable.Core (1.3.8) + Fable.Core (1.3.11) FSharp.Core (>= 4.2.3) - restriction: >= netstandard1.6 NETStandard.Library (>= 1.6.1) - restriction: >= netstandard1.6 - Fable.Elmish (1.0.1) - restriction: >= netstandard1.6 + Fable.Elmish (1.0.1) Fable.Core (>= 1.2.4) - restriction: >= netstandard1.6 Fable.PowerPack (>= 1.3) - restriction: >= netstandard1.6 FSharp.Core (>= 4.2.3) - restriction: >= netstandard1.6 @@ -37,7 +37,7 @@ NUGET Fable.Core (>= 1.2.4) - restriction: >= netstandard1.6 Fable.Elmish (>= 0.9.2) - restriction: >= netstandard1.6 FSharp.Core (>= 4.2.3) - restriction: >= netstandard1.6 - Fable.Elmish.React (1.0.1) + Fable.Elmish.React (1.0.2) Fable.Core (>= 1.3.8) - restriction: >= netstandard1.6 Fable.Elmish (>= 1.0.1) - restriction: >= netstandard1.6 Fable.PowerPack (>= 1.3.2) - restriction: >= netstandard1.6 @@ -53,7 +53,7 @@ NUGET Fable.Core (>= 1.3.8) - restriction: >= netstandard1.6 Fable.Import.Browser (>= 1.0) - restriction: >= netstandard1.6 FSharp.Core (>= 4.2.3) - restriction: >= netstandard1.6 - Fable.React (2.1) - restriction: >= netstandard1.6 + Fable.React (3.0) Fable.Core (>= 1.3.7) - restriction: >= netstandard1.6 Fable.Import.Browser (>= 0.1) - restriction: >= netstandard1.6 FSharp.Core (>= 4.2.3) - restriction: >= netstandard1.6 diff --git a/src/Client/App.fs b/src/Client/App.fs index 49ff88f2..9689939a 100644 --- a/src/Client/App.fs +++ b/src/Client/App.fs @@ -1,47 +1,31 @@ module Client.App open Fable.Core +open Fable.Core.JsInterop open Fable.Import open Fable.PowerPack open Elmish open Elmish.React -open Fable.Import.Browser open Elmish.Browser.Navigation open Elmish.HMR +open Client.Shared open Client.Pages open ServerCode.Domain JsInterop.importSideEffects "whatwg-fetch" JsInterop.importSideEffects "babel-polyfill" -/// The composed model for the different possible page states of the application -type PageModel = - | HomePageModel - | LoginModel of Login.Model - | WishListModel of WishList.Model - -/// The composed model for the application, which is a single page state plus login information -type Model = - { User : UserData option - PageModel : PageModel } - -/// The composed set of messages that update the state of the application -type Msg = - | LoggedIn of UserData - | LoggedOut - | StorageFailure of exn - | LoginMsg of Login.Msg - | WishListMsg of WishList.Msg - | Logout of unit - -/// The navigation logic of the application given a page identity parsed from the .../#info +let handleNotFound (model: Model) = + Browser.console.error("Error parsing url: " + Browser.window.location.href) + ( model, Navigation.modifyUrl (toPath Page.Home) ) + +/// The navigation logic of the application given a page identity parsed from the .../#info /// information in the URL. -let urlUpdate (result:Page option) model = +let urlUpdate (result:Page option) (model: Model) = match result with | None -> - Browser.console.error("Error parsing url: " + Browser.window.location.href) - ( model, Navigation.modifyUrl (toHash Page.Home) ) + handleNotFound model | Some Page.Login -> let m, cmd = Login.init model.User @@ -69,11 +53,17 @@ let deleteUserCmd = let init result = let user = loadUser () - let model = - { User = user - PageModel = HomePageModel } - - urlUpdate result model + let stateJson: string option = !!Browser.window?__INIT_MODEL__ + match stateJson, result with + | Some json, Some Page.Home -> + let model: Model = ofJson json + { model with User = user }, Cmd.none + | _ -> + let model = + { User = user + PageModel = HomePageModel } + + urlUpdate result model let update msg model = match msg, model.PageModel with @@ -89,7 +79,7 @@ let update msg model = | Login.ExternalMsg.NoOp -> Cmd.none | Login.ExternalMsg.UserLoggedIn newUser -> - Cmd.ofMsg (LoggedIn newUser) + saveUserCmd newUser { model with PageModel = LoginModel m }, @@ -104,53 +94,31 @@ let update msg model = { model with PageModel = WishListModel m }, Cmd.map WishListMsg cmd - | WishListMsg _, _ -> + | WishListMsg _, _ -> model, Cmd.none | LoggedIn newUser, _ -> let nextPage = Page.WishList { model with User = Some newUser }, - Cmd.batch [ - saveUserCmd newUser - Navigation.newUrl (toHash nextPage) ] + Navigation.newUrl (toPath nextPage) | LoggedOut, _ -> { model with User = None - PageModel = HomePageModel }, - Navigation.newUrl (toHash Page.Home) + PageModel = HomePageModel }, + Navigation.newUrl (toPath Page.Home) | Logout(), _ -> model, deleteUserCmd -// VIEW - -open Fable.Helpers.React -open Fable.Helpers.React.Props -open Client.Style -/// Constructs the view for a page given the model and dispatcher. -let viewPage model dispatch = - match model.PageModel with - | HomePageModel -> - Home.view () - - | LoginModel m -> - [ Login.view m (LoginMsg >> dispatch) ] - - | WishListModel m -> - [ WishList.view m (WishListMsg >> dispatch) ] +open Elmish.Debug -/// Constructs the view for the application given the model. -let view model dispatch = - div [] [ - Menu.view (Logout >> dispatch) model.User - hr [] - div [ centerStyle "column" ] (viewPage model dispatch) - ] +let withReact = + if (!!Browser.window?__INIT_MODEL__) + then Program.withReactHydrate + else Program.withReact -open Elmish.React -open Elmish.Debug // App Program.mkProgram init update view @@ -159,7 +127,7 @@ Program.mkProgram init update view |> Program.withConsoleTrace |> Program.withHMR #endif -|> Program.withReact "elmish-app" +|> withReact "elmish-app" #if DEBUG |> Program.withDebugger #endif diff --git a/src/Client/Client.fsproj b/src/Client/Client.fsproj index 94a5b062..c17ae232 100644 --- a/src/Client/Client.fsproj +++ b/src/Client/Client.fsproj @@ -2,16 +2,8 @@ netstandard2.0 + - - - - - - - - - diff --git a/src/Client/images/safe_favicon.png b/src/Client/Images/safe_favicon.png similarity index 100% rename from src/Client/images/safe_favicon.png rename to src/Client/Images/safe_favicon.png diff --git a/src/Client/images/safe_logo.png b/src/Client/Images/safe_logo.png similarity index 100% rename from src/Client/images/safe_logo.png rename to src/Client/Images/safe_logo.png diff --git a/src/Client/Pages.fs b/src/Client/Pages.fs index 39255da2..c91b98f9 100644 --- a/src/Client/Pages.fs +++ b/src/Client/Pages.fs @@ -4,23 +4,23 @@ open Elmish.Browser.UrlParser /// The different pages of the application. If you add a new page, then add an entry here. [] -type Page = +type Page = | Home | Login | WishList -let toHash = +let toPath = function - | Page.Home -> "#home" - | Page.Login -> "#login" - | Page.WishList -> "#wishlist" + | Page.Home -> "/" + | Page.Login -> "/login" + | Page.WishList -> "/wishlist" /// The URL is turned into a Result. let pageParser : Parser Page,_> = oneOf - [ map Page.Home (s "home") + [ map Page.Home (s "") map Page.Login (s "login") map Page.WishList (s "wishlist") ] -let urlParser location = parseHash pageParser location \ No newline at end of file +let urlParser location = parsePath pageParser location diff --git a/src/Client/Shared.fs b/src/Client/Shared.fs new file mode 100644 index 00000000..8af7ffea --- /dev/null +++ b/src/Client/Shared.fs @@ -0,0 +1,49 @@ +module Client.Shared + +open ServerCode.Domain +/// The composed model for the different possible page states of the application +type PageModel = + | HomePageModel + | LoginModel of Login.Model + | WishListModel of WishList.Model + +/// The composed model for the application, which is a single page state plus login information +type Model = + { User : UserData option + PageModel : PageModel } + +/// The composed set of messages that update the state of the application +type Msg = + | LoggedIn of UserData + | LoggedOut + | StorageFailure of exn + | LoginMsg of Login.Msg + | WishListMsg of WishList.Msg + | Logout of unit + + +// VIEW + +open Fable.Helpers.React +open Fable.Helpers.React.Props +open Client.Style + +/// Constructs the view for a page given the model and dispatcher. +let viewPage model dispatch = + match model.PageModel with + | HomePageModel -> + Home.view () + + | LoginModel m -> + [ Login.view m (LoginMsg >> dispatch) ] + + | WishListModel m -> + [ WishList.view m (WishListMsg >> dispatch) ] + +/// Constructs the view for the application given the model. +let view model dispatch = + div [] [ + Menu.view (Logout >> dispatch) model.User + hr [] + div [ centerStyle "column" ] (viewPage model dispatch) + ] diff --git a/src/Client/Style.fs b/src/Client/Style.fs index 878dc176..0396162c 100644 --- a/src/Client/Style.fs +++ b/src/Client/Style.fs @@ -5,29 +5,37 @@ open Fable.Core open Fable.Core.JsInterop open Fable.Import open Fable.PowerPack +open Elmish.Browser.Navigation module R = Fable.Helpers.React + +let goToUrl (e: React.MouseEvent) = + e.preventDefault() + let href = !!e.target?href + Navigation.newUrl href |> List.map (fun f -> f ignore) |> ignore + let viewLink page description = R.a [ Style [ Padding "0 20px" ] - Href (Pages.toHash page) ] + Href (Pages.toPath page) + OnClick goToUrl] [ R.str description] let centerStyle direction = Style [ Display "flex" FlexDirection direction AlignItems "center" - !!("justifyContent", "center") + JustifyContent "center" Padding "20px 0" ] let words size message = - R.span [ Style [ !!("fontSize", size |> sprintf "%dpx") ] ] [ R.str message ] + R.span [ Style [ FontSize (size |> sprintf "%dpx") ] ] [ R.str message ] let buttonLink cssClass onClick elements = R.a [ ClassName cssClass OnClick (fun _ -> onClick()) OnTouchStart (fun _ -> onClick()) - Style [ !!("cursor", "pointer") ] ] elements + Style [ Cursor "pointer" ] ] elements let onEnter msg dispatch = function diff --git a/src/Client/pages/Home.fs b/src/Client/pages/Home.fs index 9708e9ce..862d660c 100644 --- a/src/Client/pages/Home.fs +++ b/src/Client/pages/Home.fs @@ -4,6 +4,7 @@ open Fable.Helpers.React open Fable.Helpers.React.Props open Style open Pages +open Client let view () = [ @@ -22,4 +23,4 @@ let view () = br [] br [] br [] - words 20 ("version " + ReleaseNotes.Version) ] \ No newline at end of file + words 20 ("version " + ReleaseNotes.Version) ] diff --git a/src/Client/pages/Login.fs b/src/Client/pages/Login.fs index 645a1885..9eefa573 100644 --- a/src/Client/pages/Login.fs +++ b/src/Client/pages/Login.fs @@ -12,17 +12,17 @@ open Fable.PowerPack open Fable.PowerPack.Fetch.Fetch_types open ServerCode open Client.Style - + type LoginState = | LoggedOut | LoggedIn of UserData -type Model = { +type Model = { State : LoginState Login : Login ErrorMsg : string } -/// The messages processed during login +/// The messages processed during login type Msg = | LoginSuccess of UserData | SetUserName of string @@ -41,22 +41,22 @@ let authUser (login:Login) = let body = toJson login - let props = + let props = [ RequestProperties.Method HttpMethod.POST Fetch.requestHeaders [ HttpRequestHeaders.ContentType "application/json" ] RequestProperties.Body !^body ] - + try - return! Fetch.fetchAs ServerUrls.Login props - with _ -> + return! Fetch.fetchAs ServerUrls.APIUrls.Login props + with _ -> return! failwithf "Could not authenticate user." } -let authUserCmd login = +let authUserCmd login = Cmd.ofPromise authUser login LoginSuccess AuthError -let init (user:UserData option) = +let init (user:UserData option) = match user with | None -> { Login = { UserName = ""; Password = ""; PasswordId = Guid.NewGuid() } @@ -67,7 +67,7 @@ let init (user:UserData option) = State = LoggedIn user ErrorMsg = "" }, Cmd.none -let update (msg:Msg) model : Model*Cmd*ExternalMsg = +let update (msg:Msg) model : Model*Cmd*ExternalMsg = match msg with | LoginSuccess user -> { model with State = LoggedIn user; Login = { model.Login with Password = ""; PasswordId = Guid.NewGuid() } }, Cmd.none, ExternalMsg.UserLoggedIn user @@ -80,10 +80,10 @@ let update (msg:Msg) model : Model*Cmd*ExternalMsg = | AuthError exn -> { model with ErrorMsg = string (exn.Message) }, Cmd.none, NoOp -let view model (dispatch: Msg -> unit) = +let view model (dispatch: Msg -> unit) = let showErrorClass = if String.IsNullOrEmpty model.ErrorMsg then "hidden" else "" let buttonActive = if String.IsNullOrEmpty model.Login.UserName || String.IsNullOrEmpty model.Login.Password then "btn-disabled" else "btn-primary" - + match model.State with | LoggedIn user -> div [ Id "greeting"] [ @@ -93,7 +93,7 @@ let view model (dispatch: Msg -> unit) = | LoggedOut -> div [ ClassName "signInBox" ] [ h3 [ ClassName "text-center" ] [ str "Log in with 'test' / 'test'."] - + div [ ClassName showErrorClass ] [ div [ ClassName "alert alert-danger" ] [ str model.ErrorMsg ] ] @@ -102,14 +102,14 @@ let view model (dispatch: Msg -> unit) = span [ClassName "input-group-addon" ] [ span [ClassName "glyphicon glyphicon-user"] [] ] - input [ + input [ Id "username" HTMLAttr.Type "text" ClassName "form-control input-lg" Placeholder "Username" DefaultValue model.Login.UserName OnChange (fun ev -> dispatch (SetUserName !!ev.target?value)) - AutoFocus true + AutoFocus true ] ] @@ -117,7 +117,7 @@ let view model (dispatch: Msg -> unit) = span [ClassName "input-group-addon" ] [ span [ClassName "glyphicon glyphicon-asterisk"] [] ] - input [ + input [ Id "password" Key ("password_" + model.Login.PasswordId.ToString()) HTMLAttr.Type "password" @@ -125,14 +125,13 @@ let view model (dispatch: Msg -> unit) = Placeholder "Password" DefaultValue model.Login.Password OnChange (fun ev -> dispatch (SetPassword !!ev.target?value)) - onEnter ClickLogIn dispatch + onEnter ClickLogIn dispatch ] - ] - + ] + div [ ClassName "text-center" ] [ button [ ClassName ("btn " + buttonActive); - OnClick (fun _ -> dispatch ClickLogIn) ] + OnClick (fun _ -> dispatch ClickLogIn) ] [ str "Log In" ] - ] - ] - \ No newline at end of file + ] + ] diff --git a/src/Client/pages/WishList.fs b/src/Client/pages/WishList.fs index 31448765..e4a86c46 100644 --- a/src/Client/pages/WishList.fs +++ b/src/Client/pages/WishList.fs @@ -41,7 +41,7 @@ type Msg = /// Get the wish list from the server, used to populate the model let getWishList token = promise { - let url = ServerUrls.WishList + let url = ServerUrls.APIUrls.WishList let props = [ Fetch.requestHeaders [ HttpRequestHeaders.Authorization ("Bearer " + token) ]] @@ -51,7 +51,7 @@ let getWishList token = let getResetTime token = promise { - let url = ServerUrls.ResetTime + let url = ServerUrls.APIUrls.ResetTime let props = [ Fetch.requestHeaders [ HttpRequestHeaders.Authorization ("Bearer " + token) ]] @@ -69,7 +69,7 @@ let loadResetTimeCmd token = let postWishList (token,wishList) = promise { - let url = ServerUrls.WishList + let url = ServerUrls.APIUrls.WishList let body = toJson wishList let props = [ RequestProperties.Method HttpMethod.POST @@ -84,6 +84,7 @@ let postWishList (token,wishList) = let postWishListCmd (token,wishList) = Cmd.ofPromise postWishList (token,wishList) FetchedWishList FetchError + let init (user:UserData) = { WishList = WishList.New user.UserName Token = user.Token @@ -135,7 +136,7 @@ let update (msg:Msg) model : Model*Cmd = let wishList = { model.WishList with Books = model.WishList.Books |> List.filter ((<>) book) } { model with WishList = wishList - ErrorMsg = Validation.verifyBookisNotADuplicate wishList model.NewBook }, + ErrorMsg = Validation.verifyBookisNotADuplicate wishList model.NewBook }, postWishListCmd(model.Token,wishList) | AddBook -> @@ -145,7 +146,7 @@ let update (msg:Msg) model : Model*Cmd = { model with ErrorMsg = Some err }, Cmd.none | None -> let wishList = { model.WishList with Books = (model.NewBook :: model.WishList.Books) |> List.sortBy (fun b -> b.Title) } - { model with WishList = wishList; NewBook = Book.empty; NewBookId = Guid.NewGuid(); ErrorMsg = None }, + { model with WishList = wishList; NewBook = Book.empty; NewBookId = Guid.NewGuid(); ErrorMsg = None }, postWishListCmd(model.Token,wishList) else { model with diff --git a/src/Client/paket.references b/src/Client/paket.references index c0772901..b4a284b1 100644 --- a/src/Client/paket.references +++ b/src/Client/paket.references @@ -1,7 +1,8 @@ FSharp.Core +Fable.React Fable.Elmish.Browser Fable.Elmish.Debugger Fable.Elmish.React Fable.Elmish.HMR Fable.Core -dotnet-fable \ No newline at end of file +dotnet-fable diff --git a/src/Client/views/Menu.fs b/src/Client/views/Menu.fs index dac8db09..71f0e2e3 100644 --- a/src/Client/views/Menu.fs +++ b/src/Client/views/Menu.fs @@ -1,13 +1,13 @@ module Client.Menu open Fable.Helpers.React +open Fable.Helpers.Isomorphic open Client.Style open Client.Pages open ServerCode.Domain type Model = UserData option - -let view onLogout (model:Model) = +let inline private clientView onLogout (model:Model) = div [ centerStyle "row" ] [ yield viewLink Page.Home "Home" if model <> None then @@ -16,4 +16,10 @@ let view onLogout (model:Model) = yield viewLink Page.Login "Login" else yield buttonLink "logout" onLogout [ str "Logout" ] - ] \ No newline at end of file + ] + +let inline private serverView onLogout (model: Model) = + clientView onLogout None + +let view onLogout model = + isomorphicView (clientView onLogout) (serverView onLogout) model diff --git a/src/Client/webpack.config.js b/src/Client/webpack.config.js index f4ccd5cb..15f1adde 100644 --- a/src/Client/webpack.config.js +++ b/src/Client/webpack.config.js @@ -42,7 +42,8 @@ module.exports = { } }, hot: true, - inline: true + inline: true, + historyApiFallback: true, }, module: { rules: [ diff --git a/src/Server/Auth.fs b/src/Server/Auth.fs index ab53a354..b64b09e0 100644 --- a/src/Server/Auth.fs +++ b/src/Server/Auth.fs @@ -1,9 +1,11 @@ /// Login web part and functions for API web part request authorisation with JWT. module ServerCode.Auth +open System open Giraffe open RequestErrors open Microsoft.AspNetCore.Http +open ServerCode.Domain let createUserData (login : Domain.Login) = { @@ -21,16 +23,18 @@ let login : HttpHandler = let! login = ctx.BindJsonAsync() return! match login.IsValid() with - | true -> ctx.WriteJsonAsync (createUserData login) + | true -> + let data = createUserData login + ctx.WriteJsonAsync data | false -> UNAUTHORIZED "Bearer" "" (sprintf "User '%s' can't be logged in." login.UserName) next ctx } let private missingToken = RequestErrors.BAD_REQUEST "Request doesn't contain a JSON Web Token" let private invalidToken = RequestErrors.FORBIDDEN "Accessing this API is not allowed" -/// Checks if the HTTP request has a valid JWT token. +/// Checks if the HTTP request has a valid JWT token for API. /// On success it will invoke the given `f` function by passing in the valid token. -let requiresJwtToken f : HttpHandler = +let requiresJwtTokenForAPI f : HttpHandler = fun (next : HttpFunc) (ctx : HttpContext) -> (match ctx.TryGetRequestHeader "Authorization" with | Some authHeader -> @@ -38,4 +42,4 @@ let requiresJwtToken f : HttpHandler = match JsonWebToken.isValid jwt with | Some token -> f token | None -> invalidToken - | None -> missingToken) next ctx \ No newline at end of file + | None -> missingToken) next ctx diff --git a/src/Server/Pages.fs b/src/Server/Pages.fs new file mode 100644 index 00000000..36526596 --- /dev/null +++ b/src/Server/Pages.fs @@ -0,0 +1,26 @@ +module ServerCode.Pages + + + +open System.Threading.Tasks +open Microsoft.AspNetCore.Http +open Giraffe +open ServerCode.Domain +open ServerTypes +open Client.Shared + + +// Retrieve the last time the wish list was reset. +let home: HttpHandler = fun _ ctx -> + task { + let model: Model = { + User = None + PageModel = PageModel.HomePageModel + } + return! ctx.WriteHtmlViewAsync (Templates.index (Some model)) + } + +let notfound: HttpHandler = fun _ ctx -> + task { + return! ctx.WriteHtmlViewAsync (Templates.index None) + } diff --git a/src/Server/Server.fsproj b/src/Server/Server.fsproj index ba46eed6..eb2fb96f 100644 --- a/src/Server/Server.fsproj +++ b/src/Server/Server.fsproj @@ -3,9 +3,14 @@ Exe netcoreapp2.0 + + + TRACE;DEBUG + + + + - - @@ -16,8 +21,10 @@ + + - \ No newline at end of file + diff --git a/src/Server/Shared/ServerUrls.fs b/src/Server/Shared/ServerUrls.fs index b987a2fa..3e1c5d6a 100644 --- a/src/Server/Shared/ServerUrls.fs +++ b/src/Server/Shared/ServerUrls.fs @@ -1,10 +1,17 @@ /// API urls shared between client and server. -[] module ServerCode.ServerUrls -[] -let WishList = "/api/wishlist/" -[] -let ResetTime = "/api/wishlist/resetTime/" -[] -let Login = "/api/users/login/" \ No newline at end of file +[] +module PageUrls = + [] + let Home = "/" + +[] +module APIUrls = + + [] + let WishList = "/api/wishlist/" + [] + let ResetTime = "/api/wishlist/resetTime/" + [] + let Login = "/api/users/login/" diff --git a/src/Server/Templates.fs b/src/Server/Templates.fs new file mode 100644 index 00000000..fb3ee02f --- /dev/null +++ b/src/Server/Templates.fs @@ -0,0 +1,51 @@ +module ServerCode.Templates + + + +open System.Threading.Tasks +open Microsoft.AspNetCore.Http +open Giraffe +open ServerCode.Domain +open ServerCode.FableJson +open ServerTypes +open Client.Shared +open Giraffe.GiraffeViewEngine +open Fable.Helpers.ReactServer + +let index (model: Model option) = + let jsonState, htmlStr = + match model with + | Some model -> + // Note we call ofJson twice here, + // because Elmish's model can be some complicated type instead of pojo. + // The first one will seriallize the state to a json string, + // and the second one will seriallize the json string to a js string, + // so we can deseriallize it by Fable's ofJson and get the correct types. + toJson (toJson model), + Client.Shared.view model ignore |> renderToString + | None -> + "null", "" + html [] + [ head [] [ meta [ _httpEquiv "Content-Type"; _content "text/html"; _charset "utf-8" ] ] + title [] [ rawText "SAFE-Stack sample" ] + link + [ _rel "stylesheet" + _href "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css"; + attr "integrity" "sha384-BVYiiSIFeK1dGmJRAkycuHAHRg32OmUcww7on3RYdg4Va+PmSTsz/K68vbdEjh4u" + _crossorigin "anonymous" + ] + link + [ _rel "stylesheet" + _href "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap-theme.min.css" + attr "integrity" "sha384-rHyoN1iRsVXV4nD0JutlnGaslCJuC7uwjduW9SVrLvRYooPp2bWYgmgJQIXwl/Sp" + _crossorigin "anonymous" ] + link [ _rel "stylesheet"; _href "css/site.css" ] + link [ _rel "shortcut icon"; _type "image/png"; _href "/Images/safe_favicon.png" ] + body [ _class "app-container" ] [ + div [ _id "elmish-app"; _class "elmish-app" ] [ + rawText htmlStr + ] + script [ ] [ rawText (sprintf "var __INIT_MODEL__ = %s" jsonState) ] + script [ _src "/public/bundle.js" ] [] + ] + ] diff --git a/src/Server/WebServer.fs b/src/Server/WebServer.fs index 362010e2..bf8f1cf7 100644 --- a/src/Server/WebServer.fs +++ b/src/Server/WebServer.fs @@ -2,27 +2,35 @@ module ServerCode.WebServer open ServerCode +open ServerCode.ServerUrls open Giraffe open Giraffe.TokenRouter open RequestErrors +open Microsoft.AspNetCore.Http /// Start the web server and connect to database let webApp databaseType root = let startupTime = System.DateTime.UtcNow let db = Database.getDatabase databaseType startupTime - - let notfound = NOT_FOUND "Page not found" + let apiPathPrefix = PathString("/api") + let notfound: HttpHandler = + fun next ctx -> + if ctx.Request.Path.StartsWithSegments(apiPathPrefix) then + NOT_FOUND "Page not found" next ctx + else + Pages.notfound next ctx router notfound [ GET [ - route "/" (htmlFile (System.IO.Path.Combine(root,"index.html"))) - route ServerUrls.WishList => Auth.requiresJwtToken (WishList.getWishList db.LoadWishList) - route ServerUrls.ResetTime (WishList.getResetTime db.GetLastResetTime) + route PageUrls.Home Pages.home + + route APIUrls.WishList (Auth.requiresJwtTokenForAPI (WishList.getWishList db.LoadWishList)) + route APIUrls.ResetTime (WishList.getResetTime db.GetLastResetTime) ] POST [ - route ServerUrls.Login Auth.login - route ServerUrls.WishList => Auth.requiresJwtToken (WishList.postWishList db.SaveWishList) + route APIUrls.Login Auth.login + route APIUrls.WishList (Auth.requiresJwtTokenForAPI (WishList.postWishList db.SaveWishList)) ] ] diff --git a/src/Server/paket.references b/src/Server/paket.references index 22eb3d29..117aab01 100644 --- a/src/Server/paket.references +++ b/src/Server/paket.references @@ -10,4 +10,10 @@ Giraffe.TokenRouter Microsoft.AspNetCore.StaticFiles Microsoft.AspNetCore Microsoft.AspNetCore.WebSockets -Microsoft.AspNetCore.WebSockets.Server \ No newline at end of file +Microsoft.AspNetCore.WebSockets.Server + +Fable.Core +Fable.React +Fable.Import.Browser +Fable.Elmish.Browser +Fable.Elmish.React diff --git a/src/Shared/Client.props b/src/Shared/Client.props new file mode 100644 index 00000000..f1b89763 --- /dev/null +++ b/src/Shared/Client.props @@ -0,0 +1,13 @@ + + + + + + + + + + + + + diff --git a/src/Shared/Shared.props b/src/Shared/Shared.props new file mode 100644 index 00000000..c476c6ee --- /dev/null +++ b/src/Shared/Shared.props @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/test/UITests/UITests.fsproj b/test/UITests/UITests.fsproj index 366d3fcd..6b0b653b 100644 --- a/test/UITests/UITests.fsproj +++ b/test/UITests/UITests.fsproj @@ -1,8 +1,10 @@ + Exe net461 portable + true