add some caching

1 files changed, 20 insertions, 7 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 69cbdb4..55ad17d 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -54,24 +54,36 @@ instance YesodPersist Search where
     runDB action = getYesod >>= runSqlPool action . sqlPool
 
 getHomeR :: Handler ()
-getHomeR = sendFile typeHtml "index.html"
+getHomeR = do
+    cacheSeconds $ 60 * 60 * 24 * 7
+    sendFile typeHtml "index.html"
 
 getBundleR :: Handler ()
-getBundleR = sendFile typeJavascript "bundle.js"
+getBundleR = do
+    cacheSeconds $ 60 * 60 * 24 * 7
+    sendFile typeJavascript "bundle.js"
 
 getStyleR :: Handler ()
-getStyleR = sendFile typeCss "style.css"
+getStyleR = do
+    cacheSeconds $ 60 * 60 * 24 * 7
+    sendFile typeCss "style.css"
 
 getBangsR :: Handler TypedContent
 getBangsR = do
-    bangsAccessor <- lookupHeader "accept-encoding" >>= \case
+    st <- bangState <$> getYesod
+
+    -- changes here should propagate quicker, so we're using 1h.
+    -- besides, we're using an eTag as well.
+    cacheSeconds $ 60 * 60
+    setEtag =<< liftIO (getBangsHash st)
+
+    bs <- lookupHeader "accept-encoding" >>= \case
         Just ae | "br" `BS.isInfixOf` ae -> do
             addHeader "content-encoding" "br"
-            return getBangsBrotli
+            liftIO $ getBangsBrotli st
         _ -> do
-            return getBangsJSON
+            liftIO $ getBangsJSON st
 
-    bs <- liftIO . bangsAccessor . bangState =<< getYesod
     return $ TypedContent typeJson $ toContent bs
 
 postSubmitR :: Handler ()
@@ -86,6 +98,7 @@ postSubmitR = sequence (map lookupPostParam ["bang", "url", "name"])
 
 getOpenSearchR :: Handler TypedContent
 getOpenSearchR = do
+    neverExpires
     baseUrl <- liftIO getBaseUrl
     url <- lookupGetParam "default" <&> \case
         Nothing -> baseUrl <> "/#{searchTerms}"