Apply max-age header to bust PDF cache at midnight
Also update stylish-haskell config
This commit is contained in:
parent
8c7d487cae
commit
1cb8c26dfc
@ -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.
|
||||
|
||||
18
app/Main.hs
18
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
|
||||
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# OPTIONS_GHC -Wno-deriving-defaults #-}
|
||||
|
||||
module Yore.DB
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
{-# LANGUAGE OverloadedRecordDot #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Yore.Index (createEntries) where
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user