Sign in works and redirects!

Sign in now goes from Auth0, back to the app, which gets the user ID
from the response and redirects to the journal page.  Woot!

src/App.fs

@@ -3,6 +3,7 @@ module MyPrayerJournal.App
 
 open Auth0.AuthenticationApi
 open Auth0.AuthenticationApi.Models
+open Microsoft.EntityFrameworkCore
 open Newtonsoft.Json
 open Newtonsoft.Json.Linq
 open Reader
@@ -11,10 +12,20 @@ open System.IO
 open Suave
 open Suave.Filters
 open Suave.Operators
+open Suave.Redirection
 open Suave.RequestErrors
 open Suave.State.CookieStateStore
 open Suave.Successful
 
+let utf8 = System.Text.Encoding.UTF8
+
+type JsonNetCookieSerializer() =
+  interface CookieSerialiser with
+    member x.serialise m =
+      utf8.GetBytes (JsonConvert.SerializeObject m)
+    member x.deserialise m =
+      JsonConvert.DeserializeObject<Map<string, obj>> (utf8.GetString m)
+
 type Auth0Config = {
   Domain : string
   ClientId : string
@@ -27,15 +38,28 @@ with
       ClientSecret = ""
       }
 
-let auth0 =
+type Config = {
+  Conn : string
+  Auth0 : Auth0Config
+}
+with
+  static member empty =
+    { Conn = ""
+      Auth0 = Auth0Config.empty
+      }
+
+let cfg =
   try
     use sr = File.OpenText "appsettings.json"
     let settings = JToken.ReadFrom(new JsonTextReader(sr)) :?> JObject
