.gitignore

@@ -1,7 +1,6 @@
 dist*
 static/tmp/
 static/combined/
-static/uploads/
 config/client_session_key.aes
 *.hi
 *.o
@@ -20,4 +19,3 @@ cabal.sandbox.config
 *~
 \#*
 lebd.cabal
-node_modules/

LICENSE

@@ -1,21 +0,0 @@
-MIT License
-
-Copyright (c) 2017 Danielle McLean
-
-Permission is hereby granted, free of charge, to any person obtaining a copy
-of this software and associated documentation files (the "Software"), to deal
-in the Software without restriction, including without limitation the rights
-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-copies of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in all
-copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-SOFTWARE.

config/models

@@ -1,45 +1,17 @@
 User
     username Text maxlen=190
-    password Text maxlen=79
     fullName Text maxlen=500
     email Text maxlen=190
-    avatar Text maxlen=190
+    note Text
-    note Markdown sqltype=mediumtext
+    UniqueUsername username
-    UniqueUser username
     UniqueEmail email
     deriving Typeable
 
-PgpKey
-    userId UserId
-    fingerprint Text maxlen=40
-    UniqueFingerprint fingerprint
-
 Site
-    name Text sqltype=varchar(255)
     icon Text sqltype=varchar(255)
-    template Text sqltype=varchar(255)
+    url Text sqltype=varchar(255)
 
 Profile
     userId UserId
     siteId SiteId
     username Text sqltype=varchar(255)
-    displayName Text Maybe sqltype=varchar(255)
-
-Entry
-    kind EntryKind maxlen=255
-    name Text Maybe maxlen=255
-    content Markdown sqltype=longtext
-    photo Text Maybe maxlen=190
-    published UTCTime
-    updated UTCTime
-    authorId UserId
-
-Syndication
-    entryId EntryId
-    profileId ProfileId
-    url Text sqltype=varchar(255)
-
-EntryCategory
-    entryId EntryId
-    category Category sqltype=varchar(190)
-    UniqueEntryCategory entryId category

config/routes

@@ -4,15 +4,5 @@
 /favicon.ico FaviconR GET
 /keybase.txt KeybaseR GET
 /robots.txt RobotsR GET
-/sitemap.xml SitemapR GET
 
 / HomeR GET
-/avatars/#UserId AvatarR GET
-/categories/#Category CategoryR GET
-
-/feed FeedR GET
-!/#EntryKind/feed FeedKindR GET
-
-!/#EntryKind EntriesR GET
-!/#EntryKind/#EntryId EntryR GET
-!/#EntryKind/#EntryId/#Slug EntryWithSlugR GET

config/settings.yml

@@ -32,7 +32,4 @@ database:
   poolsize: "_env:MYSQL_POOLSIZE:10"
 
 title: 00dani.me
-app-name: lebd
+#analytics: UA-YOURCODE
-username: dani
-repository: https://gitlab.com/00dani/lebd
-fb-app-id: "_env:FB_APP_ID:142105433189339"

lebd.svg

@@ -1,6 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<svg width="200" height="200" version="1.1" xmlns="http://www.w3.org/2000/svg">
-    <title>lebd</title>
-    <circle id="bg" fill="#343A40" cx="100" cy="100" r="100"></circle>
-    <text id="l" font-family="Arial Unicode MS" font-size="190" fill="#00A6F9" x="15" y="160">ℒ</text>
-</svg>

package-lock.json

@@ -1,28 +0,0 @@
-{
-  "name": "lebd",
-  "version": "1.6.4",
-  "lockfileVersion": 1,
-  "requires": true,
-  "dependencies": {
-    "docopt": {
-      "version": "0.6.2",
-      "resolved": "https://registry.npmjs.org/docopt/-/docopt-0.6.2.tgz",
-      "integrity": "sha1-so6eIiDaXsSffqW7JKR3h0Be6xE=",
-      "dev": true
-    },
-    "openwebicons": {
-      "version": "1.4.3",
-      "resolved": "https://registry.npmjs.org/openwebicons/-/openwebicons-1.4.3.tgz",
-      "integrity": "sha1-Bs7ri4K3Vqv+mQXhq+X/U/o0Z+k="
-    },
-    "sync-version": {
-      "version": "1.0.1",
-      "resolved": "https://registry.npmjs.org/sync-version/-/sync-version-1.0.1.tgz",
-      "integrity": "sha1-Y6aglKmigcUqgA1obqu5ZgH4igs=",
-      "dev": true,
-      "requires": {
-        "docopt": "0.6.2"
-      }
-    }
-  }
-}

package.json

@@ -1,24 +0,0 @@
-{
-  "name": "lebd",
-  "version": "1.6.4",
-  "description": "the codebase backing 00dani.me, an indieweb.org site",
-  "repository": {
-    "type": "git",
-    "url": "https://gitlab.com/00dani/lebd"
-  },
-  "author": "Danielle McLean <dani@00dani.me>",
-  "license": "MIT",
-  "bugs": {
-    "url": "https://gitlab.com/00dani/lebd/issues"
-  },
-  "homepage": "https://gitlab.com/00dani/lebd#README",
-  "devDependencies": {
-    "sync-version": "^1.0.1"
-  },
-  "scripts": {
-    "version": "sync-version package.yaml && git add ."
-  },
-  "dependencies": {
-    "openwebicons": "^1.4.3"
-  }
-}

package.yaml

@@ -1,5 +1,5 @@
 name:    lebd
-version: "1.6.4"
+version: "1.0.2"
 
 dependencies:
 
@@ -46,21 +46,7 @@ dependencies:
 - time
 - case-insensitive
 - wai
-
+- libravatar >=0.4 && <0.5
-- blaze-markup >=0.8 && <0.9
-- conduit-combinators >=1.1 && <1.2
-- esqueleto >=2.5 && <2.6
-- friendly-time >=0.4 && <0.5
-- foreign-store >=0.2 && <0.3
-- markdown >=0.1 && <0.2
-- mustache >=2.2 && <2.3
-- parsec >=3.1 && <3.2
-- slug >=0.1 && <0.2
-- split >=0.2 && <0.3
-- unix >=2.7 && <2.8
-- yesod-auth-hashdb >=1.6.2 && <1.7
-- yesod-newsfeed >=1.6 && <1.7
-- yesod-sitemap >=1.4 && <1.5
 
 # The library contains all of our application code. The executable
 # defined below is just a thin wrapper.

src/Application.hs

@@ -6,7 +6,6 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Application
     ( getApplicationDev
@@ -48,11 +47,7 @@ import System.Log.FastLogger                (defaultBufSize, newStdoutLoggerSet,
 
 -- Import all relevant handler modules here.
 -- Don't forget to add new modules to your cabal file!
-import Handler.Avatars
 import Handler.Common
-import Handler.Categories
-import Handler.Entries
-import Handler.Feed
 import Handler.Home
 
 -- This line actually creates our YesodDispatch instance. It is the second half

src/Foundation.hs

@@ -11,27 +11,16 @@ import Import.NoFoundation
 import Database.Persist.Sql (ConnectionPool, runSqlPool)
 import Text.Hamlet          (hamletFile)
 import Text.Jasmine         (minifym)
-import Web.Slug             (Slug)
 
-import Yesod.Auth.HashDB    (authHashDBWithForm)
+-- Used only when in "auth-dummy-login" setting is enabled.
-import qualified Yesod.Auth.Message as AuthMsg
+import Yesod.Auth.Dummy
 
+import Yesod.Auth.OpenId    (authOpenId, IdentifierType (Claimed))
 import Yesod.Default.Util   (addStaticContentExternal)
 import Yesod.Core.Types     (Logger)
 import qualified Yesod.Core.Unsafe as Unsafe
-
+import qualified Data.CaseInsensitive as CI
-import Package
+import qualified Data.Text.Encoding as TE
-import Model.Cache ( getCached )
-import Model.Category ( Category )
-import Model.Entry ( entryTitle )
-import Model.Entry.Kind ( EntryKind, allEntryKinds, pluralise )
-import SchemaOrg.BreadcrumbList ( breadcrumbList )
-
-import Data.Aeson ( encode )
-import qualified Text.Blaze.Internal as B
-import qualified Data.Text as T
-import qualified Data.Text.Lazy.Encoding as E
-import qualified System.Posix.Files as F
 
 -- | The foundation datatype for your application. This can be a good place to
 -- keep settings and values requiring initialization before your application
@@ -48,8 +37,13 @@ data App = App
 data MenuItem = MenuItem
     { menuItemLabel :: Text
     , menuItemRoute :: Route App
+    , menuItemAccessCallback :: Bool
     }
 
+data MenuTypes
+    = NavbarLeft MenuItem
+    | NavbarRight MenuItem
+
 -- This is where we define all of the routes in our application. For a full
 -- explanation of the syntax, please see:
 -- http://www.yesodweb.com/book/routing-and-handlers
@@ -67,20 +61,20 @@ mkYesodData "App" $(parseRoutesFile "config/routes")
 -- | A convenient synonym for creating forms.
 type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget)
 
-sessionLifetime :: Int
-sessionLifetime = 120 -- minutes
-
 -- Please see the documentation for the Yesod typeclass. There are a number
 -- of settings which can be configured by overriding methods here.
 instance Yesod App where
     -- Controls the base of generated URLs. For more information on modifying,
     -- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot
-    approot = ApprootMaster $ fromMaybe "localhost" . appRoot . appSettings
+    approot = ApprootRequest $ \app req ->
+        case appRoot $ appSettings app of
+            Nothing -> getApprootText guessApproot app req
+            Just root -> root
 
     -- Store session data on the client in encrypted cookies,
     -- default session idle timeout is 120 minutes
     makeSessionBackend _ = sslOnlySessions . strictSameSiteSessions $ Just <$> defaultClientSessionBackend
-        sessionLifetime
+        120    -- timeout in minutes
         "config/client_session_key.aes"
 
     -- Redirect static requests to a subdomain - this is recommended for best
@@ -100,21 +94,26 @@ instance Yesod App where
     --   b) Validates that incoming write requests include that token in either a header or POST parameter.
     -- To add it, chain it together with the defaultMiddleware: yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
     -- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package.
-    yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware . sslOnlyMiddleware sessionLifetime
+    yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
 
     defaultLayout widget = do
         master <- getYesod
         mmsg <- getMessage
 
-        muser <- maybeAuthPair
+        -- muser <- maybeAuthPair
         mcurrentRoute <- getCurrentRoute
 
         -- Get the breadcrumbs, as defined in the YesodBreadcrumbs instance.
-        (title, crumbs) <- breadcrumbs
+        (title, parents) <- breadcrumbs
-        let allCrumbs = maybe crumbs (\route -> crumbs ++ [(route, title)]) mcurrentRoute
-        jsonCrumbs <- fmap (E.decodeUtf8 . encode) . withUrlRenderer $ breadcrumbList allCrumbs
 
