28 Commits
Author SHA1 Message Date
Paul Brinkmeier cf583f5ff6 Change showpdf to showpdfjs
deliver / deliver (push) Successful in 6m56s
2025-10-19 11:05:15 +02:00
paul d3dbb6e673 Clean up after dbmate
deliver / deliver (push) Successful in 1m51s
2025-10-07 18:09:29 +02:00
Paul Brinkmeier 851b3a6076 Use mktemp for dbmate invocation 2025-10-07 17:33:07 +02:00
Paul Brinkmeier dbc3103980 Don't use /tmp...
deliver / deliver (push) Successful in 1m48s
2025-10-07 17:07:12 +02:00
Paul Brinkmeier 2dacd4f747 Use /tmp for running dbmate
deliver / deliver (push) Successful in 2m6s
2025-10-07 16:48:53 +02:00
paul 94ede9a168 Use SIGINT as container StopSignal
deliver / deliver (push) Failing after 20s
2025-10-07 13:47:12 +02:00
Paul Brinkmeier c38574e005 Add exec in entrypoint
deliver / deliver (push) Successful in 1m40s
2025-10-07 13:26:46 +02:00
Paul Brinkmeier 700d53fbb0 Update todo list 2025-10-07 13:09:24 +02:00
Paul Brinkmeier c5c11ed181 Don't buffer stdout
deliver / deliver (push) Successful in 1m36s
2025-10-07 12:53:14 +02:00
paul 36c9b880a7 Merge pull request 'Add entrypoint script and cacerts to image' (#2) from image-entry into main
Reviewed-on: #2
2025-10-07 12:50:53 +02:00
paul c25ead672b Add entrypoint script and cacerts to image
deliver / deliver (push) Successful in 2m0s
build / build (pull_request) Successful in 16s
2025-10-07 12:43:48 +02:00
Paul Brinkmeier 4a6e3b2454 Reformat image flake output 2025-10-07 10:28:30 +02:00
paul b739294638 Merge pull request 'CI' (#1) from ci into main
Reviewed-on: #1
2025-10-07 01:17:42 +02:00
Paul Brinkmeier 27f5b8e23c Fix reading image tag
build / build (pull_request) Successful in 1m14s
deliver / deliver (push) Successful in 37s
2025-10-07 01:11:18 +02:00
Paul Brinkmeier 48eb27e218 Add docker image CI workflow
build / build (pull_request) Successful in 1m17s
deliver / deliver (push) Failing after 48s
2025-10-07 01:07:22 +02:00
Paul Brinkmeier 94554ad6e4 Bump opium
build / build (pull_request) Successful in 2m29s
2025-10-07 00:49:51 +02:00
Paul Brinkmeier 1ccde9e5fc Add Gitea Actions config
build / build (pull_request) Successful in 5m40s
2025-10-07 00:26:30 +02:00
Paul Brinkmeier 999c9e8c9e Ignore .gitea in flake.nix 2025-10-07 00:20:34 +02:00
Paul Brinkmeier eff74cecb4 dbmate changes 2025-10-06 10:22:28 +02:00
Paul Brinkmeier e9934276d5 Log service time 2025-10-06 08:52:39 +02:00
Paul Brinkmeier 72ffa08e18 Collect all errors in envy 2025-10-06 08:51:22 +02:00
Paul Brinkmeier 2b85c0fa93 dbmate changes 2025-10-06 08:49:52 +02:00
Paul Brinkmeier 05943c902e Remove get100YearsAgo 2025-09-22 23:54:54 +02:00
Paul Brinkmeier 0bf734730b Move Accept HTML in Yore.Servant 2025-09-22 19:04:51 +02:00
Paul Brinkmeier f2a136d27c Implement HasServer instead of using Raw 2025-09-22 18:04:13 +02:00
Paul Brinkmeier 85bbc8516a Make doIndex a loop 2025-09-22 16:07:42 +02:00
Paul Brinkmeier ac8e8a404a Add dbmate message about database version to schema 2025-09-22 16:06:22 +02:00
Paul Brinkmeier fa60291779 Bump nixpkgs 2025-09-22 11:58:59 +02:00
12 changed files with 280 additions and 105 deletions
+27
View File
@@ -0,0 +1,27 @@
name: build
on:
pull_request:
jobs:
build:
container:
image: node:24-bookworm
env:
USER: node
HOME: /home/node
NIX_CONFIG: experimental-features = nix-command flakes
volumes:
- /var/lib/pbri/docker/nix_runner_nix:/nix
- /var/lib/pbri/docker/nix_runner_etc:/etc/nix
- /var/lib/pbri/docker/nix_runner_home_node:/home/node
options: --user 1000:1000
steps:
- name: Prep nix env
run: |
if [ ! -f ~/.nix-profile/etc/profile.d/nix.sh ]; then
curl -L https://nixos.org/nix/install | bash -s -- --no-daemon
fi
. ~/.nix-profile/etc/profile.d/nix.sh
env >> "$GITHUB_ENV"
- name: Checkout repo
uses: actions/checkout@v4
- run: nix build --log-format raw --print-build-logs .#yore
+40
View File
@@ -0,0 +1,40 @@
name: deliver
on:
push:
tags:
- 'v*'
jobs:
deliver:
container:
image: node:24-bookworm
env:
USER: node
HOME: /home/node
NIX_CONFIG: experimental-features = nix-command flakes
volumes:
- /var/lib/pbri/docker/nix_runner_nix:/nix
- /var/lib/pbri/docker/nix_runner_etc:/etc/nix
- /var/lib/pbri/docker/nix_runner_home_node:/home/node
options: --user 1000:1000
steps:
- name: Prep nix env
run: |
if [ ! -f ~/.nix-profile/etc/profile.d/nix.sh ]; then
curl -L https://nixos.org/nix/install | bash -s -- --no-daemon
fi
. ~/.nix-profile/etc/profile.d/nix.sh
env >> "$GITHUB_ENV"
- name: Checkout repo
uses: actions/checkout@v4
- name: Get image meta
run: nix build .#yore-meta -o /tmp/yore-meta
- name: Version check
run: |
VERSION=$(cat /tmp/yore-meta/version)
[ "$GITHUB_REF_NAME" = v"$VERSION" ]
- run: nix build --log-format raw --print-build-logs .#image -o image.tar.gz
- run: gunzip -c image.tar.gz > image.tar
- run: nix run .#crane -- auth login git.pbrinkmeier.de -u paul -p "$PASSWORD"
env:
PASSWORD: "${{ secrets.REGISTRY_PASSWORD }}"
- run: nix run .#crane -- push image.tar $(cat /tmp/yore-meta/image-tag)
+8 -6
View File
@@ -25,7 +25,7 @@ You can also use it to run a database for development by choosing a `$COMMAND` t
```
BASE_DIR=./pgdata scripts/with-db psql "dbname=yore-test port=5433 user=yore-test"
# cabal repl with env vars set
BASE_DIR=./pgdata scripts/with-db scripts/dev
BASE_DIR=./pgdata scripts/with-db cabal run
```
By setting `$BASE_DIR` you can persist the database for later runs.
@@ -41,8 +41,10 @@ By setting `$BASE_DIR` you can persist the database for later runs.
## TODO
- CI
- Docker container (in flake)
- try fourmolu
- Test leap second handling in the `time` package
- use queue to sync logging of indexer and main thread
- [x] CI
- [x] Docker container (in flake)
- [x] try fourmolu
- [x] Test leap second handling in the `time` package
- [ ] Fix container shutdown delay
- [ ] Fix `responseFile` always returning 200
- [ ] use queue to sync logging of indexer and main thread
+55 -62
View File
@@ -17,25 +17,20 @@ import Control.Monad.Trans.Except (ExceptT (..), catchE, runExceptT)
import Data.Bifunctor (Bifunctor (..))
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Data.Time (Day, LocalTime (..), TimeOfDay (..), ZonedTime (..), addDays, toGregorian)
import Data.Time (Day, LocalTime (..), TimeOfDay (..), ZonedTime (..), addDays, nominalDiffTimeToSeconds, 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 (Middleware, Request (..), responseStatus)
import Servant
( Accept (..)
, Capture
( Capture
, Get
, Handler
, MimeRender (..)
, Raw
, ServerError (..)
, ServerT
, Tagged (..)
, err404
, err500
, hoistServer
, runHandler
, serve
, (:<|>) (..)
, (:>)
@@ -62,17 +57,15 @@ import Yore.Download (downloadInto)
import Yore.Error (Error (..))
import Yore.Schedule (schedule)
import Yore.Scrape (Issue (..), getIssuesByDay)
import Yore.Servant (GetSendfile, HTML, Sendfile (..))
import Yore.Time (addYears, getCurrentDay, getSecondsUntilMidnight)
import Data.Fixed (Pico)
import Data.Time.Clock.POSIX (getPOSIXTime)
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
import System.IO (hSetBuffering, BufferMode (..), stdout)
data ConfigT f = Config
{ yorePort :: f =@@ Int ? 3000
@@ -87,10 +80,12 @@ deriving instance Show Config
main :: IO ()
main = do
hSetBuffering stdout NoBuffering
cfg <-
Envy.load @ConfigT >>= \case
Left err -> do
Log.error $ printf "failed to read config: %s" err
Left errs -> do
forM_ errs $ Log.error . printf "failed to read config: %s"
exitFailure
Right c ->
pure c
@@ -114,35 +109,40 @@ doIndex :: Config -> DB -> ExceptT Error IO ()
doIndex cfg db =
catchE
( DB.withTransaction db $ \conn -> do
dayThen <- getTodayWithOffset (-100) 0
forM_ [0, 1, 2] $ \i -> do
dayThen <- getTodayWithOffset (-100) i
indexDay cfg dayThen conn
dayThen2 <- getTodayWithOffset (-100) 1
indexDay cfg dayThen2 conn
dayThen3 <- getTodayWithOffset (-100) 2
indexDay cfg dayThen3 conn
)
(Log.error . show)
runServer :: Config -> DB -> IO ()
runServer cfg db =
Warp.runSettings settings $ serve (Proxy @API) $ hoistServer (Proxy @API) nt $ server cfg db
Warp.runSettings settings $ loggerMiddleware $ serve (Proxy @API) $ hoistServer (Proxy @API) nt $ server cfg db
where
settings =
foldr
($)
Warp.defaultSettings
[ Warp.setLogger logger
, Warp.setPort cfg.yorePort
[ Warp.setPort cfg.yorePort
, Warp.setBeforeMainLoop $ Log.info $ printf "listening on port %d" cfg.yorePort
, Warp.setOnException onException
]
logger req status _ = do
Log.info $
printf
"%d %s"
(statusCode status)
(requestLine req)
logger :: Request -> Status -> Pico -> IO ()
logger req status s = do
Log.info $ printf "%d %s %ss" (statusCode status) (requestLine req) (formatMetric s)
loggerMiddleware :: Middleware
loggerMiddleware app req respond = do
begin <- getPOSIXTime
app req $ \res -> do
rr <- respond res
end <- getPOSIXTime
logger req (responseStatus res) (nominalDiffTimeToSeconds (end - begin))
pure rr
onException mbReq ex = do
Log.error $ printf "unhandled exception%s: %s%s" (maybe "" ((" in " ++) . requestLine) mbReq) (show ex)
requestLine :: Request -> String
requestLine req =
@@ -151,8 +151,17 @@ runServer cfg db =
(BS8.unpack $ requestMethod req)
(BS8.unpack $ rawPathInfo req <> rawQueryString req)
onException mbReq ex = do
Log.error $ printf "unhandled exception%s: %s%s" (maybe "" ((" in " ++) . requestLine) mbReq) (show ex)
formatMetric :: Pico -> String
formatMetric x = go (-9) prefixes
where
prefixes = ["p", "n", "u", "m", "", "k", "M", "G"]
go :: Int -> [String] -> String
go _ [] = show x
go e (p : ps)
| x < 10 ^^ e =
show @Int (floor $ x * 10 ^^ (-e + 3)) ++ p
| otherwise = go (e + 3) ps
nt :: ExceptT Error IO a -> Handler a
nt action = MkHandler $ do
@@ -164,11 +173,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 ->
@@ -183,14 +187,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
@@ -198,24 +198,25 @@ server cfg db = rootR :<|> todayR :<|> apiTodayR
rootR = todayR 0
todayR issue = do
dateThen <- ExceptT get100YearsAgo
dateThen <- getTodayWithOffset (-100) 0
count <- DB.withConn db $ DB.getNumberOfIssues dateThen
dayFile <- DB.withConn db $ DB.getDayFileByIssue dateThen issue
pure $ RootModel dateThen dayFile issue count
apiTodayR issue = handlerToRaw $ do
dateThen <- ExceptT get100YearsAgo
apiTodayR issue = do
dateThen <- getTodayWithOffset (-100) 0
dayFile <- DB.withConn db $ DB.getDayFileByIssue dateThen issue
let fullPath = cfg.yoreDownloadDir </> dayFile.relative_path
secondsUntilMidnight <- liftIO getSecondsUntilMidnight
pure $
responseFile
status200
pure
Sendfile
{ headers =
[ ("content-type", "application/pdf")
, ("cache-control", BS8.pack $ printf "public, max-age=%d" secondsUntilMidnight)
]
, path =
fullPath
Nothing
}
data RootModel = RootModel Day DB.DayFile Int Int
@@ -251,14 +252,6 @@ instance MimeRender HTML RootModel where
-- Utils
data HTML
instance Accept HTML where
contentType _ = "text" // "html" /: ("charset", "utf-8")
get100YearsAgo :: IO (Either Error Day)
get100YearsAgo = runExceptT $ getTodayWithOffset (-100) 0
getTodayWithOffset :: Integer -> Integer -> ExceptT Error IO Day
getTodayWithOffset yearOffset dayOffset =
ExceptT $
@@ -280,7 +273,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
+7
View File
@@ -1,3 +1,8 @@
\restrict CAC30PXzQJosjH02Spia1vzj9Ui3LB1Cq2HI8r0A4eu33HP8ngxbbM2SzRfTj0c
-- Dumped from database version 17.6
-- Dumped by pg_dump version 17.6
SET statement_timeout = 0;
SET lock_timeout = 0;
SET idle_in_transaction_session_timeout = 0;
@@ -124,6 +129,8 @@ ALTER TABLE ONLY yore.day_file
-- PostgreSQL database dump complete
--
\unrestrict CAC30PXzQJosjH02Spia1vzj9Ui3LB1Cq2HI8r0A4eu33HP8ngxbbM2SzRfTj0c
--
-- Dbmate schema migrations
Generated
+7 -7
View File
@@ -40,11 +40,11 @@
},
"nixpkgs": {
"locked": {
"lastModified": 1752536923,
"narHash": "sha256-fdgPZR7VFSSRIQKOJLcs3qCJBWM64Uak0gAGtWTYAd8=",
"lastModified": 1758518877,
"narHash": "sha256-1K1c6vNr/N1PfM77DqKINXQ/oCxA0W1ZJ80sfNzWu0w=",
"owner": "nixos",
"repo": "nixpkgs",
"rev": "c665e4d918eda5d78a175ed8d300809c44932160",
"rev": "033cc13ab4c1a60b3527b242755aa625001ff1f9",
"type": "github"
},
"original": {
@@ -64,11 +64,11 @@
]
},
"locked": {
"lastModified": 1756064767,
"narHash": "sha256-SaJK9VYc/oF5aBSMSW+We8TggER4+uTAHvc2ztnLpYo=",
"lastModified": 1759790870,
"narHash": "sha256-rEsaO38v2wvAThPzgbYPgnv29mu6GxTYLjgci3GYaO4=",
"ref": "main",
"rev": "af16429d827816cf9bec69026e13f50acc3d2691",
"revCount": 65,
"rev": "4db509c1b52ee7b5012abfef5e11e62beab27a16",
"revCount": 66,
"type": "git",
"url": "https://git.pbrinkmeier.de/paul/opium"
},
+52 -7
View File
@@ -26,11 +26,18 @@
};
# For building the package, we use only the files not ignored by Git as inputs.
# Also, flake.nix and flake.lock are not included to avoid rebuilds when
# Also, flake.nix, flake.lock and .gitea are not included to avoid rebuilds when
# working on them.
src = pkgs.lib.cleanSourceWith {
src = gitignore.lib.gitignoreSource ./.;
filter = path: type: builtins.elem (builtins.baseNameOf path) [ "flake.nix" "flake.lock" ];
src = ./.;
filter = gitignore.lib.gitignoreFilterWith {
basePath = ./.;
extraRules = ''
flake.nix
flake.lock
.gitea
'';
};
};
yore = pkgs.lib.pipe
@@ -51,16 +58,48 @@
# Return only the bin folder to curb image size
compose.justStaticExecutables
];
in {
packages = rec {
docker =
image =
pkgs.dockerTools.buildImage {
name = "git.pbrinkmeier.de/paul/yore";
tag = yore.version;
config.Cmd = [ "${yore}/bin/yore" ];
copyToRoot = [ pkgs.cacert ];
config = {
Cmd = [ "${entrypoint}/bin/run" ];
StopSignal = "SIGINT";
};
};
entrypoint = pkgs.writeShellApplication {
name = "run";
runtimeInputs = [ pkgs.coreutils pkgs.dbmate yore ];
text = ''
set -Eeuo pipefail
mkdir -p "''${YORE_DBMATE_DIR}"
TMPDIR=$(mktemp -dp "''${YORE_DBMATE_DIR}")
mkdir -p "''${TMPDIR}/db"
cp -r ${./db}/* "''${TMPDIR}/db"
cd "''${TMPDIR}"
dbmate up
chmod +w -R "''${TMPDIR}"
rm -rf "''${TMPDIR}"
# Replace bash and inherit PID 1
cd /
exec yore
'';
};
in {
packages = rec {
default = yore;
inherit yore image;
yore-meta = pkgs.runCommand "yore-meta" {} ''
mkdir -p $out
echo -n ${yore.version} > $out/version
echo -n ${image.drvAttrs.imageName}:${image.drvAttrs.imageTag} > $out/image-tag
'';
opium_ = opium.packages.${system}.opium;
};
@@ -82,5 +121,11 @@
overrides = addOpium;
}).env;
};
apps = {
crane = {
type = "app";
program = "${pkgs.crane}/bin/crane";
};
};
});
}
+12 -4
View File
@@ -56,13 +56,13 @@ type t ? d = Optional t d
load
:: forall (m :: ConfigVariant -> Type)
. (Generic (m Value), GFromEnv (Rep (m Spec)) (Rep (m Value)))
=> IO (Either String (m Value))
=> IO (Either [String] (m Value))
load = do
env <- getEnvironment
pure $ to <$> gFromEnv @(Rep (m Spec)) @(Rep (m Value)) Proxy env
class GFromEnv spec value where
gFromEnv :: Proxy (spec c) -> [(String, String)] -> Either String (value c)
gFromEnv :: Proxy (spec c) -> [(String, String)] -> Either [String] (value c)
instance
(GFromEnv i o)
@@ -77,7 +77,15 @@ instance
gFromEnv Proxy env = M1 <$> gFromEnv @i @o Proxy env
instance (GFromEnv i1 o1, GFromEnv i2 o2) => GFromEnv (i1 :*: i2) (o1 :*: o2) where
gFromEnv Proxy env = (:*:) <$> gFromEnv @i1 @o1 Proxy env <*> gFromEnv @i2 @o2 Proxy env
gFromEnv Proxy env =
case (eLhs, eRhs) of
(Left errs1, Right _) -> Left errs1
(Right _, Left errs2) -> Left errs2
(Left errs1, Left errs2) -> Left $ errs1 ++ errs2
(Right lhs, Right rhs) -> Right $ lhs :*: rhs
where
eLhs = gFromEnv @i1 @o1 Proxy env
eRhs = gFromEnv @i2 @o2 Proxy env
instance
(KnownSymbol sym, EnvVarSpec s t)
@@ -86,7 +94,7 @@ instance
(M1 S meta2 (Rec0 t))
where
gFromEnv Proxy env =
M1 . K1 <$> decodeEnvVar @s @t Proxy varName (lookup varName env)
M1 . K1 <$> first (: []) (decodeEnvVar @s @t Proxy varName (lookup varName env))
where
varName = selectorNameToEnvVarName $ symbolVal $ Proxy @sym
+19 -8
View File
@@ -2,7 +2,8 @@
module Yore.Download (downloadInto) where
import Control.Monad (guard)
import Control.Exception (Exception, IOException, catch)
import Control.Monad.Trans.Except (ExceptT (..))
import Data.Maybe (fromJust)
import Data.Text (Text)
import Network.HTTP.Req hiding (queryParam)
@@ -14,6 +15,8 @@ import qualified Data.Text as Text
import qualified Data.UUID.V4 as UUID
import qualified Text.URI as URI
import Yore.Error (Error (..))
-- | Download a URL and save it to a directory.
-- Returns the path of the downloaded file relative to the directory.
downloadInto
@@ -21,22 +24,30 @@ downloadInto
-- ^ Directory where to store the file.
-> Text
-- ^ The URL to download.
-> IO FilePath
downloadInto downloadDir textUrl = download >>= save
-> ExceptT Error IO FilePath
downloadInto downloadDir textUrl =
download >>= save
where
download :: IO LBS.ByteString
download = do
download :: ExceptT Error IO LBS.ByteString
download = toExceptT (handle @HttpException) $ do
uri <- URI.mkURI textUrl
let (url, opts) = fromJust $ useHttpsURI uri
res <- runReq defaultHttpConfig $ req GET url NoReqBody lbsResponse opts
guard $ responseStatusCode res == 200
pure $ responseBody res
save :: LBS.ByteString -> IO FilePath
save contents = do
save :: LBS.ByteString -> ExceptT Error IO FilePath
save contents = toExceptT (handle @IOException) $ do
let suffix = takeExtension $ Text.unpack textUrl
uuid <- UUID.nextRandom
let fullPath = downloadDir </> show uuid <.> suffix
createDirectoryIfMissing True downloadDir
LBS.writeFile fullPath contents
pure $ makeRelative downloadDir fullPath
toExceptT :: (Exception e) => (e -> Error) -> IO a -> ExceptT Error IO a
toExceptT showException f =
ExceptT $ (Right <$> f) `catch` (pure . Left . showException)
handle :: (Show e) => e -> Error
handle =
GenericError . Text.pack . show
+1 -1
View File
@@ -112,7 +112,7 @@ showpdfRequest (y, m, d) =
NoReqBody
bsResponse
( formToQuery
[ ("cmd" :: Text, "showpdf")
[ ("cmd" :: Text, "showpdfjs")
, ("year", y)
, ("month", m)
, ("day", d)
+38
View File
@@ -0,0 +1,38 @@
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module Yore.Servant (GetSendfile, Sendfile (..), HTML) where
import Network.HTTP.Media ((//), (/:))
import Network.HTTP.Types (ResponseHeaders, status200)
import Network.Wai (responseFile)
import Servant (Accept (..), HasServer (..))
import Servant.Server.Internal.Delayed (runAction)
import Servant.Server.Internal.RouteResult (RouteResult (..))
import Servant.Server.Internal.Router (Router' (..))
-- | Servant route type that responds with a file using @sendfile@.
data GetSendfile
data Sendfile = Sendfile
{ headers :: ResponseHeaders
-- ^ The headers to send along with the file, e.g. @content-type@ or cache information.
, path :: FilePath
-- ^ The file to respond with.
}
deriving (Show)
instance HasServer GetSendfile context where
type ServerT GetSendfile m = m Sendfile
hoistServerWithContext _ _ nt = nt
route _ _ action = RawRouter $ \env request respond ->
runAction action env request respond $ \sendfile ->
Route $ responseFile status200 sendfile.headers sendfile.path Nothing
data HTML
instance Accept HTML where
contentType _ = "text" // "html" /: ("charset", "utf-8")
+6 -2
View File
@@ -1,7 +1,7 @@
cabal-version: 3.4
name: yore
version: 0
version: 0.0.9
author: Paul Brinkmeier
maintainer: hallo@pbrinkmeier.de
copyright: 2023 Paul Brinkmeier
@@ -41,6 +41,7 @@ library
, Yore.Schedule
, Yore.Scrape
, Yore.Time
, Yore.Servant
hs-source-dirs:
src
build-depends:
@@ -49,16 +50,20 @@ library
, directory
, filepath
, html-parse
, http-media
, http-types
, lens
, modern-uri
, mtl
, opium
, req
, resource-pool
, servant-server
, text
, time
, transformers
, uuid
, wai
executable yore
import: shared-options
@@ -77,7 +82,6 @@ executable yore
, bytestring
, filepath
, opium
, http-media
, http-types
, servant-server
, text