More plumbing

App now starts with a very basic layout

src/MyPrayerJournal/App.fs

@@ -1,11 +1,23 @@
-module App
+module MyPrayerJournal.App
 
-open MyPrayerJournal
+open Microsoft.AspNetCore.Builder
+open Microsoft.AspNetCore.Hosting
 open Nancy
+open Nancy.Authentication.Forms
+open Nancy.Bootstrapper
+open Nancy.Cryptography
 open Nancy.Owin
-open Suave.Web
-open Suave.Owin
+open Nancy.Security
+open Nancy.Session.Persistable
+open Nancy.Session.RethinkDB
+open Nancy.TinyIoc
+open Nancy.ViewEngines.SuperSimpleViewEngine
+open NodaTime
+open RethinkDb.Driver.Net
 open System
+open System.Reflection
+open System.Security.Claims
+open System.Text.RegularExpressions
 
 /// Establish the configuration
 let cfg = AppConfig.FromJson (System.IO.File.ReadAllText "config.json")
@@ -13,8 +25,104 @@ let cfg = AppConfig.FromJson (System.IO.File.ReadAllText "config.json")
 do
   cfg.DataConfig.Conn.EstablishEnvironment () |> Async.RunSynchronously
 
+/// Support i18n/l10n via the @Translate SSVE alias
+type TranslateTokenViewEngineMatcher() =
+  static let regex = Regex("@Translate\.(?<TranslationKey>[a-zA-Z0-9-_]+);?", RegexOptions.Compiled)
+  interface ISuperSimpleViewEngineMatcher with
+    member this.Invoke (content, model, host) =
+      let translate (m : Match) = Strings.get m.Groups.["TranslationKey"].Value
+      regex.Replace(content, translate)
+
+/// Handle forms authentication
+type AppUser(name, claims) =
+  inherit ClaimsPrincipal()
+  member this.UserName with get() = name
+  member this.Claims   with get() = claims
+ 
+type AppUserMapper(container : TinyIoCContainer) =
+  
+  interface IUserMapper with
+    member this.GetUserFromIdentifier (identifier, context) =
+      match context.Request.PersistableSession.GetOrDefault(Keys.User, User.Empty) with
+      | user when user.Id = string identifier -> upcast AppUser(user.Name, [ "LoggedIn" ])
+      | _ -> null
+
+
+/// Set up the application environment
+type AppBootstrapper() =
+  inherit DefaultNancyBootstrapper()
+  
+  override this.ConfigureRequestContainer (container, context) =
+    base.ConfigureRequestContainer (container, context)
+    /// User mapper for forms authentication
+    ignore <| container.Register<IUserMapper, AppUserMapper>()
+
+  override this.ConfigureApplicationContainer (container) =
+    base.ConfigureApplicationContainer container
+    ignore <| container.Register<AppConfig>(cfg)
+    ignore <| container.Register<IConnection>(cfg.DataConfig.Conn)
+    // NodaTime
+    ignore <| container.Register<IClock>(SystemClock.Instance)
+    // I18N in SSVE
+    ignore <| container.Register<seq<ISuperSimpleViewEngineMatcher>>
+                (fun _ _ -> 
+                  Seq.singleton (TranslateTokenViewEngineMatcher() :> ISuperSimpleViewEngineMatcher))
+  
+  override this.ApplicationStartup (container, pipelines) =
+    base.ApplicationStartup (container, pipelines)
+    // Forms authentication configuration
+    let auth =
+      FormsAuthenticationConfiguration(
+        CryptographyConfiguration =
+          CryptographyConfiguration(
+            AesEncryptionProvider(PassphraseKeyGenerator(cfg.AuthEncryptionPassphrase, cfg.AuthSalt)),
+            DefaultHmacProvider(PassphraseKeyGenerator(cfg.AuthHmacPassphrase, cfg.AuthSalt))),
+        RedirectUrl = "~/user/log-on",
+        UserMapper  = container.Resolve<IUserMapper>())
+    FormsAuthentication.Enable (pipelines, auth)
+    // CSRF
+    Csrf.Enable pipelines
+    // Sessions
+    let sessions = RethinkDBSessionConfiguration(cfg.DataConfig.Conn)
+    sessions.Database <- cfg.DataConfig.Database
+    PersistableSessions.Enable (pipelines, sessions)
+    ()
+
+  override this.Configure (environment) =
+    base.Configure environment
+    environment.Tracing(true, true)
+
+
+let version = 
+  let v = typeof<AppConfig>.GetType().GetTypeInfo().Assembly.GetName().Version
+  match v.Build with
+  | 0 -> match v.Minor with 0 -> string v.Major | _ -> sprintf "%d.%d" v.Major v.Minor
+  | _ -> sprintf "%d.%d.%d" v.Major v.Minor v.Build
+  |> sprintf "v%s"
+
+/// Set up the request environment
+type RequestEnvironment() =
+  interface IRequestStartup with
+    member this.Initialize (pipelines, context) =
+      pipelines.BeforeRequest.AddItemToStartOfPipeline
+        (fun ctx ->
+          ctx.Items.[Keys.RequestStart] <- DateTime.Now.Ticks
+          ctx.Items.[Keys.Version]      <- version
+          null)
+
+type Startup() =
+  member this.Configure (app : IApplicationBuilder) =
+    ignore <| app.UseOwin(fun x -> x.UseNancy(fun opt -> opt.Bootstrapper <- new AppBootstrapper()) |> ignore)
+
 [<EntryPoint>]
 let main argv = 
-  let app = OwinApp.ofMidFunc "/" (NancyMiddleware.UseNancy(NancyOptions()))
-  startWebServer defaultConfig app
-  0 // return an integer exit code
+//  let app = OwinApp.ofMidFunc "/" (NancyMiddleware.UseNancy(fun opt -> opt.Bootstrapper <- new AppBootstrapper()))
+//  startWebServer defaultConfig app
+//  0 // return an integer exit code
+  WebHostBuilder()
+    .UseContentRoot(System.IO.Directory.GetCurrentDirectory())
+    .UseKestrel()
+    .UseStartup<Startup>()
+    .Build()
+    .Run()
+  0

src/MyPrayerJournal/Data.fs

@@ -1,8 +1,10 @@
 [<AutoOpen>]
 module Data
 
+open MyPrayerJournal
 open Newtonsoft.Json
 open RethinkDb.Driver
+open RethinkDb.Driver.Ast
 open RethinkDb.Driver.Net
 open System
 
@@ -20,6 +22,17 @@ module DataTable =
 /// Extensions for the RethinkDB connection
 type IConnection with
   
+  /// Log on a user
+  member this.LogOnUser (email : string) (passwordHash : string) =
+    async {
+      let! user = r.Table(DataTable.User)
+                    .GetAll(email).OptArg("index", "Email")
+                    .Filter(ReqlFunction1(fun usr -> upcast usr.["PasswordHash"].Eq(passwordHash)))
+                    .RunResultAsync<User>(this)
+                  |> Async.AwaitTask
+      return match box user with null -> None | _ -> Some user
+    }
+
   /// Set up the environment for MyPrayerJournal
   member this.EstablishEnvironment () =
     /// Shorthand for the database
