Add sslOnlyMiddleware to the Foundation

.gitignore

@@ -1,6 +1,7 @@
 dist*
 static/tmp/
 static/combined/
+static/uploads/
 config/client_session_key.aes
 *.hi
 *.o

config/models

@@ -4,7 +4,7 @@ User
     fullName Text maxlen=500
     email Text maxlen=190
     avatar Text maxlen=190
-    note Text sqltype=mediumtext
+    note Markdown sqltype=mediumtext
     UniqueUser username
     UniqueEmail email
     deriving Typeable
@@ -26,10 +26,10 @@ Profile
     displayName Text Maybe sqltype=varchar(255)
 
 Entry
-    slug Slug Maybe maxlen=255
     kind EntryKind maxlen=255
-    name Text maxlen=255
+    name Text Maybe maxlen=255
-    content Text sqltype=longtext
+    content Markdown sqltype=longtext
+    photo Text Maybe maxlen=190
     published UTCTime
     updated UTCTime
     authorId UserId
@@ -38,3 +38,8 @@ Syndication
     entryId EntryId
     profileId ProfileId
     url Text sqltype=varchar(255)
+
+EntryCategory
+    entryId EntryId
+    category Category sqltype=varchar(190)
+    UniqueEntryCategory entryId category

config/routes

@@ -8,6 +8,8 @@
 
 / HomeR GET
 /avatars/#UserId AvatarR GET
+/categories/#Category CategoryR GET
+
 /feed FeedR GET
 !/#EntryKind/feed FeedKindR GET
 

config/settings.yml

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

package-lock.json

