chore(web): Delete //web/tazblog
Deleting this code feels strange. This project has been around for a decade, and despite occasionally needing a bunch of tweaks it had aged well and worked fine for a very long time. I've reached a strange point where I don't really feel like using Haskell anymore, and every interaction with this project in recent years has been fighting dependency management tooling for Haskell, or dealing with strange build problems. The simple fact is that the service never really did anything other than render Markdown dynamically, and at this point I can do that much better with //tools/cheddar instead. So, tazblog-hs, it's time to say goodbye. Rest in peace!
This commit is contained in:
Vincent Ambo
parent
9fc9b58301
commit
05ab6825b3
14 changed files with 0 additions and 679 deletions
|
|
@ -25,5 +25,4 @@ in with pkgs; [
|
||||||
third_party.git
|
third_party.git
|
||||||
third_party.guile
|
third_party.guile
|
||||||
third_party.lisp # will build all third-party libraries
|
third_party.lisp # will build all third-party libraries
|
||||||
# web.tazblog # TODO(tazjin): Happstack build failure in nixos-unstable
|
|
||||||
]
|
]
|
||||||
|
|
|
||||||
|
|
@ -1,24 +0,0 @@
|
||||||
-- | Main module for the blog's web server
|
|
||||||
module Main where
|
|
||||||
|
|
||||||
import Control.Applicative ((<$>), (<*>))
|
|
||||||
import Server (runBlog)
|
|
||||||
import System.Environment (getEnv)
|
|
||||||
|
|
||||||
data MainOptions
|
|
||||||
= MainOptions
|
|
||||||
{ blogPort :: Int,
|
|
||||||
resourceDir :: String
|
|
||||||
}
|
|
||||||
|
|
||||||
readOpts :: IO MainOptions
|
|
||||||
readOpts =
|
|
||||||
MainOptions
|
|
||||||
<$> (fmap read $ getEnv "PORT")
|
|
||||||
<*> getEnv "RESOURCE_DIR"
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = do
|
|
||||||
opts <- readOpts
|
|
||||||
putStrLn ("tazblog starting on port " ++ (show $ blogPort opts))
|
|
||||||
runBlog (blogPort opts) (resourceDir opts)
|
|
||||||
|
|
@ -1,18 +0,0 @@
|
||||||
# Build configuration for the blog using plain Nix.
|
|
||||||
#
|
|
||||||
# tazblog.nix was generated using cabal2nix.
|
|
||||||
|
|
||||||
{ pkgs, ... }:
|
|
||||||
|
|
||||||
let
|
|
||||||
inherit (pkgs.third_party) writeShellScriptBin haskell;
|
|
||||||
tazblog = haskell.packages.ghc865.callPackage ./tazblog.nix {};
|
|
||||||
wrapper = writeShellScriptBin "tazblog" ''
|
|
||||||
export PORT=8000
|
|
||||||
export RESOURCE_DIR=${./static}
|
|
||||||
exec ${tazblog}/bin/tazblog
|
|
||||||
'';
|
|
||||||
in wrapper.overrideAttrs(_: {
|
|
||||||
allowSubstitutes = true;
|
|
||||||
meta.enableCI = true;
|
|
||||||
})
|
|
||||||
|
|
@ -1,11 +0,0 @@
|
||||||
{ pkgs ? (import ../../default.nix {}).third_party.nixpkgs }:
|
|
||||||
|
|
||||||
let tazblog = import ./tazblog.nix;
|
|
||||||
depNames = with builtins; filter (
|
|
||||||
p: hasAttr p pkgs.haskellPackages
|
|
||||||
) (attrNames (functionArgs tazblog));
|
|
||||||
ghc = pkgs.ghc.withPackages(p: map (x: p."${x}") depNames);
|
|
||||||
in pkgs.stdenv.mkDerivation {
|
|
||||||
name = "shell";
|
|
||||||
buildInputs = [ ghc pkgs.hlint ];
|
|
||||||
}
|
|
||||||
|
|
@ -1,141 +0,0 @@
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
|
||||||
|
|
||||||
module Blog where
|
|
||||||
|
|
||||||
import BlogStore
|
|
||||||
import Data.Text (Text, pack)
|
|
||||||
import qualified Data.Text as T
|
|
||||||
import Data.Text.Lazy (fromStrict)
|
|
||||||
import Data.Time
|
|
||||||
import Text.Blaze.Html (preEscapedToHtml)
|
|
||||||
import Text.Hamlet
|
|
||||||
import Text.Markdown
|
|
||||||
|
|
||||||
blogTitle :: Text = "tazjin's blog"
|
|
||||||
|
|
||||||
repoURL :: Text = "https://bitbucket.org/tazjin/tazblog-haskell"
|
|
||||||
|
|
||||||
mailTo :: Text = "mailto:mail@tazj.in"
|
|
||||||
|
|
||||||
twitter :: Text = "https://twitter.com/tazjin"
|
|
||||||
|
|
||||||
replace :: Eq a => a -> a -> [a] -> [a]
|
|
||||||
replace x y = map (\z -> if z == x then y else z)
|
|
||||||
|
|
||||||
-- |After this date all entries are Markdown
|
|
||||||
markdownCutoff :: Day
|
|
||||||
markdownCutoff = fromGregorian 2013 04 28
|
|
||||||
|
|
||||||
blogTemplate :: Text -> Html -> Html
|
|
||||||
blogTemplate t_append body =
|
|
||||||
[shamlet|
|
|
||||||
$doctype 5
|
|
||||||
<head>
|
|
||||||
<meta charset="utf-8">
|
|
||||||
<meta name="viewport" content="width=device-width, initial-scale=1">
|
|
||||||
<meta name="description" content=#{blogTitle}#{t_append}>
|
|
||||||
<link rel="stylesheet" type="text/css" href="/static/blog.css" media="all">
|
|
||||||
<link rel="alternate" type="application/rss+xml" title="RSS-Feed" href="/rss.xml">
|
|
||||||
<title>#{blogTitle}#{t_append}
|
|
||||||
<body>
|
|
||||||
<header>
|
|
||||||
<h1>
|
|
||||||
<a href="/" .unstyled-link>#{blogTitle}
|
|
||||||
<hr>
|
|
||||||
^{body}
|
|
||||||
^{showFooter}
|
|
||||||
|]
|
|
||||||
|
|
||||||
showFooter :: Html
|
|
||||||
showFooter =
|
|
||||||
[shamlet|
|
|
||||||
<footer>
|
|
||||||
<p .footer>Served without any dynamic languages.
|
|
||||||
<p .footer>
|
|
||||||
<a href=#{repoURL} .uncoloured-link>
|
|
||||||
|
|
|
||||||
<a href=#{twitter} .uncoloured-link>Twitter
|
|
||||||
|
|
|
||||||
<a href=#{mailTo} .uncoloured-link>Mail
|
|
||||||
<p .lod>
|
|
||||||
ಠ_ಠ
|
|
||||||
|]
|
|
||||||
|
|
||||||
isEntryMarkdown :: Entry -> Bool
|
|
||||||
isEntryMarkdown e = edate e > markdownCutoff
|
|
||||||
|
|
||||||
renderEntryMarkdown :: Text -> Html
|
|
||||||
renderEntryMarkdown = markdown def {msXssProtect = False} . fromStrict
|
|
||||||
|
|
||||||
renderEntries :: [Entry] -> Maybe Html -> Html
|
|
||||||
renderEntries entries pageLinks =
|
|
||||||
[shamlet|
|
|
||||||
$forall entry <- entries
|
|
||||||
<article>
|
|
||||||
<h2 .inline>
|
|
||||||
<a href=#{linkElems entry} .unstyled-link>
|
|
||||||
#{title entry}
|
|
||||||
<aside .date>
|
|
||||||
#{pack $ formatTime defaultTimeLocale "%Y-%m-%d" $ edate entry}
|
|
||||||
$if (isEntryMarkdown entry)
|
|
||||||
^{renderEntryMarkdown $ text entry}
|
|
||||||
$else
|
|
||||||
^{preEscapedToHtml $ text entry}
|
|
||||||
<hr>
|
|
||||||
$maybe links <- pageLinks
|
|
||||||
^{links}
|
|
||||||
|]
|
|
||||||
where
|
|
||||||
linkElems Entry {..} = "/" ++ show entryId
|
|
||||||
|
|
||||||
showLinks :: Maybe Int -> Html
|
|
||||||
showLinks (Just i) =
|
|
||||||
[shamlet|
|
|
||||||
$if ((>) i 1)
|
|
||||||
<div .navigation>
|
|
||||||
<a href=#{nLink $ succ i} .uncoloured-link>Earlier
|
|
||||||
|
|
|
||||||
<a href=#{nLink $ pred i} .uncoloured-link>Later
|
|
||||||
$elseif ((<=) i 1)
|
|
||||||
^{showLinks Nothing}
|
|
||||||
|]
|
|
||||||
where
|
|
||||||
nLink page = T.concat ["/?page=", show' page]
|
|
||||||
showLinks Nothing =
|
|
||||||
[shamlet|
|
|
||||||
<div .navigation>
|
|
||||||
<a href="/?page=2" .uncoloured-link>Earlier
|
|
||||||
|]
|
|
||||||
|
|
||||||
renderEntry :: Entry -> Html
|
|
||||||
renderEntry e@Entry {..} =
|
|
||||||
[shamlet|
|
|
||||||
<article>
|
|
||||||
<h2 .inline>
|
|
||||||
#{title}
|
|
||||||
<aside .date>
|
|
||||||
#{pack $ formatTime defaultTimeLocale "%Y-%m-%d" edate}
|
|
||||||
$if (isEntryMarkdown e)
|
|
||||||
^{renderEntryMarkdown text}
|
|
||||||
$else
|
|
||||||
^{preEscapedToHtml $ text}
|
|
||||||
<hr>
|
|
||||||
|]
|
|
||||||
|
|
||||||
showError :: Text -> Text -> Html
|
|
||||||
showError title err =
|
|
||||||
blogTemplate (": " <> title)
|
|
||||||
[shamlet|
|
|
||||||
<p>:(
|
|
||||||
<p>#{err}
|
|
||||||
<hr>
|
|
||||||
|]
|
|
||||||
|
|
@ -1,182 +0,0 @@
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
||||||
{-# LANGUAGE LambdaCase #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
|
|
||||||
-- |This module implements fetching of individual blog entries from
|
|
||||||
-- DNS. Yes, you read that correctly.
|
|
||||||
--
|
|
||||||
-- Each blog post is stored as a set of records in a designated DNS
|
|
||||||
-- zone. For the production blog, this zone is `blog.tazj.in.`.
|
|
||||||
--
|
|
||||||
-- A top-level record at `_posts` contains a list of all published
|
|
||||||
-- post IDs.
|
|
||||||
--
|
|
||||||
-- For each of these post IDs, there is a record at `_meta.$postID`
|
|
||||||
-- that contains the title and number of post chunks.
|
|
||||||
--
|
|
||||||
-- For each post chunk, there is a record at `_$chunkID.$postID` that
|
|
||||||
-- contains a base64-encoded post fragment.
|
|
||||||
--
|
|
||||||
-- This module implements logic for assembling a post out of these
|
|
||||||
-- fragments and caching it based on the TTL of its `_meta` record.
|
|
||||||
module BlogStore
|
|
||||||
( BlogCache,
|
|
||||||
EntryId (..),
|
|
||||||
Entry (..),
|
|
||||||
withCache,
|
|
||||||
listEntries,
|
|
||||||
getEntry,
|
|
||||||
show'
|
|
||||||
)
|
|
||||||
where
|
|
||||||
|
|
||||||
import Control.Applicative ((<$>), (<*>))
|
|
||||||
import Control.Monad (mzero)
|
|
||||||
import Control.Monad.IO.Class (MonadIO, liftIO)
|
|
||||||
import Data.Aeson ((.:), FromJSON (..), Value (Object), decodeStrict)
|
|
||||||
import Data.ByteString.Base64 (decodeLenient)
|
|
||||||
import Data.Either (fromRight)
|
|
||||||
import Data.List (sortBy)
|
|
||||||
import Data.Text as T (Text, concat, pack)
|
|
||||||
import Data.Text.Encoding (decodeUtf8', encodeUtf8)
|
|
||||||
import Data.Time (Day)
|
|
||||||
import Network.DNS (DNSError, lookupTXT)
|
|
||||||
import qualified Network.DNS.Resolver as R
|
|
||||||
|
|
||||||
newtype EntryId = EntryId {unEntryId :: Integer}
|
|
||||||
deriving (Eq, Ord, FromJSON)
|
|
||||||
|
|
||||||
instance Show EntryId where
|
|
||||||
|
|
||||||
show = show . unEntryId
|
|
||||||
|
|
||||||
data Entry
|
|
||||||
= Entry
|
|
||||||
{ entryId :: EntryId,
|
|
||||||
author :: Text,
|
|
||||||
title :: Text,
|
|
||||||
text :: Text,
|
|
||||||
edate :: Day
|
|
||||||
}
|
|
||||||
deriving (Eq, Ord, Show)
|
|
||||||
|
|
||||||
-- | Wraps a DNS resolver with caching configured. For the initial
|
|
||||||
-- version of this, all caching of entries is done by the resolver
|
|
||||||
-- (i.e. no pre-assembled versions of entries are cached).
|
|
||||||
data BlogCache = BlogCache R.Resolver Text
|
|
||||||
|
|
||||||
data StoreError
|
|
||||||
= PostNotFound EntryId
|
|
||||||
| DNS DNSError
|
|
||||||
| InvalidMetadata
|
|
||||||
| InvalidChunk
|
|
||||||
| InvalidPosts
|
|
||||||
deriving (Show)
|
|
||||||
|
|
||||||
type Offset = Int
|
|
||||||
|
|
||||||
type Count = Int
|
|
||||||
|
|
||||||
withCache :: Text -> (BlogCache -> IO a) -> IO a
|
|
||||||
withCache zone f = do
|
|
||||||
let conf =
|
|
||||||
R.defaultResolvConf
|
|
||||||
{ R.resolvCache = Just R.defaultCacheConf,
|
|
||||||
R.resolvConcurrent = True
|
|
||||||
}
|
|
||||||
seed <- R.makeResolvSeed conf
|
|
||||||
R.withResolver seed (\r -> f $ BlogCache r zone)
|
|
||||||
|
|
||||||
listEntries :: MonadIO m => BlogCache -> Offset -> Count -> m [Entry]
|
|
||||||
listEntries cache offset count = liftIO $ do
|
|
||||||
posts <- postList cache
|
|
||||||
entries <- mapM (entryFromDNS cache) $ take count $ drop offset $ fromRight (error "no posts") posts
|
|
||||||
-- TODO: maybe don't just drop broken entries
|
|
||||||
return
|
|
||||||
$ fromRight (error "no entries")
|
|
||||||
$ sequence entries
|
|
||||||
|
|
||||||
getEntry :: MonadIO m => BlogCache -> EntryId -> m (Maybe Entry)
|
|
||||||
getEntry cache eid = liftIO $ entryFromDNS cache eid >>= \case
|
|
||||||
Left _ -> return Nothing -- TODO: ??
|
|
||||||
Right entry -> return $ Just entry
|
|
||||||
|
|
||||||
show' :: Show a => a -> Text
|
|
||||||
show' = pack . show
|
|
||||||
|
|
||||||
-- * DNS fetching implementation
|
|
||||||
type Chunk = Integer
|
|
||||||
|
|
||||||
-- | Represents the metadata stored for each post in the _meta record.
|
|
||||||
data Meta = Meta Integer Text Day
|
|
||||||
deriving (Show)
|
|
||||||
|
|
||||||
instance FromJSON Meta where
|
|
||||||
|
|
||||||
parseJSON (Object v) =
|
|
||||||
Meta
|
|
||||||
<$> v
|
|
||||||
.: "c"
|
|
||||||
<*> v
|
|
||||||
.: "t"
|
|
||||||
<*> v
|
|
||||||
.: "d"
|
|
||||||
parseJSON _ = mzero
|
|
||||||
|
|
||||||
entryMetadata :: BlogCache -> EntryId -> IO (Either StoreError Meta)
|
|
||||||
entryMetadata (BlogCache r z) (EntryId eid) =
|
|
||||||
let domain = encodeUtf8 ("_meta." <> show' eid <> "." <> z)
|
|
||||||
record = lookupTXT r domain
|
|
||||||
toMeta rrdata = case decodeStrict $ decodeLenient rrdata of
|
|
||||||
Nothing -> Left InvalidMetadata
|
|
||||||
Just m -> Right m
|
|
||||||
in record >>= \case
|
|
||||||
(Left err) -> return $ Left $ DNS err
|
|
||||||
(Right [bs]) -> return $ toMeta bs
|
|
||||||
_ -> return $ Left InvalidMetadata
|
|
||||||
|
|
||||||
entryChunk :: BlogCache -> EntryId -> Chunk -> IO (Either StoreError Text)
|
|
||||||
entryChunk (BlogCache r z) (EntryId eid) c =
|
|
||||||
let domain = encodeUtf8 ("_" <> show' c <> "." <> show' eid <> "." <> z)
|
|
||||||
record = lookupTXT r domain
|
|
||||||
toChunk rrdata = case decodeUtf8' $ decodeLenient rrdata of
|
|
||||||
Left _ -> Left InvalidChunk
|
|
||||||
Right chunk -> Right chunk
|
|
||||||
in record >>= \case
|
|
||||||
(Left err) -> return $ Left $ DNS err
|
|
||||||
(Right [bs]) -> return $ toChunk bs
|
|
||||||
_ -> return $ Left InvalidChunk
|
|
||||||
|
|
||||||
fetchAssembleChunks :: BlogCache -> EntryId -> Meta -> IO (Either StoreError Text)
|
|
||||||
fetchAssembleChunks cache eid (Meta n _ _) = do
|
|
||||||
chunks <- mapM (entryChunk cache eid) [0 .. (n - 1)]
|
|
||||||
return $ fmap T.concat $ sequence chunks
|
|
||||||
|
|
||||||
entryFromDNS :: BlogCache -> EntryId -> IO (Either StoreError Entry)
|
|
||||||
entryFromDNS cache eid = do
|
|
||||||
meta <- entryMetadata cache eid
|
|
||||||
case meta of
|
|
||||||
Left err -> return $ Left err
|
|
||||||
Right meta -> do
|
|
||||||
chunks <- fetchAssembleChunks cache eid meta
|
|
||||||
let (Meta _ t d) = meta
|
|
||||||
return
|
|
||||||
$ either Left
|
|
||||||
( \text -> Right $ Entry
|
|
||||||
{ entryId = eid,
|
|
||||||
author = "tazjin",
|
|
||||||
title = t,
|
|
||||||
text = text,
|
|
||||||
edate = d
|
|
||||||
}
|
|
||||||
)
|
|
||||||
chunks
|
|
||||||
|
|
||||||
postList :: BlogCache -> IO (Either StoreError [EntryId])
|
|
||||||
postList (BlogCache r z) =
|
|
||||||
let domain = encodeUtf8 ("_posts." <> z)
|
|
||||||
record = lookupTXT r domain
|
|
||||||
toPosts =
|
|
||||||
fmap (sortBy (flip compare))
|
|
||||||
. mapM (maybe (Left InvalidPosts) Right . decodeStrict)
|
|
||||||
in either (Left . DNS) toPosts <$> record
|
|
||||||
|
|
@ -1,48 +0,0 @@
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
|
||||||
|
|
||||||
module RSS
|
|
||||||
( renderFeed
|
|
||||||
)
|
|
||||||
where
|
|
||||||
|
|
||||||
import BlogStore
|
|
||||||
import Data.Maybe (fromJust)
|
|
||||||
import qualified Data.Text as T
|
|
||||||
import Data.Time (UTCTime (..), getCurrentTime, secondsToDiffTime)
|
|
||||||
import Network.URI (URI, parseURI)
|
|
||||||
import Text.RSS
|
|
||||||
|
|
||||||
createChannel :: UTCTime -> [ChannelElem]
|
|
||||||
createChannel now =
|
|
||||||
[ Language "en",
|
|
||||||
Copyright "Vincent Ambo",
|
|
||||||
WebMaster "mail@tazj.in",
|
|
||||||
ChannelPubDate now
|
|
||||||
]
|
|
||||||
|
|
||||||
createRSS :: UTCTime -> [Item] -> RSS
|
|
||||||
createRSS t =
|
|
||||||
let link = fromJust $ parseURI "https://tazj.in"
|
|
||||||
in RSS "tazjin's blog" link "tazjin's blog feed" (createChannel t)
|
|
||||||
|
|
||||||
createItem :: Entry -> Item
|
|
||||||
createItem Entry {..} =
|
|
||||||
[ Title "tazjin's blog",
|
|
||||||
Link $ entryLink entryId,
|
|
||||||
Description $ T.unpack text,
|
|
||||||
PubDate $ UTCTime edate $ secondsToDiffTime 0
|
|
||||||
]
|
|
||||||
|
|
||||||
entryLink :: EntryId -> URI
|
|
||||||
entryLink i =
|
|
||||||
let url = "http://tazj.in/" ++ "/" ++ show i
|
|
||||||
in fromJust $ parseURI url
|
|
||||||
|
|
||||||
createItems :: [Entry] -> [Item]
|
|
||||||
createItems = map createItem
|
|
||||||
|
|
||||||
createFeed :: [Entry] -> IO RSS
|
|
||||||
createFeed e = getCurrentTime >>= (\t -> return $ createRSS t $ createItems e)
|
|
||||||
|
|
||||||
renderFeed :: [Entry] -> IO String
|
|
||||||
renderFeed e = fmap (showXML . rssToXML) (createFeed e)
|
|
||||||
|
|
@ -1,81 +0,0 @@
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
|
||||||
|
|
||||||
module Server where
|
|
||||||
|
|
||||||
import Blog
|
|
||||||
import BlogStore
|
|
||||||
import Control.Applicative (optional)
|
|
||||||
import Control.Monad (msum)
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
|
||||||
import Data.Maybe (maybe)
|
|
||||||
import qualified Data.Text as T
|
|
||||||
import Happstack.Server hiding (Session)
|
|
||||||
import RSS
|
|
||||||
|
|
||||||
pageSize :: Int
|
|
||||||
pageSize = 3
|
|
||||||
|
|
||||||
tmpPolicy :: BodyPolicy
|
|
||||||
tmpPolicy = defaultBodyPolicy "/tmp" 0 200000 1000
|
|
||||||
|
|
||||||
runBlog :: Int -> String -> IO ()
|
|
||||||
runBlog port respath =
|
|
||||||
withCache "blog.tazj.in." $ \cache ->
|
|
||||||
simpleHTTP nullConf {port = port} $ tazblog cache respath
|
|
||||||
|
|
||||||
tazblog :: BlogCache -> String -> ServerPart Response
|
|
||||||
tazblog cache resDir =
|
|
||||||
msum
|
|
||||||
[ -- legacy language-specific routes
|
|
||||||
dir "de" $ blogHandler cache,
|
|
||||||
dir "en" $ blogHandler cache,
|
|
||||||
dir "static" $ staticHandler resDir,
|
|
||||||
blogHandler cache,
|
|
||||||
staticHandler resDir,
|
|
||||||
notFound $ toResponse $ showError "Not found" "Page not found"
|
|
||||||
]
|
|
||||||
|
|
||||||
blogHandler :: BlogCache -> ServerPart Response
|
|
||||||
blogHandler cache =
|
|
||||||
msum
|
|
||||||
[ path $ \(eId :: Integer) -> showEntry cache $ EntryId eId,
|
|
||||||
nullDir >> showIndex cache,
|
|
||||||
dir "rss" $ nullDir >> showRSS cache,
|
|
||||||
dir "rss.xml" $ nullDir >> showRSS cache
|
|
||||||
]
|
|
||||||
|
|
||||||
staticHandler :: String -> ServerPart Response
|
|
||||||
staticHandler resDir = do
|
|
||||||
setHeaderM "cache-control" "max-age=630720000"
|
|
||||||
setHeaderM "expires" "Tue, 20 Jan 2037 04:20:42 GMT"
|
|
||||||
serveDirectory DisableBrowsing [] resDir
|
|
||||||
|
|
||||||
showEntry :: BlogCache -> EntryId -> ServerPart Response
|
|
||||||
showEntry cache eId = do
|
|
||||||
entry <- getEntry cache eId
|
|
||||||
tryEntry entry
|
|
||||||
|
|
||||||
tryEntry :: Maybe Entry -> ServerPart Response
|
|
||||||
tryEntry Nothing = notFound $ toResponse $ showError "Not found" "Blog entry not found"
|
|
||||||
tryEntry (Just entry) = ok $ toResponse $ blogTemplate eTitle $ renderEntry entry
|
|
||||||
where
|
|
||||||
eTitle = T.append ": " (title entry)
|
|
||||||
|
|
||||||
offset :: Maybe Int -> Int
|
|
||||||
offset = maybe 0 (pageSize *)
|
|
||||||
|
|
||||||
showIndex :: BlogCache -> ServerPart Response
|
|
||||||
showIndex cache = do
|
|
||||||
(page :: Maybe Int) <- optional $ lookRead "page"
|
|
||||||
entries <- listEntries cache (offset page) pageSize
|
|
||||||
ok $ toResponse $ blogTemplate ""
|
|
||||||
$ renderEntries entries (Just $ showLinks page)
|
|
||||||
|
|
||||||
showRSS :: BlogCache -> ServerPart Response
|
|
||||||
showRSS cache = do
|
|
||||||
entries <- listEntries cache 0 4
|
|
||||||
feed <- liftIO $ renderFeed entries
|
|
||||||
setHeaderM "content-type" "text/xml"
|
|
||||||
ok $ toResponse feed
|
|
||||||
Binary file not shown.
|
Before Width: | Height: | Size: 9.5 KiB |
|
|
@ -1,35 +0,0 @@
|
||||||
body {
|
|
||||||
margin: 40px auto;
|
|
||||||
max-width: 650px;
|
|
||||||
line-height: 1.6;
|
|
||||||
font-size: 18px;
|
|
||||||
color: #383838;
|
|
||||||
padding: 0 10px
|
|
||||||
}
|
|
||||||
h1, h2, h3 {
|
|
||||||
line-height: 1.2
|
|
||||||
}
|
|
||||||
.footer {
|
|
||||||
text-align: right;
|
|
||||||
}
|
|
||||||
.lod {
|
|
||||||
text-align: center;
|
|
||||||
}
|
|
||||||
.unstyled-link {
|
|
||||||
color: inherit;
|
|
||||||
text-decoration: none;
|
|
||||||
}
|
|
||||||
.uncoloured-link {
|
|
||||||
color: inherit;
|
|
||||||
}
|
|
||||||
.date {
|
|
||||||
text-align: right;
|
|
||||||
font-style: italic;
|
|
||||||
float: right;
|
|
||||||
}
|
|
||||||
.inline {
|
|
||||||
display: inline;
|
|
||||||
}
|
|
||||||
.navigation {
|
|
||||||
text-align: center;
|
|
||||||
}
|
|
||||||
Binary file not shown.
|
Before Width: | Height: | Size: 4.3 KiB |
|
|
@ -1,69 +0,0 @@
|
||||||
==================================================================
|
|
||||||
https://keybase.io/tazjin
|
|
||||||
--------------------------------------------------------------------
|
|
||||||
|
|
||||||
I hereby claim:
|
|
||||||
|
|
||||||
* I am an admin of http://tazj.in
|
|
||||||
* I am tazjin (https://keybase.io/tazjin) on keybase.
|
|
||||||
* I have a public key with fingerprint DCF3 4CFA C1AC 44B8 7E26 3331 36EE 3481 4F6D 294A
|
|
||||||
|
|
||||||
To claim this, I am signing this object:
|
|
||||||
|
|
||||||
{
|
|
||||||
"body": {
|
|
||||||
"key": {
|
|
||||||
"fingerprint": "dcf34cfac1ac44b87e26333136ee34814f6d294a",
|
|
||||||
"host": "keybase.io",
|
|
||||||
"key_id": "36EE34814F6D294A",
|
|
||||||
"uid": "2268b75a56bb9693d3ef077bc1217900",
|
|
||||||
"username": "tazjin"
|
|
||||||
},
|
|
||||||
"service": {
|
|
||||||
"hostname": "tazj.in",
|
|
||||||
"protocol": "http:"
|
|
||||||
},
|
|
||||||
"type": "web_service_binding",
|
|
||||||
"version": 1
|
|
||||||
},
|
|
||||||
"ctime": 1397644545,
|
|
||||||
"expire_in": 157680000,
|
|
||||||
"prev": "4973fdda56a6cfa726a813411c915458c652be45dd19283f7a4ae4f9c217df14",
|
|
||||||
"seqno": 4,
|
|
||||||
"tag": "signature"
|
|
||||||
}
|
|
||||||
|
|
||||||
with the aforementioned key, yielding the PGP signature:
|
|
||||||
|
|
||||||
-----BEGIN PGP MESSAGE-----
|
|
||||||
Version: GnuPG v2.0.22 (GNU/Linux)
|
|
||||||
|
|
||||||
owGbwMvMwMWY9pU1Q3bHF2vG0wdeJTEE+8WyVSsl5adUKllVK2Wngqm0zLz01KKC
|
|
||||||
osy8EiUrpZTkNGOT5LTEZMPEZBOTJAvzVCMzY2NjQ2Oz1FRjEwtDkzSzFCNLk0Ql
|
|
||||||
HaWM/GKQDqAxSYnFqXqZ+UAxICc+MwUoamzm6gpW72bmAlTvCJQrBUsYGZlZJJmb
|
|
||||||
JpqaJSVZmlkapxinphmYmyclGxoZmlsaGIAUFqcW5SXmpgJVlyRWZWXmKdXqKAHF
|
|
||||||
yjKTU0EuBlmMJK8HVKCjVFCUX5KfnJ8DFMwoKSmwAukpqSwAKSpPTYqHao9PysxL
|
|
||||||
AXoYqKEstag4Mz9PycoQqDK5JBNknqGxpbmZiYmpiamOUmpFQWZRanwmSIWpuZmF
|
|
||||||
ARCArEktAxppYmlunJaSAvRFohkwtMyNzBItDI1NDA2TLQ2Bui2SzUyNklJNTFNS
|
|
||||||
DC2NLIzTzBNNElNN0iyTgZ5MSTM0UQJ5qDAvX8nKBOjMxHSgkcWZ6XmJJaVFqUq1
|
|
||||||
nUwyLAyMXAxsrEygKGPg4hSARWSZH/8/0573HMdvfH5XxeayYZ2efPb8bw730i1/
|
|
||||||
WBU3qru5pKlf3xKmeK5ihtKeT6VXGm3usV2reZWyvO/0joi83oT9P80s88Q6U/vb
|
|
||||||
vmycHnB7e110v/3OZadu/Sx6+uXk/ZeCR8u+p/+6dNc8XWqX/68t06pnrGKU/BfU
|
|
||||||
F7X5S/HUy4ysvyZN+v1Jj6NtMvvN1EvPpCpv3kz2tGU1EzpZFfl8Xujq1OopuxZJ
|
|
||||||
l5kvDlgZ78ezdLZ1+aOlixbsXra4/3fdbZ8XnQX1DatzV18+e2rmMcPKm6qngqIf
|
|
||||||
Xp8oKTAz+Mg1v6gHP0wLN/Mf3JKjYHnX5U6L/KIvkbsLArtES0r7w1iWZ3OvvSPr
|
|
||||||
fW6heune1tOb7j3vP+1XeOyV2ekr6pPO3bdrv9X25HbTaqs7z06f0v35fmtQ3uUZ
|
|
||||||
Z35eLYmaEmb/x/u3vFh6GsvMDocpCTpPlHa0z+xzOGbhzLFO18v21Zd9ISG3Hqtd
|
|
||||||
F7jaLlWa2W+TsytNnXudVrfCBSbl8zNMfuk2e0Z8i9ix3PmEVa3rTEfhde3qwgtY
|
|
||||||
dy8rUbzzd5d9ccF63btqO/VMb4oe04x4uCLB5RD3p+8+s77o/T4WP2cFw+0cviX6
|
|
||||||
StlJX5f+U3Or3fZY7dUfPcmMJZ/eSs7m+1d5IUbs3jI27olHFzGVvTcsu7w79aOK
|
|
||||||
SxmXvnEIUwZXgP6BL4LrPDY1rN2V0q1cZj1/efj880rzeu6+OQYA
|
|
||||||
=xHfH
|
|
||||||
-----END PGP MESSAGE-----
|
|
||||||
|
|
||||||
And finally, I am proving ownership of this host by posting or
|
|
||||||
appending to this document.
|
|
||||||
|
|
||||||
View my publicly-auditable identity here: https://keybase.io/tazjin
|
|
||||||
|
|
||||||
==================================================================
|
|
||||||
|
|
@ -1,39 +0,0 @@
|
||||||
Name: tazblog
|
|
||||||
Version: 6.0.0
|
|
||||||
Synopsis: Tazjin's Blog
|
|
||||||
License: MIT
|
|
||||||
Author: Vincent Ambo
|
|
||||||
Maintainer: mail@tazj.in
|
|
||||||
Category: Web blog
|
|
||||||
Build-type: Simple
|
|
||||||
cabal-version: >= 1.10
|
|
||||||
|
|
||||||
library
|
|
||||||
hs-source-dirs: src
|
|
||||||
default-language: Haskell2010
|
|
||||||
ghc-options: -W
|
|
||||||
exposed-modules: Blog, BlogStore, Server, RSS
|
|
||||||
build-depends: aeson,
|
|
||||||
base,
|
|
||||||
bytestring,
|
|
||||||
happstack-server,
|
|
||||||
text,
|
|
||||||
blaze-html,
|
|
||||||
dns,
|
|
||||||
old-locale,
|
|
||||||
time,
|
|
||||||
base64-bytestring,
|
|
||||||
network,
|
|
||||||
network-uri,
|
|
||||||
rss,
|
|
||||||
shakespeare,
|
|
||||||
markdown
|
|
||||||
|
|
||||||
executable tazblog
|
|
||||||
hs-source-dirs: blog
|
|
||||||
main-is: Main.hs
|
|
||||||
default-language: Haskell2010
|
|
||||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
|
||||||
build-depends: base,
|
|
||||||
tazblog,
|
|
||||||
network
|
|
||||||
|
|
@ -1,30 +0,0 @@
|
||||||
{ mkDerivation, aeson, base, base64-bytestring, blaze-html , bytestring, dns
|
|
||||||
, happstack-server, markdown, network, network-uri, old-locale, rss
|
|
||||||
, shakespeare, stdenv, text, time }:
|
|
||||||
mkDerivation {
|
|
||||||
pname = "tazblog";
|
|
||||||
version = "6.0.0";
|
|
||||||
src = ./.;
|
|
||||||
isLibrary = true;
|
|
||||||
isExecutable = true;
|
|
||||||
libraryHaskellDepends = [
|
|
||||||
aeson
|
|
||||||
base
|
|
||||||
base64-bytestring
|
|
||||||
blaze-html
|
|
||||||
bytestring
|
|
||||||
dns
|
|
||||||
happstack-server
|
|
||||||
markdown
|
|
||||||
network
|
|
||||||
network-uri
|
|
||||||
old-locale
|
|
||||||
rss
|
|
||||||
shakespeare
|
|
||||||
text
|
|
||||||
time
|
|
||||||
];
|
|
||||||
executableHaskellDepends = [ base network ];
|
|
||||||
description = "Tazjin's Blog";
|
|
||||||
license = stdenv.lib.licenses.mit;
|
|
||||||
}
|
|
||||||
Loading…
Reference in a new issue