Apply max-age header to bust PDF cache at midnight

Also update stylish-haskell config
This commit is contained in:
Paul Brinkmeier 2025-08-07 02:09:41 +02:00
parent 8c7d487cae
commit 1cb8c26dfc
7 changed files with 44 additions and 24 deletions

View File

@ -410,7 +410,7 @@ steps:
# - vertical_compact: Similar to vertical, but use only one language pragma. # - vertical_compact: Similar to vertical, but use only one language pragma.
# #
# Default: vertical. # Default: vertical.
style: compact_line style: vertical
# Align affects alignment of closing pragma brackets. # Align affects alignment of closing pragma brackets.
# #
@ -420,7 +420,7 @@ steps:
# between actual import and closing bracket. # between actual import and closing bracket.
# #
# Default: true # Default: true
align: true align: false
# stylish-haskell can detect redundancy of some language pragmas. If this # stylish-haskell can detect redundancy of some language pragmas. If this
# is set to true, it will remove those redundant pragmas. Default: true. # is set to true, it will remove those redundant pragmas. Default: true.

View File

@ -29,6 +29,7 @@ import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Text.Blaze.Html5 ((!)) import Text.Blaze.Html5 ((!))
import Text.Printf (printf) import Text.Printf (printf)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Database.PostgreSQL.Opium as Opium import qualified Database.PostgreSQL.Opium as Opium
import Network.Wai (responseFile) import Network.Wai (responseFile)
@ -37,7 +38,7 @@ import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A import qualified Text.Blaze.Html5.Attributes as A
import Yore.DB (DayFile (..)) import Yore.DB (DayFile (..))
import Yore.Time (addYears, getCurrentDay) import Yore.Time (addYears, getCurrentDay, getSecondsUntilMidnight)
import qualified Yore.DB as DB import qualified Yore.DB as DB
@ -68,7 +69,7 @@ server connPool = rootR :<|> todayR :<|> apiTodayR
rootR = todayR 0 rootR = todayR 0
todayR issue = do todayR issue = do
dateThen <- liftIO $ get100YearsAgo dateThen <- liftIO get100YearsAgo
Right count <- liftIO $ withResource connPool $ DB.getNumberOfIssues dateThen Right count <- liftIO $ withResource connPool $ DB.getNumberOfIssues dateThen
Right dayFile <- liftIO $ withResource connPool $ DB.getDayFileByIssue dateThen issue Right dayFile <- liftIO $ withResource connPool $ DB.getDayFileByIssue dateThen issue
pure $ RootModel dateThen dayFile issue count pure $ RootModel dateThen dayFile issue count
@ -79,8 +80,15 @@ server connPool = rootR :<|> todayR :<|> apiTodayR
res <- withResource connPool $ DB.getDayFileByIssue dateThen issue res <- withResource connPool $ DB.getDayFileByIssue dateThen issue
dayFile <- either throwIO pure res dayFile <- either throwIO pure res
let fullPath = "download" </> dayFile.relative_path 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 data RootModel = RootModel Day DB.DayFile Int Int

View File

@ -6,8 +6,7 @@ module Yore.Repl (connect, exec, getToday, indexDay, addYears) where
import Control.Exception (bracket, throwIO) import Control.Exception (bracket, throwIO)
import Control.Monad (forM) import Control.Monad (forM)
import Data.Time (Day) import Data.Time (Day, getZonedTime, localDay, zonedTimeToLocalTime)
import Data.Time.LocalTime (getZonedTime, localDay, zonedTimeToLocalTime)
import Text.Printf (printf) import Text.Printf (printf)
import qualified Database.PostgreSQL.Opium as Opium import qualified Database.PostgreSQL.Opium as Opium

View File

@ -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
import Data.Time.LocalTime (getZonedTime, localDay, zonedTimeToLocalTime) ( Day
, addGregorianYearsClip
, getZonedTime
, isLeapYear
, localDay
, localTimeOfDay
, sinceMidnight
, toGregorian
, zonedTimeToLocalTime
)
addYears :: Integer -> Day -> Maybe Day addYears :: Integer -> Day -> Maybe Day
addYears yearOffset date addYears yearOffset date
@ -18,5 +27,9 @@ addYears yearOffset date
getCurrentDay :: IO Day getCurrentDay :: IO Day
getCurrentDay = do getCurrentDay = do
print =<< getZonedTime
localDay . zonedTimeToLocalTime <$> getZonedTime localDay . zonedTimeToLocalTime <$> getZonedTime
getSecondsUntilMidnight :: IO Int
getSecondsUntilMidnight = do
timeOfDay <- localTimeOfDay . zonedTimeToLocalTime <$> getZonedTime
pure $ 86400 - ceiling (sinceMidnight timeOfDay)