bit-badger/myWebLog
1
0
Fork 0
Code Issues 4 Pull Requests Packages Projects Releases 11 Activity

v2 RC2 (#33)

Browse Source 
* Add PostgreSQL back end (#30)
* Upgrade password storage (#32)
* Change podcast/episode storage for SQLite (#29)
* Move date/time handling to NodaTime (#31)
This commit was merged in pull request #33.
This commit is contained in:
Daniel J. Summers
2022-08-21 18:56:18 -04:00
committed by GitHub
parent 1ec664ad24
commit 5f3daa1de9
45 changed files with 3820 additions and 1306 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
src/MyWebLog/Caches.fs
View File

@@ -56,7 +56,6 @@ module Extensions =
defaultArg (this.UserAccessLevel |> Option.map (AccessLevel.hasAccess level)) false
open System.Collections.Concurrent
/// <summary>

31
src/MyWebLog/Handlers/Admin.fs
View File

@@ -5,6 +5,7 @@ open System.Threading.Tasks
open Giraffe
open MyWebLog
open MyWebLog.ViewModels
open NodaTime
/// ~~ DASHBOARDS ~~
module Dashboard =
@@ -12,23 +13,22 @@ module Dashboard =
// GET /admin/dashboard
let user : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let getCount (f : WebLogId -> Task<int>) = f ctx.WebLog.Id
let data = ctx.Data
let posts = getCount (data.Post.CountByStatus Published)
let drafts = getCount (data.Post.CountByStatus Draft)
let pages = getCount data.Page.CountAll
let listed = getCount data.Page.CountListed
let cats = getCount data.Category.CountAll
let topCats = getCount data.Category.CountTopLevel
let! _ = Task.WhenAll (posts, drafts, pages, listed, cats, topCats)
let data = ctx.Data
let! posts = getCount (data.Post.CountByStatus Published)
let! drafts = getCount (data.Post.CountByStatus Draft)
let! pages = getCount data.Page.CountAll
let! listed = getCount data.Page.CountListed
let! cats = getCount data.Category.CountAll
let! topCats = getCount data.Category.CountTopLevel
return!
hashForPage "Dashboard"
|> addToHash ViewContext.Model {
Posts = posts.Result
Drafts = drafts.Result
Pages = pages.Result
ListedPages = listed.Result
Categories = cats.Result
TopLevelCategories = topCats.Result
Posts = posts
Drafts = drafts
Pages = pages
ListedPages = listed
Categories = cats
TopLevelCategories = topCats
}
|> adminView "dashboard" next ctx
}
@@ -344,7 +344,8 @@ module Theme =
do! asset.Open().CopyToAsync stream
do! data.ThemeAsset.Save
{ Id = ThemeAssetId (themeId, assetName)
UpdatedOn = asset.LastWriteTime.DateTime
UpdatedOn = LocalDateTime.FromDateTime(asset.LastWriteTime.DateTime)
.InZoneLeniently(DateTimeZone.Utc).ToInstant ()
Data = stream.ToArray ()
}
}

10
src/MyWebLog/Handlers/Feed.fs
View File

@@ -95,8 +95,8 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[
let item = SyndicationItem (
Id = WebLog.absoluteUrl webLog post.Permalink,
Title = TextSyndicationContent.CreateHtmlContent post.Title,
PublishDate = DateTimeOffset post.PublishedOn.Value,
LastUpdatedTime = DateTimeOffset post.UpdatedOn,
PublishDate = post.PublishedOn.Value.ToDateTimeOffset (),
LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset (),
Content = TextSyndicationContent.CreatePlaintextContent plainText)
item.AddPermalink (Uri item.Id)
@@ -163,8 +163,8 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor)
item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit)
episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it))
episode.Duration
|> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.ToString """hh\:mm\:ss"""))
Episode.formatDuration episode
|> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it))
match episode.ChapterFile with
| Some chapters ->
@@ -381,7 +381,7 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
addNamespace feed "content" Namespace.content
setTitleAndDescription feedType webLog cats feed
feed.LastUpdatedTime <- (List.head posts).UpdatedOn |> DateTimeOffset
feed.LastUpdatedTime <- (List.head posts).UpdatedOn.ToDateTimeOffset ()
feed.Generator <- ctx.Generator
feed.Items <- posts |> Seq.ofList |> Seq.map toItem
feed.Language <- "en"

