From 008be5c2e195761167b51c4c4b6bd1527fd9d854 Mon Sep 17 00:00:00 2001 From: Vincent Ambo Date: Wed, 21 Aug 2019 11:07:25 +0100 Subject: refactor(tazblog): Directly instantiate Resolver when launching Caching behaviour is tied to the resolver. --- services/tazblog/src/BlogStore.hs | 28 +++++++++++++++++++++++----- services/tazblog/src/Server.hs | 4 ++-- 2 files changed, 25 insertions(+), 7 deletions(-) (limited to 'services/tazblog') diff --git a/services/tazblog/src/BlogStore.hs b/services/tazblog/src/BlogStore.hs index e4c7a64b2634..17149ef86a8e 100644 --- a/services/tazblog/src/BlogStore.hs +++ b/services/tazblog/src/BlogStore.hs @@ -15,12 +15,21 @@ -- -- 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 where +module BlogStore( + BlogCache, + EntryId(..), + Entry(..), + withCache, + listEntries, + getEntry, +) where import Control.Monad.IO.Class (MonadIO) import Data.Text (Text) import Data.Time (UTCTime) import Locales (BlogLang (..)) +import Network.DNS.Lookup (lookupTXT) +import qualified Network.DNS.Resolver as R newtype EntryId = EntryId {unEntryId :: Integer} deriving (Eq, Ord) @@ -41,17 +50,26 @@ data Entry } 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 { resolver :: R.Resolver + , zone :: String } type Offset = Integer type Count = Integer -newCache :: String -> IO BlogCache -newCache zone = undefined +withCache :: String -> (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 = undefined +listEntries (BlogCache r z) offset count = undefined getEntry :: MonadIO m => BlogCache -> EntryId -> m (Maybe Entry) -getEntry cache eId = undefined +getEntry (BlogCache r z) eId = undefined diff --git a/services/tazblog/src/Server.hs b/services/tazblog/src/Server.hs index 57b1463268c2..4be76052beeb 100644 --- a/services/tazblog/src/Server.hs +++ b/services/tazblog/src/Server.hs @@ -29,8 +29,8 @@ tmpPolicy = defaultBodyPolicy "/tmp" 0 200000 1000 runBlog :: Int -> String -> IO () runBlog port respath = do - cache <- newCache "blog.tazj.in." - simpleHTTP nullConf {port = port} $ tazBlog cache respath + withCache "blog.tazj.in." $ \cache -> + simpleHTTP nullConf {port = port} $ tazBlog cache respath tazBlog :: BlogCache -> String -> ServerPart Response tazBlog cache resDir = do -- cgit 1.4.1