Add a bunch of caching

src/Handler/Blog.hs

@@ -41,6 +41,7 @@ postMonth p =
 
 getBlogHomeR :: Handler ()
 getBlogHomeR = do
+    cacheSeconds 3600
     posts <- getPosts
     case headMay posts of
         Nothing -> notFound
@@ -50,6 +51,7 @@ getBlogHomeR = do
 
 getBlogPostR :: Year -> Month -> Text -> Handler Html
 getBlogPostR year month slug = do
+    cacheSeconds 3600
     posts <- getPosts
     post <- maybe notFound return $ find matches posts
     now <- getCurrentTime
@@ -64,6 +66,7 @@ getBlogPostR year month slug = do
 
 getBlogFeedR :: Handler TypedContent
 getBlogFeedR = do
+    cacheSeconds 3600
     posts <- fmap (take 10) getPosts
     latest <- maybe notFound return $ headMay posts
     newsFeed

src/Handler/Feed.hs

@@ -20,7 +20,9 @@ getBranchFeedR :: SnapshotBranch -> Handler TypedContent
 getBranchFeedR = track "Handler.Feed.getBranchFeedR" . getBranchFeed . Just
 
 getBranchFeed :: Maybe SnapshotBranch -> Handler TypedContent
-getBranchFeed mBranch = mkFeed mBranch =<< getSnapshots mBranch 20 0
+getBranchFeed mBranch = do
+  cacheSeconds 3600
+  mkFeed mBranch =<< getSnapshots mBranch 20 0
 
 mkFeed :: Maybe SnapshotBranch -> [Entity Snapshot] -> Handler TypedContent
 mkFeed _ [] = notFound

src/Handler/Haddock.hs

@@ -29,6 +29,7 @@ getHaddockR snapName rest
             Just route -> redirect route
             Nothing -> redirect $ makeURL snapName rest
     | Just docType <- mdocType = do
+        cacheSeconds $ 60 * 60 * 24 * 7
         result <- redirectWithVersion snapName rest
         case result of
             Just route -> redirect route

src/Handler/Home.hs

@@ -28,6 +28,7 @@ getHealthzR = return "This should never be used, we should use the middleware in
 -- inclined, or create a single monolithic file.
 getHomeR :: Handler Html
 getHomeR = track "Handler.Snapshots.getAllSnapshotsR" $ do
+    cacheSeconds $ 60 * 60
     now' <- getCurrentTime
     currentPageMay <- lookupGetParam "page"
     let currentPage :: Int

src/Handler/Package.hs

@@ -148,6 +148,7 @@ handlePackage epi = do
 getPackageSnapshotsR :: PackageNameP -> Handler Html
 getPackageSnapshotsR pn =
     track "Handler.Package.getPackageSnapshotsR" $ do
+        cacheSeconds $ 60 * 60 * 24
         snapshots <- getSnapshotsForPackage pn Nothing
         defaultLayout
             (do setTitle ("Packages for " >> toHtml pn)

src/Handler/PackageDeps.hs

@@ -13,13 +13,15 @@ import Stackage.Database
 
 getPackageDepsR :: PackageNameP -> Handler Html
 getPackageDepsR pname = do
+    cacheSeconds $ 60 * 60
     mspi <- getSnapshotPackageLatestVersion pname
     case mspi of
         Nothing -> redirect $ PackageR pname
         Just spi -> helper Deps spi
 
 getSnapshotPackageDepsR :: SnapName -> PackageNameVersion -> Handler Html
-getSnapshotPackageDepsR snapName pnv =
+getSnapshotPackageDepsR snapName pnv = do
+    cacheSeconds $ 60 * 60
     pnvToSnapshotPackageInfo snapName pnv (\_ _ -> notFound) $ \isSameVersion spi ->
         if isSameVersion
             then helper Deps spi
@@ -29,13 +31,15 @@ getSnapshotPackageDepsR snapName pnv =
 
 getPackageRevDepsR :: PackageNameP -> Handler Html
 getPackageRevDepsR pname = do
+    cacheSeconds $ 60 * 60
     mspi <- getSnapshotPackageLatestVersion pname
     case mspi of
         Nothing -> redirect $ PackageR pname
         Just spi -> helper RevDeps spi
 
 getSnapshotPackageRevDepsR :: SnapName -> PackageNameVersion -> Handler Html
-getSnapshotPackageRevDepsR snapName pnv =
+getSnapshotPackageRevDepsR snapName pnv = do
+    cacheSeconds $ 60 * 60
     pnvToSnapshotPackageInfo snapName pnv (\_ _ -> notFound) $ \isSameVersion spi ->
         if isSameVersion
             then helper RevDeps spi

src/Handler/PackageList.hs

@@ -12,6 +12,7 @@ getPackageListR :: Handler Html
 getPackageListR =
     track "Handler.PackageList.getPackageListR" $
     defaultLayout $ do
+        cacheSeconds $ 60 * 60 * 2
         setTitle "Package list"
         packages <- getAllPackages
         $(widgetFile "package-list")

src/Handler/Sitemap.hs

@@ -6,6 +6,7 @@ import Yesod.Sitemap
 
 getSitemapR :: Handler TypedContent
 getSitemapR = track "Handler.Sitemap.getSitemapR" $ sitemap $ do
+    cacheSeconds $ 60 * 60 * 6
     priority 1.0 $ HomeR
 
     priority 0.9 $ OldSnapshotBranchR LtsBranch []

src/Handler/Snapshots.hs

@@ -22,6 +22,7 @@ snapshotsPerPage = 50
 -- inclined, or create a single monolithic file.
 getAllSnapshotsR :: Handler TypedContent
 getAllSnapshotsR = track "Handler.Snapshots.getAllSnapshotsR" $ do
+    cacheSeconds $ 60 * 60 * 6
     now' <- getCurrentTime
     currentPageMay <- lookupGetParam "page"
     let currentPage :: Int

src/Handler/StackageHome.hs

@@ -22,6 +22,7 @@ import Stackage.Snapshot.Diff
 getStackageHomeR :: SnapName -> Handler TypedContent
 getStackageHomeR name =
     track "Handler.StackageHome.getStackageHomeR" $ do
+        cacheSeconds $ 60 * 60 * 12
         Entity sid snapshot <- lookupSnapshot name >>= maybe notFound return
         previousSnapName <- fromMaybe name . map snd <$> snapshotBefore (snapshotName snapshot)
         let hoogleForm =
@@ -51,6 +52,7 @@ instance ToJSON SnapshotInfo where
 
 getStackageDiffR :: SnapName -> SnapName -> Handler TypedContent
 getStackageDiffR name1 name2 = track "Handler.StackageHome.getStackageDiffR" $ do
+    cacheSeconds $ 60 * 60 * 48
     Entity sid1 _ <- lookupSnapshot name1 >>= maybe notFound return
     Entity sid2 _ <- lookupSnapshot name2 >>= maybe notFound return
     let fixit = sortOn Down . map (snapshotName . entityVal)
@@ -66,6 +68,7 @@ getStackageDiffR name1 name2 = track "Handler.StackageHome.getStackageDiffR" $ d
 
 getStackageCabalConfigR :: SnapName -> Handler TypedContent
 getStackageCabalConfigR name = track "Handler.StackageHome.getStackageCabalConfigR" $ do
+    cacheSeconds $ 60 * 60 * 48
     Entity sid _ <- lookupSnapshot name >>= maybe notFound return
     render <- getUrlRender
 
@@ -157,6 +160,7 @@ getSnapshotPackagesR name = track "Handler.StackageHome.getSnapshotPackagesR" $
 
 getDocsR :: SnapName -> Handler Html
 getDocsR name = track "Handler.StackageHome.getDocsR" $ do
+    cacheSeconds $ 60 * 60 * 48
     Entity sid _ <- lookupSnapshot name >>= maybe notFound return
     mlis <- getSnapshotModules sid
     render <- getUrlRender