From 03bfe08e1dd9faf48b06cb146bfa446575cde88a Mon Sep 17 00:00:00 2001 From: Vincent Ambo Date: Fri, 20 Dec 2019 20:18:41 +0000 Subject: 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) --- web/cgit-taz/cgit_depot_url.patch | 97 +++++++++++++++++ web/cgit-taz/cgit_idx.patch | 13 +++ web/cgit-taz/default.nix | 69 ++++++++++++ web/tazblog/blog/Main.hs | 24 +++++ web/tazblog/default.nix | 18 ++++ web/tazblog/shell.nix | 11 ++ web/tazblog/src/Blog.hs | 141 +++++++++++++++++++++++++ web/tazblog/src/BlogStore.hs | 182 ++++++++++++++++++++++++++++++++ web/tazblog/src/RSS.hs | 48 +++++++++ web/tazblog/src/Server.hs | 81 ++++++++++++++ web/tazblog/static/apple-touch-icon.png | Bin 0 -> 9756 bytes web/tazblog/static/blog.css | 35 ++++++ web/tazblog/static/favicon.ico | Bin 0 -> 4354 bytes web/tazblog/static/keybase.txt | 69 ++++++++++++ web/tazblog/tazblog.cabal | 39 +++++++ web/tazblog/tazblog.nix | 30 ++++++ 16 files changed, 857 insertions(+) create mode 100644 web/cgit-taz/cgit_depot_url.patch create mode 100644 web/cgit-taz/cgit_idx.patch create mode 100644 web/cgit-taz/default.nix create mode 100644 web/tazblog/blog/Main.hs create mode 100644 web/tazblog/default.nix create mode 100644 web/tazblog/shell.nix create mode 100644 web/tazblog/src/Blog.hs create mode 100644 web/tazblog/src/BlogStore.hs create mode 100644 web/tazblog/src/RSS.hs create mode 100644 web/tazblog/src/Server.hs create mode 100644 web/tazblog/static/apple-touch-icon.png create mode 100644 web/tazblog/static/blog.css create mode 100644 web/tazblog/static/favicon.ico create mode 100644 web/tazblog/static/keybase.txt create mode 100644 web/tazblog/tazblog.cabal create mode 100644 web/tazblog/tazblog.nix (limited to 'web') diff --git a/web/cgit-taz/cgit_depot_url.patch b/web/cgit-taz/cgit_depot_url.patch new file mode 100644 index 000000000000..cb81a2a49ab9 --- /dev/null +++ b/web/cgit-taz/cgit_depot_url.patch @@ -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(""); + 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(""); diff --git a/web/cgit-taz/cgit_idx.patch b/web/cgit-taz/cgit_idx.patch new file mode 100644 index 000000000000..67dbc0c7ab80 --- /dev/null +++ b/web/cgit-taz/cgit_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/cgit-taz/default.nix b/web/cgit-taz/default.nix new file mode 100644 index 000000000000..4559eb4dbf71 --- /dev/null +++ b/web/cgit-taz/default.nix @@ -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 + 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} +# '' 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 + + + + + + + #{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 Binary files /dev/null and b/web/tazblog/static/apple-touch-icon.png differ diff --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 Binary files /dev/null and b/web/tazblog/static/favicon.ico differ diff --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; +} -- cgit 1.4.1