refactor(tazblog): Directly instantiate Resolver when launching
Caching behaviour is tied to the resolver.
This commit is contained in:
parent
bf2efeba2d
commit
008be5c2e1
2 changed files with 25 additions and 7 deletions
|
|
@ -15,12 +15,21 @@
|
||||||
--
|
--
|
||||||
-- This module implements logic for assembling a post out of these
|
-- This module implements logic for assembling a post out of these
|
||||||
-- fragments and caching it based on the TTL of its `_meta` record.
|
-- 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 Control.Monad.IO.Class (MonadIO)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Time (UTCTime)
|
import Data.Time (UTCTime)
|
||||||
import Locales (BlogLang (..))
|
import Locales (BlogLang (..))
|
||||||
|
import Network.DNS.Lookup (lookupTXT)
|
||||||
|
import qualified Network.DNS.Resolver as R
|
||||||
|
|
||||||
newtype EntryId = EntryId {unEntryId :: Integer}
|
newtype EntryId = EntryId {unEntryId :: Integer}
|
||||||
deriving (Eq, Ord)
|
deriving (Eq, Ord)
|
||||||
|
|
@ -41,17 +50,26 @@ data Entry
|
||||||
}
|
}
|
||||||
deriving (Eq, Ord, Show)
|
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
|
data BlogCache
|
||||||
|
= BlogCache { resolver :: R.Resolver
|
||||||
|
, zone :: String }
|
||||||
|
|
||||||
type Offset = Integer
|
type Offset = Integer
|
||||||
|
|
||||||
type Count = Integer
|
type Count = Integer
|
||||||
|
|
||||||
newCache :: String -> IO BlogCache
|
withCache :: String -> (BlogCache -> IO a) -> IO a
|
||||||
newCache zone = undefined
|
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 :: 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 :: MonadIO m => BlogCache -> EntryId -> m (Maybe Entry)
|
||||||
getEntry cache eId = undefined
|
getEntry (BlogCache r z) eId = undefined
|
||||||
|
|
|
||||||
|
|
@ -29,7 +29,7 @@ tmpPolicy = defaultBodyPolicy "/tmp" 0 200000 1000
|
||||||
|
|
||||||
runBlog :: Int -> String -> IO ()
|
runBlog :: Int -> String -> IO ()
|
||||||
runBlog port respath = do
|
runBlog port respath = do
|
||||||
cache <- newCache "blog.tazj.in."
|
withCache "blog.tazj.in." $ \cache ->
|
||||||
simpleHTTP nullConf {port = port} $ tazBlog cache respath
|
simpleHTTP nullConf {port = port} $ tazBlog cache respath
|
||||||
|
|
||||||
tazBlog :: BlogCache -> String -> ServerPart Response
|
tazBlog :: BlogCache -> String -> ServerPart Response
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue