From 1cb8c26dfc38331f2b45a21062289e4c48e30483 Mon Sep 17 00:00:00 2001 From: Paul Brinkmeier Date: Thu, 7 Aug 2025 02:09:41 +0200 Subject: [PATCH] Apply max-age header to bust PDF cache at midnight Also update stylish-haskell config --- .stylish-haskell.yaml | 4 ++-- app/Main.hs | 18 +++++++++++++----- src/Yore/DB.hs | 4 ++-- src/Yore/Index.hs | 2 +- src/Yore/Repl.hs | 7 +++---- src/Yore/Scrape.hs | 12 ++++++------ src/Yore/Time.hs | 21 +++++++++++++++++---- 7 files changed, 44 insertions(+), 24 deletions(-) diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml index db10bfe..6762241 100644 --- a/.stylish-haskell.yaml +++ b/.stylish-haskell.yaml @@ -410,7 +410,7 @@ steps: # - vertical_compact: Similar to vertical, but use only one language pragma. # # Default: vertical. - style: compact_line + style: vertical # Align affects alignment of closing pragma brackets. # @@ -420,7 +420,7 @@ steps: # between actual import and closing bracket. # # Default: true - align: true + align: false # stylish-haskell can detect redundancy of some language pragmas. If this # is set to true, it will remove those redundant pragmas. Default: true. diff --git a/app/Main.hs b/app/Main.hs index 708af27..40d47ec 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} module Main (main) where @@ -29,6 +29,7 @@ import Text.Blaze.Html.Renderer.Utf8 (renderHtml) import Text.Blaze.Html5 ((!)) import Text.Printf (printf) +import qualified Data.ByteString.Char8 as BS8 import qualified Data.Text as Text import qualified Database.PostgreSQL.Opium as Opium import Network.Wai (responseFile) @@ -37,7 +38,7 @@ import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A import Yore.DB (DayFile (..)) -import Yore.Time (addYears, getCurrentDay) +import Yore.Time (addYears, getCurrentDay, getSecondsUntilMidnight) import qualified Yore.DB as DB @@ -68,7 +69,7 @@ server connPool = rootR :<|> todayR :<|> apiTodayR rootR = todayR 0 todayR issue = do - dateThen <- liftIO $ get100YearsAgo + dateThen <- liftIO get100YearsAgo Right count <- liftIO $ withResource connPool $ DB.getNumberOfIssues dateThen Right dayFile <- liftIO $ withResource connPool $ DB.getDayFileByIssue dateThen issue pure $ RootModel dateThen dayFile issue count @@ -79,8 +80,15 @@ server connPool = rootR :<|> todayR :<|> apiTodayR res <- withResource connPool $ DB.getDayFileByIssue dateThen issue dayFile <- either throwIO pure res let fullPath = "download" dayFile.relative_path + secondsUntilMidnight <- getSecondsUntilMidnight - respond $ responseFile status200 [("content-type", "application/pdf")] fullPath Nothing + respond $ responseFile + status200 + [ ("content-type", "application/pdf") + , ("cache-control", BS8.pack $ printf "public, max-age=%d" secondsUntilMidnight) + ] + fullPath + Nothing data RootModel = RootModel Day DB.DayFile Int Int diff --git a/src/Yore/DB.hs b/src/Yore/DB.hs index bfa6ffb..e66d030 100644 --- a/src/Yore/DB.hs +++ b/src/Yore/DB.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-deriving-defaults #-} module Yore.DB diff --git a/src/Yore/Index.hs b/src/Yore/Index.hs index 48cad6c..2debd1e 100644 --- a/src/Yore/Index.hs +++ b/src/Yore/Index.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} module Yore.Index (createEntries) where diff --git a/src/Yore/Repl.hs b/src/Yore/Repl.hs index 479e481..1fff8ff 100644 --- a/src/Yore/Repl.hs +++ b/src/Yore/Repl.hs @@ -1,13 +1,12 @@ -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} module Yore.Repl (connect, exec, getToday, indexDay, addYears) where import Control.Exception (bracket, throwIO) import Control.Monad (forM) -import Data.Time (Day) -import Data.Time.LocalTime (getZonedTime, localDay, zonedTimeToLocalTime) +import Data.Time (Day, getZonedTime, localDay, zonedTimeToLocalTime) import Text.Printf (printf) import qualified Database.PostgreSQL.Opium as Opium diff --git a/src/Yore/Scrape.hs b/src/Yore/Scrape.hs index ef6a208..3e44829 100644 --- a/src/Yore/Scrape.hs +++ b/src/Yore/Scrape.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ViewPatterns #-} module Yore.Scrape (Issue (..), getIssuesByDay) where diff --git a/src/Yore/Time.hs b/src/Yore/Time.hs index b7a4e3c..bef4420 100644 --- a/src/Yore/Time.hs +++ b/src/Yore/Time.hs @@ -1,7 +1,16 @@ -module Yore.Time (addYears, getCurrentDay) where +module Yore.Time (addYears, getCurrentDay, getSecondsUntilMidnight) where -import Data.Time (Day, addGregorianYearsClip, isLeapYear, toGregorian) -import Data.Time.LocalTime (getZonedTime, localDay, zonedTimeToLocalTime) +import Data.Time + ( Day + , addGregorianYearsClip + , getZonedTime + , isLeapYear + , localDay + , localTimeOfDay + , sinceMidnight + , toGregorian + , zonedTimeToLocalTime + ) addYears :: Integer -> Day -> Maybe Day addYears yearOffset date @@ -18,5 +27,9 @@ addYears yearOffset date getCurrentDay :: IO Day getCurrentDay = do - print =<< getZonedTime localDay . zonedTimeToLocalTime <$> getZonedTime + +getSecondsUntilMidnight :: IO Int +getSecondsUntilMidnight = do + timeOfDay <- localTimeOfDay . zonedTimeToLocalTime <$> getZonedTime + pure $ 86400 - ceiling (sinceMidnight timeOfDay)