diff options
author | Profpatsch <mail@profpatsch.de> | 2023-05-28T18·58+0200 |
---|---|---|
committer | clbot <clbot@tvl.fyi> | 2023-07-13T23·03+0000 |
commit | 8c4730c433ba01cb17aab2917d495d055c4f468e (patch) | |
tree | 0817b780ac451b91109771876805e7c0c5a93404 /users/Profpatsch/cas-serve/CasServe.hs | |
parent | ee21f725a38855e43fd8e82eb8c6c6fc99aca235 (diff) |
chore(users/Profpatsch/*): more cabal maintenance r/6409
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>
Diffstat (limited to 'users/Profpatsch/cas-serve/CasServe.hs')
-rw-r--r-- | users/Profpatsch/cas-serve/CasServe.hs | 38 |
1 files changed, 23 insertions, 15 deletions
diff --git a/users/Profpatsch/cas-serve/CasServe.hs b/users/Profpatsch/cas-serve/CasServe.hs index f7189d5f9acf..62636fe9c132 100644 --- a/users/Profpatsch/cas-serve/CasServe.hs +++ b/users/Profpatsch/cas-serve/CasServe.hs @@ -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 |