@@ -1,6 +1,6 @@
 {
   "name": "lebd",
-  "version": "1.4.6",
+  "version": "1.6.4",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {

package.json

@@ -1,6 +1,6 @@
 {
   "name": "lebd",
-  "version": "1.4.6",
+  "version": "1.6.4",
   "description": "the codebase backing 00dani.me, an indieweb.org site",
   "repository": {
     "type": "git",

package.yaml

@@ -1,5 +1,5 @@
 name:    lebd
-version: "1.4.6"
+version: "1.6.4"
 
 dependencies:
 
@@ -48,10 +48,11 @@ dependencies:
 - wai
 
 - blaze-markup >=0.8 && <0.9
-- conduit-combinators >= 1.1 && <1.2
+- 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

src/Application.hs

@@ -50,6 +50,7 @@ import System.Log.FastLogger                (defaultBufSize, newStdoutLoggerSet,
 -- 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

src/Foundation.hs

@@ -22,9 +22,12 @@ import qualified Yesod.Core.Unsafe as Unsafe
 
 import Package
 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, object )
+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
@@ -64,6 +67,9 @@ 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
@@ -74,7 +80,7 @@ instance Yesod App where
     -- Store session data on the client in encrypted cookies,
     -- default session idle timeout is 120 minutes
     makeSessionBackend _ = sslOnlySessions . strictSameSiteSessions $ Just <$> defaultClientSessionBackend
-        120    -- timeout in minutes
+        sessionLifetime
         "config/client_session_key.aes"
 
     -- Redirect static requests to a subdomain - this is recommended for best
@@ -94,7 +100,7 @@ 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
+    yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware . sslOnlyMiddleware sessionLifetime
 
     defaultLayout widget = do
         master <- getYesod
@@ -106,7 +112,7 @@ instance Yesod App where
         -- Get the breadcrumbs, as defined in the YesodBreadcrumbs instance.
         (title, crumbs) <- breadcrumbs
         let allCrumbs = maybe crumbs (\route -> crumbs ++ [(route, title)]) mcurrentRoute
-        jsonCrumbs <- fmap (E.decodeUtf8 . encode) . withUrlRenderer $ jsonLdBreadcrumbList allCrumbs
+        jsonCrumbs <- fmap (E.decodeUtf8 . encode) . withUrlRenderer $ breadcrumbList allCrumbs
 
         let navbars = [leftMenuItems, rightMenuItems] <*> [muser]
 
@@ -117,7 +123,9 @@ instance Yesod App where
         -- you to use normal widget features in default-layout.
 
         pc <- widgetToPageContent $(widgetFile "default-layout")
-        let hasPageTitle = not . B.null . pageTitle $ pc
+        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.
@@ -179,26 +187,10 @@ instance YesodBreadcrumbs App where
   breadcrumb (EntriesR kind) = return (pluralise kind, Just HomeR)
   breadcrumb (EntryR kind entryId) = do
     (Entity _ entry) <- getCached entryId
-    return (entryName entry, Just $ EntriesR kind)
+    return (entryTitle entry, Just $ EntriesR kind)
   breadcrumb (EntryWithSlugR kind entryId _) = breadcrumb $ EntryR kind entryId
   breadcrumb _ = return ("home", Nothing)
 
-jsonLdBreadcrumbList :: [(Route App, Text)] -> (Route App -> [(Text, Text)] -> Text) -> Value
-jsonLdBreadcrumbList crumbs url = object
-  [ ("@context", "http://schema.org")
-  , ("@type", "BreadcrumbList")
-  , "itemListElement" .= zipWith (jsonLdListItem url) [1 :: Int ..] crumbs
-  ]
-jsonLdListItem :: (Route App -> [(Text, Text)] -> Text) -> Int -> (Route App, Text) -> Value
-jsonLdListItem url i (r, t) = object
-  [ ("@type", "ListItem")
-  , "position" .= i
-  , "item" .= object
-    [ "@id" .= url r []
-    , "name" .= t
-    ]
-  ]
-
 -- How to run database actions.
 instance YesodPersist App where
     type YesodPersistBackend App = SqlBackend
@@ -261,3 +253,7 @@ 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,12 +1,17 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Handler.Avatars where
 
-import Import
+import Import hiding ( (==.) )
 
-import Model.Cache ( getCached )
+import Database.Esqueleto
 import Settings.StaticR ( staticR ) 
 
 getAvatarR :: UserId -> Handler ()
-getAvatarR = redirect <=< fmap (avatarR . entityVal) . getCached
+getAvatarR = responseFrom <=< runDB . select . from . queryAvatar
-    where avatarR user = staticR ["img", userAvatar user]
+    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

@@ -0,0 +1,22 @@
+{-# 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,11 +7,13 @@
 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 ( EntryKind, allEntryKinds )
+import Model.Entry.Kind ( allEntryKinds )
 import Widget.Entry ( entryR )
 
 -- These handlers embed files in the executable at compile time to avoid a
@@ -31,6 +33,9 @@ getRobotsR = robots SitemapR
 
 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
@@ -39,20 +44,19 @@ getSitemapR = do
             , sitemapChangeFreq = Just Daily
             , sitemapPriority = Nothing
             }
-        yieldMany $ kindToSitemapUrl <$> allEntryKinds
+        yieldMany $ sitemapUrl . CategoryR . E.unValue <$> categories
+        yieldMany $ sitemapUrl . EntriesR <$> allEntryKinds
         yieldMany $ entryToSitemapUrl <$> entries
 
-kindToSitemapUrl :: EntryKind -> SitemapUrl (Route App)
+sitemapUrl :: a -> SitemapUrl a
-kindToSitemapUrl kind = SitemapUrl
+sitemapUrl loc = SitemapUrl
-    { sitemapLoc = EntriesR kind
+    { sitemapLoc = loc
     , sitemapLastMod = Nothing
     , sitemapChangeFreq = Nothing
     , sitemapPriority = Nothing
     }
+
 entryToSitemapUrl :: Entity Entry -> SitemapUrl (Route App)
-entryToSitemapUrl entry = SitemapUrl
+entryToSitemapUrl entry = (sitemapUrl $ entryR entry)
-    { sitemapLoc = entryR entry
+    { sitemapLastMod = Just . entryUpdated . entityVal $ entry
-    , sitemapLastMod = Just . entryUpdated . entityVal $ entry
-    , sitemapChangeFreq = Nothing
-    , sitemapPriority = Nothing
     }

src/Handler/Entries.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
 module Handler.Entries where
 
 import Import
@@ -8,6 +8,8 @@ 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 )
 
@@ -18,10 +20,11 @@ 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
-        atomLink (FeedKindR kind) $ T.concat [K.pluralise kind, " ~ ", title]
+        FeedKindR kind `atomLink` myTitle
-        $(widgetFile "entries")
+        hFeed myTitle entries
 
 getEntryR :: a -> EntryId -> Handler Html
 getEntryR _ = renderEntry <=< getCached
@@ -33,8 +36,19 @@ 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 . entryName . entityVal $ entry
+        setTitle . toHtml . entryTitle . entityVal $ entry
-        $(widgetFile "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

@@ -5,6 +5,7 @@ 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
@@ -47,7 +48,7 @@ toFeedEntry :: Entity Entry -> FeedEntry (Route App)
 toFeedEntry entry = FeedEntry
     { feedEntryLink = entryR entry
     , feedEntryUpdated = entryUpdated $ entityVal entry
-    , feedEntryTitle = entryName $ entityVal entry
+    , feedEntryTitle = entryTitle $ entityVal entry
     , feedEntryContent = toHtml . entryContent . entityVal $ entry
     , feedEntryEnclosure = Nothing
     }

src/Handler/Home.hs

@@ -15,14 +15,9 @@ import Widget.Feed ( hFeed )
 getHomeR :: Handler Html
 getHomeR = do
     settings <- asks appSettings
-    userE@(Entity userId user) <- runDB . getBy404 . UniqueUser . siteUsername $ settings
+    user <- runDB . getBy404 . UniqueUser . siteUsername $ settings
     let title = siteTitle settings
-    entries <- runDB $ selectList [EntryAuthorId ==. userId] [Desc EntryPublished]
+    entries <- runDB $ selectList [EntryAuthorId ==. entityKey user] [Desc EntryPublished]
     defaultLayout $ do
         atomLink FeedR title
-        toWidgetHead
-            [hamlet|
-                <meta name="author" content=#{userFullName user}>
-                <link rel="author" href=@{HomeR}>
-            |]
         $(widgetFile "home")

src/Model.hs

@@ -12,11 +12,12 @@ module Model where
 import ClassyPrelude.Yesod
 import Database.Persist.Quasi
 import Yesod.Auth.HashDB ( HashDBUser(..) )
-import Web.Slug ( Slug )
 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

src/Model/Category.hs

@@ -0,0 +1,14 @@
+{-# 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

@@ -0,0 +1,30 @@
+{-# 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/Markdown.hs

@@ -0,0 +1,38 @@
+{-# 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/SchemaOrg/BreadcrumbList.hs

@@ -0,0 +1,21 @@
+{-# 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,9 +19,8 @@ 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(wfsHamletSettings), widgetFileNoReload,
+import Yesod.Default.Util         (WidgetFileSettings, widgetFileNoReload,
                                    widgetFileReload)
 import qualified Database.MySQL.Base as MySQL
 
@@ -59,9 +58,9 @@ data AppSettings = AppSettings
     , appSkipCombining          :: Bool
     -- ^ Perform no stylesheet/script combining
 
-    -- Example app-specific configuration values.
+    , appFacebookId          :: Maybe Int
-    , appAnalytics              :: Maybe Text
+    -- ^ Facebook app ID.
-    -- ^ Google Analytics code
+
     , siteTitle                 :: Text
     -- ^ Site-wide title.
     , siteUsername              :: Text
@@ -95,7 +94,7 @@ instance FromJSON AppSettings where
         appMutableStatic          <- o .:? "mutable-static"   .!= defaultDev
         appSkipCombining          <- o .:? "skip-combining"   .!= defaultDev
 
-        appAnalytics              <- o .:? "analytics"
+        appFacebookId             <- o .:? "fb-app-id"
         siteTitle                 <- o .: "title"
         siteUsername              <- o .: "username"
 
@@ -120,7 +119,7 @@ instance FromJSON AppSettings where
 --
 -- https://github.com/yesodweb/yesod/wiki/Overriding-widgetFile
 widgetFileSettings :: WidgetFileSettings
-widgetFileSettings = def { wfsHamletSettings = defaultHamletSettings { hamletNewlines = AlwaysNewlines } }
+widgetFileSettings = def
 
 -- | How static files should be combined.
 combineSettings :: CombineSettings

src/Widget/Card.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskell #-}
 module Widget.Card ( hCard ) where
 
@@ -8,6 +9,7 @@ import Import
 import Database.Esqueleto ( (^.) )
 import qualified Database.Esqueleto as E
 
+import Model.Markdown ( unMarkdown )
 import Text.Mustache ( substitute )
 import Util ( compileMustache )
 
@@ -24,6 +26,7 @@ profileUrl site = substitute $ T.unpack (siteName site) `compileMustache` siteTe
 
 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
@@ -31,4 +34,23 @@ hCard (Entity userId user) = do
         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

@@ -10,6 +10,8 @@ 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
@@ -22,7 +24,7 @@ toFormattedTime time = FormattedTime (unfriendly time) <$> friendly time
           friendly = liftIO . humanReadableTime
 
 entryR :: Entity Entry -> Route App
-entryR (Entity entryId Entry {..}) = route entrySlug entryKind entryId
+entryR (Entity entryId Entry {..}) = route (entryName >>= mkSlug) entryKind entryId
     where route (Just s) = \k i -> EntryWithSlugR k i s
           route Nothing  = EntryR
 

src/Widget/Feed.hs

@@ -4,5 +4,9 @@ module Widget.Feed ( hFeed ) where
 import Import
 import Widget.Entry ( hEntry )
 
-hFeed :: [Entity Entry] -> Widget
+import qualified Data.Text as T
-hFeed entries = $(widgetFile "mf2/h-feed")
+
+hFeed :: T.Text -> [Entity Entry] -> Widget
+hFeed name entries = do
+    mroute <- getCurrentRoute
+    $(widgetFile "mf2/h-feed")

templates/default-layout-wrapper.hamlet

@@ -5,12 +5,12 @@ $doctype 5
     <meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no">
     <meta name="generator" content="#{packageName package} #{packageVersion package}">
 
-    <title>
+    <title>#{fullTitle}
-      $if hasPageTitle
-        #{pageTitle pc} ~ #
-      #{siteTitle $ appSettings master}
     $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">
@@ -25,14 +25,3 @@ $doctype 5
     <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

@@ -7,6 +7,13 @@ a
     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

templates/default-layout.hamlet

@@ -1,5 +1,5 @@
 <header>
-    <nav .navbar .navbar-expand-lg .navbar-dark.bg-dark>
+    <nav .navbar .navbar-expand-md .navbar-dark.bg-dark>
         <a .navbar-brand rel="home" href=@{HomeR}>#{siteTitle $ appSettings master}
         <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>

templates/entries.hamlet

@@ -1 +0,0 @@
-^{hFeed entries}

templates/entry.hamlet

@@ -1 +0,0 @@
-^{hEntry entry}

templates/home.cassius

@@ -2,11 +2,10 @@ body > main
   display: flex
   flex-direction: column
   align-items: center
-  > ol.h-feed
+  > div.h-feed
     flex: 1
     margin-bottom: 0
-  > .author
+  > aside.author
-    height: 100%
     max-width: 25rem
     margin-bottom: 2em
     > .h-card
@@ -16,8 +15,8 @@ body > main
 @media (min-width: 768px)
   body > main
     flex-direction: row-reverse
-    align-items: flex-start
+    align-items: unset
-    > ol.h-feed
+    > div.h-feed
       margin-right: 2em
-    > .author
+    > aside.author
       margin-bottom: 0

templates/home.hamlet

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

templates/mf2/h-card.hamlet

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

templates/mf2/h-entry.cassius

@@ -1,7 +1,12 @@
 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,20 +1,33 @@
-<article .h-entry .card.bg-dark>
+<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>
-    <h4 .p-name .card-title>#{entryName entry}
+    $maybe name <- entryName entry
-    <div .e-content>
+      <h4 .p-name .card-title itemprop="headline">#{name}
-      #{entryContent entry}
+      <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=@{HomeR}>
+      <a .p-author.h-card href=@{userProfile author}>
-        <i .fa.fa-user>
+        <img .u-photo src=@{AvatarR $ entryAuthorId entry} alt=#{userFullName author}>
         #{userFullName author}
-    <a .u-url href="@{entryR (Entity entryId entry)}">
+      $# 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 datetime=#{timeUnfriendly published} title=#{timeUnfriendly published}>
+    <time .dt-published itemprop="datePublished" datetime=#{timeUnfriendly published} title=#{timeUnfriendly published}>
       <i .fa.fa-calendar>
       #{timeFriendly published}
-    <time .dt-updated datetime=#{timeUnfriendly updated} title=#{timeUnfriendly updated} :published == updated:hidden>
+    <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

templates/mf2/h-feed.cassius

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

templates/mf2/h-feed.hamlet

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