-    { Domain = settings.["auth0"].["domain"].ToObject<string>()
-      ClientId = settings.["auth0"].["client-id"].ToObject<string>()
-      ClientSecret = settings.["auth0"].["client-secret"].ToObject<string>()
+    { Conn = settings.["conn"].ToObject<string>()
+      Auth0 =
+        { Domain = settings.["auth0"].["domain"].ToObject<string>()
+          ClientId = settings.["auth0"].["client-id"].ToObject<string>()
+          ClientSecret = settings.["auth0"].["client-secret"].ToObject<string>()
+          }
       }
-  with _ -> Auth0Config.empty
+  with _ -> Config.empty
 
 /// Data Configuration singleton 
 //let lazyCfg = lazy (DataConfig.FromJson <| try File.ReadAllText "data-config.json" with _ -> "{}")
@@ -47,61 +71,135 @@ let auth0 =
 //    member __.Conn with get () = lazyConn.Force ()
 //  }
 
-let auth code = context (fun ctx ->
-    async {
-      let client = AuthenticationApiClient(Uri(sprintf "https://%s" auth0.Domain))
-      let! req =
-        client.ExchangeCodeForAccessTokenAsync
-          (ExchangeCodeRequest
-            (AuthorizationCode = code,
-            ClientId = auth0.ClientId,
-            ClientSecret = auth0.ClientSecret,
-            RedirectUri = "http://localhost:8080/user/log-on"))
-      let! user = client.GetUserInfoAsync((req : AccessToken).AccessToken)
-      return
-        ctx
-        |> HttpContext.state
-        |> function
-        | None -> FORBIDDEN "Cannot sign in without state"
-        | Some state ->
-            state.set "auth-token" req.IdToken
-            >=> Writers.setUserData "user" user
-      }
-    |> Async.RunSynchronously
-  )
+/// Get the scheme, host, and port of the URL
+let schemeHostPort (req : HttpRequest) =
+  sprintf "%s://%s" req.url.Scheme (req.headers |> List.filter (fun x -> fst x = "host") |> List.head |> snd)
 
-let viewHome =
-  Suave.Writers.setUserData "test" "howdy"
-  >=> fun x -> OK (Views.page Views.home (string x.userState.["test"])) x
+/// Authorization functions
+module Auth =
 
-let handleSignIn =
-  context (fun ctx ->
-    GET
-    >=> match ctx.request.queryParam "code" with
-        | Choice1Of2 authCode ->
-          auth authCode >=> OK (Views.page Views.home (Newtonsoft.Json.JsonConvert.SerializeObject(ctx.userState.["user"])))
-        | Choice2Of2 msg -> BAD_REQUEST msg
-  )
+  open Views
 
-let session = statefulForSession
+  let exchangeCodeForToken code = context (fun ctx ->
+      async {
+        let client = AuthenticationApiClient (Uri (sprintf "https://%s" cfg.Auth0.Domain))
+        let! req =
+          client.ExchangeCodeForAccessTokenAsync
+            (ExchangeCodeRequest
+              (AuthorizationCode = code,
+              ClientId = cfg.Auth0.ClientId,
+              ClientSecret = cfg.Auth0.ClientSecret,
+              RedirectUri = sprintf "%s/user/log-on" (schemeHostPort ctx.request)))
+        let! user = client.GetUserInfoAsync ((req : AccessToken).AccessToken)
+        return
+          ctx
+          |> HttpContext.state
+          |> function
+          | None -> FORBIDDEN "Cannot sign in without state"
+          | Some state ->
+              state.set "auth-token" req.IdToken
+              >=> Writers.setUserData "user" user
+        }
+      |> Async.RunSynchronously
+    )
+
+  /// Handle the sign-in callback from Auth0
+  let handleSignIn =
+    context (fun ctx ->
+      GET
+      >=> match ctx.request.queryParam "code" with
+          | Choice1Of2 authCode ->
+              exchangeCodeForToken authCode
+              >=> FOUND (sprintf "%s/journal" (schemeHostPort ctx.request))
+          | Choice2Of2 msg -> BAD_REQUEST msg
+    )
+  
+  /// Handle signing out a user
+  let handleSignOut =
+    context (fun ctx ->
+      match ctx |> HttpContext.state with
+      | Some state -> state.set "auth-key" null
+      | _ -> succeed
+      >=> FOUND (sprintf "%s/" (schemeHostPort ctx.request)))
+
+  let cw (x : string) = Console.WriteLine x
+
+  /// Convert microtime to ticks, add difference from 1/1/1 to 1/1/1970
+  let jsDate jsTicks =
+    DateTime(jsTicks * 10000000L).AddTicks(DateTime(1970, 1, 1).Ticks)
+  
+  let getIdFromToken token =
+    match token with
+    | Some jwt ->
+        try
+          let key = Convert.FromBase64String(cfg.Auth0.ClientSecret.Replace("-", "+").Replace("_", "/"))
+          let payload = Jose.JWT.Decode<JObject>(jwt, key)
+          let tokenExpires = jsDate (payload.["exp"].ToObject<int64>())
+          match tokenExpires > DateTime.UtcNow with
+          | true -> Some (payload.["sub"].ToObject<string>())
+          | _ -> None
+        with ex ->
+          sprintf "Token Deserialization Exception - %s" (ex.GetType().FullName) |> cw
+          sprintf "Message - %s" ex.Message |> cw
+          ex.StackTrace |> cw
+          None
+    | _ -> None
+  
+  /// Add the logged on user Id to the context if it exists
+  let loggedOn = warbler (fun ctx ->
+      match ctx |> HttpContext.state with
+      | Some state -> Writers.setUserData "user" (state.get "auth-token" |> getIdFromToken)
+      | _ -> Writers.setUserData "user" None)
+
+  /// Create a user context for the currently assigned user
+  let userCtx ctx = { Id = ctx.userState.["user"] :?> string option }
+    
+/// Create a new data context
+let dataCtx () =
+  new DataContext (((DbContextOptionsBuilder<DataContext>()).UseNpgsql cfg.Conn).Options)
+
+/// Home page
+let viewHome = warbler (fun ctx -> OK (Views.page (Auth.userCtx ctx) Views.home))
+
+/// Journal page
+let viewJournal = warbler (fun ctx -> OK (Views.page (Auth.userCtx ctx) Views.journal))
 
 /// Suave application
 let app =
-  session
+  statefulForSession
+  >=> Auth.loggedOn
   >=> choose [
         path Route.home >=> viewHome
-        path Route.User.logOn >=> handleSignIn
+        path Route.journal >=> viewJournal
+        path Route.User.logOn >=> Auth.handleSignIn
+        path Route.User.logOff >=> Auth.handleSignOut
         Files.browseHome
         NOT_FOUND "Page not found." 
         ]
 
-let suaveCfg = { defaultConfig with homeFolder = Some (Path.GetFullPath "./wwwroot/") }
-  
+/// Ensure the EF context is created in the right format
+let ensureDatabase () =
+  async {
+    use data = dataCtx()
+    do! data.Database.MigrateAsync ()
+  }
+  |> Async.RunSynchronously
+
+let suaveCfg =
+  { defaultConfig with
+      homeFolder = Some (Path.GetFullPath "./wwwroot/")
+      serverKey = Text.Encoding.UTF8.GetBytes("12345678901234567890123456789012")
+      cookieSerialiser = new JsonNetCookieSerializer()
+    }
+
 [<EntryPoint>]
 let main argv = 
   // Establish the data environment
   //liftDep getConn (Data.establishEnvironment >> Async.RunSynchronously)
   //|> run deps
-
+  ensureDatabase ()
   startWebServer suaveCfg app
   0 
+(*
+eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpc3MiOiJodHRwczovL2Rqcy1jb25zdWx0aW5nLmF1dGgwLmNvbS8iLCJzdWIiOiJ3aW5kb3dzbGl2ZXw3OTMyNGZhMTM4MzZlZGNiIiwiYXVkIjoiT2YyczBSUUNRM210M2R3SWtPQlk1aDg1SjlzWGJGMm4iLCJleHAiOjE0OTI5MDc1OTAsImlhdCI6MTQ5Mjg3MTU5MH0.61JPm3Hz7XW-iaSq8Esv1cajQPbK0o9L5xz-RHIYq9g
+*)

src/Data.fs

@@ -27,12 +27,6 @@ type DataContext =
   /// History
   member this.History with get () = this.history and set v = this.history <- v
 
-  override this.OnConfiguring (optionsBuilder) =
-    base.OnConfiguring optionsBuilder
-    optionsBuilder.UseNpgsql
-      "Host=severus-server;Database=mpj;Username=mpj;Password=devpassword;Application Name=myPrayerJournal"
-    |> ignore
-  
   override this.OnModelCreating (modelBuilder) =
     base.OnModelCreating modelBuilder
 

src/Entities.fs

@@ -14,7 +14,7 @@ type Request() =
   /// The Id of the prayer request
   member val RequestId = Guid.Empty with get, set
   /// The Id of the user to whom the request belongs
-  member val UserId = Guid.Empty with get, set
+  member val UserId = "" with get, set
   /// The ticks when the request was entered
   member val EnteredOn = 0L with get, set
   

src/Migrations/20170104023341_InitialDb.fs

@@ -40,7 +40,7 @@ type InitialDb () =
         (fun table ->
           { RequestId = table.Column<Guid>(nullable = false)
             EnteredOn = table.Column<int64>(nullable = false)
-            UserId = table.Column<Guid>(nullable = false)
+            UserId = table.Column<string>(nullable = false)
             }
           ),
       constraints =

src/Migrations/DataContextModelSnapshot.fs

@@ -41,7 +41,7 @@ type DataContextModelSnapshot () =
         |> ignore
         b.Property<int64>("EnteredOn")
         |> ignore
-        b.Property<Guid>("UserId")
+        b.Property<string>("UserId")
         |> ignore
         b.HasKey("RequestId")
         |> ignore

src/MyPrayerJournal.fsproj

@@ -33,6 +33,7 @@
 
   <ItemGroup>
     <PackageReference Include="Auth0.AuthenticationApi" Version="3.6.0" />
+    <PackageReference Include="jose-jwt" Version="2.3.0" />
     <PackageReference Include="Microsoft.EntityFrameworkCore.Tools" Version="1.0.0">
       <PrivateAssets>All</PrivateAssets>
     </PackageReference>

src/Route.fs

@@ -4,7 +4,12 @@ module MyPrayerJournal.Route
 /// The home page
 let home = "/"
 
+/// The main journal page
+let journal = "/journal"
+
 /// Routes dealing with users
 module User =
   /// The route for user log on response from Auth0
   let logOn = "/user/log-on"
+  let logOff = "/user/log-off"
+  

src/Views.fs

@@ -3,6 +3,8 @@ module MyPrayerJournal.Views
 //open Suave.Html
 open Suave.Xml
 
+type UserContext = { Id: string option }
+
 [<AutoOpen>]
 module Tags =
   /// Generate a meta tag
@@ -37,13 +39,17 @@ module PageComponents =
   let prependDoctype document = sprintf "<!DOCTYPE html>\n%s" document
   let render = xmlToString >> prependDoctype
 
-  let navigation =
-    [ navLink "/user/password/change" "Change Your Password"
-      navLink "/user/log-off" "Log Off"
-      jsLink "mpj.signIn()" "Log On"
+  let navigation userCtx =
+    [ 
+      match userCtx.Id with
+      | Some _ ->
+          yield navLink Route.journal "Journal"
+          yield navLink Route.User.logOff "Log Off"
+      | _ -> yield jsLink "mpj.signIn()" "Log On"
+      
       ]
     |> List.map (fun x -> tag "li" [] x)
-  let pageHeader =
+  let pageHeader userCtx =
     divAttr [ "class", "navbar navbar-inverse navbar-fixed-top" ] [
       divAttr [ "class", "container" ] [
         divAttr [ "class", "navbar-header" ] [
@@ -56,7 +62,7 @@ module PageComponents =
           navLinkAttr [ "class", "navbar-brand" ] "/" "myPrayerJournal"
           ]
         divAttr [ "class", "navbar-collapse collapse" ] [
-          ulAttr [ "class", "nav navbar-nav navbar-right" ] navigation
+          ulAttr [ "class", "nav navbar-nav navbar-right" ] (navigation userCtx)
           ]
         ]
       ]
@@ -72,7 +78,7 @@ module PageComponents =
     row [ divAttr [ "class", "col-xs-12" ] xml ]
 
 /// Display a page
-let page content somethingElse =
+let page userCtx content =
   html [
     head [
       meta [ "charset", "UTF-8" ]
@@ -83,10 +89,9 @@ let page content somethingElse =
       stylesheet "https://fonts.googleapis.com/icon?family=Material+Icons"
     ]
     body [
-      pageHeader
+      pageHeader userCtx
       divAttr [ "class", "container body-content" ] [
         content
-        div [ text somethingElse ]
         pageFooter
         ]
       js "https://cdn.auth0.com/js/lock/10.14/lock.min.js"
@@ -100,4 +105,9 @@ let home =
     p [ text "&nbsp;"]
     p [ text "myPrayerJournal is a place where individuals can record their prayer requests, record that they prayed for them, update them as God moves in the situation, and record a final answer received on that request.  It will also allow individuals to review their answered prayers." ]
     p [ text "This site is currently in very limited alpha, as it is being developed with a core group of test users.  If this is something you are interested in using, check back around mid-February 2017 to check on the development progress." ]
-    ]
+    ]
+
+let journal =
+  fullRow [
+    p [ text "journal goes here" ]
+  ]

src/wwwroot/js/mpj.js

@@ -3,7 +3,10 @@
  */
 var mpj = {
   lock: new Auth0Lock('Of2s0RQCQ3mt3dwIkOBY5h85J9sXbF2n', 'djs-consulting.auth0.com', {
-    auth: { redirectUrl: 'http://localhost:8080/user/log-on' }
+    auth: {
+      redirectUrl: 'http://localhost:8080/user/log-on',
+      allowSignUp: false
+    }
   }),
 
   signIn: function() {