summary refs log tree commit diff
diff options
context:
space:
mode:
authorVincent Ambo <tazjin@google.com>2019-08-21T10·07+0100
committerVincent Ambo <tazjin@google.com>2019-08-21T10·07+0100
commit008be5c2e195761167b51c4c4b6bd1527fd9d854 (patch)
tree3991880d65b0a32cc2afd039e62e58d4e7f3e4cd
parentbf2efeba2d5772ba1853ec5875c3c2faf02f1b07 (diff)
refactor(tazblog): Directly instantiate Resolver when launching r/48
Caching behaviour is tied to the resolver.
-rw-r--r--services/tazblog/src/BlogStore.hs28
-rw-r--r--services/tazblog/src/Server.hs4
2 files changed, 25 insertions, 7 deletions
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