about summary refs log tree commit diff
path: root/users/Profpatsch/cas-serve
diff options
context:
space:
mode:
Diffstat (limited to 'users/Profpatsch/cas-serve')
-rw-r--r--users/Profpatsch/cas-serve/CasServe.hs38
-rw-r--r--users/Profpatsch/cas-serve/cas-serve.cabal59
-rw-r--r--users/Profpatsch/cas-serve/default.nix41
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