3
src/MyWebLog/Handlers/Helpers.fs
View File

@@ -419,10 +419,11 @@ let getCategoryIds slug ctx =
open System
open System.Globalization
open NodaTime
/// Parse a date/time to UTC
let parseToUtc (date : string) =
DateTime.Parse (date, null, DateTimeStyles.AdjustToUniversal)
Instant.FromDateTimeUtc (DateTime.Parse (date, null, DateTimeStyles.AdjustToUniversal))
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Logging

6
src/MyWebLog/Handlers/Page.fs
View File

@@ -139,15 +139,13 @@ let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
| _, None -> return! Error.notFound next ctx
}
open System
// POST /admin/page/{id}/revision/{revision-date}/restore
let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update
{ pg with
Revisions = { rev with AsOf = DateTime.UtcNow }
Revisions = { rev with AsOf = Noda.now () }
:: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
}
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
@@ -173,7 +171,7 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel> ()
let data = ctx.Data
let now = DateTime.UtcNow
let now = Noda.now ()
let tryPage =
if model.IsNew then
{ Page.empty with

11
src/MyWebLog/Handlers/Post.fs
View File

@@ -52,9 +52,9 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage (data :
let! olderPost, newerPost =
match listType with
| SinglePost ->
let post = List.head posts
let dateTime = defaultArg post.PublishedOn post.UpdatedOn
data.Post.FindSurroundingPosts webLog.Id dateTime
let post = List.head posts
let target = defaultArg post.PublishedOn post.UpdatedOn
data.Post.FindSurroundingPosts webLog.Id target
| _ -> Task.FromResult (None, None)
let newerLink =
match listType, pageNbr with
@@ -350,7 +350,7 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
| Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update
{ post with
Revisions = { rev with AsOf = DateTime.UtcNow }
Revisions = { rev with AsOf = Noda.now () }
:: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
}
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
@@ -376,7 +376,6 @@ let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fu
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel> ()
let data = ctx.Data
let now = DateTime.UtcNow
let tryPost =
if model.IsNew then
{ Post.empty with
@@ -389,7 +388,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
| Some post when canEdit post.AuthorId ctx ->
let priorCats = post.CategoryIds
let updatedPost =
model.UpdatePost post now
model.UpdatePost post (Noda.now ())
|> function
| post ->
if model.SetPublished then

2
src/MyWebLog/Handlers/Routes.fs
View File

@@ -94,7 +94,7 @@ module Asset =
| Some asset ->
match Upload.checkModified asset.UpdatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx
| None -> return! Upload.sendFile asset.UpdatedOn path asset.Data next ctx
| None -> return! Upload.sendFile (asset.UpdatedOn.ToDateTimeUtc ()) path asset.Data next ctx
| None -> return! Error.notFound next ctx
}

13
src/MyWebLog/Handlers/Upload.fs
View File

@@ -29,15 +29,17 @@ module private Helpers =
// ~~ SERVING UPLOADS ~~
open System.Globalization
open Giraffe
open Microsoft.AspNetCore.Http
open NodaTime
/// Determine if the file has been modified since the date/time specified by the If-Modified-Since header
let checkModified since (ctx : HttpContext) : HttpHandler option =
match ctx.Request.Headers.IfModifiedSince with
| it when it.Count < 1 -> None
| it when since > DateTime.Parse it[0] -> None
| _ -> Some (setStatusCode 304 >=> setBodyFromString "Not Modified")
| it when since > Instant.FromDateTimeUtc (DateTime.Parse (it[0], null, DateTimeStyles.AdjustToUniversal)) -> None
| _ -> Some (setStatusCode 304)
open Microsoft.AspNetCore.Http.Headers
@@ -73,7 +75,7 @@ let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
| Some upload ->
match checkModified upload.UpdatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx
| None -> return! sendFile upload.UpdatedOn path upload.Data next ctx
| None -> return! sendFile (upload.UpdatedOn.ToDateTimeUtc ()) path upload.Data next ctx
| None -> return! Error.notFound next ctx
else
return! Error.notFound next ctx
@@ -143,7 +145,8 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let upload = Seq.head ctx.Request.Form.Files
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
Path.GetExtension(upload.FileName).ToLowerInvariant ())
let localNow = WebLog.localTime ctx.WebLog DateTime.Now
let now = Noda.now ()
let localNow = WebLog.localTime ctx.WebLog now
let year = localNow.ToString "yyyy"
let month = localNow.ToString "MM"
let! form = ctx.BindFormAsync<UploadFileModel> ()
@@ -156,7 +159,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
{ Id = UploadId.create ()
WebLogId = ctx.WebLog.Id
Path = Permalink $"{year}/{month}/{fileName}"
UpdatedOn = DateTime.UtcNow
UpdatedOn = now
Data = stream.ToArray ()
}
do! ctx.Data.Upload.Add file

66
src/MyWebLog/Handlers/User.fs
View File

@@ -2,19 +2,32 @@
module MyWebLog.Handlers.User
open System
open System.Security.Cryptography
open System.Text
open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.Identity
open MyWebLog
open NodaTime
// ~~ LOG ON / LOG OFF ~~
/// Hash a password for a given user
let hashedPassword (plainText : string) (email : string) (salt : Guid) =
let allSalt = Array.concat [ salt.ToByteArray (); Encoding.UTF8.GetBytes email ]
use alg = new Rfc2898DeriveBytes (plainText, allSalt, 2_048)
Convert.ToBase64String (alg.GetBytes 64)
/// Create a password hash a password for a given user
let createPasswordHash user password =
PasswordHasher<WebLogUser>().HashPassword (user, password)
/// Verify whether a password is valid
let verifyPassword user password (ctx : HttpContext) = backgroundTask {
match user with
| Some usr ->
let hasher = PasswordHasher<WebLogUser> ()
match hasher.VerifyHashedPassword (usr, usr.PasswordHash, password) with
| PasswordVerificationResult.Success -> return Ok ()
| PasswordVerificationResult.SuccessRehashNeeded ->
do! ctx.Data.WebLogUser.Update { usr with PasswordHash = hasher.HashPassword (usr, password) }
return Ok ()
| _ -> return Error "Log on attempt unsuccessful"
| None -> return Error "Log on attempt unsuccessful"
}
open Giraffe
open MyWebLog
open MyWebLog.ViewModels
// GET /user/log-on
@@ -35,10 +48,12 @@ open Microsoft.AspNetCore.Authentication.Cookies
// POST /user/log-on
let doLogOn : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel> ()
let data = ctx.Data
match! data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id with
| Some user when user.PasswordHash = hashedPassword model.Password user.Email user.Salt ->
let! model = ctx.BindFormAsync<LogOnModel> ()
let data = ctx.Data
let! tryUser = data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id
match! verifyPassword tryUser model.Password ctx with
| Ok _ ->
let user = tryUser.Value
let claims = seq {
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id)
Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}")
@@ -59,8 +74,8 @@ let doLogOn : HttpHandler = fun next ctx -> task {
match model.ReturnTo with
| Some url -> redirectTo false url next ctx
| None -> redirectToGet "admin/dashboard" next ctx
| _ ->
do! addMessage ctx { UserMessage.error with Message = "Log on attempt unsuccessful" }
| Error msg ->
do! addMessage ctx { UserMessage.error with Message = msg }
return! logOn model.ReturnTo next ctx
}
@@ -147,7 +162,9 @@ let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandl
|> addToHash ViewContext.Model model
|> addToHash "access_level" (AccessLevel.toString user.AccessLevel)
|> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn)
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog (defaultArg user.LastSeenOn DateTime.UnixEpoch))
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog
(defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))
|> adminView "my-info" next ctx
@@ -164,19 +181,13 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user when model.NewPassword = model.NewPasswordConfirm ->
let pw, salt =
if model.NewPassword = "" then
user.PasswordHash, user.Salt
else
let newSalt = Guid.NewGuid ()
hashedPassword model.NewPassword user.Email newSalt, newSalt
let pw = if model.NewPassword = "" then user.PasswordHash else createPasswordHash user model.NewPassword
let user =
{ user with
FirstName = model.FirstName
LastName = model.LastName
PreferredName = model.PreferredName
PasswordHash = pw
Salt = salt
}
do! data.WebLogUser.Update user
let pwMsg = if model.NewPassword = "" then "" else " and updated your password"
@@ -198,9 +209,9 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let tryUser =
if model.IsNew then
{ WebLogUser.empty with
Id = WebLogUserId.create ()
WebLogId = ctx.WebLog.Id
CreatedOn = DateTime.UtcNow
Id = WebLogUserId.create ()
WebLogId = ctx.WebLog.Id
CreatedOn = Noda.now ()
} |> someTask
else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
match! tryUser with
@@ -211,9 +222,7 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
else
let toUpdate =
if model.Password = "" then updatedUser
else
let salt = Guid.NewGuid ()
{ updatedUser with PasswordHash = hashedPassword model.Password model.Email salt; Salt = salt }
else { updatedUser with PasswordHash = createPasswordHash updatedUser model.Password }
do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate
do! addMessage ctx
{ UserMessage.success with
@@ -227,4 +236,3 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
next ctx
| None -> return! Error.notFound next ctx
}

