-elm +suave -rethink +ef-core -.json +fsproj +auth0
- Decided to go with straight Suave "Experimental" views (for now) - Created EF Core entity model (our data is pretty structured, and PostgreSQL (target DB) supports max-length strings) - Added Auth0 lock - Converted to 1.0 tooling
This commit is contained in:
Daniel J. Summers
parent
da6910e055
commit
d34302aa52
99
src/App.fs
99
src/App.fs
@ -1,36 +1,107 @@
|
||||
/// Main server module for myPrayerJournal
|
||||
module MyPrayerJournal.App
|
||||
|
||||
open Auth0.AuthenticationApi
|
||||
open Auth0.AuthenticationApi.Models
|
||||
open Newtonsoft.Json
|
||||
open Newtonsoft.Json.Linq
|
||||
open Reader
|
||||
open System
|
||||
open System.IO
|
||||
open Suave
|
||||
open Suave.Filters
|
||||
open Suave.Operators
|
||||
open Suave.RequestErrors
|
||||
open Suave.State.CookieStateStore
|
||||
open Suave.Successful
|
||||
|
||||
type Auth0Config = {
|
||||
Domain : string
|
||||
ClientId : string
|
||||
ClientSecret : string
|
||||
}
|
||||
with
|
||||
static member empty =
|
||||
{ Domain = ""
|
||||
ClientId = ""
|
||||
ClientSecret = ""
|
||||
}
|
||||
|
||||
let auth0 =
|
||||
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>()
|
||||
}
|
||||
with _ -> Auth0Config.empty
|
||||
|
||||
/// Data Configuration singleton
|
||||
let lazyCfg = lazy (DataConfig.FromJson <| try File.ReadAllText "data-config.json" with _ -> "{}")
|
||||
//let lazyCfg = lazy (DataConfig.FromJson <| try File.ReadAllText "data-config.json" with _ -> "{}")
|
||||
/// RethinkDB connection singleton
|
||||
let lazyConn = lazy lazyCfg.Force().CreateConnection ()
|
||||
//let lazyConn = lazy lazyCfg.Force().CreateConnection ()
|
||||
/// Application dependencies
|
||||
let deps = {
|
||||
new IDependencies with
|
||||
member __.Conn with get () = lazyConn.Force ()
|
||||
}
|
||||
//let deps = {
|
||||
// new IDependencies with
|
||||
// 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
|
||||
)
|
||||
|
||||
let viewHome =
|
||||
Suave.Writers.setUserData "test" "howdy"
|
||||
>=> fun x -> OK (Views.page Views.home (string x.userState.["test"])) x
|
||||
|
||||
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
|
||||
)
|
||||
|
||||
let session = statefulForSession
|
||||
|
||||
/// Suave application
|
||||
let app : WebPart =
|
||||
choose [
|
||||
GET >=> Files.browseHome
|
||||
GET >=> Files.browseFileHome "index.html"
|
||||
RequestErrors.NOT_FOUND "Page not found."
|
||||
]
|
||||
let app =
|
||||
session
|
||||
>=> choose [
|
||||
path Route.home >=> viewHome
|
||||
path Route.User.logOn >=> handleSignIn
|
||||
Files.browseHome
|
||||
NOT_FOUND "Page not found."
|
||||
]
|
||||
|
||||
let suaveCfg = { defaultConfig with homeFolder = Some (Path.GetFullPath "./wwwroot/") }
|
||||
|
||||
[<EntryPoint>]
|
||||
let main argv =
|
||||
// Establish the data environment
|
||||
liftDep getConn (Data.establishEnvironment >> Async.RunSynchronously)
|
||||
|> run deps
|
||||
//liftDep getConn (Data.establishEnvironment >> Async.RunSynchronously)
|
||||
//|> run deps
|
||||
|
||||
startWebServer suaveCfg app
|
||||
0
|
||||
|
||||
154
src/Data.fs
154
src/Data.fs
@ -1,130 +1,42 @@
|
||||
namespace MyPrayerJournal
|
||||
|
||||
open Chiron
|
||||
open RethinkDb.Driver
|
||||
open RethinkDb.Driver.Net
|
||||
open System
|
||||
open Microsoft.EntityFrameworkCore
|
||||
open System.Runtime.CompilerServices
|
||||
|
||||
type ConfigParameter =
|
||||
| Hostname of string
|
||||
| Port of int
|
||||
| AuthKey of string
|
||||
| Timeout of int
|
||||
| Database of string
|
||||
/// Data context for myPrayerJournal
|
||||
type DataContext =
|
||||
inherit DbContext
|
||||
|
||||
type DataConfig = { Parameters : ConfigParameter list }
|
||||
with
|
||||
member this.CreateConnection () : IConnection =
|
||||
let folder (builder : Connection.Builder) block =
|
||||
match block with
|
||||
| Hostname x -> builder.Hostname x
|
||||
| Port x -> builder.Port x
|
||||
| AuthKey x -> builder.AuthKey x
|
||||
| Timeout x -> builder.Timeout x
|
||||
| Database x -> builder.Db x
|
||||
let bldr =
|
||||
this.Parameters
|
||||
|> Seq.fold folder (RethinkDB.R.Connection ())
|
||||
upcast bldr.Connect()
|
||||
member this.Database =
|
||||
match this.Parameters
|
||||
|> List.filter (fun x -> match x with Database _ -> true | _ -> false)
|
||||
|> List.tryHead with
|
||||
| Some (Database x) -> x
|
||||
| _ -> RethinkDBConstants.DefaultDbName
|
||||
static member FromJson json =
|
||||
match Json.parse json with
|
||||
| Object config ->
|
||||
let options =
|
||||
config
|
||||
|> Map.toList
|
||||
|> List.map (fun item ->
|
||||
match item with
|
||||
| "Hostname", String x -> Hostname x
|
||||
| "Port", Number x -> Port <| int x
|
||||
| "AuthKey", String x -> AuthKey x
|
||||
| "Timeout", Number x -> Timeout <| int x
|
||||
| "Database", String x -> Database x
|
||||
| key, value ->
|
||||
invalidOp <| sprintf "Unrecognized RethinkDB configuration parameter %s (value %A)" key value)
|
||||
{ Parameters = options }
|
||||
| _ -> { Parameters = [] }
|
||||
(*--- CONSTRUCTORS ---*)
|
||||
|
||||
new () = { inherit DbContext () }
|
||||
new (options : DbContextOptions<DataContext>) = { inherit DbContext (options) }
|
||||
|
||||
/// Tables for data storage
|
||||
module DataTable =
|
||||
/// The table for prayer requests
|
||||
[<Literal>]
|
||||
let Request = "Request"
|
||||
/// The table for users
|
||||
[<Literal>]
|
||||
let User = "User"
|
||||
(*--- DbSet FIELDS ---*)
|
||||
|
||||
/// Extensions for the RethinkDB connection
|
||||
[<RequireQualifiedAccess>]
|
||||
module Data =
|
||||
[<DefaultValue>]
|
||||
val mutable private requests : DbSet<Request>
|
||||
[<DefaultValue>]
|
||||
val mutable private history : DbSet<History>
|
||||
|
||||
let private r = RethinkDB.R
|
||||
(*--- DbSet PROPERTIES ---*)
|
||||
|
||||
/// Set up the environment for MyPrayerJournal
|
||||
let establishEnvironment (conn : IConnection) =
|
||||
/// Shorthand for the database
|
||||
let db () = r.Db "myPrayerJournal"
|
||||
// Be chatty about what we're doing
|
||||
let mkStep = sprintf "[MyPrayerJournal] %s"
|
||||
let logStep = mkStep >> Console.WriteLine
|
||||
let logStepStart = mkStep >> Console.Write
|
||||
let logStepEnd () = Console.WriteLine " done"
|
||||
/// Ensure the database exists
|
||||
let checkDatabase () =
|
||||
async {
|
||||
logStep "|> Checking database"
|
||||
let! dbList = r.DbList().RunResultAsync<string list> conn
|
||||
match dbList |> List.contains "myPrayerJournal" with
|
||||
| true -> ()
|
||||
| _ ->
|
||||
logStepStart " Database not found - creating..."
|
||||
do! r.DbCreate("myPrayerJournal").RunResultAsync conn
|
||||
logStepEnd ()
|
||||
}
|
||||
/// Ensure all tables exit
|
||||
let checkTables () =
|
||||
async {
|
||||
logStep "|> Checking tables"
|
||||
let! tables = db().TableList().RunResultAsync<string list> conn
|
||||
[ DataTable.Request; DataTable.User ]
|
||||
|> List.filter (fun tbl -> not (tables |> List.contains tbl))
|
||||
|> List.map (fun tbl ->
|
||||
async {
|
||||
logStepStart <| sprintf " %s table not found - creating..." tbl
|
||||
do! db().TableCreate(tbl).RunResultAsync conn
|
||||
logStepEnd()
|
||||
})
|
||||
|> List.iter Async.RunSynchronously
|
||||
}
|
||||
/// Ensure the proper indexes exist
|
||||
let checkIndexes () =
|
||||
async {
|
||||
logStep "|> Checking indexes"
|
||||
let! reqIdx = db().Table(DataTable.Request).IndexList().RunResultAsync<string list> conn
|
||||
match reqIdx |> List.contains "UserId" with
|
||||
| true -> ()
|
||||
| _ ->
|
||||
logStepStart <| sprintf " %s.UserId index not found - creating..." DataTable.Request
|
||||
do! db().Table(DataTable.Request).IndexCreate("UserId").RunResultAsync conn
|
||||
logStepEnd ()
|
||||
let! usrIdx = db().Table(DataTable.User).IndexList().RunResultAsync<string list> conn
|
||||
match usrIdx |> List.contains "Email" with
|
||||
| true -> ()
|
||||
| _ ->
|
||||
logStepStart <| sprintf " %s.Email index not found - creating..." DataTable.User
|
||||
do! db().Table(DataTable.User).IndexCreate("Email").RunResultAsync conn
|
||||
logStepEnd ()
|
||||
}
|
||||
async {
|
||||
logStep "Database checks starting"
|
||||
do! checkDatabase ()
|
||||
do! checkTables ()
|
||||
do! checkIndexes ()
|
||||
logStep "Database checks complete"
|
||||
}
|
||||
/// Prayer Requests
|
||||
member this.Requests with get () = this.requests and set v = this.requests <- v
|
||||
|
||||
/// 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
|
||||
|
||||
modelBuilder.HasDefaultSchema "mpj"
|
||||
|> Request.ConfigureEF
|
||||
|> History.ConfigureEF
|
||||
|> ignore
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
namespace MyPrayerJournal
|
||||
|
||||
open RethinkDb.Driver.Net
|
||||
//open RethinkDb.Driver.Net
|
||||
|
||||
// -- begin code lifted from #er demo --
|
||||
type ReaderM<'d, 'out> = 'd -> 'out
|
||||
@ -39,10 +39,10 @@ module Reader =
|
||||
let reader = ReaderMBuilder()
|
||||
// -- end code lifted from #er demo --
|
||||
|
||||
type IDependencies =
|
||||
(*type IDependencies =
|
||||
abstract Conn : IConnection
|
||||
|
||||
[<AutoOpen>]
|
||||
module DependencyExtraction =
|
||||
|
||||
let getConn (deps : IDependencies) = deps.Conn
|
||||
let getConn (deps : IDependencies) = deps.Conn*)
|
||||
|
||||
@ -1,9 +1,65 @@
|
||||
namespace MyPrayerJournal
|
||||
|
||||
open Microsoft.EntityFrameworkCore;
|
||||
open Newtonsoft.Json
|
||||
open System
|
||||
open System.Collections.Generic
|
||||
|
||||
/// A prayer request
|
||||
[<AllowNullLiteral>]
|
||||
type Request() =
|
||||
/// The history collection (can be overridden)
|
||||
let mutable historyCollection : ICollection<History> = upcast List<History> ()
|
||||
|
||||
/// 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
|
||||
/// The ticks when the request was entered
|
||||
member val EnteredOn = 0L with get, set
|
||||
|
||||
/// The history for the prayer request
|
||||
abstract History : ICollection<History> with get, set
|
||||
default this.History
|
||||
with get () = historyCollection
|
||||
and set v = historyCollection <- v
|
||||
|
||||
static member ConfigureEF (mb : ModelBuilder) =
|
||||
mb.Entity<Request>().ToTable "Request"
|
||||
|> ignore
|
||||
mb
|
||||
|
||||
|
||||
/// A historial update to a prayer request
|
||||
and [<AllowNullLiteral>] History() =
|
||||
/// The request to which this entry applies (may be overridden)
|
||||
let mutable request = null
|
||||
|
||||
/// The Id of the request to which this update applies
|
||||
member val RequestId = Guid.Empty with get, set
|
||||
/// The ticks when this entry was made
|
||||
member val AsOf = 0L with get, set
|
||||
/// The status of the request as of this history entry
|
||||
member val Status = "" with get, set
|
||||
/// The text of this history entry
|
||||
member val Text = "" with get, set
|
||||
|
||||
/// The request to which this entry belongs
|
||||
abstract Request : Request with get, set
|
||||
default this.Request
|
||||
with get () = request
|
||||
and set v = request <- v
|
||||
|
||||
static member ConfigureEF (mb : ModelBuilder) =
|
||||
mb.Entity<History>().ToTable("History")
|
||||
|> ignore
|
||||
mb.Entity<History>().HasKey(fun e -> (e.RequestId, e.AsOf) :> obj)
|
||||
|> ignore
|
||||
mb
|
||||
|
||||
(*
|
||||
/// A user
|
||||
type User = {
|
||||
type Userr = {
|
||||
/// The Id of the user
|
||||
[<JsonProperty("id")>]
|
||||
Id : string
|
||||
@ -27,7 +83,7 @@ type User = {
|
||||
|
||||
|
||||
/// Request history entry
|
||||
type History = {
|
||||
type Historyy = {
|
||||
/// The instant at which the update was made
|
||||
AsOf : int64
|
||||
/// The action that was taken on the request
|
||||
@ -39,7 +95,7 @@ type History = {
|
||||
}
|
||||
|
||||
/// A prayer request
|
||||
type Request = {
|
||||
type Requestt = {
|
||||
/// The Id of the request
|
||||
[<JsonProperty("id")>]
|
||||
Id : string
|
||||
@ -48,7 +104,7 @@ type Request = {
|
||||
/// The instant this request was entered
|
||||
EnteredOn : int64
|
||||
/// The history for this request
|
||||
History : History list
|
||||
History : Historyy list
|
||||
}
|
||||
with
|
||||
/// The current status of the prayer request
|
||||
@ -72,3 +128,4 @@ type Request = {
|
||||
|> List.sortBy (fun item -> -item.AsOf)
|
||||
|> List.map (fun item -> item.AsOf)
|
||||
|> List.head
|
||||
*)
|
||||
87
src/Migrations/20170104023341_InitialDb.fs
Normal file
87
src/Migrations/20170104023341_InitialDb.fs
Normal file
@ -0,0 +1,87 @@
|
||||
namespace MyPrayerJournal.Migrations
|
||||
|
||||
open System
|
||||
open System.Collections.Generic
|
||||
open Microsoft.EntityFrameworkCore
|
||||
open Microsoft.EntityFrameworkCore.Infrastructure
|
||||
open Microsoft.EntityFrameworkCore.Metadata
|
||||
open Microsoft.EntityFrameworkCore.Migrations
|
||||
open Microsoft.EntityFrameworkCore.Migrations.Operations
|
||||
open Microsoft.EntityFrameworkCore.Migrations.Operations.Builders
|
||||
open MyPrayerJournal
|
||||
|
||||
type RequestTable = {
|
||||
RequestId : OperationBuilder<AddColumnOperation>
|
||||
EnteredOn : OperationBuilder<AddColumnOperation>
|
||||
UserId : OperationBuilder<AddColumnOperation>
|
||||
}
|
||||
|
||||
type HistoryTable = {
|
||||
RequestId : OperationBuilder<AddColumnOperation>
|
||||
AsOf : OperationBuilder<AddColumnOperation>
|
||||
Status : OperationBuilder<AddColumnOperation>
|
||||
Text : OperationBuilder<AddColumnOperation>
|
||||
}
|
||||
|
||||
[<DbContext (typeof<DataContext>)>]
|
||||
[<Migration "20170104023341_InitialDb">]
|
||||
type InitialDb () =
|
||||
inherit Migration ()
|
||||
|
||||
override this.Up migrationBuilder =
|
||||
migrationBuilder.EnsureSchema(
|
||||
name = "mpj")
|
||||
|> ignore
|
||||
|
||||
migrationBuilder.CreateTable(
|
||||
name = "Request",
|
||||
schema = "mpj",
|
||||
columns =
|
||||
(fun table ->
|
||||
{ RequestId = table.Column<Guid>(nullable = false)
|
||||
EnteredOn = table.Column<int64>(nullable = false)
|
||||
UserId = table.Column<Guid>(nullable = false)
|
||||
}
|
||||
),
|
||||
constraints =
|
||||
fun table ->
|
||||
table.PrimaryKey("PK_Request", fun x -> x.RequestId :> obj) |> ignore
|
||||
)
|
||||
|> ignore
|
||||
|
||||
migrationBuilder.CreateTable(
|
||||
name = "History",
|
||||
schema = "mpj",
|
||||
columns =
|
||||
(fun table ->
|
||||
{ RequestId = table.Column<Guid>(nullable = false)
|
||||
AsOf = table.Column<int64>(nullable = false)
|
||||
Status = table.Column<string>(nullable = true)
|
||||
Text = table.Column<string>(nullable = true)
|
||||
}
|
||||
),
|
||||
constraints =
|
||||
fun table ->
|
||||
table.PrimaryKey("PK_History", fun x -> (x.RequestId, x.AsOf) :> obj)
|
||||
|> ignore
|
||||
table.ForeignKey(
|
||||
name = "FK_History_Request_RequestId",
|
||||
column = (fun x -> x.RequestId :> obj),
|
||||
principalSchema = "mpj",
|
||||
principalTable = "Request",
|
||||
principalColumn = "RequestId",
|
||||
onDelete = ReferentialAction.Cascade)
|
||||
|> ignore
|
||||
)
|
||||
|> ignore
|
||||
|
||||
override this.Down migrationBuilder =
|
||||
migrationBuilder.DropTable(
|
||||
name = "History",
|
||||
schema = "mpj")
|
||||
|> ignore
|
||||
|
||||
migrationBuilder.DropTable(
|
||||
name = "Request",
|
||||
schema = "mpj")
|
||||
|> ignore
|
||||
61
src/Migrations/DataContextModelSnapshot.fs
Normal file
61
src/Migrations/DataContextModelSnapshot.fs
Normal file
@ -0,0 +1,61 @@
|
||||
namespace MyPrayerJournal.Migrations
|
||||
|
||||
open System
|
||||
open Microsoft.EntityFrameworkCore
|
||||
open Microsoft.EntityFrameworkCore.Infrastructure
|
||||
open Microsoft.EntityFrameworkCore.Metadata
|
||||
open Microsoft.EntityFrameworkCore.Migrations
|
||||
open MyPrayerJournal
|
||||
|
||||
[<DbContext (typeof<DataContext>)>]
|
||||
type DataContextModelSnapshot () =
|
||||
inherit ModelSnapshot ()
|
||||
override this.BuildModel modelBuilder =
|
||||
modelBuilder
|
||||
.HasDefaultSchema("mpj")
|
||||
.HasAnnotation("Npgsql:ValueGenerationStrategy", NpgsqlValueGenerationStrategy.SerialColumn)
|
||||
.HasAnnotation("ProductVersion", "1.1.0-rtm-22752")
|
||||
|> ignore
|
||||
|
||||
modelBuilder.Entity("MyPrayerJournal.History",
|
||||
fun b ->
|
||||
b.Property<Guid>("RequestId")
|
||||
|> ignore
|
||||
b.Property<int64>("AsOf")
|
||||
|> ignore
|
||||
b.Property<string>("Status")
|
||||
|> ignore
|
||||
b.Property<string>("Text")
|
||||
|> ignore
|
||||
b.HasKey("RequestId", "AsOf")
|
||||
|> ignore
|
||||
b.ToTable("History")
|
||||
|> ignore
|
||||
)
|
||||
|> ignore
|
||||
|
||||
modelBuilder.Entity("MyPrayerJournal.Request",
|
||||
fun b ->
|
||||
b.Property<Guid>("RequestId")
|
||||
.ValueGeneratedOnAdd()
|
||||
|> ignore
|
||||
b.Property<int64>("EnteredOn")
|
||||
|> ignore
|
||||
b.Property<Guid>("UserId")
|
||||
|> ignore
|
||||
b.HasKey("RequestId")
|
||||
|> ignore
|
||||
b.ToTable("Request")
|
||||
|> ignore
|
||||
)
|
||||
|> ignore
|
||||
|
||||
modelBuilder.Entity("MyPrayerJournal.History",
|
||||
fun b ->
|
||||
b.HasOne("MyPrayerJournal.Request", "Request")
|
||||
.WithMany("History")
|
||||
.HasForeignKey("RequestId")
|
||||
.OnDelete(DeleteBehavior.Cascade)
|
||||
|> ignore
|
||||
)
|
||||
|> ignore
|
||||
50
src/MyPrayerJournal.fsproj
Normal file
50
src/MyPrayerJournal.fsproj
Normal file
@ -0,0 +1,50 @@
|
||||
<Project Sdk="FSharp.NET.Sdk;Microsoft.NET.Sdk">
|
||||
|
||||
<PropertyGroup>
|
||||
<VersionPrefix>0.8.1</VersionPrefix>
|
||||
<TargetFramework>netcoreapp1.1</TargetFramework>
|
||||
<DebugType>portable</DebugType>
|
||||
<AssemblyName>myPrayerJournal</AssemblyName>
|
||||
<OutputType>Exe</OutputType>
|
||||
<PackageId>src</PackageId>
|
||||
<PackageTargetFallback>$(PackageTargetFallback);dnxcore50</PackageTargetFallback>
|
||||
<RuntimeFrameworkVersion>1.1.1</RuntimeFrameworkVersion>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<Compile Include="Extensions.fs" />
|
||||
<Compile Include="Entities.fs" />
|
||||
<Compile Include="Dependencies.fs" />
|
||||
<Compile Include="Data.fs" />
|
||||
<Compile Include="Migrations/20170104023341_InitialDb.fs" />
|
||||
<Compile Include="Migrations/DataContextModelSnapshot.fs" />
|
||||
<Compile Include="Route.fs" />
|
||||
<Compile Include="Views.fs" />
|
||||
<Compile Include="App.fs" />
|
||||
<None Update="appsettings.json">
|
||||
<CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
|
||||
</None>
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="FSharp.NET.Sdk" Version="1.0.*" PrivateAssets="All" />
|
||||
<PackageReference Include="FSharp.Core" Version="4.1.*" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="Auth0.AuthenticationApi" Version="3.6.0" />
|
||||
<PackageReference Include="Microsoft.EntityFrameworkCore.Tools" Version="1.0.0">
|
||||
<PrivateAssets>All</PrivateAssets>
|
||||
</PackageReference>
|
||||
<PackageReference Include="Newtonsoft.Json" Version="10.0.2" />
|
||||
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="1.1.0" />
|
||||
<PackageReference Include="Suave" Version="2.0.0" />
|
||||
<PackageReference Include="Suave.Experimental" Version="2.0.0" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<DotNetCliToolReference Include="dotnet-compile-fsc" Version="1.0.0-preview2.1-*" />
|
||||
<DotNetCliToolReference Include="Microsoft.EntityFrameworkCore.Tools.DotNet" Version="1.0.0" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
10
src/Route.fs
Normal file
10
src/Route.fs
Normal file
@ -0,0 +1,10 @@
|
||||
/// URL routes for myPrayerJournal
|
||||
module MyPrayerJournal.Route
|
||||
|
||||
/// The home page
|
||||
let home = "/"
|
||||
|
||||
/// Routes dealing with users
|
||||
module User =
|
||||
/// The route for user log on response from Auth0
|
||||
let logOn = "/user/log-on"
|
||||
103
src/Views.fs
Normal file
103
src/Views.fs
Normal file
@ -0,0 +1,103 @@
|
||||
module MyPrayerJournal.Views
|
||||
|
||||
//open Suave.Html
|
||||
open Suave.Xml
|
||||
|
||||
[<AutoOpen>]
|
||||
module Tags =
|
||||
/// Generate a meta tag
|
||||
let meta attr = tag "meta" attr empty
|
||||
|
||||
/// Generate a link to a stylesheet
|
||||
let stylesheet url = linkAttr [ "rel", "stylesheet"; "href", url ]
|
||||
|
||||
let aAttr attr x = tag "a" attr (flatten x)
|
||||
let a = aAttr []
|
||||
let buttonAttr attr x = tag "button" attr (flatten x)
|
||||
let button = buttonAttr []
|
||||
|
||||
let footerAttr attr x = tag "footer" attr (flatten x)
|
||||
let footer = footerAttr []
|
||||
let ulAttr attr x = tag "ul" attr (flatten x)
|
||||
let ul = ulAttr []
|
||||
|
||||
/// Used to prevent a self-closing tag where we need no text
|
||||
let noText = text ""
|
||||
let navLinkAttr attr url linkText = aAttr (("href", url) :: attr) [ text linkText ]
|
||||
|
||||
let navLink = navLinkAttr []
|
||||
|
||||
let jsLink func linkText = navLinkAttr [ "onclick", func ] "javascript:void(0)" linkText
|
||||
|
||||
/// Create a link to a JavaScript file
|
||||
let js src = scriptAttr [ "src", src ] [ noText ]
|
||||
|
||||
[<AutoOpen>]
|
||||
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"
|
||||
]
|
||||
|> List.map (fun x -> tag "li" [] x)
|
||||
let pageHeader =
|
||||
divAttr [ "class", "navbar navbar-inverse navbar-fixed-top" ] [
|
||||
divAttr [ "class", "container" ] [
|
||||
divAttr [ "class", "navbar-header" ] [
|
||||
buttonAttr [ "class", "navbar-toggle"; "data-toggle", "collapse"; "data-target", ".navbar-collapse" ] [
|
||||
spanAttr [ "class", "sr-only" ] (text "Toggle navigation")
|
||||
spanAttr [ "class", "icon-bar" ] noText
|
||||
spanAttr [ "class", "icon-bar" ] noText
|
||||
spanAttr [ "class", "icon-bar" ] noText
|
||||
]
|
||||
navLinkAttr [ "class", "navbar-brand" ] "/" "myPrayerJournal"
|
||||
]
|
||||
divAttr [ "class", "navbar-collapse collapse" ] [
|
||||
ulAttr [ "class", "nav navbar-nav navbar-right" ] navigation
|
||||
]
|
||||
]
|
||||
]
|
||||
let pageFooter =
|
||||
footerAttr [ "class", "mpj-footer" ] [
|
||||
pAttr [ "class", "text-right" ] [
|
||||
text "myPrayerJournal v0.8.1"
|
||||
]
|
||||
]
|
||||
let row = divAttr [ "class", "row" ]
|
||||
|
||||
let fullRow xml =
|
||||
row [ divAttr [ "class", "col-xs-12" ] xml ]
|
||||
|
||||
/// Display a page
|
||||
let page content somethingElse =
|
||||
html [
|
||||
head [
|
||||
meta [ "charset", "UTF-8" ]
|
||||
meta [ "name", "viewport"; "content", "width=device-width, initial-scale=1" ]
|
||||
title "myPrayerJournal"
|
||||
stylesheet "https://ajax.aspnetcdn.com/ajax/bootstrap/3.3.6/css/bootstrap.min.css"
|
||||
stylesheet "/content/styles.css"
|
||||
stylesheet "https://fonts.googleapis.com/icon?family=Material+Icons"
|
||||
]
|
||||
body [
|
||||
pageHeader
|
||||
divAttr [ "class", "container body-content" ] [
|
||||
content
|
||||
div [ text somethingElse ]
|
||||
pageFooter
|
||||
]
|
||||
js "https://cdn.auth0.com/js/lock/10.14/lock.min.js"
|
||||
js "/js/mpj.js"
|
||||
]
|
||||
]
|
||||
|> render
|
||||
|
||||
let home =
|
||||
fullRow [
|
||||
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." ]
|
||||
]
|
||||
@ -1,17 +0,0 @@
|
||||
{
|
||||
"version": "0.8.1",
|
||||
"summary": "A place to record requests, prayers, and answers",
|
||||
"repository": "https://github.com/user/project.git",
|
||||
"license": "MIT",
|
||||
"source-directories": [
|
||||
"wwwroot"
|
||||
],
|
||||
"exposed-modules": [],
|
||||
"dependencies": {
|
||||
"elm-lang/core": "5.0.0 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0",
|
||||
"elm-lang/navigation": "2.0.1 <= v < 3.0.0",
|
||||
"evancz/url-parser": "2.0.1 <= v < 3.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
@ -1,44 +0,0 @@
|
||||
{
|
||||
"buildOptions": {
|
||||
"compile": {
|
||||
"includeFiles": [
|
||||
"Extensions.fs",
|
||||
"Entities.fs",
|
||||
"Dependencies.fs",
|
||||
"Data.fs",
|
||||
"App.fs"
|
||||
]
|
||||
},
|
||||
"compilerName": "fsc",
|
||||
"debugType": "portable",
|
||||
"emitEntryPoint": true,
|
||||
"outputName": "myPrayerJournal"
|
||||
},
|
||||
"dependencies": {
|
||||
"Chiron": "6.2.1",
|
||||
"Newtonsoft.Json": "9.0.1",
|
||||
"RethinkDb.Driver": "2.3.15",
|
||||
"Suave": "2.0.0-rc2"
|
||||
},
|
||||
"frameworks": {
|
||||
"netcoreapp1.1": {
|
||||
"dependencies": {
|
||||
"Microsoft.FSharp.Core.netcore": "1.0.0-alpha-161111",
|
||||
"Microsoft.NETCore.App": {
|
||||
"type": "platform",
|
||||
"version": "1.1.0"
|
||||
}
|
||||
},
|
||||
"imports": [
|
||||
"portable-net45+win8+dnxcore50",
|
||||
"portable-net45+win8",
|
||||
"net452",
|
||||
"dnxcore50"
|
||||
]
|
||||
}
|
||||
},
|
||||
"tools": {
|
||||
"dotnet-compile-fsc": "1.0.0-preview2.1-*"
|
||||
},
|
||||
"version": "0.8.1-*"
|
||||
}
|
||||
@ -1,23 +0,0 @@
|
||||
module App exposing (..)
|
||||
|
||||
import Messages exposing (..)
|
||||
import Models exposing (Model, initialModel)
|
||||
import Navigation exposing (Location)
|
||||
import Routing exposing (Route(..), parseLocation)
|
||||
import Update exposing (update)
|
||||
import View exposing (view)
|
||||
|
||||
|
||||
init : Location -> (Model, Cmd Msg)
|
||||
init location =
|
||||
(parseLocation location |> initialModel, Cmd.none)
|
||||
|
||||
|
||||
main : Program Never Model Msg
|
||||
main =
|
||||
Navigation.program OnLocationChange
|
||||
{ init = init
|
||||
, view = view
|
||||
, update = update
|
||||
, subscriptions = \_ -> Sub.none
|
||||
}
|
||||
@ -1,19 +0,0 @@
|
||||
module Home.Public exposing (view)
|
||||
|
||||
import Html exposing (Html, p, text)
|
||||
import Messages exposing (Msg(..))
|
||||
import Models exposing (Model)
|
||||
import Utils.View exposing (fullRow)
|
||||
|
||||
|
||||
view : List (Html Msg)
|
||||
view =
|
||||
let
|
||||
paragraphs =
|
||||
[ " "
|
||||
, "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."
|
||||
, "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."
|
||||
]
|
||||
|> List.map (\para -> p [] [ text para ])
|
||||
in
|
||||
[ fullRow paragraphs ]
|
||||
@ -1,10 +0,0 @@
|
||||
module Messages exposing (..)
|
||||
|
||||
import Navigation exposing (Location)
|
||||
import Routing exposing (Route)
|
||||
|
||||
|
||||
type Msg
|
||||
= OnLocationChange Location
|
||||
| NavTo String
|
||||
| UpdateTitle String
|
||||
@ -1,16 +0,0 @@
|
||||
module Models exposing (..)
|
||||
|
||||
import Routing exposing (Route(..))
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ route : Route
|
||||
, title : String
|
||||
}
|
||||
|
||||
|
||||
initialModel : Route -> Model
|
||||
initialModel route =
|
||||
{ route = route
|
||||
, title = "Index"
|
||||
}
|
||||
@ -1,31 +0,0 @@
|
||||
module Routing exposing (..)
|
||||
|
||||
import Navigation exposing (Location)
|
||||
import UrlParser exposing ((</>), Parser, map, oneOf, parsePath, s, top)
|
||||
|
||||
|
||||
type Route
|
||||
= Home
|
||||
| ChangePassword
|
||||
| LogOff
|
||||
| LogOn
|
||||
| NotFound
|
||||
|
||||
|
||||
findRoute : Parser (Route -> a) a
|
||||
findRoute =
|
||||
oneOf
|
||||
[ map Home top
|
||||
, map LogOn (s "user" </> s "log-on")
|
||||
, map LogOff (s "user" </> s "log-off")
|
||||
, map ChangePassword (s "user" </> s "password" </> s "change")
|
||||
]
|
||||
|
||||
|
||||
parseLocation : Location -> Route
|
||||
parseLocation location =
|
||||
case (parsePath findRoute location) of
|
||||
Just route ->
|
||||
route
|
||||
Nothing ->
|
||||
NotFound
|
||||
@ -1,32 +0,0 @@
|
||||
module Update exposing (..)
|
||||
|
||||
import Dict
|
||||
import Models exposing (Model)
|
||||
import Messages exposing (Msg(..))
|
||||
import Navigation exposing (newUrl)
|
||||
import Routing exposing (Route(..), parseLocation)
|
||||
import Utils.View exposing (documentTitle)
|
||||
|
||||
|
||||
update : Msg -> Model -> (Model, Cmd Msg)
|
||||
update msg model =
|
||||
case msg of
|
||||
OnLocationChange location ->
|
||||
let
|
||||
newRoute = parseLocation location
|
||||
title =
|
||||
case newRoute of
|
||||
ChangePassword -> "Change Your Password"
|
||||
Home -> "Welcome"
|
||||
LogOn -> "Log On"
|
||||
LogOff -> "Log Off"
|
||||
NotFound -> "Page Not Found"
|
||||
pageTitle = title ++ " | myPrayerJournal"
|
||||
in
|
||||
({ model | route = newRoute, title = pageTitle }, documentTitle model.title)
|
||||
|
||||
NavTo url ->
|
||||
(model, newUrl url)
|
||||
|
||||
UpdateTitle newTitle ->
|
||||
(model, documentTitle model.title)
|
||||
@ -1,46 +0,0 @@
|
||||
port module Utils.View exposing (..)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (class, href, style, title)
|
||||
import Html.Events exposing (defaultOptions, onWithOptions)
|
||||
import Json.Decode as Json
|
||||
import Messages exposing (Msg(..))
|
||||
|
||||
|
||||
-- Set the document title
|
||||
port documentTitle : String -> Cmd a
|
||||
|
||||
|
||||
-- Wrap the given content in a row
|
||||
row : List (Html Msg) -> Html Msg
|
||||
row columns =
|
||||
div [ class "row "] columns
|
||||
|
||||
|
||||
-- Display the given content in a full row
|
||||
fullRow : List (Html Msg) -> Html Msg
|
||||
fullRow content =
|
||||
row
|
||||
[ div
|
||||
[ class "col-xs-12" ]
|
||||
content
|
||||
]
|
||||
|
||||
|
||||
-- Create a navigation link
|
||||
navLink : String -> String -> List (Attribute Msg) -> Html Msg
|
||||
navLink url linkText attrs =
|
||||
let
|
||||
attributes =
|
||||
List.concat
|
||||
[ [ title linkText
|
||||
, onWithOptions
|
||||
"click" { defaultOptions | preventDefault = True }
|
||||
<| Json.succeed
|
||||
<| NavTo url
|
||||
, href url
|
||||
]
|
||||
, attrs
|
||||
]
|
||||
in
|
||||
a attributes [ text linkText ]
|
||||
@ -1,110 +0,0 @@
|
||||
module View exposing (view)
|
||||
|
||||
import Html exposing (Html, button, div, footer, h2, li, p, span, text, ul)
|
||||
import Html.Attributes exposing (attribute, class)
|
||||
import Messages exposing (Msg(..))
|
||||
import Models exposing (..)
|
||||
import Routing exposing (Route(..))
|
||||
import String exposing (split, trim)
|
||||
import Utils.View exposing (documentTitle, navLink)
|
||||
|
||||
import Home.Public
|
||||
|
||||
|
||||
-- Layout functions
|
||||
|
||||
navigation : List (Html Msg)
|
||||
navigation =
|
||||
[ navLink "/user/password/change" "Change Your Password" []
|
||||
, navLink "/user/log-off" "Log Off" []
|
||||
, navLink "/user/log-on" "Log On" []
|
||||
]
|
||||
|> List.map (\anchor -> li [] [ anchor ])
|
||||
|
||||
|
||||
pageHeader : Html Msg
|
||||
pageHeader =
|
||||
div
|
||||
[ class "navbar navbar-inverse navbar-fixed-top" ]
|
||||
[ div
|
||||
[ class "container" ]
|
||||
[ div
|
||||
[ class "navbar-header" ]
|
||||
[ button
|
||||
[ class "navbar-toggle"
|
||||
, attribute "data-toggle" "collapse"
|
||||
, attribute "data-target" ".navbar-collapse"
|
||||
]
|
||||
[ span [ class "sr-only" ] [ text "Toggle navigation" ]
|
||||
, span [ class "icon-bar" ] []
|
||||
, span [ class "icon-bar" ] []
|
||||
, span [ class "icon-bar" ] []
|
||||
]
|
||||
, navLink "/" "myPrayerJournal" [ class "navbar-brand" ]
|
||||
]
|
||||
, div
|
||||
[ class "navbar-collapse collapse" ]
|
||||
[ ul
|
||||
[ class "nav navbar-nav navbar-right" ]
|
||||
navigation
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
pageTitle : Model -> Html Msg
|
||||
pageTitle model =
|
||||
let
|
||||
title =
|
||||
case List.head <| split "|" model.title of
|
||||
Just ttl ->
|
||||
trim ttl
|
||||
Nothing ->
|
||||
""
|
||||
in
|
||||
h2 [ class "page-title" ] [ text title ]
|
||||
|
||||
|
||||
pageFooter : Html Msg
|
||||
pageFooter =
|
||||
footer
|
||||
[ class "mpj-footer" ]
|
||||
[ p
|
||||
[ class "text-right" ]
|
||||
[ text "myPrayerJournal v0.8.1" ]
|
||||
]
|
||||
|
||||
|
||||
layout : Model -> List (Html Msg) -> Html Msg
|
||||
layout model contents =
|
||||
let
|
||||
pageContent =
|
||||
[ [ pageTitle model ]
|
||||
, contents
|
||||
, [ pageFooter ]
|
||||
]
|
||||
|> List.concat
|
||||
in
|
||||
div []
|
||||
[ pageHeader
|
||||
, div
|
||||
[ class "container body-content" ]
|
||||
pageContent
|
||||
]
|
||||
|
||||
|
||||
-- View functions
|
||||
|
||||
view : Model -> Html Msg
|
||||
view model =
|
||||
case model.route of
|
||||
ChangePassword ->
|
||||
layout model [ text "password change page goes here" ]
|
||||
Home ->
|
||||
layout model Home.Public.view
|
||||
LogOff ->
|
||||
layout model [ text "Log off page goes here" ]
|
||||
LogOn ->
|
||||
layout model [ text "Log On page goes here" ]
|
||||
NotFound ->
|
||||
layout model [ text "404, dude" ]
|
||||
@ -1,20 +0,0 @@
|
||||
<!DOCTYPE html>
|
||||
<html>
|
||||
<head>
|
||||
<title>myPrayerJournal</title>
|
||||
<base href="/">
|
||||
<meta charset="UTF-8">
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||
<link rel="stylesheet" href="https://ajax.aspnetcdn.com/ajax/bootstrap/3.3.6/css/bootstrap.min.css">
|
||||
<link rel="stylesheet" href="/content/styles.css">
|
||||
<link rel="stylesheet" href="https://fonts.googleapis.com/icon?family=Material+Icons">
|
||||
<script src="/app.js"></script>
|
||||
</head>
|
||||
<body>
|
||||
<div id="app"></div>
|
||||
<script>
|
||||
var app = Elm.App.embed(document.getElementById('app'))
|
||||
app.ports.documentTitle.subscribe(function (title) { document.title = title })
|
||||
</script>
|
||||
</body>
|
||||
</html>
|
||||
12
src/wwwroot/js/mpj.js
Normal file
12
src/wwwroot/js/mpj.js
Normal file
@ -0,0 +1,12 @@
|
||||
/**
|
||||
* myPrayerJournal script file
|
||||
*/
|
||||
var mpj = {
|
||||
lock: new Auth0Lock('Of2s0RQCQ3mt3dwIkOBY5h85J9sXbF2n', 'djs-consulting.auth0.com', {
|
||||
auth: { redirectUrl: 'http://localhost:8080/user/log-on' }
|
||||
}),
|
||||
|
||||
signIn: function() {
|
||||
this.lock.show()
|
||||
}
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user