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.
#
# 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.

View File

@ -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

View File

@ -1,6 +1,6 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-deriving-defaults #-}
module Yore.DB

View File

@ -1,5 +1,5 @@
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
module Yore.Index (createEntries) where

View File

@ -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

View File

@ -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

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.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)