Apply max-age header to bust PDF cache at midnight

Also update stylish-haskell config

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

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
 

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

src/Yore/Index.hs

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

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 (Day, getZonedTime, localDay, zonedTimeToLocalTime)
-import Data.Time.LocalTime (getZonedTime, localDay, zonedTimeToLocalTime)
 import Text.Printf (printf)
 
 import qualified Database.PostgreSQL.Opium as Opium

src/Yore/Scrape.hs

@@ -1,10 +1,10 @@
-{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedRecordDot   #-}
+{-# LANGUAGE OverloadedRecordDot #-}
-{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE ViewPatterns          #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Yore.Scrape (Issue (..), getIssuesByDay) where
 

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
-import Data.Time.LocalTime (getZonedTime, localDay, zonedTimeToLocalTime)
+    ( 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)