-        let navbars = [leftMenuItems, rightMenuItems] <*> [muser]
+        -- Define the menu items of the header.
+        let menuItems = []
+
+        let navbarLeftMenuItems = [x | NavbarLeft x <- menuItems]
+        let navbarRightMenuItems = [x | NavbarRight x <- menuItems]
+
+        let navbarLeftFilteredMenuItems = [x | x <- navbarLeftMenuItems, menuItemAccessCallback x]
+        let navbarRightFilteredMenuItems = [x | x <- navbarRightMenuItems, menuItemAccessCallback x]
 
         -- We break up the default layout into two components:
         -- default-layout is the contents of the body tag, and
@@ -123,16 +122,18 @@ instance Yesod App where
         -- you to use normal widget features in default-layout.
 
         pc <- widgetToPageContent $(widgetFile "default-layout")
-        let globalTitle = toHtml . siteTitle . appSettings $ master
-            hasPageTitle = not . B.null $ pageTitle pc
-            fullTitle = if hasPageTitle then mconcat [pageTitle pc, " ~ ", globalTitle] else globalTitle
         withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
 
     -- The page to be redirected to when authentication is required.
     authRoute _ = Just $ AuthR LoginR
 
     -- Routes not requiring authentication.
-    isAuthorized _ _ = return Authorized
+    isAuthorized (AuthR _) _ = return Authorized
+    isAuthorized HomeR _ = return Authorized
+    isAuthorized FaviconR _ = return Authorized
+    isAuthorized KeybaseR _ = return Authorized
+    isAuthorized RobotsR _ = return Authorized
+    isAuthorized (StaticR _) _ = return Authorized
 
     -- This function creates static content files in the static folder
     -- and names them based on a hash of their content. This allows
@@ -141,7 +142,7 @@ instance Yesod App where
     addStaticContent ext mime content = do
         master <- getYesod
         let staticDir = appStaticDir $ appSettings master
-        external <- addStaticContentExternal
+        addStaticContentExternal
             minifym
             genFileName
             staticDir
@@ -149,13 +150,6 @@ instance Yesod App where
             ext
             mime
             content
-        case external of
-          (Just (Right (StaticR (StaticRoute filePath _), _))) -> liftIO $ do
-            let staticPath = ((staticDir ++ "/") ++) . T.unpack . T.intercalate "/" $ filePath
-            mode <- F.fileMode <$> F.getFileStatus staticPath
-            F.setFileMode staticPath $ mode `F.unionFileModes` F.groupReadMode
-          _ -> return ()
-        return external
       where
         -- Generate a unique filename based on the content itself
         genFileName lbs = "autogen-" ++ base64md5 lbs
@@ -169,26 +163,10 @@ instance Yesod App where
 
     makeLogger = return . appLogger
 
-leftMenuItems, rightMenuItems :: Maybe (UserId, User) -> [MenuItem]
-leftMenuItems _ = toMenuItem <$> take 5 allEntryKinds
-  where toMenuItem kind = pluralise kind `MenuItem` EntriesR kind
-rightMenuItems = loggedOutItems `maybe` loggedInItems
-  where loggedOutItems =
-          [ "log in" `MenuItem` AuthR LoginR
-          ]
-        loggedInItems (_id, user) =
-          [ userUsername user `MenuItem` HomeR
-          , "log out" `MenuItem` AuthR LogoutR
-          ]
-
 -- Define breadcrumbs.
 instance YesodBreadcrumbs App where
-  breadcrumb (AuthR _) = return ("log in", Just HomeR)
+  breadcrumb HomeR = return ("Home", Nothing)
-  breadcrumb (EntriesR kind) = return (pluralise kind, Just HomeR)
+  breadcrumb (AuthR _) = return ("Login", Just HomeR)
-  breadcrumb (EntryR kind entryId) = do
-    (Entity _ entry) <- getCached entryId
-    return (entryTitle entry, Just $ EntriesR kind)
-  breadcrumb (EntryWithSlugR kind entryId _) = breadcrumb $ EntryR kind entryId
   breadcrumb  _ = return ("home", Nothing)
 
 -- How to run database actions.
@@ -207,19 +185,25 @@ instance YesodAuth App where
     loginDest _ = HomeR
     -- Where to send a user after logout
     logoutDest _ = HomeR
+    -- Override the above two destinations when a Referer: header is present
+    redirectToReferer _ = True
 
-    authenticate = fmap toResult . lookupCreds
+    authenticate creds = runDB $ do
-      where
+        x <- getBy . UniqueUsername $ credsIdent creds
-        lookupCreds = runDB . getBy . UniqueUser . credsIdent
+        case x of
-        toResult = UserError AuthMsg.InvalidLogin `maybe` (Authenticated . entityKey)
+            Just (Entity uid _) -> return $ Authenticated uid
+            Nothing -> Authenticated <$> insert User
+                { userUsername = credsIdent creds
+                , userFullName = ""
+                , userEmail = ""
+                , userNote = ""
+                }
 
     -- You can add other plugins like Google Email, email or OAuth here
-    authPlugins _ = [authHashDBWithForm loginForm (Just . UniqueUser)]
+    authPlugins app = [authOpenId Claimed []] ++ extraAuthPlugins
-      where loginForm :: Route App -> Widget
+        -- Enable authDummy login if enabled.
-            loginForm action = do
+        where extraAuthPlugins = [authDummy | appAuthDummyLogin $ appSettings app]
-              mtok <- reqToken <$> getRequest
+
-              setTitle "log in"
-              $(widgetFile "auth/login")
     authHttpManager = getHttpManager
 
 -- | Access function to determine if a user is logged in.
@@ -253,7 +237,3 @@ unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
 -- https://github.com/yesodweb/yesod/wiki/Sending-email
 -- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain
 -- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding
-userProfile :: User -> Route App
-userProfile user
-  | userUsername user == siteUsername compileTimeAppSettings = HomeR
-  | otherwise = error "Multiple profile pages are not yet supported"

src/Handler/Avatars.hs

@@ -1,17 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Handler.Avatars where
-
-import Import hiding ( (==.) )
-
-import Database.Esqueleto
-import Settings.StaticR ( staticR ) 
-
-getAvatarR :: UserId -> Handler ()
-getAvatarR = responseFrom <=< runDB . select . from . queryAvatar
-    where responseFrom (a:_) = redirect $ staticR ["img", unValue a]
-          responseFrom    [] = notFound
-          queryAvatar userId user = do
-              where_ $ user ^. UserId ==. val userId
-              return $ user ^. UserAvatar

src/Handler/Categories.hs

@@ -1,22 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Handler.Categories where
-
-import Import hiding ( on, (==.) )
-
-import Database.Esqueleto
-import Widget.Feed ( hFeed )
-import Model.Category ( Category, asTag )
-
-import qualified Data.Text as T
-
-getCategoryR :: Category -> Handler Html
-getCategoryR tag = do
-    title <- asks $ siteTitle . appSettings
-    entries <- runDB . select . from $ \(entry `InnerJoin` category) -> do
-        on $ entry ^. EntryId ==. category ^. EntryCategoryEntryId
-        where_ $ category ^. EntryCategoryCategory ==. val tag
-        return entry
-    defaultLayout $ do
-        setTitle . toHtml . asTag $ tag
-        T.concat [asTag tag, " ~ ", title] `hFeed` entries

src/Handler/Common.hs

@@ -7,15 +7,8 @@
 module Handler.Common where
 
 import Data.FileEmbed (embedFile)
-import Database.Esqueleto ( (^.) )
-import qualified Database.Esqueleto as E
-import Yesod.Sitemap
-
 import Import
 
-import Model.Entry.Kind ( allEntryKinds )
-import Widget.Entry ( entryR )
-
 -- These handlers embed files in the executable at compile time to avoid a
 -- runtime dependency, and for efficiency.
 
@@ -28,35 +21,6 @@ getKeybaseR :: Handler TypedContent
 getKeybaseR = return $ TypedContent typePlain
                      $ toContent $(embedFile "config/keybase.txt")
 
-getRobotsR :: Handler Text
+getRobotsR :: Handler TypedContent
-getRobotsR = robots SitemapR
+getRobotsR = return $ TypedContent typePlain
-
+                    $ toContent $(embedFile "config/robots.txt")
-getSitemapR :: Handler TypedContent
-getSitemapR = do
-    categories <- runDB . E.select . E.distinct . E.from $ \ec -> do
-        E.orderBy [E.asc $ ec ^. EntryCategoryCategory]
-        return $ ec ^. EntryCategoryCategory
-    entries <- runDB $ selectList [] [Desc EntryPublished]
-    sitemap $ do
-        yield SitemapUrl
-            { sitemapLoc = HomeR
-            , sitemapLastMod = Nothing
-            , sitemapChangeFreq = Just Daily
-            , sitemapPriority = Nothing
-            }
-        yieldMany $ sitemapUrl . CategoryR . E.unValue <$> categories
-        yieldMany $ sitemapUrl . EntriesR <$> allEntryKinds
-        yieldMany $ entryToSitemapUrl <$> entries
-
-sitemapUrl :: a -> SitemapUrl a
-sitemapUrl loc = SitemapUrl
-    { sitemapLoc = loc
-    , sitemapLastMod = Nothing
-    , sitemapChangeFreq = Nothing
-    , sitemapPriority = Nothing
-    }
-
-entryToSitemapUrl :: Entity Entry -> SitemapUrl (Route App)
-entryToSitemapUrl entry = (sitemapUrl $ entryR entry)
-    { sitemapLastMod = Just . entryUpdated . entityVal $ entry
-    }

src/Handler/Entries.hs

@@ -1,54 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Handler.Entries where
-
-import Import
-
-import Yesod.AtomFeed ( atomLink )
-
-import Model.Cache ( getCached )
-import Model.Entry ( entryTitle )
-import Model.Markdown ( unMarkdown )
-import Widget.Entry ( entryR, hEntry )
-import Widget.Feed ( hFeed )
-
-import qualified Data.Text as T
-import qualified Model.Entry.Kind as K
-
-getEntriesR :: K.EntryKind -> Handler Html
-getEntriesR kind = do
-    entries <- runDB $ selectList [EntryKind ==. kind] [Desc EntryPublished]
-    title <- asks $ siteTitle . appSettings
-    let myTitle = T.concat [K.pluralise kind, " ~ ", title]
-    defaultLayout $ do
-        setTitle . toHtml . K.pluralise $ kind
-        FeedKindR kind `atomLink` myTitle
-        hFeed myTitle entries
-
-getEntryR :: a -> EntryId -> Handler Html
-getEntryR _ = renderEntry <=< getCached
-
-getEntryWithSlugR :: a -> EntryId -> b -> Handler Html
-getEntryWithSlugR kind = const . getEntryR kind
-
-renderEntry :: (Entity Entry) -> Handler Html
-renderEntry entry = do
-    let correctRoute = entryR entry
-    actualRoute <- getCurrentRoute
-    author <- getCached . entryAuthorId $ entityVal entry
-    when (actualRoute /= Just correctRoute) $
-        redirectWith movedPermanently301 correctRoute
-    defaultLayout $ do
-        setTitle . toHtml . entryTitle . entityVal $ entry
-        toWidgetHead [hamlet|
-            <meta name="author" content=#{userFullName $ entityVal author}>
-            <link rel="author" href=@{userProfile $ entityVal author}>
-            <meta name="description" content=#{unMarkdown $ entryContent $ entityVal entry}>
-            <meta property="og:title" content=#{entryTitle $ entityVal entry}>
-            <meta property="og:type" content="article">
-            <meta property="og:description" content=#{unMarkdown $ entryContent $ entityVal entry}>
-            <meta property="article:author" content=@{userProfile $ entityVal author}>
-            <meta property="article:section" content=#{K.pluralise $ entryKind $ entityVal entry}>
-            |]
-        hEntry entry

