about summary refs log tree commit diff
path: root/web
diff options
context:
space:
mode:
Diffstat (limited to 'web')
-rw-r--r--web/cgit-taz/0001-cgit_monorepo_urls.patch114
-rw-r--r--web/cgit-taz/0002-cgit_subtree_readmes.patch46
-rw-r--r--web/cgit-taz/0003-cgit_subtree_about_links.patch50
-rw-r--r--web/cgit-taz/default.nix80
-rw-r--r--web/cgit-taz/thttpd_cgi_idx.patch13
-rw-r--r--web/tazblog/blog/Main.hs24
-rw-r--r--web/tazblog/default.nix18
-rw-r--r--web/tazblog/shell.nix11
-rw-r--r--web/tazblog/src/Blog.hs141
-rw-r--r--web/tazblog/src/BlogStore.hs182
-rw-r--r--web/tazblog/src/RSS.hs48
-rw-r--r--web/tazblog/src/Server.hs81
-rw-r--r--web/tazblog/static/apple-touch-icon.pngbin0 -> 9756 bytes
-rw-r--r--web/tazblog/static/blog.css35
-rw-r--r--web/tazblog/static/favicon.icobin0 -> 4354 bytes
-rw-r--r--web/tazblog/static/keybase.txt69
-rw-r--r--web/tazblog/tazblog.cabal39
-rw-r--r--web/tazblog/tazblog.nix30
18 files changed, 981 insertions, 0 deletions
diff --git a/web/cgit-taz/0001-cgit_monorepo_urls.patch b/web/cgit-taz/0001-cgit_monorepo_urls.patch
new file mode 100644
index 000000000000..624a74b5dbbc
--- /dev/null
+++ b/web/cgit-taz/0001-cgit_monorepo_urls.patch
@@ -0,0 +1,114 @@
+From f6646e5a6da29da979d6954feba9d85556bc6936 Mon Sep 17 00:00:00 2001
+From: Vincent Ambo <tazjin@google.com>
+Date: Sat, 21 Dec 2019 18:41:45 +0000
+Subject: [PATCH 1/3] feat: Generate monorepo compatible URLs
+
+Generates URLs that do not include the repository name.
+
+On git.tazj.in, only one repository (depot) is served - hence URLs
+generated by cgit need not include the name.
+---
+ cmd.c       | 24 +-----------------------
+ ui-shared.c | 29 +++++++++--------------------
+ 2 files changed, 10 insertions(+), 43 deletions(-)
+
+diff --git a/cmd.c b/cmd.c
+index 63f0ae5..b37b79d 100644
+--- a/cmd.c
++++ b/cmd.c
+@@ -39,29 +39,7 @@ static void atom_fn(void)
+ 
+ static void about_fn(void)
+ {
+-	if (ctx.repo) {
+-		size_t path_info_len = ctx.env.path_info ? strlen(ctx.env.path_info) : 0;
+-		if (!ctx.qry.path &&
+-		    ctx.qry.url[strlen(ctx.qry.url) - 1] != '/' &&
+-		    (!path_info_len || ctx.env.path_info[path_info_len - 1] != '/')) {
+-			char *currenturl = cgit_currenturl();
+-			char *redirect = fmtalloc("%s/", currenturl);
+-			cgit_redirect(redirect, true);
+-			free(currenturl);
+-			free(redirect);
+-		} else if (ctx.repo->readme.nr)
+-			cgit_print_repo_readme(ctx.qry.path);
+-		else if (ctx.repo->homepage)
+-			cgit_redirect(ctx.repo->homepage, false);
+-		else {
+-			char *currenturl = cgit_currenturl();
+-			char *redirect = fmtalloc("%s../", currenturl);
+-			cgit_redirect(redirect, false);
+-			free(currenturl);
+-			free(redirect);
+-		}
+-	} else
+-		cgit_print_site_readme();
++	cgit_print_repo_readme(ctx.qry.path);
+ }
+ 
+ static void blame_fn(void)
+diff --git a/ui-shared.c b/ui-shared.c
+index 739505a..c7c3754 100644
+--- a/ui-shared.c
++++ b/ui-shared.c
+@@ -95,29 +95,23 @@ const char *cgit_loginurl(void)
+ 
+ char *cgit_repourl(const char *reponame)
+ {
+-	if (ctx.cfg.virtual_root)
+-		return fmtalloc("%s%s/", ctx.cfg.virtual_root, reponame);
+-	else
+-		return fmtalloc("?r=%s", reponame);
++	// my cgit instance *only* serves the depot, hence that's the only value ever
++	// needed.
++	return fmtalloc("/");
+ }
+ 
+ char *cgit_fileurl(const char *reponame, const char *pagename,
+ 		   const char *filename, const char *query)
+ {
+ 	struct strbuf sb = STRBUF_INIT;
+-	char *delim;
+ 
+-	if (ctx.cfg.virtual_root) {
+-		strbuf_addf(&sb, "%s%s/%s/%s", ctx.cfg.virtual_root, reponame,
+-			    pagename, (filename ? filename:""));
+-		delim = "?";
+-	} else {
+-		strbuf_addf(&sb, "?url=%s/%s/%s", reponame, pagename,
+-			    (filename ? filename : ""));
+-		delim = "&amp;";
++	strbuf_addf(&sb, "%s%s/%s", ctx.cfg.virtual_root,
++		pagename, (filename ? filename:""));
++
++	if (query) {
++		strbuf_addf(&sb, "%s%s", "?", query);
+ 	}
+-	if (query)
+-		strbuf_addf(&sb, "%s%s", delim, query);
++
+ 	return strbuf_detach(&sb, NULL);
+ }
+ 
+@@ -245,9 +239,6 @@ static char *repolink(const char *title, const char *class, const char *page,
+ 	html(" href='");
+ 	if (ctx.cfg.virtual_root) {
+ 		html_url_path(ctx.cfg.virtual_root);
+-		html_url_path(ctx.repo->url);
+-		if (ctx.repo->url[strlen(ctx.repo->url) - 1] != '/')
+-			html("/");
+ 		if (page) {
+ 			html_url_path(page);
+ 			html("/");
+@@ -957,8 +948,6 @@ static void print_header(void)
+ 
+ 	html("<td class='main'>");
+ 	if (ctx.repo) {
+-		cgit_index_link("index", NULL, NULL, NULL, NULL, 0, 1);
+-		html(" : ");
+ 		cgit_summary_link(ctx.repo->name, ctx.repo->name, NULL, NULL);
+ 		if (ctx.env.authenticated) {
+ 			html("</td><td class='form'>");
+-- 
+2.24.1.735.g03f4e72817-goog
+
diff --git a/web/cgit-taz/0002-cgit_subtree_readmes.patch b/web/cgit-taz/0002-cgit_subtree_readmes.patch
new file mode 100644
index 000000000000..f3aba10215bc
--- /dev/null
+++ b/web/cgit-taz/0002-cgit_subtree_readmes.patch
@@ -0,0 +1,46 @@
+From 61500898c7d1363f88b763c7778cf1a8dfd13aca Mon Sep 17 00:00:00 2001
+From: Vincent Ambo <tazjin@google.com>
+Date: Sat, 21 Dec 2019 22:58:19 +0000
+Subject: [PATCH 2/3] feat(ui-summary): Attempt to use README at each subtree
+
+This means that individual subtrees of a repository will also have
+their READMEs rendered on the about page, for example:
+
+    /foo/bar/README.md
+
+Will render on:
+
+    /about/foo/bar/
+
+This is useful for monorepo setups in which subtrees represent
+individual projects.
+---
+ ui-summary.c | 12 ++++++++++++
+ 1 file changed, 12 insertions(+)
+
+diff --git a/ui-summary.c b/ui-summary.c
+index 8e81ac4..34ce4e9 100644
+--- a/ui-summary.c
++++ b/ui-summary.c
+@@ -128,6 +128,18 @@ void cgit_print_repo_readme(char *path)
+ 			goto done;
+ 	}
+ 
++	/* Determine which file to serve by checking whether the given filename is
++	 * already a valid file and otherwise appending the expected file name of
++	 * the readme.
++	 *
++	 * If neither yield a valid file, the user gets a blank page. Could probably
++	 * do with an error message in between there, but whatever.
++	 */
++	if (path && ref && !cgit_ref_path_exists(filename, ref, 1)) {
++	  filename = fmtalloc("%s/%s", path, ctx.repo->readme.items[0].string);
++	  free_filename = 1;
++	}
++
+ 	/* Print the calculated readme, either from the git repo or from the
+ 	 * filesystem, while applying the about-filter.
+ 	 */
+-- 
+2.24.1.735.g03f4e72817-goog
+
diff --git a/web/cgit-taz/0003-cgit_subtree_about_links.patch b/web/cgit-taz/0003-cgit_subtree_about_links.patch
new file mode 100644
index 000000000000..6b3d0a70b11d
--- /dev/null
+++ b/web/cgit-taz/0003-cgit_subtree_about_links.patch
@@ -0,0 +1,50 @@
+From 531b55dc96bb7ee2ce52a3612021e1c1f4ddac8a Mon Sep 17 00:00:00 2001
+From: Vincent Ambo <tazjin@google.com>
+Date: Sat, 21 Dec 2019 23:27:28 +0000
+Subject: [PATCH 3/3] feat(ui-shared): Generate links to about pages from
+ subtrees
+
+If you're on tree/foo/bar, the about link will now point to
+about/foo/bar.
+
+Currently the annoying thing about this is that it will also do it for
+files.
+---
+ ui-shared.c | 14 ++++++++++----
+ 1 file changed, 10 insertions(+), 4 deletions(-)
+
+diff --git a/ui-shared.c b/ui-shared.c
+index c7c3754..c37835a 100644
+--- a/ui-shared.c
++++ b/ui-shared.c
+@@ -297,6 +297,12 @@ void cgit_tag_link(const char *name, const char *title, const char *class,
+ 	reporevlink("tag", name, title, class, tag, NULL, NULL);
+ }
+ 
++void cgit_about_link(const char *name, const char *title, const char *class,
++		    const char *head, const char *rev, const char *path)
++{
++	reporevlink("about", name, title, class, head, rev, path);
++}
++
+ void cgit_tree_link(const char *name, const char *title, const char *class,
+ 		    const char *head, const char *rev, const char *path)
+ {
+@@ -985,10 +991,10 @@ void cgit_print_pageheader(void)
+ 
+ 	html("<table class='tabs'><tr><td>\n");
+ 	if (ctx.env.authenticated && ctx.repo) {
+-		if (ctx.repo->readme.nr)
+-			reporevlink("about", "about", NULL,
+-				    hc("about"), ctx.qry.head, NULL,
+-				    NULL);
++		if (ctx.repo->readme.nr) {
++			cgit_about_link("about", NULL, hc("about"), ctx.qry.head,
++					 ctx.qry.sha1, ctx.qry.vpath);
++		}
+ 		cgit_summary_link("summary", NULL, hc("summary"),
+ 				  ctx.qry.head);
+ 		cgit_refs_link("refs", NULL, hc("refs"), ctx.qry.head,
+-- 
+2.24.1.735.g03f4e72817-goog
+
diff --git a/web/cgit-taz/default.nix b/web/cgit-taz/default.nix
new file mode 100644
index 000000000000..962efab91ac7
--- /dev/null
+++ b/web/cgit-taz/default.nix
@@ -0,0 +1,80 @@
+# This derivation configures a 'cgit' instance to serve repositories
+# from a different source.
+#
+# In the first round this will just serve my GitHub repositories until
+# I'm happy with the display.
+
+{ pkgs, ... }:
+
+with pkgs.third_party;
+
+let
+  # Patched version of cgit that has monorepo-specific features.
+  monocgit = cgit.overrideAttrs(old: {
+    patches = old.patches ++ [
+      ./0001-cgit_monorepo_urls.patch
+      ./0002-cgit_subtree_readmes.patch
+      ./0003-cgit_subtree_about_links.patch
+    ];
+  });
+
+  cgitConfig = writeText "cgitrc" ''
+    # Global configuration
+    virtual-root=/
+    enable-http-clone=1
+    readme=:README.md
+    about-filter=${pkgs.tools.cheddar}/bin/cheddar
+    source-filter=${pkgs.tools.cheddar}/bin/cheddar
+    enable-log-filecount=1
+    enable-log-linecount=1
+    enable-follow-links=1
+    enable-blame=1
+    mimetype-file=${mime-types}/etc/mime.types
+    logo=/plain/fun/logo/depot-logo.png
+
+    # Repository configuration
+    repo.url=depot
+    repo.path=/git/depot/
+    repo.desc=tazjin's personal monorepo
+    repo.owner=tazjin <mail@tazj.in>
+    repo.clone-url=https://git.tazj.in ssh://source.developers.google.com:2022/p/tazjins-infrastructure/r/depot
+  '';
+
+  thttpdConfig = writeText "thttpd.conf" ''
+    port=8080
+    dir=${monocgit}/cgit
+    nochroot
+    novhost
+    logfile=/dev/stdout
+    cgipat=**.cgi
+  '';
+
+  # Patched version of thttpd that serves cgit.cgi as the index and
+  # sets the environment variable for pointing cgit at the correct
+  # configuration.
+  #
+  # Things are done this way because recompilation of thttpd is much
+  # faster than cgit and I don't want to wait long when iterating on
+  # config.
+  thttpdConfigPatch = writeText "thttpd_cgit_conf.patch" ''
+    diff --git a/libhttpd.c b/libhttpd.c
+    index c6b1622..eef4b73 100644
+    --- a/libhttpd.c
+    +++ b/libhttpd.c
+    @@ -3055,4 +3055,6 @@ make_envp( httpd_conn* hc )
+
+         envn = 0;
+    +    // force cgit to load the correct configuration
+    +    envp[envn++] = "CGIT_CONFIG=${cgitConfig}";
+         envp[envn++] = build_env( "PATH=%s", CGI_PATH );
+     #ifdef CGI_LD_LIBRARY_PATH
+  '';
+  thttpdCgit = thttpd.overrideAttrs(old: {
+    patches = [
+      ./thttpd_cgi_idx.patch
+      thttpdConfigPatch
+    ];
+  });
+in writeShellScriptBin "cgit-launch" ''
+  exec ${thttpdCgit}/bin/thttpd -D -C ${thttpdConfig}
+# ''
diff --git a/web/cgit-taz/thttpd_cgi_idx.patch b/web/cgit-taz/thttpd_cgi_idx.patch
new file mode 100644
index 000000000000..67dbc0c7ab80
--- /dev/null
+++ b/web/cgit-taz/thttpd_cgi_idx.patch
@@ -0,0 +1,13 @@
+diff --git a/config.h b/config.h
+index 65ab1e3..cde470f 100644
+--- a/config.h
++++ b/config.h
+@@ -327,7 +327,7 @@
+ /* CONFIGURE: A list of index filenames to check.  The files are searched
+ ** for in this order.
+ */
+-#define INDEX_NAMES "index.html", "index.htm", "index.xhtml", "index.xht", "Default.htm", "index.cgi"
++#define INDEX_NAMES "cgit.cgi"
+ 
+ /* CONFIGURE: If this is defined then thttpd will automatically generate
+ ** index pages for directories that don't have an explicit index file.
diff --git a/web/tazblog/blog/Main.hs b/web/tazblog/blog/Main.hs
new file mode 100644
index 000000000000..6074f96b7685
--- /dev/null
+++ b/web/tazblog/blog/Main.hs
@@ -0,0 +1,24 @@
+-- | 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)
diff --git a/web/tazblog/default.nix b/web/tazblog/default.nix
new file mode 100644
index 000000000000..eecadff6ba17
--- /dev/null
+++ b/web/tazblog/default.nix
@@ -0,0 +1,18 @@
+# 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;
+})
diff --git a/web/tazblog/shell.nix b/web/tazblog/shell.nix
new file mode 100644
index 000000000000..ebb891a87458
--- /dev/null
+++ b/web/tazblog/shell.nix
@@ -0,0 +1,11 @@
+{ 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 ];
+}
diff --git a/web/tazblog/src/Blog.hs b/web/tazblog/src/Blog.hs
new file mode 100644
index 000000000000..0a53b5f2fbf4
--- /dev/null
+++ b/web/tazblog/src/Blog.hs
@@ -0,0 +1,141 @@
+{-# 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>
+|]
diff --git a/web/tazblog/src/BlogStore.hs b/web/tazblog/src/BlogStore.hs
new file mode 100644
index 000000000000..60ccd0b5a003
--- /dev/null
+++ b/web/tazblog/src/BlogStore.hs
@@ -0,0 +1,182 @@
+{-# 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
diff --git a/web/tazblog/src/RSS.hs b/web/tazblog/src/RSS.hs
new file mode 100644
index 000000000000..913aa9a4081b
--- /dev/null
+++ b/web/tazblog/src/RSS.hs
@@ -0,0 +1,48 @@
+{-# 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)
diff --git a/web/tazblog/src/Server.hs b/web/tazblog/src/Server.hs
new file mode 100644
index 000000000000..40129988393b
--- /dev/null
+++ b/web/tazblog/src/Server.hs
@@ -0,0 +1,81 @@
+{-# 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
diff --git a/web/tazblog/static/apple-touch-icon.png b/web/tazblog/static/apple-touch-icon.png
new file mode 100644
index 000000000000..22ba058cddd4
--- /dev/null
+++ b/web/tazblog/static/apple-touch-icon.png
Binary files differdiff --git a/web/tazblog/static/blog.css b/web/tazblog/static/blog.css
new file mode 100644
index 000000000000..e6e4ae3c2be0
--- /dev/null
+++ b/web/tazblog/static/blog.css
@@ -0,0 +1,35 @@
+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;
+}
diff --git a/web/tazblog/static/favicon.ico b/web/tazblog/static/favicon.ico
new file mode 100644
index 000000000000..2958dd3afcb0
--- /dev/null
+++ b/web/tazblog/static/favicon.ico
Binary files differdiff --git a/web/tazblog/static/keybase.txt b/web/tazblog/static/keybase.txt
new file mode 100644
index 000000000000..661c33e01e73
--- /dev/null
+++ b/web/tazblog/static/keybase.txt
@@ -0,0 +1,69 @@
+==================================================================
+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
+
+==================================================================
diff --git a/web/tazblog/tazblog.cabal b/web/tazblog/tazblog.cabal
new file mode 100644
index 000000000000..58aeb7049ed1
--- /dev/null
+++ b/web/tazblog/tazblog.cabal
@@ -0,0 +1,39 @@
+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
diff --git a/web/tazblog/tazblog.nix b/web/tazblog/tazblog.nix
new file mode 100644
index 000000000000..b59cddec07a7
--- /dev/null
+++ b/web/tazblog/tazblog.nix
@@ -0,0 +1,30 @@
+{ 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;
+}
generated by cgit-pink 1.4.1 (git 2.44.2) at 2024-11-07T18·43+0000