diff --git a/src/Handler/Blog.hs b/src/Handler/Blog.hs index 0b5a8e7..b5c9ac2 100644 --- a/src/Handler/Blog.hs +++ b/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 diff --git a/src/Handler/Feed.hs b/src/Handler/Feed.hs index 91960d9..a157073 100644 --- a/src/Handler/Feed.hs +++ b/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 diff --git a/src/Handler/Haddock.hs b/src/Handler/Haddock.hs index 8940f4a..5a7112b 100644 --- a/src/Handler/Haddock.hs +++ b/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 diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index 087cff2..78b37df 100644 --- a/src/Handler/Home.hs +++ b/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 diff --git a/src/Handler/Package.hs b/src/Handler/Package.hs index b1eca39..393da0f 100644 --- a/src/Handler/Package.hs +++ b/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) diff --git a/src/Handler/PackageDeps.hs b/src/Handler/PackageDeps.hs index 653a808..5bf4379 100644 --- a/src/Handler/PackageDeps.hs +++ b/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 diff --git a/src/Handler/PackageList.hs b/src/Handler/PackageList.hs index 7817a15..844aa1d 100644 --- a/src/Handler/PackageList.hs +++ b/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") diff --git a/src/Handler/Sitemap.hs b/src/Handler/Sitemap.hs index 26d4317..c7a138a 100644 --- a/src/Handler/Sitemap.hs +++ b/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 [] diff --git a/src/Handler/Snapshots.hs b/src/Handler/Snapshots.hs index 8508bec..b4d2cc7 100644 --- a/src/Handler/Snapshots.hs +++ b/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 diff --git a/src/Handler/StackageHome.hs b/src/Handler/StackageHome.hs index c11dc78..c531233 100644 --- a/src/Handler/StackageHome.hs +++ b/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