Implement HasServer instead of using Raw

app/Main.hs

@@ -20,22 +20,19 @@ import Data.Text (Text)
 import Data.Time (Day, LocalTime (..), TimeOfDay (..), ZonedTime (..), addDays, toGregorian)
 import GHC.Generics (Generic)
 import Network.HTTP.Media ((//), (/:))
-import Network.HTTP.Types (Status (..), mkStatus, status200)
-import Network.Wai (Application, Request (..), Response, responseFile, responseLBS)
+import Network.HTTP.Types (Status (..))
+import Network.Wai (Request (..))
 import Servant
   ( Accept (..)
   , Capture
   , Get
   , Handler
   , MimeRender (..)
-  , Raw
   , ServerError (..)
   , ServerT
-  , Tagged (..)
   , err404
   , err500
   , hoistServer
-  , runHandler
   , serve
   , (:<|>) (..)
   , (:>)
@@ -62,18 +59,13 @@ import Yore.Download (downloadInto)
 import Yore.Error (Error (..))
 import Yore.Schedule (schedule)
 import Yore.Scrape (Issue (..), getIssuesByDay)
+import Yore.Servant (GetSendfile, Sendfile (..))
 import Yore.Time (addYears, getCurrentDay, getSecondsUntilMidnight)
 
 import qualified Envy
 import qualified Yore.DB as DB
 import qualified Yore.Log as Log
 
-newtype ConnectionString = ConnectionString String
-  deriving (Show)
-
-instance Envy.ReadEnvVar ConnectionString where
-  readEnvVar = fmap ConnectionString . Envy.readEnvVar
-
 data ConfigT f = Config
   { yorePort :: f =@@ Int ? 3000
   , yoreDownloadDir :: f =@@ FilePath ? "./download"
@@ -161,11 +153,6 @@ nt action = MkHandler $ do
     Right x ->
       pure $ Right x
 
-type API =
-  Get '[HTML] RootModel
-    :<|> "today" :> "issue" :> Capture "issue" Int :> Get '[HTML] RootModel
-    :<|> "api" :> "today" :> "issue" :> Capture "issue" Int :> "fz.pdf" :> Raw
-
 toServerError :: Error -> ServerError
 toServerError = \case
   ConnectionError msg ->
@@ -180,14 +167,10 @@ toServerError = \case
 encodeUtf8LBS :: String -> LBS.ByteString
 encodeUtf8LBS = LBS.fromStrict . Encoding.encodeUtf8 . Text.pack
 
-handlerToRaw :: ExceptT Error IO Response -> Tagged t Application
-handlerToRaw handler = Tagged $ \_ respond -> do
-  r <- runHandler $ nt handler
-  case r of
-    Left e ->
-      respond $ responseLBS (mkStatus e.errHTTPCode $ BS8.pack e.errReasonPhrase) e.errHeaders e.errBody
-    Right response ->
-      respond response
+type API =
+  Get '[HTML] RootModel
+    :<|> "today" :> "issue" :> Capture "issue" Int :> Get '[HTML] RootModel
+    :<|> "api" :> "today" :> "issue" :> Capture "issue" Int :> "fz.pdf" :> GetSendfile
 
 server :: Config -> DB -> ServerT API (ExceptT Error IO)
 server cfg db = rootR :<|> todayR :<|> apiTodayR
@@ -200,19 +183,20 @@ server cfg db = rootR :<|> todayR :<|> apiTodayR
       dayFile <- DB.withConn db $ DB.getDayFileByIssue dateThen issue
       pure $ RootModel dateThen dayFile issue count
 
-    apiTodayR issue = handlerToRaw $ do
+    apiTodayR issue = do
       dateThen <- ExceptT get100YearsAgo
       dayFile <- DB.withConn db $ DB.getDayFileByIssue dateThen issue
       let fullPath = cfg.yoreDownloadDir </> dayFile.relative_path
       secondsUntilMidnight <- liftIO getSecondsUntilMidnight
-      pure $
-        responseFile
-          status200
-          [ ("content-type", "application/pdf")
-          , ("cache-control", BS8.pack $ printf "public, max-age=%d" secondsUntilMidnight)
-          ]
-          fullPath
-          Nothing
+      pure
+        Sendfile
+          { headers =
+              [ ("content-type", "application/pdf")
+              , ("cache-control", BS8.pack $ printf "public, max-age=%d" secondsUntilMidnight)
+              ]
+          , path =
+              fullPath
+          }
 
 data RootModel = RootModel Day DB.DayFile Int Int
 
@@ -277,7 +261,7 @@ indexDay cfg dayThen conn = do
       issues <- liftIO $ getIssuesByDay dayThen
       paths <- forM issues $ \issue -> do
         Log.info $ printf "downloading %s" issue.url
-        path <- liftIO $ downloadInto cfg.yoreDownloadDir issue.url
+        path <- downloadInto cfg.yoreDownloadDir issue.url
         pure (issue.label, path)
       Log.info "creating DB entries"
       dayIndex <- DB.createDayIndex dayThen conn