diff --git a/src/App.fs b/src/App.fs index f9fa7db..17adbd4 100644 --- a/src/App.fs +++ b/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> (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() - ClientId = settings.["auth0"].["client-id"].ToObject() - ClientSecret = settings.["auth0"].["client-secret"].ToObject() + { Conn = settings.["conn"].ToObject() + Auth0 = + { Domain = settings.["auth0"].["domain"].ToObject() + ClientId = settings.["auth0"].["client-id"].ToObject() + ClientSecret = settings.["auth0"].["client-secret"].ToObject() + } } - 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(jwt, key) + let tokenExpires = jsDate (payload.["exp"].ToObject()) + match tokenExpires > DateTime.UtcNow with + | true -> Some (payload.["sub"].ToObject()) + | _ -> 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()).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() + } + [] 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 +*) \ No newline at end of file diff --git a/src/Data.fs b/src/Data.fs index 02e8986..96281ac 100644 --- a/src/Data.fs +++ b/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 diff --git a/src/Entities.fs b/src/Entities.fs index 5cd9191..0c271df 100644 --- a/src/Entities.fs +++ b/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 diff --git a/src/Migrations/20170104023341_InitialDb.fs b/src/Migrations/20170104023341_InitialDb.fs index 3f38404..575f0a7 100644 --- a/src/Migrations/20170104023341_InitialDb.fs +++ b/src/Migrations/20170104023341_InitialDb.fs @@ -40,7 +40,7 @@ type InitialDb () = (fun table -> { RequestId = table.Column(nullable = false) EnteredOn = table.Column(nullable = false) - UserId = table.Column(nullable = false) + UserId = table.Column(nullable = false) } ), constraints = diff --git a/src/Migrations/DataContextModelSnapshot.fs b/src/Migrations/DataContextModelSnapshot.fs index de71f7e..fb05713 100644 --- a/src/Migrations/DataContextModelSnapshot.fs +++ b/src/Migrations/DataContextModelSnapshot.fs @@ -41,7 +41,7 @@ type DataContextModelSnapshot () = |> ignore b.Property("EnteredOn") |> ignore - b.Property("UserId") + b.Property("UserId") |> ignore b.HasKey("RequestId") |> ignore diff --git a/src/MyPrayerJournal.fsproj b/src/MyPrayerJournal.fsproj index 94812c6..baa4b07 100644 --- a/src/MyPrayerJournal.fsproj +++ b/src/MyPrayerJournal.fsproj @@ -33,6 +33,7 @@ + All diff --git a/src/Route.fs b/src/Route.fs index 9532e6c..bbe2587 100644 --- a/src/Route.fs +++ b/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" + \ No newline at end of file diff --git a/src/Views.fs b/src/Views.fs index 3e78422..c91a43a 100644 --- a/src/Views.fs +++ b/src/Views.fs @@ -3,6 +3,8 @@ module MyPrayerJournal.Views //open Suave.Html open Suave.Xml +type UserContext = { Id: string option } + [] module Tags = /// Generate a meta tag @@ -37,13 +39,17 @@ module PageComponents = let prependDoctype document = sprintf "\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 " "] 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." ] - ] \ No newline at end of file + ] + +let journal = + fullRow [ + p [ text "journal goes here" ] + ] diff --git a/src/wwwroot/js/mpj.js b/src/wwwroot/js/mpj.js index 0c60b39..4b7e2f0 100644 --- a/src/wwwroot/js/mpj.js +++ b/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() {