about summary refs log tree commit diff
path: root/web/tazblog/src/BlogStore.hs
diff options
context:
space:
mode:
authorVincent Ambo <tazjin@google.com>2020-02-09T00·43+0000
committerVincent Ambo <tazjin@google.com>2020-02-09T00·43+0000
commit05ab6825b3451687fbaf6f8c987e94e616b6d4ff (patch)
treed1e8ad284bc89f6f6eb6156121151465fa3e3672 /web/tazblog/src/BlogStore.hs
parent9fc9b58301b3e0c538ffb8b7e4e7a7dab9fbc243 (diff)
chore(web): Delete //web/tazblog r/499
Deleting this code feels strange. This project has been around for a
decade, and despite occasionally needing a bunch of tweaks it had aged
well and worked fine for a very long time.

I've reached a strange point where I don't really feel like using
Haskell anymore, and every interaction with this project in recent
years has been fighting dependency management tooling for Haskell, or
dealing with strange build problems.

The simple fact is that the service never really did anything other
than render Markdown dynamically, and at this point I can do that much
better with //tools/cheddar instead.

So, tazblog-hs, it's time to say goodbye. Rest in peace!
Diffstat (limited to 'web/tazblog/src/BlogStore.hs')
-rw-r--r--web/tazblog/src/BlogStore.hs182
1 files changed, 0 insertions, 182 deletions
diff --git a/web/tazblog/src/BlogStore.hs b/web/tazblog/src/BlogStore.hs
deleted file mode 100644
index 60ccd0b5a0..0000000000
--- a/web/tazblog/src/BlogStore.hs
+++ /dev/null
@@ -1,182 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-
--- |This module implements fetching of individual blog entries from
--- DNS. Yes, you read that correctly.
---
--- Each blog post is stored as a set of records in a designated DNS
--- zone. For the production blog, this zone is `blog.tazj.in.`.
---
--- A top-level record at `_posts` contains a list of all published
--- post IDs.
---
--- For each of these post IDs, there is a record at `_meta.$postID`
--- that contains the title and number of post chunks.
---
--- For each post chunk, there is a record at `_$chunkID.$postID` that
--- contains a base64-encoded post fragment.
---
--- This module implements logic for assembling a post out of these
--- fragments and caching it based on the TTL of its `_meta` record.
-module BlogStore
-  ( BlogCache,
-    EntryId (..),
-    Entry (..),
-    withCache,
-    listEntries,
-    getEntry,
-    show'
-    )
-where
-
-import Control.Applicative ((<$>), (<*>))
-import Control.Monad (mzero)
-import Control.Monad.IO.Class (MonadIO, liftIO)
-import Data.Aeson ((.:), FromJSON (..), Value (Object), decodeStrict)
-import Data.ByteString.Base64 (decodeLenient)
-import Data.Either (fromRight)
-import Data.List (sortBy)
-import Data.Text as T (Text, concat, pack)
-import Data.Text.Encoding (decodeUtf8', encodeUtf8)
-import Data.Time (Day)
-import Network.DNS (DNSError, lookupTXT)
-import qualified Network.DNS.Resolver as R
-
-newtype EntryId = EntryId {unEntryId :: Integer}
-  deriving (Eq, Ord, FromJSON)
-
-instance Show EntryId where
-
-  show = show . unEntryId
-
-data Entry
-  = Entry
-      { entryId :: EntryId,
-        author :: Text,
-        title :: Text,
-        text :: Text,
-        edate :: Day
-        }
-  deriving (Eq, Ord, Show)
-
--- | Wraps a DNS resolver with caching configured. For the initial
--- version of this, all caching of entries is done by the resolver
--- (i.e. no pre-assembled versions of entries are cached).
-data BlogCache = BlogCache R.Resolver Text
-
-data StoreError
-  = PostNotFound EntryId
-  | DNS DNSError
-  | InvalidMetadata
-  | InvalidChunk
-  | InvalidPosts
-  deriving (Show)
-
-type Offset = Int
-
-type Count = Int
-
-withCache :: Text -> (BlogCache -> IO a) -> IO a
-withCache zone f = do
-  let conf =
-        R.defaultResolvConf
-          { R.resolvCache = Just R.defaultCacheConf,
-            R.resolvConcurrent = True
-            }
-  seed <- R.makeResolvSeed conf
-  R.withResolver seed (\r -> f $ BlogCache r zone)
-
-listEntries :: MonadIO m => BlogCache -> Offset -> Count -> m [Entry]
-listEntries cache offset count = liftIO $ do
-  posts <- postList cache
-  entries <- mapM (entryFromDNS cache) $ take count $ drop offset $ fromRight (error "no posts") posts
-  -- TODO: maybe don't just drop broken entries
-  return
-    $ fromRight (error "no entries")
-    $ sequence entries
-
-getEntry :: MonadIO m => BlogCache -> EntryId -> m (Maybe Entry)
-getEntry cache eid = liftIO $ entryFromDNS cache eid >>= \case
-  Left _ -> return Nothing -- TODO: ??
-  Right entry -> return $ Just entry
-
-show' :: Show a => a -> Text
-show' = pack . show
-
--- * DNS fetching implementation
-type Chunk = Integer
-
--- | Represents the metadata stored for each post in the _meta record.
-data Meta = Meta Integer Text Day
-  deriving (Show)
-
-instance FromJSON Meta where
-
-  parseJSON (Object v) =
-    Meta
-      <$> v
-      .: "c"
-      <*> v
-      .: "t"
-      <*> v
-      .: "d"
-  parseJSON _ = mzero
-
-entryMetadata :: BlogCache -> EntryId -> IO (Either StoreError Meta)
-entryMetadata (BlogCache r z) (EntryId eid) =
-  let domain = encodeUtf8 ("_meta." <> show' eid <> "." <> z)
-      record = lookupTXT r domain
-      toMeta rrdata = case decodeStrict $ decodeLenient rrdata of
-        Nothing -> Left InvalidMetadata
-        Just m -> Right m
-   in record >>= \case
-        (Left err) -> return $ Left $ DNS err
-        (Right [bs]) -> return $ toMeta bs
-        _ -> return $ Left InvalidMetadata
-
-entryChunk :: BlogCache -> EntryId -> Chunk -> IO (Either StoreError Text)
-entryChunk (BlogCache r z) (EntryId eid) c =
-  let domain = encodeUtf8 ("_" <> show' c <> "." <> show' eid <> "." <> z)
-      record = lookupTXT r domain
-      toChunk rrdata = case decodeUtf8' $ decodeLenient rrdata of
-        Left _ -> Left InvalidChunk
-        Right chunk -> Right chunk
-   in record >>= \case
-        (Left err) -> return $ Left $ DNS err
-        (Right [bs]) -> return $ toChunk bs
-        _ -> return $ Left InvalidChunk
-
-fetchAssembleChunks :: BlogCache -> EntryId -> Meta -> IO (Either StoreError Text)
-fetchAssembleChunks cache eid (Meta n _ _) = do
-  chunks <- mapM (entryChunk cache eid) [0 .. (n - 1)]
-  return $ fmap T.concat $ sequence chunks
-
-entryFromDNS :: BlogCache -> EntryId -> IO (Either StoreError Entry)
-entryFromDNS cache eid = do
-  meta <- entryMetadata cache eid
-  case meta of
-    Left err -> return $ Left err
-    Right meta -> do
-      chunks <- fetchAssembleChunks cache eid meta
-      let (Meta _ t d) = meta
-      return
-        $ either Left
-            ( \text -> Right $ Entry
-                { entryId = eid,
-                  author = "tazjin",
-                  title = t,
-                  text = text,
-                  edate = d
-                  }
-              )
-            chunks
-
-postList :: BlogCache -> IO (Either StoreError [EntryId])
-postList (BlogCache r z) =
-  let domain = encodeUtf8 ("_posts." <> z)
-      record = lookupTXT r domain
-      toPosts =
-        fmap (sortBy (flip compare))
-          . mapM (maybe (Left InvalidPosts) Right . decodeStrict)
-   in either (Left . DNS) toPosts <$> record