src/Handler/Feed.hs

@@ -1,54 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Handler.Feed where
-
-import Import
-
-import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
-import Model.Entry ( entryTitle )
-import Widget.Entry ( entryR )
-
-import qualified Data.Text as T
-import qualified Model.Entry.Kind as K
-
-getFeedR :: Handler TypedContent
-getFeedR = do
-    entries <- runDB $ selectList [] [Desc EntryPublished]
-    newsFeed $ toFeed entries
-
-getFeedKindR :: K.EntryKind -> Handler TypedContent
-getFeedKindR kind = do
-    entries <- runDB $ selectList [EntryKind ==. kind] [Desc EntryPublished]
-    let basicFeed = toFeed entries
-    newsFeed $ basicFeed
-        { feedTitle = T.concat [K.pluralise kind, " ~ ", feedTitle basicFeed]
-        , feedDescription = toHtml $ T.concat ["feed of all ", K.pluralise kind]
-        , feedLinkSelf = FeedKindR kind
-        , feedLinkHome = EntriesR kind
-        }
-
-toFeed :: [Entity Entry] -> Feed (Route App)
-toFeed entries@(latestEntry:_) = (toFeed [])
-    { feedEntries = toFeedEntry <$> entries
-    , feedUpdated = entryUpdated $ entityVal latestEntry
-    }
-toFeed [] = Feed
-    { feedTitle = siteTitle compileTimeAppSettings
-    , feedLinkSelf = FeedR
-    , feedLinkHome = HomeR
-    , feedAuthor = ""
-    , feedDescription = "sitewide feed of all entries"
-    , feedLanguage = "en-au"
-    , feedUpdated = posixSecondsToUTCTime 0
-    , feedLogo = Nothing
-    , feedEntries = []
-    }
-
-toFeedEntry :: Entity Entry -> FeedEntry (Route App)
-toFeedEntry entry = FeedEntry
-    { feedEntryLink = entryR entry
-    , feedEntryUpdated = entryUpdated $ entityVal entry
-    , feedEntryTitle = entryTitle $ entityVal entry
-    , feedEntryContent = toHtml . entryContent . entityVal $ entry
-    , feedEntryEnclosure = Nothing
-    }

src/Handler/Home.hs

@@ -1,23 +1,14 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
 module Handler.Home where
 
 import Import
-
+import Widget.Hcard (hcard)
-import Yesod.AtomFeed ( atomLink )
-
-import Widget.Card ( hCard )
-import Widget.Feed ( hFeed )
 
 getHomeR :: Handler Html
 getHomeR = do
-    settings <- asks appSettings
+    user <- runDB . getBy404 $ UniqueUsername "dani"
-    user <- runDB . getBy404 . UniqueUser . siteUsername $ settings
+    defaultLayout $(widgetFile "home")
-    let title = siteTitle settings
-    entries <- runDB $ selectList [EntryAuthorId ==. entityKey user] [Desc EntryPublished]
-    defaultLayout $ do
-        atomLink FeedR title
-        $(widgetFile "home")

src/Import.hs

@@ -3,5 +3,4 @@ module Import
     ) where
 
 import Foundation            as Import
-import Settings.StaticR      as Import
 import Import.NoFoundation   as Import

src/Model.hs

@@ -11,13 +11,6 @@ module Model where
 
 import ClassyPrelude.Yesod
 import Database.Persist.Quasi
-import Yesod.Auth.HashDB ( HashDBUser(..) )
-import Text.Mustache ( (~>) )
-import qualified Text.Mustache as M
-
-import Model.Category ( Category )
-import Model.Entry.Kind ( EntryKind )
-import Model.Markdown ( Markdown )
 
 -- You can define all of your database entities in the entities file.
 -- You can find more information on persistent and how to declare entities
@@ -25,12 +18,3 @@ import Model.Markdown ( Markdown )
 -- http://www.yesodweb.com/book/persistent/
 share [mkPersist sqlSettings, mkMigrate "migrateAll"]
     $(persistFileWith lowerCaseSettings "config/models")
-
-instance HashDBUser User where
-  userPasswordHash = Just . userPassword
-  setPasswordHash pw u = u { userPassword = pw }
-
-instance M.ToMustache Profile where
-  toMustache p = M.object
-    [ "username" ~> profileUsername p
-    ]

src/Model/Cache.hs

@@ -1,23 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TypeFamilies #-}
-module Model.Cache ( getCached ) where
-
-import Data.Typeable ( Typeable )
-import Database.Persist ( Entity (..), Key (..), PersistStore, PersistRecordBackend, keyToValues )
-import Yesod ( MonadHandler, HandlerSite, YesodPersist, YesodPersistBackend, cachedBy, get404, liftHandlerT, runDB )
-
-import qualified Data.ByteString.Char8 as C
-
-newtype CachedEntity t = CachedEntity { unCachedEntity :: Entity t } deriving Typeable
-
-getCached :: ( MonadHandler m
-             , YesodPersist (HandlerSite m)
-             , PersistStore (YesodPersistBackend (HandlerSite m))
-             , PersistRecordBackend entity (YesodPersistBackend (HandlerSite m))
-             , Typeable entity
-             ) => Key entity -> m (Entity entity)
-getCached entId = liftHandlerT . cached . runDB . withId . get404 $ entId
-    where key = C.pack . show . keyToValues $ entId
-          withId = fmap $ Entity entId
-          cached = fmap unCachedEntity . cachedBy key . fmap CachedEntity

src/Model/Category.hs

@@ -1,14 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Model.Category where
-
-import Database.Persist ( PersistField )
-import Web.Slug ( Slug, unSlug )
-import Yesod ( PathPiece )
-
-import qualified Data.Text as T
-
-newtype Category = Category { unCategory :: Slug }
-    deriving (Eq, Read, Show, PathPiece, PersistField)
-
-asTag :: Category -> T.Text
-asTag = T.cons '#' . unSlug . unCategory

src/Model/Entry.hs

@@ -1,30 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Model.Entry where
-
-import Model ( Entry, entryName, entryContent )
-import Model.Markdown ( Markdown(Markdown), unMarkdown )
-import Data.Maybe ( fromMaybe )
-
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
-
-entryTitle :: Entry -> T.Text
-entryTitle = fromMaybe <$> TL.toStrict . unMarkdown . shorten 30 . entryContent <*> entryName
-
-class Shorten a where
-  shorten :: Int -> a -> a
-
-instance Shorten T.Text where
-  shorten i t
-    | T.compareLength t n == GT = flip T.append "..." . T.take (n - 1) $ t
-    | otherwise                 = t
-    where n = fromIntegral i
-
-instance Shorten TL.Text where
-  shorten i t
-    | TL.compareLength t n == GT = flip TL.append "..." . TL.take (n - 1) $ t
-    | otherwise                  = t
-    where n = fromIntegral i
-
-instance Shorten Markdown where
-  shorten n (Markdown t) = Markdown $ shorten n t

src/Model/Entry/Kind.hs

@@ -1,32 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-module Model.Entry.Kind where
-
-import Database.Persist.TH ( derivePersistField )
-import Yesod.Core.Dispatch ( PathPiece, toPathPiece, fromPathPiece )
-
-import qualified Data.Text as T
-import Text.Read ( readMaybe )
-
-data EntryKind = Note | Article | Photo | Video | Audio
-               | Reply | Repost | Like | Favourite | Bookmark | Quote | Rsvp
-               | Listen | Jam | Watch | Play | Read
-              deriving (Enum, Eq, Read, Show)
-derivePersistField "EntryKind"
-
-allEntryKinds :: [EntryKind]
-allEntryKinds = [Note ..]
-
-singularise :: T.Text -> Maybe EntryKind
-singularise "replies" = Just Reply
-singularise "watches" = Just Watch
-singularise k = readMaybe . T.unpack . T.toTitle . T.init $ k
-
-pluralise :: EntryKind -> T.Text
-pluralise Reply = "replies"
-pluralise Watch = "watches"
-pluralise k = T.toLower . flip T.snoc 's' . T.pack . show $ k
-
-instance PathPiece EntryKind where
-    toPathPiece = pluralise
-    fromPathPiece = singularise

src/Model/Markdown.hs

@@ -1,38 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Model.Markdown ( Markdown(..) ) where
-
-import Data.Aeson ( FromJSON(..), ToJSON(..), Value(Object), object, (.=), (.:) )
-import Data.Default ( def )
-import Database.Persist ( PersistField(..), PersistValue(PersistText) )
-import Database.Persist.Sql ( PersistFieldSql(..), SqlType(SqlString) )
-import Data.String ( IsString )
-import Text.Blaze ( ToMarkup(..) )
-import Text.Markdown ( markdown )
-
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
-
-newtype Markdown = Markdown { unMarkdown :: TL.Text }
-    deriving (Eq, Ord, Monoid, IsString, Show)
-
-instance ToMarkup Markdown where
-    toMarkup (Markdown t) = markdown def t
-
-instance PersistField Markdown where
-    toPersistValue (Markdown t) = PersistText $ TL.toStrict t
-    fromPersistValue (PersistText t) = Right . Markdown $ TL.fromStrict t
-    fromPersistValue wrongValue = Left $ T.concat
-        [ "Model.Markdown: When attempting to create Markdown from a PersistValue, received "
-        , T.pack $ show wrongValue
-        , " when a value of type PersistText was expected."
-        ]
-instance PersistFieldSql Markdown where
-    sqlType _ = SqlString
-
-instance ToJSON Markdown where
-    toJSON (Markdown text) = object ["markdown" .= text]
-
-instance FromJSON Markdown where
-    parseJSON (Object v) = Markdown <$> v .: "markdown"
-    parseJSON _ = mempty

src/Package.hs

@@ -1,21 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Package ( Package(..)
-               , Repository(..)
-               , package
-               ) where
-
-import Data.Aeson ( eitherDecodeStrict )
-import Data.Either ( either )
-import Language.Haskell.TH.Syntax ( addDependentFile, lift, runIO )
-import Package.Types
-
-import qualified Data.ByteString as B
-
-package :: Package
-package = $(do
-    let f = "package.json"
-    addDependentFile f
-    json <- runIO $ B.readFile f
-    let result = eitherDecodeStrict json :: Either String Package
-    either fail lift result)

src/Package/Types.hs

