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

IT LIVES! (on dotnet core)

Browse Source 
Commented out RSS feed stuff dependent on SyndicationFeed; revamped
bootstrapper to make everything work in the proper order; qualified
resource name in Resources project
This commit is contained in:
Daniel J. Summers 2016-09-18 15:01:16 -05:00
parent 1c3e84f5ec
commit 3f9665a2e6
10 changed files with 71 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/MyWebLog.App/App.fs
View File

@ -18,7 +18,7 @@ open Nancy.Owin
open Nancy.Security
open Nancy.Session.Persistable
//open Nancy.Session.Relational
open Nancy.Session.RethinkDb
open Nancy.Session.RethinkDB
open Nancy.TinyIoc
open Nancy.ViewEngines.SuperSimpleViewEngine
open NodaTime
@ -26,16 +26,14 @@ open RethinkDb.Driver.Net
open System
open System.IO
open System.Reflection
open System.Security.Claims
open System.Text.RegularExpressions
/// Establish the configuration for this instance
let cfg = try AppConfig.FromJson (System.IO.File.ReadAllText "config.json")
with ex -> raise <| Exception (Strings.get "ErrBadAppConfig", ex)
let data : IMyWebLogData = upcast RethinkMyWebLogData(cfg.DataConfig.Conn, cfg.DataConfig)
do
data.SetUp ()
let data = lazy (RethinkMyWebLogData(cfg.DataConfig.Conn, cfg.DataConfig) :> IMyWebLogData)
/// Support RESX lookup via the @Translate SSVE alias
type TranslateTokenViewEngineMatcher() =
@ -48,7 +46,7 @@ type TranslateTokenViewEngineMatcher() =
/// Handle forms authentication
type MyWebLogUser(name, claims) =
interface IUserIdentity with
inherit ClaimsPrincipal()
member this.UserName with get() = name
member this.Claims with get() = claims
@ -85,12 +83,12 @@ type MyWebLogBootstrapper() =
Directory.EnumerateDirectories (Path.Combine [| "views"; "themes" |])
|> Seq.iter addContentDir
override this.ApplicationStartup (container, pipelines) =
base.ApplicationStartup (container, pipelines)
// Application configuration
override this.ConfigureApplicationContainer (container) =
base.ConfigureApplicationContainer container
container.Register<AppConfig>(cfg)
|> ignore
container.Register<IMyWebLogData>(data)
data.Force().SetUp ()
container.Register<IMyWebLogData>(data.Force ())
|> ignore
// NodaTime
container.Register<IClock>(SystemClock.Instance)
@ -99,12 +97,15 @@ type MyWebLogBootstrapper() =
container.Register<seq<ISuperSimpleViewEngineMatcher>>(fun _ _ ->
Seq.singleton (TranslateTokenViewEngineMatcher() :> ISuperSimpleViewEngineMatcher))
|> ignore
override this.ApplicationStartup (container, pipelines) =
base.ApplicationStartup (container, pipelines)
// Forms authentication configuration
let auth =
FormsAuthenticationConfiguration(
CryptographyConfiguration =
CryptographyConfiguration(
RijndaelEncryptionProvider(PassphraseKeyGenerator(cfg.AuthEncryptionPassphrase, cfg.AuthSalt)),
AesEncryptionProvider(PassphraseKeyGenerator(cfg.AuthEncryptionPassphrase, cfg.AuthSalt)),
DefaultHmacProvider(PassphraseKeyGenerator(cfg.AuthHmacPassphrase, cfg.AuthSalt))),
RedirectUrl = "~/user/logon",
UserMapper = container.Resolve<IUserMapper>())
@ -112,12 +113,16 @@ type MyWebLogBootstrapper() =
// CSRF
Csrf.Enable pipelines
// Sessions
let sessions = RethinkDbSessionConfiguration(cfg.DataConfig.Conn)
let sessions = RethinkDBSessionConfiguration(cfg.DataConfig.Conn)
sessions.Database <- cfg.DataConfig.Database
//let sessions = RelationalSessionConfiguration(ConfigurationManager.ConnectionStrings.["SessionStore"].ConnectionString)
PersistableSessions.Enable (pipelines, sessions)
()
override this.Configure (environment) =
base.Configure environment
environment.Tracing(true, true)
let version =
let v = typeof<AppConfig>.GetType().GetTypeInfo().Assembly.GetName().Version
@ -132,7 +137,7 @@ type RequestEnvironment() =
member this.Initialize (pipelines, context) =
let establishEnv (ctx : NancyContext) =
ctx.Items.[Keys.RequestStart] <- DateTime.Now.Ticks
match tryFindWebLogByUrlBase data ctx.Request.Url.HostName with
match tryFindWebLogByUrlBase (data.Force ()) ctx.Request.Url.HostName with
| Some webLog -> ctx.Items.[Keys.WebLog] <- webLog
| None -> // TODO: redirect to domain set up page
Exception (sprintf "%s %s" ctx.Request.Url.HostName (Strings.get "ErrNotConfigured"))
@ -144,7 +149,9 @@ type RequestEnvironment() =
type Startup() =
member this.Configure (app : IApplicationBuilder) =
app.UseOwin(fun x -> x.UseNancy() |> ignore) |> ignore
let opt = NancyOptions()
opt.Bootstrapper <- new MyWebLogBootstrapper()
app.UseOwin(fun x -> x.UseNancy(opt) |> ignore) |> ignore
let Run () =

