chore: Significantly restructure folder layout
This moves the various projects from "type-based" folders (such as "services" or "tools") into more appropriate semantic folders (such as "nix", "ops" or "web"). Deprecated projects (nixcon-demo & gotest) which only existed for testing/demonstration purposes have been removed. (Note: *all* builds are broken with this commit)
This commit is contained in:
Vincent Ambo
parent
e52eed3cd4
commit
03bfe08e1d
110 changed files with 1 additions and 998 deletions
97
web/cgit-taz/cgit_depot_url.patch
Normal file
97
web/cgit-taz/cgit_depot_url.patch
Normal file
|
|
@ -0,0 +1,97 @@
|
|||
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 = "&";
|
||||
+ 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'>");
|
||||
13
web/cgit-taz/cgit_idx.patch
Normal file
13
web/cgit-taz/cgit_idx.patch
Normal file
|
|
@ -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.
|
||||
69
web/cgit-taz/default.nix
Normal file
69
web/cgit-taz/default.nix
Normal file
|
|
@ -0,0 +1,69 @@
|
|||
# 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 builds repository URLs correctly
|
||||
# (since only one repository is served)
|
||||
monocgit = cgit.overrideAttrs(old: {
|
||||
patches = old.patches ++ [ ./cgit_depot_url.patch ];
|
||||
});
|
||||
|
||||
cgitConfig = writeText "cgitrc" ''
|
||||
# Global configuration
|
||||
virtual-root=/
|
||||
enable-http-clone=1
|
||||
readme=:README.md
|
||||
about-filter=${monocgit}/lib/cgit/filters/about-formatting.sh
|
||||
source-filter=${monocgit}/lib//cgit/filters/syntax-highlighting.py
|
||||
|
||||
# Repository configuration
|
||||
repo.url=depot
|
||||
repo.path=/git/depot/.git
|
||||
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
|
||||
repo.enable-remote-branches=1
|
||||
'';
|
||||
|
||||
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 = [ ./cgit_idx.patch thttpdConfigPatch ];
|
||||
});
|
||||
in writeShellScriptBin "cgit-launch" ''
|
||||
exec ${thttpdCgit}/bin/thttpd -D -C ${thttpdConfig}
|
||||
# ''
|
||||
24
web/tazblog/blog/Main.hs
Normal file
24
web/tazblog/blog/Main.hs
Normal file
|
|
@ -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)
|
||||
18
web/tazblog/default.nix
Normal file
18
web/tazblog/default.nix
Normal file
|
|
@ -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;
|
||||
})
|
||||
11
web/tazblog/shell.nix
Normal file
11
web/tazblog/shell.nix
Normal file
|
|
@ -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 ];
|
||||
}
|
||||
141
web/tazblog/src/Blog.hs
Normal file
141
web/tazblog/src/Blog.hs
Normal file
|
|
@ -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>
|
||||
|]
|
||||
182
web/tazblog/src/BlogStore.hs
Normal file
182
web/tazblog/src/BlogStore.hs
Normal file
|
|
@ -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
|
||||
48
web/tazblog/src/RSS.hs
Normal file
48
web/tazblog/src/RSS.hs
Normal file
|
|
@ -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)
|
||||
81
web/tazblog/src/Server.hs
Normal file
81
web/tazblog/src/Server.hs
Normal file
|
|
@ -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
|
||||
BIN
web/tazblog/static/apple-touch-icon.png
Normal file
BIN
web/tazblog/static/apple-touch-icon.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 9.5 KiB |
35
web/tazblog/static/blog.css
Normal file
35
web/tazblog/static/blog.css
Normal file
|
|
@ -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;
|
||||
}
|
||||
BIN
web/tazblog/static/favicon.ico
Normal file
BIN
web/tazblog/static/favicon.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 4.3 KiB |
69
web/tazblog/static/keybase.txt
Normal file
69
web/tazblog/static/keybase.txt
Normal file
|
|
@ -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
|
||||
|
||||
==================================================================
|
||||
39
web/tazblog/tazblog.cabal
Normal file
39
web/tazblog/tazblog.cabal
Normal file
|
|
@ -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
|
||||
30
web/tazblog/tazblog.nix
Normal file
30
web/tazblog/tazblog.nix
Normal file
|
|
@ -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;
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue