diff options
author | Vincent Ambo <tazjin@google.com> | 2019-12-20T20·18+0000 |
---|---|---|
committer | Vincent Ambo <tazjin@google.com> | 2019-12-20T20·18+0000 |
commit | 03bfe08e1dd9faf48b06cb146bfa446575cde88a (patch) | |
tree | 55317968922a9b2a01516f1b79527874df037517 /services/tazblog/src/Server.hs | |
parent | e52eed3cd4f73779c2e7c350537fb346835ba9f3 (diff) |
chore: Significantly restructure folder layout r/237
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)
Diffstat (limited to 'services/tazblog/src/Server.hs')
-rw-r--r-- | services/tazblog/src/Server.hs | 81 |
1 files changed, 0 insertions, 81 deletions
diff --git a/services/tazblog/src/Server.hs b/services/tazblog/src/Server.hs deleted file mode 100644 index 40129988393b..000000000000 --- a/services/tazblog/src/Server.hs +++ /dev/null @@ -1,81 +0,0 @@ -{-# 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 |