-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 2017-04-21 07:49:46 -05:00
parent da6910e055
commit d34302aa52
21 changed files with 505 additions and 510 deletions

View File

@ -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

View File

@ -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

View File

@ -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*)

View File

@ -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
*)

View 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

View 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

View 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
View 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
View 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 "&nbsp;"]
p [ text "myPrayerJournal is a place where individuals can record their prayer requests, record that they prayed for them, update them as God moves in the situation, and record a final answer received on that request. It will also allow individuals to review their answered prayers." ]
p [ text "This site is currently in very limited alpha, as it is being developed with a core group of test users. If this is something you are interested in using, check back around mid-February 2017 to check on the development progress." ]
]

View File

@ -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"
}

View File

@ -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-*"
}

View File

@ -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
}

View File

@ -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 ]

View File

@ -1,10 +0,0 @@
module Messages exposing (..)
import Navigation exposing (Location)
import Routing exposing (Route)
type Msg
= OnLocationChange Location
| NavTo String
| UpdateTitle String

View File

@ -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"
}

View File

@ -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

View File

@ -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)

View File

@ -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 ]

View File

@ -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" ]

View File

@ -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
View 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()
}
}