@@ -29,7 +42,7 @@ type IConnection with
     /// Ensure the database exists
     let checkDatabase () =
       async {
-        logStep "|> Checking database..."
+        logStep "|> Checking database"
         let! dbList = r.DbList().RunResultAsync<string list>(this) |> Async.AwaitTask 
         match dbList |> List.contains "MyPrayerJournal" with
         | true -> ()
@@ -40,7 +53,7 @@ type IConnection with
     /// Ensure all tables exit
     let checkTables () =
       async {
-        logStep "|> Checking tables..."
+        logStep "|> Checking tables"
         let! tables = db().TableList().RunResultAsync<string list>(this) |> Async.AwaitTask
         [ DataTable.Request; DataTable.User ]
         |> List.filter (fun tbl -> not (tables |> List.contains tbl))
@@ -55,7 +68,7 @@ type IConnection with
     /// Ensure the proper indexes exist
     let checkIndexes () =
       async {
-        logStep "|> Checking indexes..."
+        logStep "|> Checking indexes"
         let! reqIdx = db().Table(DataTable.Request).IndexList().RunResultAsync<string list>(this) |> Async.AwaitTask
         match reqIdx |> List.contains "UserId" with
         | true -> ()

src/MyPrayerJournal/Entities.fs

@@ -13,9 +13,21 @@ type User = {
   PasswordHash : string
   /// The user's name
   Name : string
+  /// The time zone in which the user resides
+  TimeZone : string
   /// The last time the user logged on
   LastSeenOn : int64
 }
+  with
+    /// An empty User
+    static member Empty =
+      { Id           = ""
+        Email        = ""
+        PasswordHash = ""
+        Name         = ""
+        TimeZone     = ""
+        LastSeenOn   = int64 0 }
+
         
 /// Request history entry
 type History = {

src/MyPrayerJournal/HomeModule.fs

@@ -0,0 +1,15 @@
+namespace MyPrayerJournal
+
+open Nancy
+
+type HomeModule() as this =
+  inherit NancyModule()
+
+  do
+    this.Get ("/", fun _ -> this.Home ())
+
+  member this.Home () : obj =
+    let model = MyPrayerJournalModel(this.Context)
+    model.PageTitle <- Strings.get "Welcome"
+    upcast this.View.["home/index", model]
+  

src/MyPrayerJournal/Keys.fs

@@ -0,0 +1,14 @@
+[<RequireQualifiedAccess>]
+module MyPrayerJournal.Keys
+
+/// Messages stored in the session
+let Messages = "messages"
+
+/// The request start time (stored in the context for each request)
+let RequestStart = "request-start"
+
+/// The current user
+let User = "user"
+
+/// The version of myPrayerJournal
+let Version = "version"

src/MyPrayerJournal/Strings.fs

@@ -0,0 +1,40 @@
+module MyPrayerJournal.Strings
+
+open Newtonsoft.Json
+open System.Collections.Generic
+open System.IO
+
+/// The locales we'll try to load
+let private supportedLocales = [ "en-US" ]
+
+/// The fallback locale, if a key is not found in a non-default locale
+let private fallbackLocale = "en-US"
+
+/// Get an embedded JSON file as a string
+let private getEmbedded locale =
+  use stream = new FileStream((sprintf "resources/%s.json" locale), FileMode.Open)
+  use rdr = new StreamReader(stream)
+  rdr.ReadToEnd()
+
+/// The dictionary of localized strings
+let private strings =
+  supportedLocales
+  |> List.map (fun loc -> loc, JsonConvert.DeserializeObject<Dictionary<string, string>>(getEmbedded loc))
+  |> dict
+
+/// Get a key from the resources file for the given locale
+let getForLocale locale key =
+  let getString thisLocale = 
+    match strings.ContainsKey thisLocale with
+    | true -> match strings.[thisLocale].ContainsKey key with
+              | true -> Some strings.[thisLocale].[key]
+              | _ -> None
+    | _ -> None
+  match getString locale with
+  | Some xlat -> Some xlat
+  | _ when locale <> fallbackLocale -> getString fallbackLocale
+  | _ -> None
+  |> function Some xlat -> xlat | _ -> sprintf "%s.%s" locale key
+
+/// Translate the key for the current locale
+let get key = getForLocale System.Globalization.CultureInfo.CurrentCulture.Name key

src/MyPrayerJournal/UserModule.fs

@@ -0,0 +1,18 @@
+namespace MyPrayerJournal
+
+open Nancy
+
+type UserModule() as this =
+  inherit NancyModule("user")
+
+  do
+    this.Get ("/log-on", fun _ -> this.ShowLogOn ())
+    this.Post("/log-on", fun parms -> this.DoLogOn (downcast parms))
+
+  member this.ShowLogOn () : obj =
+    let model = MyPrayerJournalModel(this.Context)
+    model.PageTitle <- Strings.get "LogOn"
+    upcast this.View.["user/log-on", model]
+  
+  member this.DoLogOn (parms : DynamicDictionary) : obj =
+    upcast "X"

src/MyPrayerJournal/ViewModels.fs

@@ -0,0 +1,140 @@
+namespace MyPrayerJournal
+
+open Nancy
+open Nancy.Session.Persistable
+open Newtonsoft.Json
+open NodaTime
+open NodaTime.Text
+open System
+
+/// Levels for a user message
+[<RequireQualifiedAccess>]
+module Level =
+  /// An informational message
+  let Info = "Info"
+  /// A message regarding a non-fatal but non-optimal condition
+  let Warning = "WARNING"
+  /// A message regarding a failure of the expected result
+  let Error = "ERROR"
+
+
+/// A message for the user
+type UserMessage = 
+  { /// The level of the message (use Level module constants)
+    Level : string
+    /// The text of the message
+    Message : string
+    /// Further details regarding the message
+    Details : string option }
+with
+  /// An empty message
+  static member Empty =
+    { Level   = Level.Info
+      Message = ""
+      Details = None }
+
+  /// Display version
+  [<JsonIgnore>]
+  member this.ToDisplay =
+    let classAndLabel =
+      dict [
+        Level.Error,   ("danger",  Strings.get "Error")
+        Level.Warning, ("warning", Strings.get "Warning")
+        Level.Info,    ("info",    "")
+        ]
+    seq {
+      yield "<div class=\"alert alert-dismissable alert-"
+      yield fst classAndLabel.[this.Level]
+      yield "\" role=\"alert\"><button type=\"button\" class=\"close\" data-dismiss=\"alert\" aria-label=\""
+      yield Strings.get "Close"
+      yield "\">&times;</button><strong>"
+      match snd classAndLabel.[this.Level] with
+      | ""  -> ()
+      | lbl -> yield lbl.ToUpper ()
+               yield " &#xbb; "
+      yield this.Message
+      yield "</strong>"
+      match this.Details with
+      | Some d -> yield "<br />"
+                  yield d
+      | None -> ()
+      yield "</div>"
+      }
+    |> Seq.reduce (+)
+
+
+/// Helpers to format local date/time using NodaTime
+module FormatDateTime =
+  
+  /// Convert ticks to a zoned date/time
+  let zonedTime timeZone ticks = Instant.FromUnixTimeTicks(ticks).InZone(DateTimeZoneProviders.Tzdb.[timeZone])
+
+  /// Display a long date
+  let longDate timeZone ticks =
+    zonedTime timeZone ticks
+    |> ZonedDateTimePattern.CreateWithCurrentCulture("MMMM d',' yyyy", DateTimeZoneProviders.Tzdb).Format
+  
+  /// Display a short date
+  let shortDate timeZone ticks =
+    zonedTime timeZone ticks
+    |> ZonedDateTimePattern.CreateWithCurrentCulture("MMM d',' yyyy", DateTimeZoneProviders.Tzdb).Format
+  
+  /// Display the time
+  let time timeZone ticks =
+    (zonedTime timeZone ticks
+     |> ZonedDateTimePattern.CreateWithCurrentCulture("h':'mmtt", DateTimeZoneProviders.Tzdb).Format).ToLower()
+  
+
+/// Parent view model for all myPrayerJournal view models
+type MyPrayerJournalModel(ctx : NancyContext) =
+  
+  /// Get the messages from the session
+  let getMessages () =
+    let msg = ctx.Request.PersistableSession.GetOrDefault<UserMessage list>(Keys.Messages, [])
+    match List.length msg with
+    | 0 -> ()
+    | _ -> ctx.Request.Session.Delete Keys.Messages
+    msg
+
+  /// User messages
+  member val Messages = getMessages () with get, set
+  /// The currently logged in user
+  member this.User = ctx.Request.PersistableSession.GetOrDefault<User>(Keys.User, User.Empty)
+  /// The title of the page
+  member val PageTitle = "" with get, set
+  /// The name and version of the application
+  member this.Generator = sprintf "myPrayerJournal %s" (ctx.Items.[Keys.Version].ToString ())
+  /// The request start time
+  member this.RequestStart = ctx.Items.[Keys.RequestStart] :?> int64
+  /// Is a user authenticated for this request?
+  member this.IsAuthenticated = "" <> this.User.Id
+  /// Add a message to the output
+  member this.AddMessage message = this.Messages <- message :: this.Messages
+
+  /// Display a long date
+  member this.DisplayLongDate ticks = FormatDateTime.longDate this.User.TimeZone ticks
+  /// Display a short date
+  member this.DisplayShortDate ticks = FormatDateTime.shortDate this.User.TimeZone ticks
+  /// Display the time
+  member this.DisplayTime ticks = FormatDateTime.time this.User.TimeZone ticks
+  /// The page title with the web log name appended
+  member this.DisplayPageTitle = this.PageTitle (*
+    match this.PageTitle with
+    | "" -> match this.WebLog.Subtitle with
+            | Some st -> sprintf "%s | %s" this.WebLog.Name st
+            | None -> this.WebLog.Name
+    | pt -> sprintf "%s | %s" pt this.WebLog.Name *)
+
+  /// An image with the version and load time in the tool tip
+  member this.FooterLogo =
+    seq {
+      yield "<img src=\"/default/footer-logo.png\" alt=\"myWebLog\" title=\""
+      yield sprintf "%s %s &bull; " (Strings.get "PoweredBy") this.Generator
+      yield Strings.get "LoadedIn"
+      yield " "
+      yield TimeSpan(System.DateTime.Now.Ticks - this.RequestStart).TotalSeconds.ToString "f3"
+      yield " "
+      yield (Strings.get "Seconds").ToLower ()
+      yield "\" />"
+      }
+    |> Seq.reduce (+)

src/MyPrayerJournal/project.json

@@ -1,39 +1,50 @@
 {
-  "version": "1.0.0-*",
   "buildOptions": {
-    "debugType": "portable",
-    "emitEntryPoint": true,
-    "compilerName": "fsc",
     "compile": {
       "includeFiles": [
         "Entities.fs",
+        "Strings.fs",
         "Config.fs",
         "Data.fs",
+        "Keys.fs",
+        "ViewModels.fs",
+        "HomeModule.fs",
+        "UserModule.fs",
         "App.fs"
       ]
-    }
+    },
+    "compilerName": "fsc",
+    "copyToOutput": {
+      "include": [ "views", "resources" ]
+    },
+    "debugType": "portable",
+    "emitEntryPoint": true
   },
   "dependencies": {
+    "Microsoft.AspNetCore.Hosting": "1.0.0",
+    "Microsoft.AspNetCore.Owin": "1.0.0",
+    "Microsoft.AspNetCore.Server.Kestrel": "1.0.1",
     "Nancy": "2.0.0-barneyrubble",
     "Nancy.Authentication.Forms": "2.0.0-barneyrubble",
     "Nancy.Session.Persistable": "0.9.1-pre",
     "Nancy.Session.RethinkDB": "0.9.1-pre",
     "Newtonsoft.Json": "9.0.1",
-    "RethinkDb.Driver": "2.3.15",
-    "Suave": "2.0.0-alpha5"
-  },
-  "tools": {
-    "dotnet-compile-fsc":"1.0.0-preview2-*"
+    "NodaTime": "2.0.0-alpha20160729",
+    "RethinkDb.Driver": "2.3.15"
   },
   "frameworks": {
     "netcoreapp1.0": {
       "dependencies": {
+        "Microsoft.FSharp.Core.netcore": "1.0.0-alpha-160831",
         "Microsoft.NETCore.App": {
           "type": "platform",
           "version": "1.0.1"
+        }
+      }
+    }
   },
-        "Microsoft.FSharp.Core.netcore": "1.0.0-alpha-160831"
-      }
-    }
-  }
+  "tools": {
+    "dotnet-compile-fsc":"1.0.0-preview2-*"
+  },
+  "version": "1.0.0-*"
 }

