diff options
Diffstat (limited to 'src/Main.hs')
-rw-r--r-- | src/Main.hs | 27 |
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}" |