@@ -1,27 +0,0 @@
-{-# LANGUAGE DeriveLift #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
-
-module Package.Types where
-
-import Data.Aeson
-import Data.Aeson.Types ( fieldLabelModifier )
-import Data.Aeson.TH ( deriveJSON )
-
-import Data.Char ( toLower )
-import Language.Haskell.TH.Syntax ( Lift )
-import Util ( mapFirst )
-
-data Package = Package
-    { packageName :: !String
-    , packageVersion :: !String
-    , packageRepository :: !Repository
-    } deriving (Show, Lift)
-
-data Repository = Repository
-    { repositoryType :: !String
-    , repositoryUrl :: !String
-    } deriving (Show, Lift)
-
-$(deriveJSON defaultOptions { fieldLabelModifier = mapFirst toLower . drop 7 } ''Package)
-$(deriveJSON defaultOptions { fieldLabelModifier = mapFirst toLower . drop 10 } ''Repository)

src/SchemaOrg/BreadcrumbList.hs

@@ -1,21 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module SchemaOrg.BreadcrumbList ( breadcrumbList ) where
-
-import Data.Aeson
-import qualified Data.Text as T
-
-breadcrumbList :: [(a, T.Text)] -> (a -> [(T.Text, T.Text)] -> T.Text) -> Value
-breadcrumbList crumbs url = object
-  [ ("@context", "http://schema.org")
-  , ("@type", "BreadcrumbList")
-  , "itemListElement" .= zipWith (listItem url) [1 :: Int ..] crumbs
-  ]
-listItem :: (a -> [(T.Text, T.Text)] -> T.Text) -> Int -> (a, T.Text) -> Value
-listItem url i (r, t) = object
-  [ ("@type", "ListItem")
-  , "position" .= i
-  , "item" .= object
-    [ "@id" .= url r []
-    , "name" .= t
-    ]
-  ]

src/Settings.hs

@@ -19,8 +19,9 @@ import Data.Yaml                  (decodeEither')
 import Database.Persist.MySQL     (MySQLConf (..))
 import Language.Haskell.TH.Syntax (Exp, Name, Q)
 import Network.Wai.Handler.Warp   (HostPreference)
+import Text.Hamlet                (HamletSettings(hamletNewlines), NewlineStyle(AlwaysNewlines), defaultHamletSettings)
 import Yesod.Default.Config2      (applyEnvValue, configSettingsYml)
-import Yesod.Default.Util         (WidgetFileSettings, widgetFileNoReload,
+import Yesod.Default.Util         (WidgetFileSettings(wfsHamletSettings), widgetFileNoReload,
                                    widgetFileReload)
 import qualified Database.MySQL.Base as MySQL
 
@@ -58,14 +59,11 @@ data AppSettings = AppSettings
     , appSkipCombining          :: Bool
     -- ^ Perform no stylesheet/script combining
 
-    , appFacebookId          :: Maybe Int
+    -- Example app-specific configuration values.
-    -- ^ Facebook app ID.
+    , appAnalytics              :: Maybe Text
-
+    -- ^ Google Analytics code
-    , siteTitle                 :: Text
+    , appTitle                  :: Maybe Text
     -- ^ Site-wide title.
-    , siteUsername              :: Text
-    -- ^ Username of the site's main user, whose h-card will appear on the
-    -- homepage.
 
     , appAuthDummyLogin         :: Bool
     -- ^ Indicate if auth dummy login should be enabled.
@@ -94,9 +92,8 @@ instance FromJSON AppSettings where
         appMutableStatic          <- o .:? "mutable-static"   .!= defaultDev
         appSkipCombining          <- o .:? "skip-combining"   .!= defaultDev
 
-        appFacebookId             <- o .:? "fb-app-id"
+        appAnalytics              <- o .:? "analytics"
-        siteTitle                 <- o .: "title"
+        appTitle                  <- o .:? "title"
-        siteUsername              <- o .: "username"
 
         -- This code enables MySQL's strict mode, without which MySQL will truncate data.
         -- See https://github.com/yesodweb/persistent/wiki/Database-Configuration#strict-mode for details
@@ -119,7 +116,7 @@ instance FromJSON AppSettings where
 --
 -- https://github.com/yesodweb/yesod/wiki/Overriding-widgetFile
 widgetFileSettings :: WidgetFileSettings
-widgetFileSettings = def
+widgetFileSettings = def { wfsHamletSettings = defaultHamletSettings { hamletNewlines = AlwaysNewlines } }
 
 -- | How static files should be combined.
 combineSettings :: CombineSettings

src/Settings/StaticR.hs

@@ -1,21 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
-module Settings.StaticR ( staticR ) where
-
-import Foundation ( App, Route(StaticR) )
-import Settings ( appStaticDir, compileTimeAppSettings )
-import Yesod.Static ( Route(StaticRoute) )
-
-import Settings.StaticR.TH ( mkHashMap )
-
-import qualified Data.Map as M
-import qualified Data.Text as T
-
-staticR :: [T.Text] -> Route App
-staticR pieces = StaticR $ StaticRoute pieces params
-    where params = case pieces `M.lookup` staticMap of
-                     Just etag -> [("etag", etag)]
-                     Nothing -> []
-
-staticMap :: M.Map [T.Text] T.Text
-staticMap = M.fromList $(mkHashMap . appStaticDir $ compileTimeAppSettings)

src/Settings/StaticR/TH.hs

@@ -1,25 +0,0 @@
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE TupleSections     #-}
-module Settings.StaticR.TH ( mkHashMap ) where
-
-import Conduit hiding ( lift )
-import Data.List.Split ( splitOn )
-import Language.Haskell.TH.Syntax ( Q, Exp, lift, runIO )
-import Yesod.Static ( base64md5 )
-
-import qualified Data.ByteString.Lazy as L
-
-base64md5File :: MonadIO m => FilePath -> m String
-base64md5File = fmap base64md5 . liftIO . L.readFile
-
-genHashPair :: MonadIO m => FilePath -> m ([String], String)
-genHashPair fp = (tail $ splitOn "/" fp,) <$> base64md5File fp
-
-genHashMap :: FilePath -> IO [([String], String)]
-genHashMap dir = runConduitRes
-               $ sourceDirectoryDeep True dir
-              .| mapMC genHashPair
-              .| sinkList
-
-mkHashMap :: FilePath -> Q Exp
-mkHashMap fp = lift =<< runIO (genHashMap fp)

src/Util.hs

@@ -1,26 +0,0 @@
-module Util ( compileMustache, entityToTuple, mapFirst ) where
-
-import Database.Persist ( Entity(..), Key )
-import Text.Mustache ( Template(..), compileTemplate )
-import Text.Mustache.Types ( Node(TextBlock) )
-import Text.Parsec.Error ( ParseError )
-
-import qualified Data.Text as T
-import qualified Data.HashMap.Lazy as M
-
-mapFirst :: (a -> a) -> [a] -> [a]
-mapFirst f (x:xs) = f x : xs
-mapFirst _ [] = []
-
-compileMustache :: String -> T.Text -> Template
-compileMustache n = either errorTemplate id . compileTemplate n
-
-errorTemplate :: ParseError -> Template
-errorTemplate err = Template
-    { name = "error"
-    , ast = [TextBlock . T.pack $ show err]
-    , partials = M.empty
-    }
-
-entityToTuple :: Entity t -> (Key t, t)
-entityToTuple (Entity key value) = (key, value)

src/Widget/Card.hs

@@ -1,56 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
-module Widget.Card ( hCard ) where
-
-import Import
-
-import Database.Esqueleto ( (^.) )
-import qualified Database.Esqueleto as E
-
-import Model.Markdown ( unMarkdown )
-import Text.Mustache ( substitute )
-import Util ( compileMustache )
-
-import qualified Data.Text as T
-
-prettyPgp :: PgpKey -> Text
-prettyPgp = T.unwords . T.chunksOf 4 . pgpKeyFingerprint
-
-routeFromPgp :: PgpKey -> Route App
-routeFromPgp PgpKey { pgpKeyFingerprint = f } = staticR ["pgp", T.takeEnd 8 f ++ ".asc"]
-
-profileUrl :: Site -> Profile -> Text
-profileUrl site = substitute $ T.unpack (siteName site) `compileMustache` siteTemplate site
-
-hCard :: Entity User -> Widget
-hCard (Entity userId user) = do
-    let (firstName:lastName) = T.words $ userFullName user
-    mcurrentRoute <- getCurrentRoute
-    userProfiles <- handlerToWidget . runDB . E.select . E.from $ \(profile `E.InnerJoin` site) -> do
-        E.on $ profile ^. ProfileSiteId E.==. site ^. SiteId
-        E.where_ $ profile ^. ProfileUserId E.==. E.val userId
-        E.orderBy [E.asc $ site ^. SiteName]
-        return (site, profile)
-    pgpKeys <- handlerToWidget . runDB $ map entityVal <$> selectList [PgpKeyUserId ==. userId] []
-    let maybeFb = find (\(Entity _ site, _) -> "Facebook" == siteName site) userProfiles
-
-    toWidgetHead [hamlet|
-        <meta name="author" content=#{userFullName user}>
-        <meta name="description" content=#{unMarkdown $ userNote user}>
-        <link rel="author" href=@{HomeR}>
-        <meta property="og:type" content="profile">
-        <meta property="og:title" content="#{userFullName user}">
-        <meta property="og:description" content=#{unMarkdown $ userNote user}>
-        <meta property="og:image" content=@{staticR ["img", userAvatar user]}>
-        <meta property="profile:first_name" content=#{firstName}>
-        <meta property="profile:last_name" content=#{T.unwords lastName}>
-        <meta property="profile:username" content=#{userUsername user}>
-        $maybe (_, Entity _ fb) <- maybeFb
-            <meta property="fb:profile_id" content=#{profileUsername fb}>
-        $forall key <- pgpKeys
-            <link rel="pgpkey" type="application/pgp-keys" href=@{routeFromPgp key}>
-    |]
-
-    $(widgetFile "mf2/h-card")

src/Widget/Entry.hs

@@ -1,42 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-module Widget.Entry ( entryR, hEntry ) where
-
-import Import
-
-import Database.Esqueleto ( (^.) )
-import qualified Database.Esqueleto as E
-import Data.Time.Format ( defaultTimeLocale, formatTime, iso8601DateFormat )
-import Data.Time.Format.Human ( humanReadableTime )
-import Model.Entry ( entryTitle )
-import Web.Slug ( mkSlug )
-
-data FormattedTime = FormattedTime
-    { timeUnfriendly :: String
-    , timeFriendly :: String
-    } deriving Eq
-
-toFormattedTime :: MonadIO m => UTCTime -> m FormattedTime
-toFormattedTime time = FormattedTime (unfriendly time) <$> friendly time
-    where unfriendly = formatTime defaultTimeLocale . iso8601DateFormat . Just $ "%H:%M:%S%z"
-          friendly = liftIO . humanReadableTime
-
-entryR :: Entity Entry -> Route App
-entryR (Entity entryId Entry {..}) = route (entryName >>= mkSlug) entryKind entryId
-    where route (Just s) = \k i -> EntryWithSlugR k i s
-          route Nothing  = EntryR
-
-hEntry :: Entity Entry -> Widget
-hEntry (Entity entryId entry) = do
-    published <- toFormattedTime . entryPublished $ entry
-    updated <- toFormattedTime . entryUpdated $ entry
-    posses <- handlerToWidget . runDB . E.select . E.from $ \(syndication `E.InnerJoin` profile `E.InnerJoin` site) -> do
-        E.on $ profile ^. ProfileSiteId E.==. site ^. SiteId
-        E.on $ syndication ^. SyndicationProfileId E.==. profile ^. ProfileId
-        E.where_ $ syndication ^. SyndicationEntryId E.==. E.val entryId
-        E.orderBy [E.asc $ site ^. SiteName]
-        return (syndication ^. SyndicationUrl, site ^. SiteIcon, E.coalesceDefault [profile ^. ProfileDisplayName] (profile ^. ProfileUsername))
-    maybeAuthor <- handlerToWidget . runDB . get . entryAuthorId $ entry
-    $(widgetFile "mf2/h-entry")

src/Widget/Feed.hs

@@ -1,12 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-module Widget.Feed ( hFeed ) where
-
-import Import
-import Widget.Entry ( hEntry )
-
-import qualified Data.Text as T
-
-hFeed :: T.Text -> [Entity Entry] -> Widget
-hFeed name entries = do
-    mroute <- getCurrentRoute
-    $(widgetFile "mf2/h-feed")

src/Widget/Hcard.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Widget.Hcard (hcard) where
+
+import Import
+import Data.Maybe (fromJust)
+import qualified Data.Map as M
+import qualified Network.Libravatar as L
+
+entityToTuple :: Entity t -> (Key t, t)
+entityToTuple (Entity key value) = (key, value)
+
+arrangeProfiles :: M.Map (Key Site) Site -> [Profile] -> [(Site,Profile)]
+arrangeProfiles sites profiles = sortBy icon $ zip profileSites profiles
+    where findSite = fromJust . flip M.lookup sites . profileSiteId
+          profileSites = findSite <$> profiles
+          icon = comparing $ siteIcon . fst
+
+hcard :: Entity User -> Widget
+hcard (Entity userId user) = do
+    maybeAvatar <- liftIO $ L.avatarUrl (L.Email $ userEmail user) def { L.optSecure = True, L.optSize = L.Size 512 }
+    userProfiles <- handlerToWidget . runDB $ do
+        profiles <- map entityVal <$> selectList [ProfileUserId ==. userId] []
+        sites <- M.fromList . map entityToTuple <$> selectList [SiteId <-. (profileSiteId <$> profiles)] []
+        return $ arrangeProfiles sites profiles
+    $(widgetFile "hcard")

stack.yaml

@@ -39,7 +39,8 @@ packages:
 - .
 # Dependency packages to be pulled from upstream that are not in the resolver
 # (e.g., acme-missiles-0.3)
-extra-deps: []
+extra-deps:
+- libravatar-0.4.0.1
 
 # Override default flag values for local packages and extra-deps
 flags: {}

static/openwebicons

@@ -1 +0,0 @@
-../node_modules/openwebicons/

static/pgp/ACA7BABE.asc

@@ -1,171 +0,0 @@
------BEGIN PGP PUBLIC KEY BLOCK-----
-
-mQIOBFjiLrYBEADRY2loV+x/nyMum5uuEhxtOhoZ14Mu1TwWyegWXt/DmOkbpJ5i
-xRfIDxmY6gRWLsNukOTsrbQEbV5BdsRxYa4iCH/9d6shDui14bCwOCIPnp3lxKSz
-aaA3tm/Q1OWdP7KPT4fQLwEC2mDwMvuL11DsBc8jT2H6MI0t5YsD93k9+hLs9mMu
-3Kh5/sEhMoevLXCV22Nb1dljZJcdS0IDTClNcyh3veba4pv2Xm+L7x676REB1VVz
-CsAdv/DclzQycqswotSOJYpjW1kKm1hgk8ps5IUTXCP073T1vMy0SXM9bV8klw9y
-cRY6nudSbkheHjC9oNKsfIdSQCBx/TahVa8pE6wNk61uNWnGTnzohvnwTR8hvKeM
-kYESEeNnkLs/diLeBHNEzuyA1/cHDDR8FhjRwlxD8AzLEHmYcoghR6kcmy9y0sUE
-Ey96KQp8XtBoIM8OU9pnaTcHnUK4g/08WymgI68KqLcJ5eVBhVrN9/VH8UNFpzN2
-xQ75XJEfsozsNDh1sQtKY5EuMBfg1yTVzl09TrqJFLrB4aLWmBOO4wq+SLshtVKx
-kZvXHHX5ycJFVos3QGWw7sYRdDaBqQA9idnWTvQhCyrKbuGOgjEAS43ONSfXLAiS
-eu8shkl3kHpL62paWQzXTQlU7mnPOnOKX/SNPz8y0n25xiwrFxWz2/JCrQAgh4fy
-B7QpRGFuaWVsbGUgTWNMZWFuIDxnb3BzeWNob25hdXRzQGdtYWlsLmNvbT6JAk4E
-EwEIADgWIQSD89zsmNUitqOK9dkn0HbSrKe6vgUCWPShRgIbAQULCQgHAgYVCAkK
-CwIEFgIDAQIeAQIXgAAKCRAn0HbSrKe6vofaEACp9yUFlvkDpILwZ6C3epO/thCw
-L6qDKvAfY+Ib7yW0+/tcflGJ/XwhN2WlRmWVP+ptmGLvlErdE8HKDZ2tx653fSC6
-7V50RAXwI9LNX7GH3vavQTfC4hHdgNNAnE4IIloTg+2aWP91EPACrwC4jClGhXar
-bKFeHAuV1q48d+04nxLPdPlhkSFb9KeX/QkdNiBKlAVe+4yOzX4pTe5kV+MlIA99
-TL4KEmikL3nCHm/TyfHSqY4AkGeLR+RsDeFGP7FzCG/0e9fYMAccy84zY1DeL/3u
-1bAOquspxXW2fFZuw62GgITlg+bEQXbEAV+DZC7wLPtOGYiSnF3TNqnFjVvuOcar
-g5Spqml/mnoUutV1FKfqfyEE6G2UV+R/shmkjVPxsUsUv5RiWCRJ/phObiMkes56
-qpc0clwr9H6MknCwfpPzUzdTvixpqkQia8WhJMzlrVotj48Y600JYANoYpd4fAsB
-5Gko3ctvPM2D76jcSeM6mbykBd3eknoiaRbVFU1oKhbgS925wmtKsUPhtxAWnNZn
-WGOQKeIa4SSE3OB2kfZgDESYAayEFARkJY86mJS9I+YycdPMZ1IlR35wYk2lLFb7
-NSZL/9+6q0O3xOvyLtexj38JOSm6o3HWsZmDEBZIPpelaJr+81FagePg7lKfqayp
-nuzeWVVeuo0coLgVUbQgRGFuaWVsbGUgTWNMZWFuIDxkYW5pQDAwZGFuaS5tZT6J
-AlEEEwEIADsCGwECHgECF4AFCwkIBwMFFQoJCAsFFgMCAQAWIQSD89zsmNUitqOK
-9dkn0HbSrKe6vgUCWPSipgIZAQAKCRAn0HbSrKe6vnaIEADNdyMM8qG4E11/t2M2
-c/Hy+w3qrrT1dDX/qLMpbRX2hyYdIAdwyqNjezNIFbd8kAtDSf9RQB9aUcLzhM4D
-Pgg6UQJQX5mdDIvc8Bjehb5Gj/UNf6OOF1eG/R+isszE1gum4ADRLeyCGJSNlayQ
-8RDzTh4BsQWf3oWmCvaDFNsoI5aBT6Z5aPlEimTf/8vbbih47jBFFKwHFSm+G4Wa
-J528hJ72alkILNaBf50Y8mK8IpDYQeFApyGJ98+0I+DoPzh+HMblPRnyMG0XG8gs
-51aEyajg0IMRekFejnKfj/I9FCgDW5TjKO+mKCV67ufGc3TJA2YhoDvBkwXW1FId
-KL4nnxCp2SOH44dDNpZ9GVGJ/rGfjvxTkChiVkaSzmSXeqorNnO3nE9Q5lHHLanz
-hCd2BDg4Jj35m9Ordh3Q8Z7Jvr4WFJcYWKam3tIbbHfGV4IbGV2v+F5gepPbwk3T
-Xe97JXU96zAzgT0a5Txbo4+LLQgHJ3B0G5Rj7cCTBzE2GzZj7RbVYbvuWvL3/ggm
-N5tjsorBKubh8/BoGV4qfor0ojNsB+ujjHXsKqsIr59IsP/RNfzixqXp9SUREDI5
-dtTkADr5LUHLky0AnkFTg+peUe6IK/YvSxzlj4F7NXeo8nTkFRhirLRW2jTa/FNQ
-TCDBIIPIHqiqf8W+EZP/lmmBwYkCMwQQAQgAHRYhBH/XTs6mrHwHPn9gKTjF3ca9
-pPrjBQJY5M4cAAoJEDjF3ca9pPrjU5oP/RCJmW0ZQPIZqULaVfUgzPyY7tBDB6wf
-KrWcQ3z1JmFQO0GbZ/kkQCQ1S2vUiDDDsWbDf/o0iWbgHb3YVbyUM9PVxtIKnT4m
-9m0wxYCY4nCUsYGYAfhX97CkhBWgcPPZjUswblFhl8gbmGbSgA7idazvH/SkLC8G
-d5Ajth0tC9Z42NTwQG7QrKacW1MVz6B0i6OriL8jBf7DHVlx1joH4AwZmOhyVLEe
-wrWJpb5oIwiCUkovTzbfUX4js55Db2X22xg5+MgcW6XJfx3Euq5Ke1CUxSotlvgx
-d5SpNdr2PDwgvXLI7Em6cGzW0JE5HrUDeLGJbzz13J+lbCk/mZrhNusEsuEkgr/S
-+zNIisab8rWeKC78Utk/u2dpElOa4T4vs4cOXQ+0NZPN0XvyakmZDWeTa4X2RYCI
-6ICWswKPqGXNCzNRU8xupFFNvnhh8nGwRIyiprGUY/79rFhd0iiZmkVtCgVCGUKw
-+w8BG5yxNmFIYgz88cNycmQ2lHmh3wm9KEuvMZGc7EleM0QZPcKfuJ5PRm54ZJK6
-+tHKnO3OsvbApQmapYRFNrbHrqyVmbBkN07kLgzV+2/Pfhyff7kB0avoQ3+Ekh28
-K4o4D45p7LDJf3aLbW3VTIndE16Mfm0GTFnxiuuUgqGEDbs6LJ+6OjHiXhq0/TA+
-XJtuv7RhTwV0uQINBFjjBZcBEADq9GCx36ZgTfp4on/Rc2x2imK0QBSFoOYHeRzL
-xBwjLgq642VQ5PVEaIk5jePv3ZccgMETWYGyu2UG6q4JdfF0URRWv6fq37DCUdsz
-TIgQISWFLuhsYVq01pxO8lMwtQjJJWdZpK8FltOuY6toKuahVKlUdxz73iFO6L4G
-QUNwtpvmRx6opqCUbibTWG6/PEzI48Vbt31BK82VTrf9Io/lrYTEFokcTwv7Aj1i
-ZxjKaI29sz54hMXuAeMaDQCv8vRDcP60WCaEZP8pj1y2P5xY5D5/fL5iQ5IiUNx4
-z36RnYjImiPbxiO4V4ZqcxNgnC78Rn6GrzGJOdep3rFTa4+1fCkST/2a3K0p0ipZ
-0LUHDBR4z3KnkH6i7yWiJez2dRdiZ3ggris/WqJyGuM3TYsjKvT/mTE81M2/o9TA
-d5MDf84/m0QAXtDxQQLuXKfE5P4jgWmeEr1VLNC/BSrj7/4F8eUBO+cd7NkiSOMb
-yuayNDj2cSnKs43/TLQObQ2ONQ7rEn+GM+b4mp67KNeO8ux3u5tYhwMW5UY0JVIf
-qKVZEGo3PszAJsvC0Wva3Y3BWBmq2/5HQaGPe8M6QqCnAbyhahoWXKUqe5S4HwBV
-68nnACCQCTdj+PRRIlmFvmYpAFr//QewlVa0KF0qvGK8mWeH5NWgTrDOtXWjai4f
-dNMUaQARAQABiQRyBBgBCAAmFiEEg/Pc7JjVIrajivXZJ9B20qynur4FAljjBZcC
-GwIFCQHhM4ACQAkQJ9B20qynur7BdCAEGQEIAB0WIQRnZchCiF3SGSAtYm5aXS0a
-/xLuxQUCWOMFlwAKCRBaXS0a/xLuxfVFD/9vOtlJXgDmNvFIQPHJjTPKu4e63qOe
-UYApRxC4/TzjPNpTvPFWDOzOuf4WSHSAyuJG+Ryo4cZQ0bRatctEXwxxExJV90IS
-S/QboxJE9Fp+hu1aXP/G4UKQlFXCPQSfWw5nwBWcPfNJXSDQY15iGgMYI+bVBJRi
-69rpnVeqLlWc4QmvIRVMyQu6xjiB1XKiQ6w6QVcNoAgj8b5zweWmAFaJQnomUvta
-eKcH8ybn4ZuZTIO1BFgQdVo7vRl3BUKWVd+eu7CWG5hyt8VFeUpQEVxtC1DSSDLq
-3T8I32mq1ygASxV5Q8ySKqX6mB8WUJdciadwh7M07RR7snMkrCbOFafRrXavoQWO
-0ebXg3SjhPeZ14kljysg//DwNWXP32P1j7JN9jW15iuxonmXAPXn4q8IagZyvD1u
-oEnal1e9yoCwm5ss4ia3mp8YuJVvzbgTeNl963hvLFOM8n0kz9zRrLGS7NFwqgDr
-cWFc0bdyLtWnV6mc4FtOwIAF/pX7G5KNw+Sl1ewZHg3rnelA4SYfphn6/lVrlCoq
-3CwVbwBDxqw5pWveJFB/s1GHTTctYM+7HYbjNyDjc4CsvN8mpDSx886VYI5Ww5rH
-O4YORwPvXk8K+qZrDDWanY9pj7BRyJD23BtmdokcuW1fyKZFVyJLFDPDh9G1JWk3
-CRdhDS1zXOyP+OEzD/0ekMu3OKSjXuRmJhTSe7tObTqodJJ+nucMXeWl19KnRYG8
-qeRl9f2K4shgXkyLgDws0A0d5k4zGNufNiKyEj+oVrFNNebxQ7+nSYcjkFoRUV+/
-Qmm3guqG16PLiQdNdAUsZ9zXEnC0Wx5TsD1xqdyGSsLd5sDYIBTii+5xbkw1wXnW
-S0Zg76Ou6jbP9COtoyrUn5GOwJJidvYsZL1I7Ldq47GtQQbYyqIzfcaNPn5RtR0x
-lgZ8nl8UDLCAthjZc+6Gk4hphIg/hhX/VAaqL1Cd8a7MfEhlvMuL/SFlPjob7IJd
-kdc2ijF1LAoOx0D1l4JvNznDkPljEv+goPZfXBOTOU6EnKZnLo3ZiHr0KbRuWDuP
-VnwhVlHoWGN7aBDrtN8+l2hh/d4ocQkoEoG1vchnbbG+1LzWjKCWgw0D3TW1aIj3
-3o9+YJ5eY8LupV/FXnrccEs5RxApfd9J6GRApnR0ouRKgyboqyWVbjmfII/RleoX
-CqInYef5sdXalUvSDWWtsFr/f7ChKlim7jXw/6db5V7CkspEk4OTF1L/y1Qajf8n
-klYnmwk3brshndA6LhBmiVEjo4eYtVgSeteZKRw0Q0ShU8Gc54uPDDdQCKZvjSFL
-4tOi1r/POR3O6xAzlzuKC4rCStTZ9dSkVxBvqeWgJuGLGdyDlIvHH7xMtzLjOLkC
-DQRY4wcfARAAuUmVZZuzjGtsaOq+ubO0nGc1JuOrWtg0J7iuGVLe8L+z/pvnL+BR
-vAlkWGjS9pWTR2oe8U6Fue+VAi0ccfcoqqL5VaieSdflZYZ0zCOfwuuL4sVr2d1v
-uywlXvBbYlxJhkUHj2j8XKWKIFj5oqaPuA4Pic19nidUGgmMzXQuzwmyr6zlFDt9
-PlNKaLUAOnzZiErzbxT6R4sT5TOW/dkIwEI4dzqSnDtVEm4T2FESM5ne7ZfW2dF5
-uj4WoKr2NpQithuLelNbq36omxBAbt4ee2KCsHoB1rg67OgNXQUHsUV1i06QXs4G
-x6GjarVEw2eAeV8MVAzxTA0iFym/RndfO5RXjZJeBe0WbKwbkwtHOv/2Yf8orokB
-24bbS3DLYlP1H9CFQVXlO5XbpW1MGVpIMZdBgk5/M6bLvR645DecAVKFGcA8PJZt
-1uhhNtcafJ7Jrs96zGq035Y6ECAQwNKKVOUOzNKFvilPj4e1E3n7M7XZGQDDTSu4
-iVEiM81XWTDfeac1Ma2kY0jQNUDgCS3+/vuIWriHazj5jL82WtttGRxgQJR4Yns0
-aNCgB0SMjDIYkgrA4RY6t89UsUyNDP4hTaUVpjXvdTpOYeuAo5EoXOaNObBck6mT
-imS47ZKASBf8BqG+owHZGKFtiaQs/II5HTR/dxFylzDX3NFqHeC6hGcAEQEAAYkC
-PAQYAQgAJhYhBIPz3OyY1SK2o4r12SfQdtKsp7q+BQJY4wcfAhsgBQkB4TOAAAoJ
-ECfQdtKsp7q+F6UP/jyc/r+w+2n6k+rEja+UL6UvfFnpVr1exewYksciNsWCYr4+
-1KJ/b3OWjd064rJeVTXj0H7sDO+lyVpGHt51ug7FJIkmUTE/GZE42q43pp0axEQZ
-ZWfDLZfyZqVIatOSotPZ07hgF89arLI+OqMKAq6ygGL4iSXiqihmCOKQf1UgzC66
-4xPJtI9tFHFwN0LUwdLSNONuJjccvHU1H5MSXsQyZg3SqPbcAqgaz44JhMbWjVri
-SWxS/X9Fa4InvfiPeWmFjRsWfbYgMIPcUmfXz5uk++d50vVdOkgD8wsj1hzQ9I42
-44Ewpq7FlOT96uQWfdVSIBVWhjPP9JddX+bEB6FCKHhRK8gKvmBZTm5IDHfnCJjJ
-esTLyyht4ddTYKI1/VHBfK+i6Mgqqtc28pu9a56B5OqUzi569nTHO57njxDcbWvr
-bEWRSpuRXCVQtnjDDGuCZH5asqMNjLVXeebbSXrdhcvaK7B22wN5HL8FgdhtX/PC
-m55dGvI6x9dkmfHE89nJNUbprE0PGkFTQsvwV4434xRooJxFSp56jtb/nJaKAiMl
-XdS5RTHETNNJKXUdli3O7PXEAiYQGYZldjUJ36yHvsbwJP35D0tZi40dETPm1eIZ
-MTPT50oaBbGB90Hmj3YIco9Zxvr8nM4XDosRIpcTLwuHJYwCr9zwm/CqxylKuQEN
-BFjkzJoBCACu3OXGbQuZP99746QAVQUyGFZT8aCOLxLhRMAMI2i9tF9OAT/0jKdE
-Y8A902ohZBGJW8duJToo3FrFzahLqHuh4RxpXNTzSs6RejZW+/MH655aLGzAhsbb
-fMVwthwAeoU0O8G6OWqVLg7HG2CQLE+Fyd1sPfHfTxPpktrT1602MraBt9rr6U/A
-JnZYhPYQmAJuPw0KVpningaf2S6zGQEQFSgAwTULUSK/ttF89Pi3xEfYxG8cVFdr
-p+BfbeZOaHYc9Oa+Q5Bu55vvOfEEenOtJD/ChsPtACj8ljzSrcd8bIhYsNBRPw/u
-SYKc6MdjwcjXtUicBj1NlzqsULfWMkZhABEBAAGJA3IEGAEIACYWIQSD89zsmNUi
-tqOK9dkn0HbSrKe6vgUCWOTMmgIbAgUJAeEzgAFACRAn0HbSrKe6vsB0IAQZAQgA
-HRYhBE4dQnAaY/My3CyZcjhEppc8YFjxBQJY5MyaAAoJEDhEppc8YFjxUbMH/1Yv
-9y1+iE0griFJ6wgqirv3UizDRBltTgz/I45jfnqlxcbOsjNwTOT7WVba4quX9eYg
-cjDZg8Ay28zwqcc4hWKEcm//CusMYd1pveFYNWX0IxH1sNLOcjsG8KI5wjPrNiyG
-6gE686ZmeNFyN9XQcbZW1J1OQ+KN+RhZK8cs3pyIlx0gYv2XP3V0zSZPzVVe8n3M
-6csRHXGol6iH6gI3LC5xoVtWniE2DYeIZViCWfguJ2SQ9X/FwRL0reZm1QN4hOzl
-Gd+OT+A10a6MW5aayIdyuGe+6e0ajt7ydFi6jWSjAcZC6EaDLtanWmbxD35QTXX7
-4otb6A4lMZezqvFiKzRf0A/9GPyO8jjCDpaP7Z7kjHUfsqy7EoPz9RNCQLbHXnN0
-xMztLw9GuGqrQ6ml8IX+rkyV5b6DT+agVPIeFbU3O7B70XFyU/nAnjx1GxDLoAyT
-RXasEYDENzX/veKPDSq8JoUKvHqFUJCZsqjzz7jx1HQdxmdLdHfVxFRya/Ubo6+l
-nvZ6m+U03oGWXzZaxTRkgBFjE549VuXHiX3jGxZku5gILPg+Oi2Ukixar/f5V2BU
-4zK57RmjfsLcHx8MvMCePTIylGQoK/1VGpGFkyY672Rcj/N44bxWH2LthvRtSakF
-vh2VDVzvhtIEQOVylor3fiAmrU0ipWczkbTSEoLCAv7Q/Vo0zpB20O9Msgpt70rz
-bj3+uwMoPcOaFqdo0PSSIApDJN34cTwpRXUd3SaAoIDiY1tmXVqAzPqoYtaucKCq
-7f9GS3x7BsW4O5WVRSVYWvnzL0OL1HqAc7glmRu8lav7o6bv/XxNDFA1mzEjleqr
-d3vBkz4KUWoFu0tuqkv/ynk9bB9FTHkKpNr7mlH0pxrNfbpaGmsoMrwWwyFAvtvj
-qrXcU18w6Gqh57HyJ/l2T//u2BvSOkbWrWlUY6CVZ4hf8wTlH03oAWcz/cDwMkZm
-yh4fGsLlB2nGCN4BxJcuvcG0IB2NPA7KrlKRqpBBj25rRZ4uPbbVQCs034tt6Wh6
-SZu5AQ0EWOTMtQEIANHooblpe5weIA7dqTVz3cWHW+rdR1royPhQ+NWnmQA4c05G
-9J2Boo3STvQuMjGbrc1nxYuzWjZ/XQ+n4LFbG5G2/wpq9Ez7faxLizBxejFmJm0t
-pxe/Nu20deSI9Z+xc+uFtu6cTCqtBtXbO4gddGXBGDWCn3KbmR/+CuRW8Bj6r7Q5
-BgHRgidfrfDsdmO5IilpJt0S4sXAsVxfBYsEhUIQ8eK0V0/fOwbwmtFRLi7KoaBC
-YKkKqkWzBvrz0O8qZ8Ta3fHoGL5sqnPuEbK9IdMhBeqUhmNSipcJzAN/VSQwu99y
-zVCr5whn1G5ZNUl4SiceoyOVFZusbijbc5OqY9MAEQEAAYkCPAQYAQgAJhYhBIPz
-3OyY1SK2o4r12SfQdtKsp7q+BQJY5My1AhsMBQkB4TOAAAoJECfQdtKsp7q+GPoP
-/ikUGXFlu9fFRJUtrA0/hhY+9BqTDUxtAL7VlXuISi5r2yq7ohh4boQH6l3SJgk2
-CSKi4Y1ymDZTPS5LDje5faeWPH+xnDHLD00lQbdbl1TCUJNtJvY6SzcpurCuCWTb
-e5HHvL7UowAmm/Gb40Jjkf/7xLCuwfIuWuIb5gePrBA20SYpxc9UfQEZklbvtO+c
-rV6+YemSHe2K/Xu34+R4edgVnQLEOFytbd30BVvXjxeZTp8r+F7OeNrRQoIx9Ppa
-EYQhya9S/Mofh8YH4HzZcembQIE068+5hHn2Bp7ZwAJl6hVTBdPhy947V24xmZUw
-XQByHpBrbpvYnSFJgVToOGAEkbwuKg1kuazViGpReiAakEFVjQ+eWQRgex9im3T8
-ix9VKvAE5ZT6NNtqnmnBdNgY93jYn8EW7PSGVZP3hMyqi7wqGDw7rQR8A36BLCBI
-/qu+gF66p+OBbCSUPX+WRg7sU30pMrBWQR4t79/aqahKzeEaGKuvrDBfS3C6xB1Z
-q76UyHbdXsNJ6JHBHd92+6X1MSz5KkjUE3lJlKa0Mnr4HAPWwMh40LT9TTAAUhhk
-R7nkNTXe1ELqyf84C4SZOrYc09FDmPeZdYtkv7ntTv3tGHtjOT0mRfJZxeNTQYBi
-M9nQJbvjkA22/WfNoyAad/O7Qn1PvHgsWV0l7msrgbUluQENBFjkzMkBCAC1TZQJ
-rfv61cJV2FXMqorK5FQP0LSfjzbUwjXqQV3gHfpu9pAus4jJU/JQkGXfzY3muJIp
-SCbpQsVwUCezH8cmr5mI7EDsBzp7vOt1ZFCqqcnTkUjZ4b6qKLkATmPDrG3QaaBu
-fScRSVfRq7epyW3ALfdPtKMuLQV3LToFmr3z0ocI8zGGVlp+3Yk1uHdoRoYJcxs7
-bxZHRhlUBa6eUKz5R9aHFD20sw9vJBwQrxhpnkeXj7u2jHFg5SlSNDrC8zL4RPMd
-Lh5ySx68cKo4VOuuL436vnlFOimRZyfBCsn8tGUD8VCSsxIVlZ7/1et/zrJ/S+/l
-ECeOfVKtyRgk1PDbABEBAAGJAjwEGAEIACYWIQSD89zsmNUitqOK9dkn0HbSrKe6
-vgUCWOTMyQIbIAUJAeEzgAAKCRAn0HbSrKe6vqa3D/4w0SvKF0a+DjqpbycK+6iE
-at1IpEAk/cT40o/poOYiIRh3OBksRywDNiguCiYH+Wprg1GXbp26I+rk1f6VOgu4
-7KygMe/DYn1Oca8ucXclpnE6d6r3JfIR3bqQGYsS5Qg0aXaM4fktiXf8FzfbNOgV
-6Eea7qw2G3waJswrYR+h9CjapI3PFckF0LUBs9+IAGXVz8uNhM8BmjReqF+6vTRm
-Hv1ss/UKwrW6D+DroN0M8IWhtvvAz5VQxh7/O/QXNo/x4FCbp/mu+uPFplu90tX6
-fHUIxT7FctBEHAeuI5pXcsSKxo6f0ylXrMjzWmEblyru+Hco1WQK6hKYaQHegsqC
-+n08NLoLiiyMWZD4wVY+b3wWGn98VkLpusnArnMEWvmaGN3WsBaJlM4xye0QdI7i
-I2q3VA0m36WMLTK8gzlSqH70sybnW9g+uCVcZdhr0IzrZg/p+Ctlo9Nd/LwK6y3c
-PC7zumWHH7bpoRSYvftvVU0yKQOTLvGQqdLBlpkK1tFHFEeKOObs8qw8fAYfZ7r7
-QhuL1oHmteYCQjxzf42ydfgQl/oy06YBV8PFad3w9/p4oUJHHyjjkQe6G6vk7tT8
-f47r228ZRJ4vo+iGnoCNFTtWwbQxOaiiFUas2YNdV7MIR8BYU9dDMXGRjw0D9hTY
-6fGcFiSe50Klf2ctCTwAVg==
-=8wOv
------END PGP PUBLIC KEY BLOCK-----

templates/auth/login.cassius

@@ -1,14 +0,0 @@
-body > main
-  display: flex
-  align-items: center
-  justify-content: center
-  .form-control
-    background-color: #1d1f21
-    color: #c9cacc
-    &:focus
-      background-color: #404449
-      color: #c9cacc
-  .input-group-addon
-    background-color: #000
-    color: #fff
-    width: 2.4rem

templates/auth/login.hamlet

@@ -1,24 +0,0 @@
-<form .container method="post" action=@{action}>
-  $maybe tok <- mtok
-    <input type="hidden" name=#{defaultCsrfParamName} value=#{tok}>
-
-  <div .card.bg-dark>
-    <div .card-body>
-      <div .form-group>
-        <label .sr-only for="auth-login-username">username
-        <div .input-group>
-          <span .input-group-addon aria-hidden>
-            <i .fa.fa-at>
-          <input #auth-login-username .form-control type="text" name="username" placeholder="username" required>
-
-      <div .form-group>
-        <label .sr-only for="auth-login-password">password
-        <div .input-group>
-          <span .input-group-addon aria-hidden>
-            <i .fa.fa-asterisk>
-          <input #auth-login-password .form-control type="password" name="password" placeholder="password" required>
-
-    <div .card-footer>
-      <button type="submit" class="btn btn-primary">
-        <i .fa.fa-sign-in>
-        log in

templates/default-layout-wrapper.hamlet

@@ -3,25 +3,50 @@ $doctype 5
   <head>
     <meta charset="utf-8">
     <meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no">
-    <meta name="generator" content="#{packageName package} #{packageVersion package}">
 
-    <title>#{fullTitle}
+    <title>#{pageTitle pc}
+    <meta name="description" content="">
+    <meta name="author" content="">
     $maybe route <- mcurrentRoute
       <link rel="canonical" href=@{route}>
-      <meta property="og:url" content=@{route}>
-    $maybe fb <- appFacebookId $ appSettings master
-      <meta property="fb:app_id" content=#{fb}>
-    <link rel="sitemap" href=@{SitemapR}>
 
     <link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0-beta/css/bootstrap.min.css" integrity="sha384-/Y6pD6FV/Vv2HJnA6t+vslU6fwYXjCFtcEpHbNJ0lyAFsXTsjBbfaDjzALeQsN6M" crossorigin="anonymous">
-    <link rel="stylesheet" href=@{StaticR openwebicons_css_openwebicons_min_css}>
     <script src="https://use.fontawesome.com/4fbab4ae27.js">
 
     ^{pageHead pc}
 
+    <script>
+      /* The `defaultCsrfMiddleware` Middleware added in Foundation.hs adds a CSRF token to the request cookies. */
+      /* AJAX requests should add that token to a header to be validated by the server. */
+      /* See the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package for details. */
+      var csrfHeaderName = "#{TE.decodeUtf8 $ CI.foldedCase defaultCsrfHeaderName}";
+
+      var csrfCookieName = "#{TE.decodeUtf8 defaultCsrfCookieName}";
+      var csrfToken = Cookies.get(csrfCookieName);
+
+
+      if (csrfToken) {
+      \  $.ajaxPrefilter(function( options, originalOptions, jqXHR ) {
+      \      if (!options.crossDomain) {
+      \          jqXHR.setRequestHeader(csrfHeaderName, csrfToken);
+      \      }
+      \  });
+      }
+
   <body>
     ^{pageBody pc}
 
     <script src="https://code.jquery.com/jquery-3.2.1.slim.min.js" integrity="sha384-KJ3o2DKtIkvYIK3UENzmM7KCkRr/rE9/Qpg6aAZGJwFDMVNA/GpGFF93hXpG5KkN" crossorigin="anonymous">
     <script src="https://cdnjs.cloudflare.com/ajax/libs/popper.js/1.11.0/umd/popper.min.js" integrity="sha384-b/U6ypiBEHpOf/4+1nzFpr53nxSS+GLCkfwBdFNTxtclqqenISfwAzpKaMNFNmj4" crossorigin="anonymous">
     <script src="https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0-beta/js/bootstrap.min.js" integrity="sha384-h0AbiXch4ZDo7tp9hKZ4TsHbi047NrKGLO3SEJAg45jXxnGIfYzk4Si90RDIqNm1" crossorigin="anonymous">
+    $maybe analytics <- appAnalytics $ appSettings master
+      <script>
+        if(!window.location.href.match(/localhost/)){
+            (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
+            (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
+            m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
+            })(window,document,'script','https://www.google-analytics.com/analytics.js','ga');
+
+            ga('create', '#{analytics}', 'auto');
+            ga('send', 'pageview');
+        }

templates/default-layout.cassius

@@ -1,38 +1,6 @@
-a
-  color: #00a6f9
-  &:hover
-    color: #0084d6
-
-  [class^="openwebicons-"], [class*=" openwebicons-"]
-    text-decoration: none
-    line-height: 1
-
-code, kbd, pre, samp
-  font-family: Monoid, Hack, Inconsolata, Menlo, Monaco, Consolas, "Liberation Mono", monospace
-code, pre
-  color: #cccccc
-code
-  background-color: #141414
-
 body
-  background-color: #1d1f21
-  color: #c9cacc
   display: flex
   flex-direction: column
   min-height: 100vh
   > main
     flex: 1
-    margin: 2em
-  > footer
-    text-align: center
-    padding-bottom: 1em
-    display: flex
-    justify-content: space-evenly
-    margin: auto 1em
-#navbar
-  justify-content: space-between
-.breadcrumb
-  background-color: #404449
-  border-radius: 0
-  .breadcrumb-item.active
-    color: #fff

templates/default-layout.hamlet

@@ -1,34 +1,35 @@
 <header>
-    <nav .navbar .navbar-expand-md .navbar-dark.bg-dark>
+    <nav .navbar .navbar-expand-lg .navbar-dark.bg-dark>
-        <a .navbar-brand rel="home" href=@{HomeR}>#{siteTitle $ appSettings master}
+        $maybe title <- appTitle $ appSettings master
+            <a .navbar-brand href=@{HomeR}>#{title}
         <button type="button" .navbar-toggler data-toggle="collapse" data-target="#navbar" aria-expanded="false" aria-controls="navbar" aria-label="Toggle navigation">
             <span .navbar-toggler-icon>
 
         <div #navbar .collapse.navbar-collapse>
-            $forall bar <- navbars
+            <ul .navbar-nav.mr-auto>
-                <ul .navbar-nav>
+                $forall MenuItem label route _ <- navbarLeftFilteredMenuItems
-                    $forall MenuItem label route <- bar
                     <li .nav-item :Just route == mcurrentRoute:.active>
                         <a .nav-link href=@{route}>#{label}
 
-    $if not $ null crumbs
+            <ul .navbar-nav>
-        <ol .breadcrumb>
+                $forall MenuItem label route _ <- navbarRightFilteredMenuItems
-            $forall (route, title) <- crumbs
+                    <li .nav-item :Just route == mcurrentRoute:.active>
+                        <a .nav-link href=@{route}>#{label}
+    $if not $ null parents
+        <ul .breadcrumb.rounded-0>
+            $forall bc <- parents
                 <li .breadcrumb-item>
-                    <a href=@{route}>#{title}
+                    <a href=@{fst bc}>#{snd bc}
             <li .breadcrumb-item.active>#{title}
-        <script type="application/ld+json">#{preEscapedToMarkup jsonCrumbs}
     $maybe msg <- mmsg
       <div .alert.alert-info #message>#{msg}
 
 <main>
     ^{widget}
 
+<!-- Footer -->
 <footer>
-    <p>
+    <div .container>
-        all content licensed under #
+        <p .text-muted>
-        <a rel="license" href="https://creativecommons.org/licenses/by-sa/4.0/">cc by-sa 4.0
+            All content on this site is licensed under a
-    $with Package { packageName = n, packageVersion = v, packageRepository = r } <- package
+            <a rel="license" href="//creativecommons.org/licenses/by-sa/4.0/">Creative Commons Attribution-ShareAlike 4.0 International License</a>.
-        <p>
-            powered by #
-            <a rel="code-repository" href="#{repositoryUrl r}/tree/v#{v}">#{n} #{v}

templates/hcard.cassius

@@ -0,0 +1,5 @@
+.card.h-card
+  margin: 2em auto
+  width: 22rem
+  .card-link
+    white-space: nowrap

templates/hcard.hamlet

@@ -0,0 +1,13 @@
+<div .card.h-card>
+  $maybe avatar <- maybeAvatar
+    <img .card-img-top.u-photo src=#{avatar} alt="Avatar for #{userFullName user}">
+  <div .card-body>
+    <h4 .card-title.p-name>#{userFullName user}
+    <p .card-text.p-note .text-muted>#{userNote user}
+    <a .card-link.u-email rel="me" href="mailto:#{userEmail user}">
+      <i .fa.fa-envelope>
+      #{userEmail user}
+    $forall (site, profile) <- userProfiles
+      <a .card-link.u-url rel="me" href="#{siteUrl site}#{profileUsername profile}">
+        <i .fa.fa-#{siteIcon site}>
+        #{profileUsername profile}

templates/home.cassius

@@ -1,22 +0,0 @@
-body > main
-  display: flex
-  flex-direction: column
-  align-items: center
-  > div.h-feed
-    flex: 1
-    margin-bottom: 0
-  > aside.author
-    max-width: 25rem
-    margin-bottom: 2em
-    > .h-card
-      position: sticky
-      top: 1em
-
-@media (min-width: 768px)
-  body > main
-    flex-direction: row-reverse
-    align-items: unset
-    > div.h-feed
-      margin-right: 2em
-    > aside.author
-      margin-bottom: 0

templates/home.hamlet

@@ -1,2 +1 @@
-<aside .author>^{hCard user}
+^{hcard user}
-^{hFeed title entries}

templates/mf2/h-card.cassius

@@ -1,16 +0,0 @@
-.card.h-card
-  ul.profiles
-    list-style: none
-    padding-left: 0
-    margin-bottom: 0
-    text-align: center
-    > li
-      display: inline-block
-      margin-right: 5px
-      &:last-child
-        margin-right: 0
-
-      /* Provide a little extra space around the badges added by the
-       * http://www.kevinmarks.com/distributed-verify.html script. */
-      .verified, .unverified
-        margin-right: 4px

templates/mf2/h-card.hamlet

@@ -1,27 +0,0 @@
-<article .card.h-card .bg-dark itemscope itemtype="http://schema.org/Person">
-  $maybe route <- mcurrentRoute
-    <a .u-uid.u-url itemprop="url" href=@{route} hidden>
-
-  <img .card-img-top.u-photo itemprop="image" src=@{AvatarR userId} alt=#{userFullName user}>
-
-  <div .card-body>
-    <h4 .card-title.p-name itemprop="name">#{userFullName user}
-    $forall key <- pgpKeys
-      <a .card-subtitle.u-key type="application/pgp-keys" href=@{routeFromPgp key}>
-        <i .fa.fa-key>
-        #{prettyPgp key}
-    <div .p-note itemprop="description" .text-muted>#{userNote user}
-
-    <ul .profiles>
-      <li>
-        <a .u-email rel="me" itemprop="email" href="mailto:#{userEmail user}">
-          <i .fa.fa-envelope>
-          #{userEmail user}
-      $forall (Entity _ site, Entity _ profile) <- userProfiles
-        <li>
-          <a .u-url rel="me" itemprop="sameAs" href="#{profileUrl site profile}">
-            <i .#{siteIcon site}>
-            $maybe name <- profileDisplayName profile
-              #{name}
-            $nothing
-              #{profileUsername profile}

templates/mf2/h-entry.cassius

@@ -1,12 +0,0 @@
-article.h-entry
-  .e-content p:last-child
-    margin-bottom: 0
-  > .card-footer
-    display: flex
-    flex-wrap: wrap
-    justify-content: space-evenly
-    > *
-      margin-right: 1em
-    > .p-author img
-      height: 1em
-      vertical-align: -0.1em

templates/mf2/h-entry.hamlet

@@ -1,36 +0,0 @@
-<article .h-entry .card.bg-dark itemscope itemtype="http://schema.org/BlogPosting">
-  $maybe photo <- entryPhoto entry
-    <img .card-img-top.u-photo itemprop="image" src=@{staticR ["uploads", photo]} alt=#{entryTitle entry}>
-  <div .card-body>
-    $maybe name <- entryName entry
-      <h4 .p-name .card-title itemprop="headline">#{name}
-      <div .e-content itemprop="articleBody">
-        #{entryContent entry}
-    $nothing
-      <div itemprop="headline" hidden>#{entryTitle entry}
-      <div .e-content.p-name itemprop="articleBody">
-        #{entryContent entry}
-  <div .card-footer>
-    $maybe author <- maybeAuthor
-      <a .p-author.h-card href=@{userProfile author}>
-        <img .u-photo src=@{AvatarR $ entryAuthorId entry} alt=#{userFullName author}>
-        #{userFullName author}
-      $# Use a separate hidden block for the schema.org metadata because you
-      $# can't put itemprop="author" and itemprop="url" on the same element,
-      $# because schema.org is garbage.
-      <div hidden itemprop="author" itemscope itemtype="http://schema.org/Person">
-        <a itemprop="url" href=@{userProfile author}>
-          <span itemprop="name">#{userFullName author}
-    <a .u-url itemprop="mainEntityOfPage" href=@{entryR (Entity entryId entry)}>
-      <i .fa.fa-link>
-      permalink
-    <time .dt-published itemprop="datePublished" datetime=#{timeUnfriendly published} title=#{timeUnfriendly published}>
-      <i .fa.fa-calendar>
-      #{timeFriendly published}
-    <time .dt-updated itemprop="dateModified" datetime=#{timeUnfriendly updated} title=#{timeUnfriendly updated} :published == updated:hidden>
-      <i .fa.fa-pencil>
-      #{timeFriendly updated}
-    $forall (E.Value url, E.Value icon, E.Value name) <- posses
-      <a .u-syndication href=#{url}>
-        <i .#{icon}>
-        #{name}

templates/mf2/h-feed.cassius

@@ -1,5 +0,0 @@
-div.h-feed
-  > ol.list-unstyled
-    margin-bottom: 0
-    > li:not(:last-child)
-      margin-bottom: 1em

templates/mf2/h-feed.hamlet

@@ -1,7 +0,0 @@
-<div .h-feed>
-  <span .p-name hidden>#{name}
-  $maybe route <- mroute
-    <a .u-url href=@{route} hidden>
-  <ol .list-unstyled>
-    $forall entry <- entries
-      <li>^{hEntry entry}