From 3f9665a2e609fd6174ff7c5b90d8d8e3787c6807 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sun, 18 Sep 2016 15:01:16 -0500 Subject: [PATCH] IT LIVES! (on dotnet core) Commented out RSS feed stuff dependent on SyndicationFeed; revamped bootstrapper to make everything work in the proper order; qualified resource name in Resources project --- src/MyWebLog.App/App.fs | 39 ++++++++++++++++------------ src/MyWebLog.App/CategoryModule.fs | 6 ++--- src/MyWebLog.App/ModuleExtensions.fs | 5 +++- src/MyWebLog.App/PageModule.fs | 15 +++++------ src/MyWebLog.App/PostModule.fs | 29 +++++++++++---------- src/MyWebLog.App/UserModule.fs | 6 ++--- src/MyWebLog.App/ViewModels.fs | 2 +- src/MyWebLog.Resources/Library.fs | 2 +- src/MyWebLog/project.json | 5 +++- src/global.json | 10 +++++++ 10 files changed, 71 insertions(+), 48 deletions(-) create mode 100644 src/global.json diff --git a/src/MyWebLog.App/App.fs b/src/MyWebLog.App/App.fs index b55bff5..c3e451f 100644 --- a/src/MyWebLog.App/App.fs +++ b/src/MyWebLog.App/App.fs @@ -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,9 +46,9 @@ type TranslateTokenViewEngineMatcher() = /// Handle forms authentication type MyWebLogUser(name, claims) = - interface IUserIdentity with - member this.UserName with get() = name - member this.Claims with get() = claims + inherit ClaimsPrincipal() + member this.UserName with get() = name + member this.Claims with get() = claims type MyWebLogUserMapper(container : TinyIoCContainer) = @@ -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(cfg) |> ignore - container.Register(data) + data.Force().SetUp () + container.Register(data.Force ()) |> ignore // NodaTime container.Register(SystemClock.Instance) @@ -99,12 +97,15 @@ type MyWebLogBootstrapper() = container.Register>(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()) @@ -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.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 () = diff --git a/src/MyWebLog.App/CategoryModule.fs b/src/MyWebLog.App/CategoryModule.fs index 4db2534..9b621c2 100644 --- a/src/MyWebLog.App/CategoryModule.fs +++ b/src/MyWebLog.App/CategoryModule.fs @@ -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 () diff --git a/src/MyWebLog.App/ModuleExtensions.fs b/src/MyWebLog.App/ModuleExtensions.fs index 5b412b8..0efca20 100644 --- a/src/MyWebLog.App/ModuleExtensions.fs +++ b/src/MyWebLog.App/ModuleExtensions.fs @@ -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(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 |] diff --git a/src/MyWebLog.App/PageModule.fs b/src/MyWebLog.App/PageModule.fs index dcb24df..0059c28 100644 --- a/src/MyWebLog.App/PageModule.fs +++ b/src/MyWebLog.App/PageModule.fs @@ -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 () - 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 () diff --git a/src/MyWebLog.App/PostModule.fs b/src/MyWebLog.App/PostModule.fs index 7b61779..c28a469 100644 --- a/src/MyWebLog.App/PostModule.fs +++ b/src/MyWebLog.App/PostModule.fs @@ -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() - 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 ',' diff --git a/src/MyWebLog.App/UserModule.fs b/src/MyWebLog.App/UserModule.fs index 4742da7..bc414fe 100644 --- a/src/MyWebLog.App/UserModule.fs +++ b/src/MyWebLog.App/UserModule.fs @@ -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 () 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 (Keys.User, User.Empty) this.Session.DeleteAll () diff --git a/src/MyWebLog.App/ViewModels.fs b/src/MyWebLog.App/ViewModels.fs index 427bcac..c5a9120 100644 --- a/src/MyWebLog.App/ViewModels.fs +++ b/src/MyWebLog.App/ViewModels.fs @@ -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 = diff --git a/src/MyWebLog.Resources/Library.fs b/src/MyWebLog.Resources/Library.fs index 6cba184..6ec3f4b 100644 --- a/src/MyWebLog.Resources/Library.fs +++ b/src/MyWebLog.Resources/Library.fs @@ -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 diff --git a/src/MyWebLog/project.json b/src/MyWebLog/project.json index 8efe313..673b24b 100644 --- a/src/MyWebLog/project.json +++ b/src/MyWebLog/project.json @@ -1,6 +1,9 @@ { "buildOptions": { - "emitEntryPoint": true + "emitEntryPoint": true, + "copyToOutput": { + "include": "views" + } }, "dependencies": { "MyWebLog.App": "0.9.2", diff --git a/src/global.json b/src/global.json new file mode 100644 index 0000000..05d66c1 --- /dev/null +++ b/src/global.json @@ -0,0 +1,10 @@ +{ + "projects":[ + "MyWebLog", + "MyWebLog.App", + "MyWebLog.Data.RethinkDB", + "MyWebLog.Entities", + "MyWebLog.Logic", + "MyWebLog.Resources" + ] +} \ No newline at end of file