chore(users/Profpatsch/*): more cabal maintenance

Change-Id: Ib1714abce2815873eb50dbeac088e812fa9098ab
Reviewed-on: https://cl.tvl.fyi/c/depot/+/8686
Tested-by: BuildkiteCI
Reviewed-by: Profpatsch <mail@profpatsch.de>
Autosubmit: Profpatsch <mail@profpatsch.de>
This commit is contained in:
Profpatsch 2023-05-28 20:58:20 +02:00 committed by clbot
parent ee21f725a3
commit 8c4730c433
24 changed files with 264 additions and 203 deletions

View file

@ -1,16 +1,9 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Main where
import ArglibNetencode (arglibNetencode)
import Control.Applicative
import Control.Monad.Reader
import Crypto.Hash qualified as Crypto
@ -20,7 +13,6 @@ import Data.ByteString.Lazy qualified as Lazy
import Data.Functor.Compose
import Data.Int (Int64)
import Data.List qualified as List
import Data.Maybe (fromMaybe)
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import Database.SQLite.Simple (NamedParam ((:=)))
@ -28,12 +20,29 @@ import Database.SQLite.Simple qualified as Sqlite
import Database.SQLite.Simple.FromField qualified as Sqlite
import Database.SQLite.Simple.QQ qualified as Sqlite
import Label
import MyPrelude
import Netencode.Parse qualified as Net
import Network.HTTP.Types qualified as Http
import Network.Wai qualified as Wai
import Network.Wai.Handler.Warp qualified as Warp
import PossehlAnalyticsPrelude
import System.IO (stderr)
parseArglib = do
let env = label @"arglibEnvvar" "CAS_SERVE_ARGS"
let asApi =
Net.asRecord >>> do
address <- label @"bindToAddress" <$> (Net.key "bindToAddress" >>> Net.asText)
port <- label @"port" <$> (Net.key "port" >>> Net.asText)
pure (T2 address port)
arglibNetencode "cas-serve" (Just env)
<&> Net.runParse
[fmt|Cannot parse arguments in "{env.arglibEnvvar}"|]
( Net.asRecord >>> do
publicApi <- label @"publicApi" <$> (Net.key "publicApi" >>> asApi)
privateApi <- label @"privateApi" <$> (Net.key "privateApi" >>> asApi)
pure $ T2 publicApi privateApi
)
main :: IO ()
main = do
withEnv $ \env ->
@ -64,8 +73,7 @@ api env req respond = do
Wai.responseLBS
Http.status200
headers
( body & toLazyBytes
)
(body & toLazyBytes)
data Env = Env
{ envWordlist :: Sqlite.Connection,
@ -102,7 +110,7 @@ getById = handler $ \(req, env) -> do
"size"
Int
)
(env & envData)
(env.envData)
[Sqlite.sql|
SELECT
mimetype,
@ -172,7 +180,7 @@ insertById = handler $ \(req, env) -> do
name <- getNameFromWordlist env
let fullname = name <> extension
let conn = env & envData
let conn = env.envData
Sqlite.withTransaction conn $ do
Sqlite.executeNamed
conn
@ -218,7 +226,7 @@ getNameFromWordlist env =
do
let numberOfWords = 3 :: Int
Sqlite.queryNamed @(Sqlite.Only Text)
(env & envWordlist)
(env.envWordlist)
[Sqlite.sql|SELECT word FROM wordlist ORDER BY RANDOM() LIMIT :words|]
[":words" Sqlite.:= numberOfWords]
<&> map Sqlite.fromOnly