Moved to ASP.NET Core MVC
Thanks to an outstanding presentation from Enrico Sada, I was inspired to use ASP.NET Core MVC for this F# project
This commit is contained in:
Daniel J. Summers
parent
1251c28a89
commit
5235e5a5db
4
.gitignore
vendored
4
.gitignore
vendored
@ -24,6 +24,7 @@ bld/
|
||||
|
||||
# Visual Studio 2015 cache/options directory
|
||||
.vs/
|
||||
.vscode/
|
||||
# Uncomment if you have tasks that create the project's static files in wwwroot
|
||||
#wwwroot/
|
||||
|
||||
@ -250,3 +251,6 @@ paket-files/
|
||||
# JetBrains Rider
|
||||
.idea/
|
||||
*.sln.iml
|
||||
|
||||
# wwwroot/lib
|
||||
src/MyPrayerJournal/wwwroot/lib
|
||||
3
src/MyPrayerJournal/.bowerrc
Normal file
3
src/MyPrayerJournal/.bowerrc
Normal file
@ -0,0 +1,3 @@
|
||||
{
|
||||
"directory": "wwwroot/lib"
|
||||
}
|
||||
234
src/MyPrayerJournal/.gitignore
vendored
Normal file
234
src/MyPrayerJournal/.gitignore
vendored
Normal file
@ -0,0 +1,234 @@
|
||||
## Ignore Visual Studio temporary files, build results, and
|
||||
## files generated by popular Visual Studio add-ons.
|
||||
|
||||
# User-specific files
|
||||
*.suo
|
||||
*.user
|
||||
*.userosscache
|
||||
*.sln.docstates
|
||||
|
||||
# User-specific files (MonoDevelop/Xamarin Studio)
|
||||
*.userprefs
|
||||
|
||||
# Build results
|
||||
[Dd]ebug/
|
||||
[Dd]ebugPublic/
|
||||
[Rr]elease/
|
||||
[Rr]eleases/
|
||||
x64/
|
||||
x86/
|
||||
build/
|
||||
bld/
|
||||
[Bb]in/
|
||||
[Oo]bj/
|
||||
|
||||
# Visual Studio 2015 cache/options directory
|
||||
.vs/
|
||||
# Uncomment if you have tasks that create the project's static files in wwwroot
|
||||
#wwwroot/
|
||||
|
||||
# MSTest test Results
|
||||
[Tt]est[Rr]esult*/
|
||||
[Bb]uild[Ll]og.*
|
||||
|
||||
# NUNIT
|
||||
*.VisualState.xml
|
||||
TestResult.xml
|
||||
|
||||
# Build Results of an ATL Project
|
||||
[Dd]ebugPS/
|
||||
[Rr]eleasePS/
|
||||
dlldata.c
|
||||
|
||||
# DNX
|
||||
project.lock.json
|
||||
artifacts/
|
||||
|
||||
*_i.c
|
||||
*_p.c
|
||||
*_i.h
|
||||
*.ilk
|
||||
*.meta
|
||||
*.obj
|
||||
*.pch
|
||||
*.pdb
|
||||
*.pgc
|
||||
*.pgd
|
||||
*.rsp
|
||||
*.sbr
|
||||
*.tlb
|
||||
*.tli
|
||||
*.tlh
|
||||
*.tmp
|
||||
*.tmp_proj
|
||||
*.log
|
||||
*.vspscc
|
||||
*.vssscc
|
||||
.builds
|
||||
*.pidb
|
||||
*.svclog
|
||||
*.scc
|
||||
|
||||
# Chutzpah Test files
|
||||
_Chutzpah*
|
||||
|
||||
# Visual C++ cache files
|
||||
ipch/
|
||||
*.aps
|
||||
*.ncb
|
||||
*.opendb
|
||||
*.opensdf
|
||||
*.sdf
|
||||
*.cachefile
|
||||
|
||||
# Visual Studio profiler
|
||||
*.psess
|
||||
*.vsp
|
||||
*.vspx
|
||||
*.sap
|
||||
|
||||
# TFS 2012 Local Workspace
|
||||
$tf/
|
||||
|
||||
# Guidance Automation Toolkit
|
||||
*.gpState
|
||||
|
||||
# ReSharper is a .NET coding add-in
|
||||
_ReSharper*/
|
||||
*.[Rr]e[Ss]harper
|
||||
*.DotSettings.user
|
||||
|
||||
# JustCode is a .NET coding add-in
|
||||
.JustCode
|
||||
|
||||
# TeamCity is a build add-in
|
||||
_TeamCity*
|
||||
|
||||
# DotCover is a Code Coverage Tool
|
||||
*.dotCover
|
||||
|
||||
# NCrunch
|
||||
_NCrunch_*
|
||||
.*crunch*.local.xml
|
||||
nCrunchTemp_*
|
||||
|
||||
# MightyMoose
|
||||
*.mm.*
|
||||
AutoTest.Net/
|
||||
|
||||
# Web workbench (sass)
|
||||
.sass-cache/
|
||||
|
||||
# Installshield output folder
|
||||
[Ee]xpress/
|
||||
|
||||
# DocProject is a documentation generator add-in
|
||||
DocProject/buildhelp/
|
||||
DocProject/Help/*.HxT
|
||||
DocProject/Help/*.HxC
|
||||
DocProject/Help/*.hhc
|
||||
DocProject/Help/*.hhk
|
||||
DocProject/Help/*.hhp
|
||||
DocProject/Help/Html2
|
||||
DocProject/Help/html
|
||||
|
||||
# Click-Once directory
|
||||
publish/
|
||||
|
||||
# Publish Web Output
|
||||
*.[Pp]ublish.xml
|
||||
*.azurePubxml
|
||||
# TODO: Comment the next line if you want to checkin your web deploy settings
|
||||
# but database connection strings (with potential passwords) will be unencrypted
|
||||
*.pubxml
|
||||
*.publishproj
|
||||
|
||||
# NuGet Packages
|
||||
*.nupkg
|
||||
# The packages folder can be ignored because of Package Restore
|
||||
**/packages/*
|
||||
# except build/, which is used as an MSBuild target.
|
||||
!**/packages/build/
|
||||
# Uncomment if necessary however generally it will be regenerated when needed
|
||||
#!**/packages/repositories.config
|
||||
|
||||
# Microsoft Azure Build Output
|
||||
csx/
|
||||
*.build.csdef
|
||||
|
||||
# Microsoft Azure Emulator
|
||||
ecf/
|
||||
rcf/
|
||||
|
||||
# Microsoft Azure ApplicationInsights config file
|
||||
ApplicationInsights.config
|
||||
|
||||
# Windows Store app package directory
|
||||
AppPackages/
|
||||
BundleArtifacts/
|
||||
|
||||
# Visual Studio cache files
|
||||
# files ending in .cache can be ignored
|
||||
*.[Cc]ache
|
||||
# but keep track of directories ending in .cache
|
||||
!*.[Cc]ache/
|
||||
|
||||
# Others
|
||||
ClientBin/
|
||||
~$*
|
||||
*~
|
||||
*.dbmdl
|
||||
*.dbproj.schemaview
|
||||
*.pfx
|
||||
*.publishsettings
|
||||
node_modules/
|
||||
orleans.codegen.cs
|
||||
|
||||
# RIA/Silverlight projects
|
||||
Generated_Code/
|
||||
|
||||
# Backup & report files from converting an old project file
|
||||
# to a newer Visual Studio version. Backup files are not needed,
|
||||
# because we have git ;-)
|
||||
_UpgradeReport_Files/
|
||||
Backup*/
|
||||
UpgradeLog*.XML
|
||||
UpgradeLog*.htm
|
||||
|
||||
# SQL Server files
|
||||
*.mdf
|
||||
*.ldf
|
||||
|
||||
# Business Intelligence projects
|
||||
*.rdl.data
|
||||
*.bim.layout
|
||||
*.bim_*.settings
|
||||
|
||||
# Microsoft Fakes
|
||||
FakesAssemblies/
|
||||
|
||||
# GhostDoc plugin setting file
|
||||
*.GhostDoc.xml
|
||||
|
||||
# Node.js Tools for Visual Studio
|
||||
.ntvs_analysis.dat
|
||||
|
||||
# Visual Studio 6 build log
|
||||
*.plg
|
||||
|
||||
# Visual Studio 6 workspace options file
|
||||
*.opt
|
||||
|
||||
# Visual Studio LightSwitch build output
|
||||
**/*.HTMLClient/GeneratedArtifacts
|
||||
**/*.DesktopClient/GeneratedArtifacts
|
||||
**/*.DesktopClient/ModelManifest.xml
|
||||
**/*.Server/GeneratedArtifacts
|
||||
**/*.Server/ModelManifest.xml
|
||||
_Pvt_Extensions
|
||||
|
||||
# Paket dependency manager
|
||||
.paket/paket.exe
|
||||
|
||||
# FAKE - F# Make
|
||||
.fake/
|
||||
@ -1,127 +1,79 @@
|
||||
module MyPrayerJournal.App
|
||||
|
||||
open Microsoft.AspNetCore.Builder
|
||||
open Microsoft.AspNetCore.Hosting
|
||||
open Nancy
|
||||
open Nancy.Authentication.Forms
|
||||
open Nancy.Bootstrapper
|
||||
open Nancy.Cryptography
|
||||
open Nancy.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 Microsoft.AspNetCore.Localization
|
||||
open Microsoft.Extensions.Configuration
|
||||
open Microsoft.Extensions.DependencyInjection
|
||||
open Microsoft.Extensions.Logging
|
||||
open Microsoft.Extensions.Options
|
||||
open System
|
||||
open System.Reflection
|
||||
open System.Security.Claims
|
||||
open System.Text.RegularExpressions
|
||||
open System.IO
|
||||
|
||||
/// Establish the configuration
|
||||
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) =
|
||||
/// Startup class for myPrayerJournal
|
||||
type Startup(env : IHostingEnvironment) =
|
||||
|
||||
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
|
||||
/// Configuration for this application
|
||||
member this.Configuration =
|
||||
let builder =
|
||||
ConfigurationBuilder()
|
||||
.SetBasePath(env.ContentRootPath)
|
||||
.AddJsonFile("appsettings.json", optional = true, reloadOnChange = true)
|
||||
.AddJsonFile(sprintf "appsettings.%s.json" env.EnvironmentName, optional = true)
|
||||
// For more details on using the user secret store see https://go.microsoft.com/fwlink/?LinkID=532709
|
||||
match env.IsDevelopment () with true -> ignore <| builder.AddUserSecrets () | _ -> ()
|
||||
ignore <| builder.AddEnvironmentVariables ()
|
||||
builder.Build ()
|
||||
|
||||
// This method gets called by the runtime. Use this method to add services to the container.
|
||||
member this.ConfigureServices (services : IServiceCollection) =
|
||||
ignore <| services.AddOptions ()
|
||||
ignore <| services.Configure<AppConfig>(this.Configuration.GetSection("MyPrayerJournal"))
|
||||
ignore <| services.AddLocalization (fun options -> options.ResourcesPath <- "Resources")
|
||||
ignore <| services.AddMvc ()
|
||||
ignore <| services.AddDistributedMemoryCache ()
|
||||
ignore <| services.AddSession ()
|
||||
// RethinkDB connection
|
||||
async {
|
||||
let cfg = services.BuildServiceProvider().GetService<IOptions<AppConfig>>().Value
|
||||
let! conn = DataConfig.Connect cfg.DataConfig
|
||||
do! conn.EstablishEnvironment cfg
|
||||
ignore <| services.AddSingleton conn
|
||||
} |> Async.RunSynchronously
|
||||
|
||||
/// 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>()
|
||||
// This method gets called by the runtime. Use this method to configure the HTTP request pipeline.
|
||||
member this.Configure (app : IApplicationBuilder, env : IHostingEnvironment, loggerFactory : ILoggerFactory) =
|
||||
ignore <| loggerFactory.AddConsole(this.Configuration.GetSection "Logging")
|
||||
ignore <| loggerFactory.AddDebug ()
|
||||
|
||||
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)
|
||||
()
|
||||
match env.IsDevelopment () with
|
||||
| true -> ignore <| app.UseDeveloperExceptionPage ()
|
||||
ignore <| app.UseBrowserLink ()
|
||||
| _ -> ignore <| app.UseExceptionHandler("/error")
|
||||
|
||||
override this.Configure (environment) =
|
||||
base.Configure environment
|
||||
environment.Tracing(true, true)
|
||||
ignore <| app.UseStaticFiles ()
|
||||
|
||||
// Add external authentication middleware below. To configure them please see https://go.microsoft.com/fwlink/?LinkID=532715
|
||||
|
||||
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"
|
||||
ignore <| app.UseMvc(fun routes ->
|
||||
ignore <| routes.MapRoute(name = "default", template = "{controller=Home}/{action=Index}/{id?}"))
|
||||
|
||||
/// 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)
|
||||
/// Default to Development environment
|
||||
let defaults = seq { yield WebHostDefaults.EnvironmentKey, "Development" }
|
||||
|> dict
|
||||
|
||||
[<EntryPoint>]
|
||||
let main argv =
|
||||
// let app = OwinApp.ofMidFunc "/" (NancyMiddleware.UseNancy(fun opt -> opt.Bootstrapper <- new AppBootstrapper()))
|
||||
// startWebServer defaultConfig app
|
||||
// 0 // return an integer exit code
|
||||
let main argv =
|
||||
let cfg =
|
||||
ConfigurationBuilder()
|
||||
.AddInMemoryCollection(defaults)
|
||||
.AddEnvironmentVariables("ASPNETCORE_")
|
||||
.AddCommandLine(argv)
|
||||
.Build()
|
||||
|
||||
WebHostBuilder()
|
||||
.UseContentRoot(System.IO.Directory.GetCurrentDirectory())
|
||||
.UseConfiguration(cfg)
|
||||
.UseKestrel()
|
||||
.UseContentRoot(Directory.GetCurrentDirectory())
|
||||
.UseStartup<Startup>()
|
||||
.Build()
|
||||
.Run()
|
||||
|
||||
@ -1,90 +0,0 @@
|
||||
namespace MyPrayerJournal
|
||||
|
||||
open Newtonsoft.Json
|
||||
open RethinkDb.Driver
|
||||
open RethinkDb.Driver.Net
|
||||
open System.Text
|
||||
|
||||
/// Data configuration
|
||||
type DataConfig = {
|
||||
/// The hostname for the RethinkDB server
|
||||
[<JsonProperty("hostname")>]
|
||||
Hostname : string
|
||||
/// The port for the RethinkDB server
|
||||
[<JsonProperty("port")>]
|
||||
Port : int
|
||||
/// The authorization key to use when connecting to the server
|
||||
[<JsonProperty("authKey")>]
|
||||
AuthKey : string
|
||||
/// How long an attempt to connect to the server should wait before giving up
|
||||
[<JsonProperty("timeout")>]
|
||||
Timeout : int
|
||||
/// The name of the default database to use on the connection
|
||||
[<JsonProperty("database")>]
|
||||
Database : string
|
||||
/// A connection to the RethinkDB server using the configuration in this object
|
||||
[<JsonIgnore>]
|
||||
Conn : IConnection
|
||||
}
|
||||
with
|
||||
/// Use RethinkDB defaults for non-provided options, and connect to the server
|
||||
static member Connect config =
|
||||
let ensureHostname cfg = match cfg.Hostname with
|
||||
| null -> { cfg with Hostname = RethinkDBConstants.DefaultHostname }
|
||||
| _ -> cfg
|
||||
let ensurePort cfg = match cfg.Port with
|
||||
| 0 -> { cfg with Port = RethinkDBConstants.DefaultPort }
|
||||
| _ -> cfg
|
||||
let ensureAuthKey cfg = match cfg.AuthKey with
|
||||
| null -> { cfg with AuthKey = RethinkDBConstants.DefaultAuthkey }
|
||||
| _ -> cfg
|
||||
let ensureTimeout cfg = match cfg.Timeout with
|
||||
| 0 -> { cfg with Timeout = RethinkDBConstants.DefaultTimeout }
|
||||
| _ -> cfg
|
||||
let ensureDatabase cfg = match cfg.Database with
|
||||
| null -> { cfg with Database = RethinkDBConstants.DefaultDbName }
|
||||
| _ -> cfg
|
||||
let connect cfg = { cfg with Conn = RethinkDB.R.Connection()
|
||||
.Hostname(cfg.Hostname)
|
||||
.Port(cfg.Port)
|
||||
.AuthKey(cfg.AuthKey)
|
||||
.Db(cfg.Database)
|
||||
.Timeout(cfg.Timeout)
|
||||
.Connect() }
|
||||
config
|
||||
|> ensureHostname
|
||||
|> ensurePort
|
||||
|> ensureAuthKey
|
||||
|> ensureTimeout
|
||||
|> ensureDatabase
|
||||
|> connect
|
||||
|
||||
/// Application configuration
|
||||
type AppConfig = {
|
||||
/// The text from which to derive salt to use for passwords
|
||||
[<JsonProperty("password-salt")>]
|
||||
PasswordSaltString : string
|
||||
/// The text from which to derive salt to use for forms authentication
|
||||
[<JsonProperty("auth-salt")>]
|
||||
AuthSaltString : string
|
||||
/// The encryption passphrase to use for forms authentication
|
||||
[<JsonProperty("encryption-passphrase")>]
|
||||
AuthEncryptionPassphrase : string
|
||||
/// The HMAC passphrase to use for forms authentication
|
||||
[<JsonProperty("hmac-passphrase")>]
|
||||
AuthHmacPassphrase : string
|
||||
/// The data configuration
|
||||
[<JsonProperty("data")>]
|
||||
DataConfig : DataConfig
|
||||
}
|
||||
with
|
||||
/// The salt to use for passwords
|
||||
member this.PasswordSalt = Encoding.UTF8.GetBytes this.PasswordSaltString
|
||||
/// The salt to use for forms authentication
|
||||
member this.AuthSalt = Encoding.UTF8.GetBytes this.AuthSaltString
|
||||
|
||||
/// Deserialize the configuration from the JSON file
|
||||
static member FromJson json =
|
||||
let cfg = JsonConvert.DeserializeObject<AppConfig> json
|
||||
{ cfg with DataConfig = DataConfig.Connect cfg.DataConfig }
|
||||
|
||||
45
src/MyPrayerJournal/Configuration/Configuration.fs
Normal file
45
src/MyPrayerJournal/Configuration/Configuration.fs
Normal file
@ -0,0 +1,45 @@
|
||||
namespace MyPrayerJournal
|
||||
|
||||
open RethinkDb.Driver
|
||||
open RethinkDb.Driver.Net
|
||||
open System
|
||||
open System.Text
|
||||
|
||||
/// Data configuration
|
||||
type DataConfig() =
|
||||
/// The hostname for the RethinkDB server
|
||||
member val Hostname = "" with get, set
|
||||
/// The port for the RethinkDB server
|
||||
member val Port = 0 with get, set
|
||||
/// The authorization key to use when connecting to the server
|
||||
member val AuthKey = "" with get, set
|
||||
/// How long an attempt to connect to the server should wait before giving up
|
||||
member val Timeout = 0 with get, set
|
||||
/// The name of the default database to use on the connection
|
||||
member val Database = "" with get, set
|
||||
|
||||
/// Use RethinkDB defaults for non-provided options, and connect to the server
|
||||
static member Connect (cfg : DataConfig) =
|
||||
async {
|
||||
let builder =
|
||||
seq<Connection.Builder -> Connection.Builder> {
|
||||
yield fun b -> if String.IsNullOrEmpty cfg.Hostname then b else b.Hostname cfg.Hostname
|
||||
yield fun b -> if String.IsNullOrEmpty cfg.AuthKey then b else b.AuthKey cfg.AuthKey
|
||||
yield fun b -> if String.IsNullOrEmpty cfg.Database then b else b.Db cfg.Database
|
||||
yield fun b -> if 0 = cfg.Port then b else b.Port cfg.Port
|
||||
yield fun b -> if 0 = cfg.Timeout then b else b.Timeout cfg.Timeout
|
||||
}
|
||||
|> Seq.fold (fun curr block -> block curr) (RethinkDB.R.Connection())
|
||||
let! conn = builder.ConnectAsync()
|
||||
return conn :> IConnection
|
||||
}
|
||||
|
||||
/// Application configuration
|
||||
type AppConfig() =
|
||||
/// The text from which to derive salt to use for passwords
|
||||
member val PasswordSalt = "" with get, set
|
||||
/// The data configuration
|
||||
member val DataConfig = DataConfig() with get, set
|
||||
/// The salt to use for passwords
|
||||
member this.PasswordSaltBytes = Encoding.UTF8.GetBytes this.PasswordSalt
|
||||
|
||||
12
src/MyPrayerJournal/Configuration/Keys.fs
Normal file
12
src/MyPrayerJournal/Configuration/Keys.fs
Normal file
@ -0,0 +1,12 @@
|
||||
/// Magic strings? Look behind the curtain...
|
||||
[<RequireQualifiedAccess>]
|
||||
module MyPrayerJournal.Keys
|
||||
|
||||
/// The current user
|
||||
let CurrentUser = "mpj-user"
|
||||
|
||||
/// The page generator
|
||||
let Generator = "mpj-generator"
|
||||
|
||||
/// The request start ticks
|
||||
let RequestTimer = "mpj-request-timer"
|
||||
30
src/MyPrayerJournal/Controllers/ApplicationController.fs
Normal file
30
src/MyPrayerJournal/Controllers/ApplicationController.fs
Normal file
@ -0,0 +1,30 @@
|
||||
namespace MyPrayerJournal.Controllers
|
||||
|
||||
open Microsoft.AspNetCore.Mvc
|
||||
open Microsoft.AspNetCore.Mvc.Filters
|
||||
open Microsoft.Extensions.Localization
|
||||
open MyPrayerJournal
|
||||
open RethinkDb.Driver.Net
|
||||
open System
|
||||
open System.Reflection
|
||||
|
||||
/// Base controller for all myPrayerJournal controllers
|
||||
type ApplicationController(data : IConnection) =
|
||||
inherit Controller()
|
||||
|
||||
let version =
|
||||
let v = typeof<ApplicationController>.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"
|
||||
|
||||
/// Fill common items for every request
|
||||
override this.OnActionExecuting (context : ActionExecutingContext) =
|
||||
let sw = System.Diagnostics.Stopwatch()
|
||||
sw.Start()
|
||||
base.OnActionExecuting context
|
||||
this.ViewData.[Keys.CurrentUser] <- Option<User>.None
|
||||
this.ViewData.[Keys.Generator] <- sprintf "myPrayerJournal %s" version
|
||||
this.ViewData.[Keys.RequestTimer] <- sw
|
||||
|
||||
12
src/MyPrayerJournal/Controllers/HomeController.fs
Normal file
12
src/MyPrayerJournal/Controllers/HomeController.fs
Normal file
@ -0,0 +1,12 @@
|
||||
namespace MyPrayerJournal.Controllers
|
||||
|
||||
open Microsoft.AspNetCore.Mvc
|
||||
open RethinkDb.Driver.Net
|
||||
|
||||
/// Home controller
|
||||
[<Route("")>]
|
||||
type HomeController(data : IConnection) =
|
||||
inherit ApplicationController(data)
|
||||
|
||||
[<HttpGet("")>]
|
||||
member this.Index() = this.View()
|
||||
40
src/MyPrayerJournal/Controllers/UserController.fs
Normal file
40
src/MyPrayerJournal/Controllers/UserController.fs
Normal file
@ -0,0 +1,40 @@
|
||||
namespace MyPrayerJournal.Controllers
|
||||
|
||||
open Microsoft.AspNetCore.Mvc
|
||||
open Microsoft.Extensions.Options
|
||||
open MyPrayerJournal
|
||||
open MyPrayerJournal.ViewModels
|
||||
open RethinkDb.Driver.Net
|
||||
|
||||
/// Controller for all /user URLs
|
||||
[<Route("user")>]
|
||||
type UserController(data : IConnection, cfg : IOptions<AppConfig>) =
|
||||
inherit ApplicationController(data)
|
||||
|
||||
[<HttpGet("log-on")>]
|
||||
member this.ShowLogOn () =
|
||||
this.View(LogOnViewModel())
|
||||
|
||||
|
||||
[<HttpPost("log-on")>]
|
||||
[<ValidateAntiForgeryToken>]
|
||||
member this.DoLogOn (form : LogOnViewModel) =
|
||||
async {
|
||||
let! user = data.LogOnUser form.Email (User.HashPassword form.Password cfg.Value.PasswordSaltBytes)
|
||||
match user with
|
||||
| Some usr -> (* this.Session.[Keys.User] <- usr
|
||||
{ UserMessage.Empty with Level = Level.Info
|
||||
Message = Strings.get "LogOnSuccess" }
|
||||
|> model.AddMessage
|
||||
this.Redirect "" model |> ignore // Save the messages in the session before the Nancy redirect
|
||||
// TODO: investigate if addMessage should update the session when it's called
|
||||
return this.LoginAndRedirect (System.Guid.Parse usr.Id, fallbackRedirectUrl = "/") :> obj
|
||||
*)
|
||||
return this.Redirect "/" :> IActionResult
|
||||
| _ -> (*{ UserMessage.Empty with Level = Level.Error
|
||||
Message = Strings.get "LogOnFailure" }
|
||||
|> model.AddMessage
|
||||
return this.Redirect "/user/log-on" model *)
|
||||
return upcast this.RedirectToAction("ShowLogOn")
|
||||
//return this.View()
|
||||
} |> Async.StartAsTask
|
||||
@ -1,7 +1,6 @@
|
||||
[<AutoOpen>]
|
||||
module Data
|
||||
module MyPrayerJournal.Data
|
||||
|
||||
open MyPrayerJournal
|
||||
open Newtonsoft.Json
|
||||
open RethinkDb.Driver
|
||||
open RethinkDb.Driver.Ast
|
||||
@ -28,59 +27,74 @@ type IConnection with
|
||||
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
|
||||
.RunResultAsync<User list>(this)
|
||||
return user |> List.tryHead
|
||||
}
|
||||
|
||||
/// Set up the environment for MyPrayerJournal
|
||||
member this.EstablishEnvironment () =
|
||||
member this.EstablishEnvironment (cfg : AppConfig) =
|
||||
/// Shorthand for the database
|
||||
let db () = r.Db("MyPrayerJournal")
|
||||
/// Log a step in the database environment set up
|
||||
let logStep step = sprintf "[MyPrayerJournal] %s" step |> Console.WriteLine
|
||||
// Be chatty about what we're doing
|
||||
let mkStep step = sprintf "[MyPrayerJournal] %s" step
|
||||
let logStep step = mkStep step |> Console.WriteLine
|
||||
let logStepStart step = mkStep step |> Console.Write
|
||||
let logStepEnd () = Console.WriteLine " done"
|
||||
/// Ensure the database exists
|
||||
let checkDatabase () =
|
||||
async {
|
||||
logStep "|> Checking database"
|
||||
let! dbList = r.DbList().RunResultAsync<string list>(this) |> Async.AwaitTask
|
||||
let! dbList = r.DbList().RunResultAsync<string list>(this)
|
||||
match dbList |> List.contains "MyPrayerJournal" with
|
||||
| true -> ()
|
||||
| _ -> logStep " Database not found - creating..."
|
||||
do! r.DbCreate("MyPrayerJournal").RunResultAsync(this) |> Async.AwaitTask |> Async.Ignore
|
||||
logStep " ...done"
|
||||
| _ -> logStepStart " Database not found - creating..."
|
||||
do! r.DbCreate("MyPrayerJournal").RunResultAsync(this)
|
||||
logStepEnd ()
|
||||
}
|
||||
/// Ensure all tables exit
|
||||
let checkTables () =
|
||||
async {
|
||||
logStep "|> Checking tables"
|
||||
let! tables = db().TableList().RunResultAsync<string list>(this) |> Async.AwaitTask
|
||||
let! tables = db().TableList().RunResultAsync<string list>(this)
|
||||
[ DataTable.Request; DataTable.User ]
|
||||
|> List.filter (fun tbl -> not (tables |> List.contains tbl))
|
||||
|> List.map (fun tbl ->
|
||||
async {
|
||||
logStep <| sprintf " %s table not found - creating..." tbl
|
||||
do! db().TableCreate(tbl).RunResultAsync(this) |> Async.AwaitTask |> Async.Ignore
|
||||
logStep " ...done"
|
||||
logStepStart <| sprintf " %s table not found - creating..." tbl
|
||||
do! db().TableCreate(tbl).RunResultAsync(this)
|
||||
logStepEnd()
|
||||
})
|
||||
|> List.iter Async.RunSynchronously
|
||||
// Seed the user table if it is empty
|
||||
let! userCount = db().Table(DataTable.User).Count().RunResultAsync<int64>(this)
|
||||
match int64 0 = userCount with
|
||||
| true -> logStepStart " No users found - seeding..."
|
||||
do! db().Table(DataTable.User).Insert(
|
||||
{ User.Empty with
|
||||
Id = Guid.NewGuid().ToString ()
|
||||
Email = "test@example.com"
|
||||
PasswordHash = User.HashPassword "password" cfg.PasswordSaltBytes
|
||||
Name = "Default User"
|
||||
TimeZone = "America/Chicago" }).RunResultAsync(this)
|
||||
logStepEnd ()
|
||||
| _ -> ()
|
||||
}
|
||||
/// Ensure the proper indexes exist
|
||||
let checkIndexes () =
|
||||
async {
|
||||
logStep "|> Checking indexes"
|
||||
let! reqIdx = db().Table(DataTable.Request).IndexList().RunResultAsync<string list>(this) |> Async.AwaitTask
|
||||
let! reqIdx = db().Table(DataTable.Request).IndexList().RunResultAsync<string list>(this)
|
||||
match reqIdx |> List.contains "UserId" with
|
||||
| true -> ()
|
||||
| _ -> logStep <| sprintf " %s.UserId index not found - creating..." DataTable.Request
|
||||
do! db().Table(DataTable.Request).IndexCreate("UserId").RunResultAsync(this) |> Async.AwaitTask |> Async.Ignore
|
||||
logStep " ...done"
|
||||
let! usrIdx = db().Table(DataTable.User).IndexList().RunResultAsync<string list>(this) |> Async.AwaitTask
|
||||
| _ -> logStepStart <| sprintf " %s.UserId index not found - creating..." DataTable.Request
|
||||
do! db().Table(DataTable.Request).IndexCreate("UserId").RunResultAsync(this)
|
||||
logStepEnd ()
|
||||
let! usrIdx = db().Table(DataTable.User).IndexList().RunResultAsync<string list>(this)
|
||||
match usrIdx |> List.contains "Email" with
|
||||
| true -> ()
|
||||
| _ -> logStep <| sprintf " %s.Email index not found - creating..." DataTable.User
|
||||
do! db().Table(DataTable.User).IndexCreate("Email").RunResultAsync(this) |> Async.AwaitTask |> Async.Ignore
|
||||
logStep " ...done"
|
||||
| _ -> logStepStart <| sprintf " %s.Email index not found - creating..." DataTable.User
|
||||
do! db().Table(DataTable.User).IndexCreate("Email").RunResultAsync(this)
|
||||
logStepEnd ()
|
||||
}
|
||||
async {
|
||||
logStep "Database checks starting"
|
||||
@ -1,6 +1,7 @@
|
||||
namespace MyPrayerJournal
|
||||
|
||||
open Newtonsoft.Json
|
||||
open System.Security.Cryptography
|
||||
|
||||
/// A user
|
||||
type User = {
|
||||
@ -27,8 +28,13 @@ type User = {
|
||||
Name = ""
|
||||
TimeZone = ""
|
||||
LastSeenOn = int64 0 }
|
||||
/// Hash a user's password
|
||||
static member HashPassword (pw : string) (salt : byte[]) =
|
||||
use hash = new Rfc2898DeriveBytes(pw, salt, 4096)
|
||||
hash.GetBytes 512
|
||||
|> Seq.fold (fun acc byt -> sprintf "%s%s" acc (byt.ToString "x2")) ""
|
||||
|
||||
|
||||
|
||||
/// Request history entry
|
||||
type History = {
|
||||
/// The instant at which the update was made
|
||||
19
src/MyPrayerJournal/Helpers/Extensions.fs
Normal file
19
src/MyPrayerJournal/Helpers/Extensions.fs
Normal file
@ -0,0 +1,19 @@
|
||||
[<AutoOpen>]
|
||||
module MyPrayerJournal.Extensions
|
||||
|
||||
open Microsoft.FSharp.Control
|
||||
open System.Threading.Tasks
|
||||
|
||||
// H/T: Suave
|
||||
type AsyncBuilder with
|
||||
/// An extension method that overloads the standard 'Bind' of the 'async' builder. The new overload awaits on
|
||||
/// a standard .NET task
|
||||
member x.Bind(t : Task<'T>, f:'T -> Async<'R>) : Async<'R> = async.Bind(Async.AwaitTask t, f)
|
||||
|
||||
/// An extension method that overloads the standard 'Bind' of the 'async' builder. The new overload awaits on
|
||||
/// a standard .NET task which does not commpute a value
|
||||
member x.Bind(t : Task, f : unit -> Async<'R>) : Async<'R> = async.Bind(Async.AwaitTask t, f)
|
||||
|
||||
/// Object to which common IStringLocalizer calls cal be made
|
||||
type I18N() =
|
||||
member this.X = ()
|
||||
@ -1,15 +0,0 @@
|
||||
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]
|
||||
|
||||
@ -1,14 +0,0 @@
|
||||
[<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"
|
||||
50
src/MyPrayerJournal/Models/ViewModels/AppViewModel.fs
Normal file
50
src/MyPrayerJournal/Models/ViewModels/AppViewModel.fs
Normal file
@ -0,0 +1,50 @@
|
||||
namespace MyPrayerJournal.ViewModels
|
||||
|
||||
//open MyPrayerJournal
|
||||
|
||||
/// Parent view model for all myPrayerJournal view models
|
||||
[<AllowNullLiteral>]
|
||||
type AppViewModel() =
|
||||
member this.Q = "X"
|
||||
(*
|
||||
/// User messages
|
||||
member val Messages = getMessages () with get, set
|
||||
/// The currently logged in user
|
||||
member val User = Option<User>.None with get, set
|
||||
/// 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 application name appended
|
||||
member this.DisplayPageTitle =
|
||||
match this.PageTitle with
|
||||
| "" -> Strings.get "myPrayerJournal"
|
||||
| pt -> sprintf "%s | %s" pt (Strings.get "myPrayerJournal")
|
||||
|
||||
/// An image with the version and load time in the tool tip
|
||||
member this.FooterLogo =
|
||||
seq {
|
||||
yield "<span title=\""
|
||||
yield sprintf "%s %s • " (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 "\"><span style=\"font-weight:100;\">my</span><span style=\"font-weight:600;\">Prayer</span><span style=\"font-weight:700;\">Journal</span></span>"
|
||||
}
|
||||
|> Seq.reduce (+)
|
||||
*)
|
||||
17
src/MyPrayerJournal/Models/ViewModels/User/LogOnViewModel.fs
Normal file
17
src/MyPrayerJournal/Models/ViewModels/User/LogOnViewModel.fs
Normal file
@ -0,0 +1,17 @@
|
||||
namespace MyPrayerJournal.ViewModels
|
||||
|
||||
open System.ComponentModel.DataAnnotations
|
||||
|
||||
[<AllowNullLiteral>]
|
||||
type LogOnViewModel() =
|
||||
inherit AppViewModel()
|
||||
|
||||
[<Required>]
|
||||
[<DataType(DataType.EmailAddress)>]
|
||||
[<Display(Name = "E-mail Address")>]
|
||||
member val Email = "" with get, set
|
||||
|
||||
[<Required>]
|
||||
[<DataType(DataType.Password)>]
|
||||
[<Display(Name = "Password")>]
|
||||
member val Password = "" with get, set
|
||||
@ -1,40 +0,0 @@
|
||||
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
|
||||
@ -1,18 +0,0 @@
|
||||
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"
|
||||
@ -1,140 +0,0 @@
|
||||
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 "\">×</button><strong>"
|
||||
match snd classAndLabel.[this.Level] with
|
||||
| "" -> ()
|
||||
| lbl -> yield lbl.ToUpper ()
|
||||
yield " » "
|
||||
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 • " (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 (+)
|
||||
14
src/MyPrayerJournal/Views/Home/Index.cshtml
Normal file
14
src/MyPrayerJournal/Views/Home/Index.cshtml
Normal file
@ -0,0 +1,14 @@
|
||||
@{
|
||||
ViewData["Title"] = "";
|
||||
}
|
||||
<div class="row">
|
||||
<div class="col-xs-12">
|
||||
<p> </p>
|
||||
<p>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>
|
||||
<p>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-November 2016 to check on the
|
||||
development progress.</p>
|
||||
</div>
|
||||
</div>
|
||||
14
src/MyPrayerJournal/Views/Shared/Error.cshtml
Normal file
14
src/MyPrayerJournal/Views/Shared/Error.cshtml
Normal file
@ -0,0 +1,14 @@
|
||||
@{
|
||||
ViewData["Title"] = "Error";
|
||||
}
|
||||
|
||||
<h1 class="text-danger">Error.</h1>
|
||||
<h2 class="text-danger">An error occurred while processing your request.</h2>
|
||||
|
||||
<h3>Development Mode</h3>
|
||||
<p>
|
||||
Swapping to <strong>Development</strong> environment will display more detailed information about the error that occurred.
|
||||
</p>
|
||||
<p>
|
||||
<strong>Development environment should not be enabled in deployed applications</strong>, as it can result in sensitive information from exceptions being displayed to end users. For local debugging, development environment can be enabled by setting the <strong>ASPNETCORE_ENVIRONMENT</strong> environment variable to <strong>Development</strong>, and restarting the application.
|
||||
</p>
|
||||
80
src/MyPrayerJournal/Views/Shared/_Layout.cshtml
Normal file
80
src/MyPrayerJournal/Views/Shared/_Layout.cshtml
Normal file
@ -0,0 +1,80 @@
|
||||
@{
|
||||
var title = ViewData["Title"] as string;
|
||||
var pageTitle = string.IsNullOrEmpty(title) ? "myPrayerJournal" : String.Format("{0} - myPrayerJournal", title);
|
||||
var sw = ViewData[Keys.RequestTimer] as System.Diagnostics.Stopwatch;
|
||||
}
|
||||
<!DOCTYPE html>
|
||||
<html>
|
||||
<head>
|
||||
<meta charset="utf-8" />
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1.0" />
|
||||
<meta name="generator" content="@ViewData[Keys.Generator]" />
|
||||
<title>@pageTitle</title>
|
||||
|
||||
<link rel="stylesheet" href="https://fonts.googleapis.com/icon?family=Material+Icons" />
|
||||
<environment names="Development">
|
||||
<link rel="stylesheet" href="~/lib/bootstrap/dist/css/bootstrap.css" />
|
||||
<link rel="stylesheet" href="~/css/site.css" />
|
||||
</environment>
|
||||
<environment names="Staging,Production">
|
||||
<link rel="stylesheet" href="https://ajax.aspnetcdn.com/ajax/bootstrap/3.3.6/css/bootstrap.min.css"
|
||||
asp-fallback-href="~/lib/bootstrap/dist/css/bootstrap.min.css"
|
||||
asp-fallback-test-class="sr-only" asp-fallback-test-property="position" asp-fallback-test-value="absolute" />
|
||||
<link rel="stylesheet" href="~/css/site.min.css" asp-append-version="true" />
|
||||
</environment>
|
||||
</head>
|
||||
<body>
|
||||
<div class="navbar navbar-inverse navbar-fixed-top">
|
||||
<div class="container">
|
||||
<div class="navbar-header">
|
||||
<button type="button" class="navbar-toggle" data-toggle="collapse" data-target=".navbar-collapse">
|
||||
<span class="sr-only">Toggle navigation</span>
|
||||
<span class="icon-bar"></span>
|
||||
<span class="icon-bar"></span>
|
||||
<span class="icon-bar"></span>
|
||||
</button>
|
||||
<a asp-controller="Home" asp-action="Index" class="navbar-brand"><span style="font-weight:100;">my</span><span style="font-weight:600;">Prayer</span><span style="font-weight:700;">Journal</span></a>
|
||||
</div>
|
||||
<div class="navbar-collapse collapse">
|
||||
<ul class="nav navbar-nav navbar-right">
|
||||
@if (OptionModule.IsSome(ViewData[Keys.CurrentUser] as FSharpOption<User>)) {
|
||||
<li><a asp-controller="User" asp-action="ShowChangePassword">Change Your Password</a></li>
|
||||
<li><a asp-controller="User" asp-action="LogOff">Log Off</a></li>
|
||||
}
|
||||
else {
|
||||
<li><a asp-controller="User" asp-action="ShowLogOn">Log On</a></li>
|
||||
}
|
||||
</ul>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="container body-content">
|
||||