diff options
Diffstat (limited to 'users/Profpatsch/cas-serve')
| -rw-r--r-- | users/Profpatsch/cas-serve/CasServe.hs | 38 | ||||
| -rw-r--r-- | users/Profpatsch/cas-serve/cas-serve.cabal | 59 | ||||
| -rw-r--r-- | users/Profpatsch/cas-serve/default.nix | 41 |
3 files changed, 109 insertions, 29 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 diff --git a/users/Profpatsch/cas-serve/cas-serve.cabal b/users/Profpatsch/cas-serve/cas-serve.cabal index 3d988e42273c..82db1f5fd89a 100644 --- a/users/Profpatsch/cas-serve/cas-serve.cabal +++ b/users/Profpatsch/cas-serve/cas-serve.cabal @@ -1,23 +1,74 @@ -cabal-version: 2.4 +cabal-version: 3.0 name: cas-serve version: 0.1.0.0 author: Profpatsch maintainer: mail@profpatsch.de +common common-options + ghc-options: + -Wall + -Wno-type-defaults + -Wunused-packages + -Wredundant-constraints + -fwarn-missing-deriving-strategies + + -- See https://downloads.haskell.org/ghc/latest/docs/users_guide/exts.html + -- for a description of all these extensions + default-extensions: + -- Infer Applicative instead of Monad where possible + ApplicativeDo + + -- Allow literal strings to be Text + OverloadedStrings + + -- Syntactic sugar improvements + LambdaCase + MultiWayIf + + -- Makes the (deprecated) usage of * instead of Data.Kind.Type an error + NoStarIsType + + -- Convenient and crucial to deal with ambiguous field names, commonly + -- known as RecordDotSyntax + OverloadedRecordDot + + -- does not export record fields as functions, use OverloadedRecordDot to access instead + NoFieldSelectors + + -- Record punning + RecordWildCards + + -- Improved Deriving + DerivingStrategies + DerivingVia + + -- Type-level strings + DataKinds + + -- to enable the `type` keyword in import lists (ormolu uses this automatically) + ExplicitNamespaces + + default-language: GHC2021 + + executable cas-serve + import: common-options + main-is: CasServe.hs build-depends: base >=4.15 && <5, + pa-prelude, + pa-label, + arglib-netencode, + netencode, text, sqlite-simple, http-types, + ihp-hsx, wai, warp, mtl, - my-prelude, bytestring, memory, cryptonite, - - default-language: Haskell2010 diff --git a/users/Profpatsch/cas-serve/default.nix b/users/Profpatsch/cas-serve/default.nix index 6e4bfd324233..1b4fbe03e78f 100644 --- a/users/Profpatsch/cas-serve/default.nix +++ b/users/Profpatsch/cas-serve/default.nix @@ -1,17 +1,38 @@ { depot, pkgs, lib, ... }: let - cas-serve = pkgs.writers.writeHaskell "cas-serve" - { - libraries = [ - pkgs.haskellPackages.wai - pkgs.haskellPackages.warp - pkgs.haskellPackages.sqlite-simple - depot.users.Profpatsch.my-prelude - ]; - ghcArgs = [ "-threaded" ]; + bins = depot.nix.getBins pkgs.sqlite [ "sqlite3" ]; - } ./CasServe.hs; + cas-serve = pkgs.haskellPackages.mkDerivation { + pname = "cas-serve"; + version = "0.1.0"; + src = depot.users.Profpatsch.exactSource ./. [ + ./cas-serve.cabal + ./CasServe.hs + ]; + + libraryHaskellDepends = [ + pkgs.haskellPackages.pa-prelude + pkgs.haskellPackages.pa-label + pkgs.haskellPackages.ihp-hsx + pkgs.haskellPackages.wai + pkgs.haskellPackages.warp + pkgs.haskellPackages.sqlite-simple + depot.users.Profpatsch.arglib.netencode.haskell + depot.users.Profpatsch.netencode.netencode-hs + ]; + + isExecutable = true; + isLibrary = false; + license = lib.licenses.mit; + }; + + create-cas-database = depot.nix.writeExecline "create-cas-database" { readNArgs = 1; } [ + bins.sqlite3 + "$1" + "-init" + ./schema.sql + ]; in cas-serve |