src/MyPrayerJournal/resources/en-US.json

@@ -0,0 +1,8 @@
+{
+  "ChangeYourPassword": "Change Your Password",
+  "EmailAddress": "E-mail Address",
+  "LogOff": "Log Off",
+  "LogOn": "Log On",
+  "MyPrayerJournal": "MyPrayerJournal",
+  "Password": "Password"
+}

src/MyPrayerJournal/views/home/index.html

@@ -0,0 +1,5 @@
+@Master['layout']
+
+@Section['Content']
+  <p>Hi</p>
+@EndSection

src/MyPrayerJournal/views/layout.html

@@ -0,0 +1,60 @@
+<!DOCTYPE html>
+<html>
+<head>
+  <meta charset="utf-8"/>
+  <meta name="viewport" content="width=device-width" />
+  <meta name="generator" content="@Model.Generator" />
+  <title>@Model.DisplayPageTitle</title>
+  <link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css" integrity="sha384-BVYiiSIFeK1dGmJRAkycuHAHRg32OmUcww7on3RYdg4Va+PmSTsz/K68vbdEjh4u" crossorigin="anonymous" />
+  <link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap-theme.min.css" integrity="sha384-rHyoN1iRsVXV4nD0JutlnGaslCJuC7uwjduW9SVrLvRYooPp2bWYgmgJQIXwl/Sp" crossorigin="anonymous" />
+  <link rel="stylesheet" href="https://fonts.googleapis.com/icon?family=Material+Icons" />
+  <style>
+    body {
+      font-family: -apple-system,BlinkMacSystemFont,"Segoe UI",Roboto,Oxygen-Sans,Ubuntu,Cantarell,"Helvetica Neue",sans-serif;
+    }
+    .material-icons.md-18 {
+      font-size: 18px;
+    }
+    .material-icons.md-24 {
+      font-size: 24px;
+    }
+    .material-icons.md-36 {
+      font-size: 36px;
+    }
+    .material-icons.md-48 {
+      font-size: 48px;
+    }
+    .material-icons {
+      vertical-align: middle;
+    }
+  </style>
+  @Section['Head'];
+</head>
+<body>
+  <header>
+    <nav class="navbar navbar-default">
+      <div class="container-fluid">
+        <div class="navbar-header">
+          <a class="navbar-brand" href="/"><span style="font-weight:100;">My</span><span style="font-weight:600;">Prayer</span><span style="font-weight:700;">Journal</span></a>
+        </div>
+        <ul class="nav navbar-nav navbar-right">
+          @If.IsAuthenticated
+            <li><a href="/user/change-password">@Translate.ChangeYourPassword</a></li>
+            <li><a href="/user/log-off">@Translate.LogOff</a></li>
+          @EndIf
+          @IfNot.IsAuthenticated
+            <li><a href="/user/log-on">@Translate.LogOn</a></li>
+          @EndIf
+        </ul>
+      </div>
+    </nav>
+  </header>
+  <div class="container">
+    @Section['Content'];
+  </div>
+  @Section['Footer'];
+  <script type="text/javascript" src="//ajax.aspnetcdn.com/ajax/jQuery/jquery-2.1.3.min.js"></script>
+  <script src="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/js/bootstrap.min.js" integrity="sha384-Tc5IQib027qvyjSMfHjOMaLkfuWVxZxUPnCJA7l2mCWNIpG9mGCD8wGNIcPD7Txa" crossorigin="anonymous"></script>
+  @Section['Scripts'];
+</body>
+</html>