6
src/MyWebLog.App/CategoryModule.fs
View File

@ -28,7 +28,7 @@ type CategoryModule(data : IMyWebLogData) as this =
upcast this.View.["/admin/category/list", model]
/// Edit a category
member this.EditCategory (parameters : DynamicDictionary) =
member this.EditCategory (parameters : DynamicDictionary) : obj =
this.RequiresAccessLevel AuthorizationLevel.Administrator
let catId = parameters.["id"].ToString ()
match (match catId with
@ -42,7 +42,7 @@ type CategoryModule(data : IMyWebLogData) as this =
| _ -> this.NotFound ()
/// Save a category
member this.SaveCategory (parameters : DynamicDictionary) =
member this.SaveCategory (parameters : DynamicDictionary) : obj =
this.ValidateCsrfToken ()
this.RequiresAccessLevel AuthorizationLevel.Administrator
let catId = parameters.["id"].ToString ()
@ -75,7 +75,7 @@ type CategoryModule(data : IMyWebLogData) as this =
| _ -> this.NotFound ()
/// Delete a category
member this.DeleteCategory (parameters : DynamicDictionary) =
member this.DeleteCategory (parameters : DynamicDictionary) : obj =
this.ValidateCsrfToken ()
this.RequiresAccessLevel AuthorizationLevel.Administrator
let catId = parameters.["id"].ToString ()

5
src/MyWebLog.App/ModuleExtensions.fs
View File

@ -4,6 +4,8 @@ module MyWebLog.ModuleExtensions
open MyWebLog.Entities
open Nancy
open Nancy.Security
open System
open System.Security.Claims
/// Parent class for all myWebLog Nancy modules
type NancyModule with
@ -27,5 +29,6 @@ type NancyModule with
/// Require a specific level of access for the current web log
member this.RequiresAccessLevel level =
let findClaim = new Predicate<Claim>(fun claim -> claim.Type = ClaimTypes.Role && claim.Value = sprintf "%s|%s" this.WebLog.Id level)
this.RequiresAuthentication()
this.RequiresClaims [| sprintf "%s|%s" this.WebLog.Id level |]
this.RequiresClaims [| findClaim |]

15
src/MyWebLog.App/PageModule.fs
View File

@ -1,6 +1,5 @@
namespace MyWebLog
open FSharp.Markdown
open MyWebLog.Data
open MyWebLog.Entities
open MyWebLog.Logic.Page
@ -22,15 +21,15 @@ type PageModule(data : IMyWebLogData, clock : IClock) as this =
this.Delete("/page/{id}/delete", fun parms -> this.DeletePage (downcast parms))
/// List all pages
member this.PageList () =
member this.PageList () : obj =
this.RequiresAccessLevel AuthorizationLevel.Administrator
let model = PagesModel(this.Context, this.WebLog, (findAllPages data this.WebLog.Id
|> List.map (fun p -> PageForDisplay(this.WebLog, p))))
model.PageTitle <- Resources.Pages
model.PageTitle <- Strings.get "Pages"
upcast this.View.["admin/page/list", model]
/// Edit a page
member this.EditPage (parameters : DynamicDictionary) =
member this.EditPage (parameters : DynamicDictionary) : obj =
this.RequiresAccessLevel AuthorizationLevel.Administrator
let pageId = parameters.["id"].ToString ()
match pageId with "new" -> Some Page.Empty | _ -> tryFindPage data this.WebLog.Id pageId
@ -46,12 +45,12 @@ type PageModule(data : IMyWebLogData, clock : IClock) as this =
| _ -> this.NotFound ()
/// Save a page
member this.SavePage (parameters : DynamicDictionary) =
member this.SavePage (parameters : DynamicDictionary) : obj =
this.ValidateCsrfToken ()
this.RequiresAccessLevel AuthorizationLevel.Administrator
let pageId = parameters.["id"].ToString ()
let form = this.Bind<EditPageForm> ()
let now = clock.Now.Ticks
let now = clock.GetCurrentInstant().ToUnixTimeTicks()
match (match pageId with "new" -> Some Page.Empty | _ -> tryFindPage data this.WebLog.Id pageId) with
| Some p -> let page = match pageId with "new" -> { p with WebLogId = this.WebLog.Id } | _ -> p
let pId = { p with
@ -60,7 +59,7 @@ type PageModule(data : IMyWebLogData, clock : IClock) as this =
PublishedOn = match pageId with "new" -> now | _ -> page.PublishedOn
UpdatedOn = now
Text = match form.Source with
| RevisionSource.Markdown -> Markdown.TransformHtml form.Text
| RevisionSource.Markdown -> (* Markdown.TransformHtml *) form.Text
| _ -> form.Text
Revisions = { AsOf = now
SourceType = form.Source
@ -77,7 +76,7 @@ type PageModule(data : IMyWebLogData, clock : IClock) as this =
| _ -> this.NotFound ()
/// Delete a page
member this.DeletePage (parameters : DynamicDictionary) =
member this.DeletePage (parameters : DynamicDictionary) : obj =
this.ValidateCsrfToken ()
this.RequiresAccessLevel AuthorizationLevel.Administrator
let pageId = parameters.["id"].ToString ()

29
src/MyWebLog.App/PostModule.fs
View File

@ -13,7 +13,7 @@ open Nancy.Session.Persistable
open NodaTime
open RethinkDb.Driver.Net
open System
open System.ServiceModel.Syndication
//open System.ServiceModel.Syndication
/// Routes dealing with posts (including the home page, /tag, /category, RSS, and catch-all routes)
type PostModule(data : IMyWebLogData, clock : IClock) as this =
@ -28,7 +28,8 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
/// Generate an RSS/Atom feed of the latest posts
let generateFeed format : obj =
let posts = findFeedPosts data this.WebLog.Id 10
this.NotFound ()
(* let posts = findFeedPosts data this.WebLog.Id 10
let feed =
SyndicationFeed(
this.WebLog.Name, defaultArg this.WebLog.Subtitle null,
@ -55,7 +56,7 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
Xml.XmlWriter.Create(stream)
|> match format with "atom" -> feed.SaveAsAtom10 | _ -> feed.SaveAsRss20
stream.Position <- int64 0
upcast this.Response.FromStream(stream, sprintf "application/%s+xml" format)
upcast this.Response.FromStream(stream, sprintf "application/%s+xml" format) *)
do
this.Get ("/", fun _ -> this.HomePage ())
@ -74,7 +75,7 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
// ---- Display posts to users ----
/// Display a page of published posts
member this.PublishedPostsPage pageNbr =
member this.PublishedPostsPage pageNbr : obj =
let model = PostsModel(this.Context, this.WebLog)
model.PageNbr <- pageNbr
model.Posts <- findPageOfPublishedPosts data this.WebLog.Id pageNbr 10 |> forDisplay
@ -91,7 +92,7 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
this.ThemedView "index" model
/// Display either the newest posts or the configured home page
member this.HomePage () =
member this.HomePage () : obj =
match this.WebLog.DefaultPage with
| "posts" -> this.PublishedPostsPage 1
| pageId -> match tryFindPageWithoutRevisions data this.WebLog.Id pageId with
@ -101,7 +102,7 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
| _ -> this.NotFound ()
/// Derive a post or page from the URL, or redirect from a prior URL to the current one
member this.CatchAll (parameters : DynamicDictionary) =
member this.CatchAll (parameters : DynamicDictionary) : obj =
let url = parameters.["permalink"].ToString ()
match tryFindPostByPermalink data this.WebLog.Id url with
| Some post -> // Hopefully the most common result; the permalink is a permalink!
@ -124,7 +125,7 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
| _ -> this.NotFound ()
/// Display categorized posts
member this.CategorizedPosts (parameters : DynamicDictionary) =
member this.CategorizedPosts (parameters : DynamicDictionary) : obj =
let slug = parameters.["slug"].ToString ()
match tryFindCategoryBySlug data this.WebLog.Id slug with
| Some cat -> let pageNbr = getPage parameters
@ -149,7 +150,7 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
| _ -> this.NotFound ()
/// Display tagged posts
member this.TaggedPosts (parameters : DynamicDictionary) =
member this.TaggedPosts (parameters : DynamicDictionary) : obj =
let tag = parameters.["tag"].ToString ()
let pageNbr = getPage parameters
let model = PostsModel(this.Context, this.WebLog)
@ -167,7 +168,7 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
this.ThemedView "index" model
/// Generate an RSS feed
member this.Feed () =
member this.Feed () : obj =
let query = this.Request.Query :?> DynamicDictionary
match query.ContainsKey "format" with
| true -> match query.["format"].ToString () with
@ -179,7 +180,7 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
// ---- Administer posts ----
/// Display a page of posts in the admin area
member this.PostList pageNbr =
member this.PostList pageNbr : obj =
this.RequiresAccessLevel AuthorizationLevel.Administrator
let model = PostsModel(this.Context, this.WebLog)
model.PageNbr <- pageNbr
@ -191,7 +192,7 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
upcast this.View.["admin/post/list", model]
/// Edit a post
member this.EditPost (parameters : DynamicDictionary) =
member this.EditPost (parameters : DynamicDictionary) : obj =
this.RequiresAccessLevel AuthorizationLevel.Administrator
let postId = parameters.["postId"].ToString ()
match (match postId with "new" -> Some Post.Empty | _ -> tryFindPost data this.WebLog.Id postId) with
@ -211,12 +212,12 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
| _ -> this.NotFound ()
/// Save a post
member this.SavePost (parameters : DynamicDictionary) =
member this.SavePost (parameters : DynamicDictionary) : obj =
this.RequiresAccessLevel AuthorizationLevel.Administrator
this.ValidateCsrfToken ()
let postId = parameters.["postId"].ToString ()
let form = this.Bind<EditPostForm>()
let now = clock.Now.Ticks
let now = clock.GetCurrentInstant().ToUnixTimeTicks()
match (match postId with "new" -> Some Post.Empty | _ -> tryFindPost data this.WebLog.Id postId) with
| Some p -> let justPublished = p.PublishedOn = int64 0 && form.PublishNow
let post = match postId with
@ -234,7 +235,7 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
PublishedOn = match justPublished with true -> now | _ -> int64 0
UpdatedOn = now
Text = match form.Source with
| RevisionSource.Markdown -> Markdown.TransformHtml form.Text
| RevisionSource.Markdown -> (* Markdown.TransformHtml *) form.Text
| _ -> form.Text
CategoryIds = Array.toList form.Categories
Tags = form.Tags.Split ','

6
src/MyWebLog.App/UserModule.fs
View File

@ -28,14 +28,14 @@ type UserModule(data : IMyWebLogData, cfg : AppConfig) as this =
this.Get ("/logoff", fun _ -> this.LogOff ())
/// Show the log on page
member this.ShowLogOn () =
member this.ShowLogOn () : obj =
let model = LogOnModel(this.Context, this.WebLog)
let query = this.Request.Query :?> DynamicDictionary
model.Form.ReturnUrl <- match query.ContainsKey "returnUrl" with true -> query.["returnUrl"].ToString () | _ -> ""
upcast this.View.["admin/user/logon", model]
/// Process a user log on
member this.DoLogOn (parameters : DynamicDictionary) =
member this.DoLogOn (parameters : DynamicDictionary) : obj =
this.ValidateCsrfToken ()
let form = this.Bind<LogOnForm> ()
let model = MyWebLogModel(this.Context, this.WebLog)
@ -54,7 +54,7 @@ type UserModule(data : IMyWebLogData, cfg : AppConfig) as this =
this.Redirect (sprintf "/user/logon?returnUrl=%s" form.ReturnUrl) model
/// Log a user off
member this.LogOff () =
member this.LogOff () : obj =
// FIXME: why are we getting the user here if we don't do anything with it?
let user = this.Request.PersistableSession.GetOrDefault<User> (Keys.User, User.Empty)
this.Session.DeleteAll ()

2
src/MyWebLog.App/ViewModels.fs
View File

@ -71,7 +71,7 @@ with
module FormatDateTime =
/// Convert ticks to a zoned date/time
let zonedTime timeZone ticks = Instant(ticks).InZone(DateTimeZoneProviders.Tzdb.[timeZone])
let zonedTime timeZone ticks = Instant.FromUnixTimeTicks(ticks).InZone(DateTimeZoneProviders.Tzdb.[timeZone])
/// Display a long date
let longDate timeZone ticks =

2
src/MyWebLog.Resources/Library.fs
View File

@ -13,7 +13,7 @@ let private fallbackLocale = "en-US"
let private getEmbedded locale =
use rdr =
new System.IO.StreamReader
(MyWebLog.Resources.AssemblyInfo.HorribleHack().Assembly.GetManifestResourceStream(sprintf "%s.json" locale))
(AssemblyInfo.HorribleHack().Assembly.GetManifestResourceStream(sprintf "MyWebLog.Resources.%s.json" locale))
rdr.ReadToEnd()
/// The dictionary of localized strings

5
src/MyWebLog/project.json
View File

@ -1,6 +1,9 @@
{
"buildOptions": {
"emitEntryPoint": true
"emitEntryPoint": true,
"copyToOutput": {
"include": "views"
}
},
"dependencies": {
"MyWebLog.App": "0.9.2",

10
src/global.json Normal file
View File

@ -0,0 +1,10 @@
{
"projects":[
"MyWebLog",
"MyWebLog.App",
"MyWebLog.Data.RethinkDB",
"MyWebLog.Entities",
"MyWebLog.Logic",
"MyWebLog.Resources"
]
}