77
src/MyWebLog/Maintenance.fs
View File

@@ -4,6 +4,7 @@ open System
open System.IO
open Microsoft.Extensions.DependencyInjection
open MyWebLog.Data
open NodaTime
/// Create the web log information
let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
@@ -41,22 +42,19 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
}
// Create the admin user
let salt = Guid.NewGuid ()
let now = DateTime.UtcNow
do! data.WebLogUser.Add
{ WebLogUser.empty with
Id = userId
WebLogId = webLogId
Email = args[3]
FirstName = "Admin"
LastName = "User"
PreferredName = "Admin"
PasswordHash = Handlers.User.hashedPassword args[4] args[3] salt
Salt = salt
AccessLevel = accessLevel
CreatedOn = now
}
let now = Noda.now ()
let user =
{ WebLogUser.empty with
Id = userId
WebLogId = webLogId
Email = args[3]
FirstName = "Admin"
LastName = "User"
PreferredName = "Admin"
AccessLevel = accessLevel
CreatedOn = now
}
do! data.WebLogUser.Add { user with PasswordHash = Handlers.User.createPasswordHash user args[4] }
// Create the default home page
do! data.Page.Add
@@ -70,8 +68,8 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
UpdatedOn = now
Text = "<p>This is your default home page.</p>"
Revisions = [
{ AsOf = now
Text = Html "<p>This is your default home page.</p>"
{ AsOf = now
Text = Html "<p>This is your default home page.</p>"
}
]
}
@@ -155,7 +153,6 @@ let loadTheme (args : string[]) (sp : IServiceProvider) = task {
/// Back up a web log's data
module Backup =
open System.Threading.Tasks
open MyWebLog.Converters
open Newtonsoft.Json
@@ -165,7 +162,7 @@ module Backup =
Id : ThemeAssetId
/// The updated date for this asset
UpdatedOn : DateTime
UpdatedOn : Instant
/// The data for this asset, base-64 encoded
Data : string
@@ -197,7 +194,7 @@ module Backup =
Path : Permalink
/// The date/time this upload was last updated (file time)
UpdatedOn : DateTime
UpdatedOn : Instant
/// The data for the upload, base-64 encoded
Data : string
@@ -251,10 +248,9 @@ module Backup =
Uploads : EncodedUpload list
}
/// Create a JSON serializer (uses RethinkDB data implementation's JSON converters)
/// Create a JSON serializer
let private getSerializer prettyOutput =
let serializer = JsonSerializer.CreateDefault ()
Json.all () |> Seq.iter serializer.Converters.Add
let serializer = Json.configure (JsonSerializer.CreateDefault ())
if prettyOutput then serializer.Formatting <- Formatting.Indented
serializer
@@ -382,7 +378,8 @@ module Backup =
printfn ""
printfn "- Importing theme..."
do! data.Theme.Save restore.Theme
let! _ = restore.Assets |> List.map (EncodedAsset.toAsset >> data.ThemeAsset.Save) |> Task.WhenAll
restore.Assets
|> List.iter (EncodedAsset.toAsset >> data.ThemeAsset.Save >> Async.AwaitTask >> Async.RunSynchronously)
// Restore web log data
@@ -393,19 +390,20 @@ module Backup =
do! data.WebLogUser.Restore restore.Users
printfn "- Restoring categories and tag mappings..."
do! data.TagMap.Restore restore.TagMappings
do! data.Category.Restore restore.Categories
if not (List.isEmpty restore.TagMappings) then do! data.TagMap.Restore restore.TagMappings
if not (List.isEmpty restore.Categories) then do! data.Category.Restore restore.Categories
printfn "- Restoring pages..."
do! data.Page.Restore restore.Pages
if not (List.isEmpty restore.Pages) then do! data.Page.Restore restore.Pages
printfn "- Restoring posts..."
do! data.Post.Restore restore.Posts
if not (List.isEmpty restore.Posts) then do! data.Post.Restore restore.Posts
// TODO: comments not yet implemented
printfn "- Restoring uploads..."
do! data.Upload.Restore (restore.Uploads |> List.map EncodedUpload.toUpload)
if not (List.isEmpty restore.Uploads) then
do! data.Upload.Restore (restore.Uploads |> List.map EncodedUpload.toUpload)
displayStats "Restored for <>NAME<>:" restore.WebLog restore
}
@@ -490,3 +488,22 @@ let upgradeUser (args : string[]) (sp : IServiceProvider) = task {
| 3 -> do! doUserUpgrade args[1] args[2] (sp.GetRequiredService<IData> ())
| _ -> eprintfn "Usage: myWebLog upgrade-user [web-log-url-base] [email-address]"
}
/// Set a user's password
let doSetPassword urlBase email password (data : IData) = task {
match! data.WebLog.FindByHost urlBase with
| Some webLog ->
match! data.WebLogUser.FindByEmail email webLog.Id with
| Some user ->
do! data.WebLogUser.Update { user with PasswordHash = Handlers.User.createPasswordHash user password }
printfn $"Password for user {email} at {webLog.Name} set successfully"
| None -> eprintfn $"ERROR: no user {email} found at {urlBase}"
| None -> eprintfn $"ERROR: no web log found for {urlBase}"
}
/// Set a user's password if the command-line arguments are good
let setPassword (args : string[]) (sp : IServiceProvider) = task {
match args.Length with
| 4 -> do! doSetPassword args[1] args[2] args[3] (sp.GetRequiredService<IData> ())
| _ -> eprintfn "Usage: myWebLog set-password [web-log-url-base] [email-address] [password]"
}