src/MyPrayerJournal/views/user/log-on.html

@@ -0,0 +1,40 @@
+@Master['layout']
+
+@Section['Content']
+  <form action="/user/log-on" method="post">
+    @AntiForgeryToken
+    <div class="row">
+      <div class="col-sm-offset-1 col-sm-8 col-md-offset-3 col-md-6">
+        <div class="input-group">
+          <span class="input-group-addon" title="@Translate.EmailAddress"><i class="material-icons md-18">email</i></span>
+          <input type="text" name="Email" id="Email" class="form-control" placeholder="@Translate.EmailAddress" />
+        </div>
+      </div>
+    </div>
+    <div class="row">
+      <div class="col-sm-offset-1 col-sm-8 col-md-offset-3 col-md-6">
+        <br />
+        <div class="input-group">
+          <span class="input-group-addon" title="@Translate.Password"><i class="material-icons md-18">security</i></span>
+          <input type="password" name="Password" class="form-control" placeholder="@Translate.Password" />
+        </div>
+      </div>
+    </div>
+    <div class="row">
+      <div class="col-xs-12 text-center">
+        <p>
+          <br />
+          <button class="btn btn-primary"><i class="material-icons md-18">verified_user</i> @Translate.LogOn</button>
+        </p>
+      </div>
+    </div>
+  </form>
+@EndSection
+
+@Section['Scripts']
+  <script type="text/javascript">
+    /* <![CDATA[ */
+    $(document).ready(function () { $("#Email").focus() })
+    /* ]]> */
+  </script>
+@EndSection