66
src/MyWebLog/Program.fs
View File

@@ -29,11 +29,14 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>)
open System
open Microsoft.Extensions.DependencyInjection
open MyWebLog.Data
open Newtonsoft.Json
open Npgsql
/// Logic to obtain a data connection and implementation based on configured values
module DataImplementation =
open MyWebLog.Converters
// open Npgsql.Logging
open RethinkDb.Driver.FSharp
open RethinkDb.Driver.Net
@@ -43,23 +46,29 @@ module DataImplementation =
let await it = (Async.AwaitTask >> Async.RunSynchronously) it
let connStr name = config.GetConnectionString name
let hasConnStr name = (connStr >> isNull >> not) name
let createSQLite connStr =
let createSQLite connStr : IData =
let log = sp.GetRequiredService<ILogger<SQLiteData>> ()
let conn = new SqliteConnection (connStr)
log.LogInformation $"Using SQLite database {conn.DataSource}"
await (SQLiteData.setUpConnection conn)
SQLiteData (conn, log)
SQLiteData (conn, log, Json.configure (JsonSerializer.CreateDefault ()))
if hasConnStr "SQLite" then
upcast createSQLite (connStr "SQLite")
createSQLite (connStr "SQLite")
elif hasConnStr "RethinkDB" then
let log = sp.GetRequiredService<ILogger<RethinkDbData>> ()
Json.all () |> Seq.iter Converter.Serializer.Converters.Add
let log = sp.GetRequiredService<ILogger<RethinkDbData>> ()
let _ = Json.configure Converter.Serializer
let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB")
let conn = await (rethinkCfg.CreateConnectionAsync log)
upcast RethinkDbData (conn, rethinkCfg, log)
RethinkDbData (conn, rethinkCfg, log)
elif hasConnStr "PostgreSQL" then
let log = sp.GetRequiredService<ILogger<PostgresData>> ()
// NpgsqlLogManager.Provider <- ConsoleLoggingProvider NpgsqlLogLevel.Debug
let conn = new NpgsqlConnection (connStr "PostgreSQL")
log.LogInformation $"Using PostgreSQL database {conn.Host}:{conn.Port}/{conn.Database}"
PostgresData (conn, log, Json.configure (JsonSerializer.CreateDefault ()))
else
upcast createSQLite "Data Source=./myweblog.db;Cache=Shared"
createSQLite "Data Source=./myweblog.db;Cache=Shared"
open System.Threading.Tasks
@@ -76,6 +85,7 @@ let showHelp () =
printfn "init Initializes a new web log"
printfn "load-theme Load a theme"
printfn "restore Restore a JSON file backup (prompt before overwriting)"
printfn "set-password Set a password for a specific user"
printfn "upgrade-user Upgrade a WebLogAdmin user to a full Administrator"
printfn " "
printfn "For more information on a particular command, run it with no options."
@@ -88,6 +98,7 @@ open Giraffe.EndpointRouting
open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Builder
open Microsoft.AspNetCore.HttpOverrides
open Microsoft.Extensions.Caching.Distributed
open NeoSmart.Caching.Sqlite
open RethinkDB.DistributedCache
@@ -108,8 +119,9 @@ let rec main args =
let _ = builder.Services.AddAuthorization ()
let _ = builder.Services.AddAntiforgery ()
let sp = builder.Services.BuildServiceProvider ()
let sp = builder.Services.BuildServiceProvider ()
let data = DataImplementation.get sp
let _ = builder.Services.AddSingleton<JsonSerializer> data.Serializer
task {
do! data.StartUp ()
@@ -121,23 +133,36 @@ let rec main args =
match data with
| :? RethinkDbData as rethink ->
// A RethinkDB connection is designed to work as a singleton
builder.Services.AddSingleton<IData> data |> ignore
builder.Services.AddDistributedRethinkDBCache (fun opts ->
opts.TableName <- "Session"
opts.Connection <- rethink.Conn)
|> ignore
let _ = builder.Services.AddSingleton<IData> data
let _ =
builder.Services.AddDistributedRethinkDBCache (fun opts ->
opts.TableName <- "Session"
opts.Connection <- rethink.Conn)
()
| :? SQLiteData as sql ->
// ADO.NET connections are designed to work as per-request instantiation
let cfg = sp.GetRequiredService<IConfiguration> ()
builder.Services.AddScoped<SqliteConnection> (fun sp ->
let conn = new SqliteConnection (sql.Conn.ConnectionString)
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
conn)
|> ignore
builder.Services.AddScoped<IData, SQLiteData> () |> ignore
let _ =
builder.Services.AddScoped<SqliteConnection> (fun sp ->
let conn = new SqliteConnection (sql.Conn.ConnectionString)
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
conn)
let _ = builder.Services.AddScoped<IData, SQLiteData> () |> ignore
// Use SQLite for caching as well
let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SQLiteCachePath")) "./session.db"
builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath) |> ignore
let _ = builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath)
()
| :? PostgresData ->
// ADO.NET connections are designed to work as per-request instantiation
let cfg = sp.GetRequiredService<IConfiguration> ()
let _ =
builder.Services.AddScoped<NpgsqlConnection> (fun sp ->
new NpgsqlConnection (cfg.GetConnectionString "PostgreSQL"))
let _ = builder.Services.AddScoped<IData, PostgresData> ()
let _ =
builder.Services.AddSingleton<IDistributedCache> (fun sp ->
Postgres.DistributedCache (cfg.GetConnectionString "PostgreSQL") :> IDistributedCache)
()
| _ -> ()
let _ = builder.Services.AddSession(fun opts ->
@@ -159,6 +184,7 @@ let rec main args =
| Some it when it = "restore" -> Maintenance.Backup.restoreFromBackup args app.Services
| Some it when it = "do-restore" -> Maintenance.Backup.restoreFromBackup args app.Services
| Some it when it = "upgrade-user" -> Maintenance.upgradeUser args app.Services
| Some it when it = "set-password" -> Maintenance.setPassword args app.Services
| Some it when it = "help" -> showHelp ()
| Some it ->
printfn $"""Unrecognized command "{it}" - valid commands are:"""

2
src/MyWebLog/appsettings.json
View File

@@ -1,5 +1,5 @@
{
"Generator": "myWebLog 2.0-rc1",
"Generator": "myWebLog 2.0-rc2",
"Logging": {
"LogLevel": {
"MyWebLog.Handlers": "Information"