167 files changed, 15011 insertions, 1617 deletions

diff --git a/users/Profpatsch/.envrc b/users/Profpatsch/.envrc
new file mode 100644
index 0000000000..c91f923756
--- /dev/null
+++ b/users/Profpatsch/.envrc
@@ -0,0 +1,5 @@
+if pass apps/declib/mastodon_access_token >/dev/null; then
+    export DECLIB_MASTODON_ACCESS_TOKEN=$(pass apps/declib/mastodon_access_token)
+fi
+
+eval "$(lorri direnv)"
diff --git a/users/Profpatsch/.gitignore b/users/Profpatsch/.gitignore
new file mode 100644
index 0000000000..c33954f53a
--- /dev/null
+++ b/users/Profpatsch/.gitignore
@@ -0,0 +1 @@
+dist-newstyle/
diff --git a/users/Profpatsch/.hlint.yaml b/users/Profpatsch/.hlint.yaml
new file mode 100644
index 0000000000..f00f78c525
--- /dev/null
+++ b/users/Profpatsch/.hlint.yaml
@@ -0,0 +1,357 @@
+# HLint configuration file
+# https://github.com/ndmitchell/hlint
+# Run `hlint --default` to see the example configuration file.
+##########################
+
+# WARNING: These need to be synced with the default-extensions field
+# in the cabal file.
+- arguments: [-XGHC2021, -XOverloadedRecordDot]
+
+# Ignore some builtin hints
+
+# often functions are more readable with explicit arguments
+- ignore: { name: Eta reduce }
+
+# these redundancy warnings are just completely irrelevant
+- ignore: { name: Redundant bracket }
+- ignore: { name: Move brackets to avoid $ }
+- ignore: { name: Redundant $ }
+- ignore: { name: Redundant do }
+- ignore: { name: Redundant multi-way if }
+
+# allow case-matching on bool, because why not
+- ignore: { name: Use if }
+
+# hlint cannot distinguish actual newtypes from data types
+# that accidentally have only one field
+# (but might have more in the future).
+# Since it’s a mostly irrelevant runtime optimization, we don’t care.
+- ignore: { name: Use newtype instead of data }
+
+# these lead to harder-to-read/more implicit code
+- ignore: { name: Use fmap }
+- ignore: { name: Use <$> }
+- ignore: { name: Use tuple-section }
+- ignore: { name: Use forM_ }
+- ignore: { name: Functor law }
+# fst and snd are usually a code smell and should be explicit matches, _naming the ignored side.
+- ignore: { name: Use fst }
+- ignore: { name: Use snd }
+- ignore: { name: Use fromMaybe }
+- ignore: { name: Use const }
+- ignore: { name: Replace case with maybe }
+- ignore: { name: Replace case with fromMaybe }
+- ignore: { name: Avoid lambda }
+- ignore: { name: Avoid lambda using `infix` }
+- ignore: { name: Use curry }
+- ignore: { name: Use uncurry }
+- ignore: { name: Use first }
+- ignore: { name: Redundant first }
+- ignore: { name: Use second }
+- ignore: { name: Use bimap }
+# just use `not x`
+- ignore: { name: Use unless }
+- ignore: { name: Redundant <&> }
+
+# list comprehensions are a seldomly used part of the Haskell language
+# and they introduce syntactic overhead that is usually not worth the conciseness
+- ignore: { name: Use list comprehension }
+
+# Seems to be buggy in cases
+- ignore: { name: Use section }
+
+# multiple maps in a row are usually used for clarity,
+# and the compiler will optimize them away, thank you very much.
+- ignore: { name: Use map once }
+- ignore: { name: Fuse foldr/map }
+- ignore: { name: Fuse traverse/map }
+- ignore: { name: Fuse traverse_/map }
+- ignore: { name: Fuse traverse/<$> }
+
+# this is silly, why would I use a special function if I can just (heh) `== Nothing`
+- ignore: { name: Use isNothing }
+
+# The duplication heuristic is not very smart
+# and more annoying than helpful.
+# see https://github.com/ndmitchell/hlint/issues/1009
+- ignore: { name: Reduce duplication }
+
+# Stops the pattern match trick
+- ignore: { name: Use record patterns }
+- ignore: { name: Use null }
+- ignore: { name: Use uncurry }
+
+# we don’t want void, see below
+- ignore: { name: Use void }
+
+- functions:
+    # disallow Enum instance functions, they are partial
+    - name: Prelude.succ
+      within: [Relude.Extra.Enum]
+      message: "Dangerous, will fail for highest element"
+    - name: Prelude.pred
+      within: [Relude.Extra.Enum]
+      message: "Dangerous, will fail for lowest element"
+    - name: Prelude.toEnum
+      within: []
+      message: "Extremely partial"
+    - name: Prelude.fromEnum
+      within: []
+      message: "Dangerous for most uses"
+    - name: Prelude.enumFrom
+      within: []
+    - name: Prelude.enumFromThen
+      within: []
+    - name: Prelude.enumFromThenTo
+      within: []
+    - name: Prelude.oundedEnumFrom
+      within: []
+    - name: Prelude.boundedEnumFromThen
+      within: []
+
+    - name: Text.Read.readMaybe
+      within:
+        # The BSON ObjectId depends on Read for parsing
+        - Milkmap.Milkmap
+        - Milkmap.FieldData.Value
+      message: "`readMaybe` is probably not what you want for parsing values, please use the `FieldParser` module."
+
+    # `void` discards its argument and is polymorphic,
+    # thus making it brittle in the face of code changes.
+    # (see https://tech.freckle.com/2020/09/23/void-is-a-smell/)
+    # Use an explicit `_ <- …` instead.
+    - name: Data.Functor.void
+      within: []
+      message: "`void` leads to bugs. Use an explicit `_ <- …` instead"
+
+    - name: Data.Foldable.length
+      within: ["MyPrelude"]
+      message: "`Data.Foldable.length` is dangerous to use, because it also works on types you wouldn’t expect, like `length (3,4) == 1` and `length (Just 2) == 1`. Use the `length` function for your specific type instead, for example `List.length` or `Map.length`."
+
+    - name: Prelude.length
+      within: ["MyPrelude"]
+      message: "`Prelude.length` is dangerous to use, because it also works on types you wouldn’t expect, like `length (3,4) == 1` and `length (Just 2) == 1`. Use the `length` function for your specific type instead, for example `List.length` or `Map.length`."
+
+    # Using an explicit lambda with its argument “underscored”
+    # is more clear in every case.
+    # e.g. `const True` => `\_request -> True`
+    # shows the reader that the ignored argument was a request.
+    - name: Prelude.const
+      within: []
+      message: "Replace `const` with an explicit lambda with type annotation for code clarity and type safety, e.g.: `const True` => `\\(_ :: Request) -> True`. If you really don’t want to spell out the type (which might lead to bugs!), you can also use something like `\_request -> True`."
+
+    - name: Data.List.nub
+      within: []
+      message: "O(n²), use `Data.Containers.ListUtils.nubOrd"
+
+    - name: Prelude.maximum
+      within: []
+      message: "`maximum` crashes on empty list; use non-empty lists and `maximum1`"
+
+    - name: Data.List.maximum
+      within: []
+      message: "`maximum` crashes on empty list; use non-empty lists and `maximum1`"
+
+    - name: Prelude.minimum
+      within: []
+      message: "`minimum` crashes on empty list; use non-empty lists and `minimum1`"
+
+    - name: Data.List.minimum
+      within: []
+      message: "`minimum` crashes on empty list; use non-empty lists and `minimum1`"
+
+    - name: Data.Foldable.maximum
+      within: []
+      message: "`maximum` crashes on empty foldable stucture; use Foldable1 and `maximum1`."
+
+    - name: Data.Foldable.minimum
+      within: []
+      message: "`minimum` crashes on empty foldable stucture; use Foldable1 and `minimum1`."
+
+    # Using prelude functions instead of stdlib functions
+
+    - name: "Data.Text.Encoding.encodeUtf8"
+      within: ["MyPrelude"]
+      message: "Use `textToBytesUtf8`"
+
+    - name: "Data.Text.Lazy.Encoding.encodeUtf8"
+      within: ["MyPrelude"]
+      message: "Use `textToBytesUtf8Lazy`"
+
+    - name: "Data.Text.Encoding.decodeUtf8'"
+      within: ["MyPrelude"]
+      message: "Use `bytesToTextUtf8`"
+
+    - name: "Data.Text.Encoding.Lazy.decodeUtf8'"
+      within: ["MyPrelude"]
+      message: "Use `bytesToTextUtf8Lazy`"
+
+    - name: "Data.Text.Encoding.decodeUtf8"
+      within: ["MyPrelude"]
+      message: "Either check for errors with `bytesToTextUtf8`, decode leniently with unicode replacement characters with `bytesToTextUtf8Lenient` or use the crashing version `bytesToTextUtf8Unsafe` (discouraged)."
+
+    - name: "Data.Text.Encoding.Lazy.decodeUtf8"
+      within: ["MyPrelude"]
+      message: "Either check for errors with `bytesToTextUtf8Lazy`, decode leniently with unicode replacement characters with `bytesToTextUtf8LenientLazy` or use the crashing version `bytesToTextUtf8UnsafeLazy` (discouraged)."
+
+    - name: "Data.Text.Lazy.toStrict"
+      within: ["MyPrelude"]
+      message: "Use `toStrict`"
+
+    - name: "Data.Text.Lazy.fromStrict"
+      within: ["MyPrelude"]
+      message: "Use `toLazy`"
+
+    - name: "Data.ByteString.Lazy.toStrict"
+      within: ["MyPrelude"]
+      message: "Use `toStrictBytes`"
+
+    - name: "Data.ByteString.Lazy.fromStrict"
+      within: ["MyPrelude"]
+      message: "Use `toLazyBytes`"
+
+    - name: "Data.Text.unpack"
+      within: ["MyPrelude"]
+      message: "Use `textToString`"
+
+    - name: "Data.Text.pack"
+      within: ["MyPrelude"]
+      message: "Use `stringToText`"
+
+    - name: "Data.Maybe.listToMaybe"
+      within: []
+      message: |
+        `listToMaybe`` throws away everything but the first element of a list (it is essentially `safeHead`).
+        If that is what you want, please use a pattern match like
+
+        ```
+        case xs of
+          [] -> …
+          (x:_) -> …
+        ```
+
+    - name: "Data.List.head"
+      within: []
+      message: |
+        `List.head` fails on an empty list. I didn’t think I have to say this, but please use a pattern match on the list, like:
+
+        ```
+        case xs of
+          [] -> … error handling …
+          (x:_) -> …
+        ```
+
+        Also think about why the rest of the list should be ignored.
+
+    - name: "Prelude.head"
+      within: []
+      message: |
+        `List.head` fails on an empty list. I didn’t think I have to say this, but please use a pattern match on the list, like.
+
+        ```
+        case xs of
+          [] -> … error handling …
+          (x:_) -> …
+        ```
+
+        Also think about why the rest of the list should be ignored.
+
+    - name: "Data.Maybe.fromJust"
+      within: []
+      message: |
+        `Maybe.fromJust` is obviously partial. Please use a pattern match.
+
+        In case you actually want to throw an error on an empty list,
+        please add an error message, like so:
+
+        ```
+        myMaybe & annotate "my error message" & unwrapError
+        ```
+
+        If you are in `IO`, use `unwrapIOError` instead,
+        or throw a monad-specific error.
+
+    - name: "Data.Either.fromLeft"
+      within: []
+      message: |
+        `Either.fromLeft` is obviously partial. Please use a pattern match.
+
+    - name: "Data.Either.fromRight"
+      within: []
+      message: |
+        `Either.fromRight` is obviously partial. Please use a pattern match.
+
+# Make restricted functions into an error if found
+- error: { name: "Avoid restricted function, see comment in .hlint.yaml" }
+
+# Some functions that have (more modern) aliases.
+# They are not dangerous per se,
+# but we want to make it easier to read our code so we should
+# make sure we don’t use too many things that are renames.
+
+- hint:
+    lhs: "undefined"
+    rhs: "todo"
+    note: "`undefined` is a silent error, `todo` will display a warning as long as it exists in the code."
+
+- hint:
+    lhs: "return"
+    rhs: "pure"
+    note: "Use `pure` from `Applicative` instead, it’s the exact same function."
+
+- hint:
+    lhs: "mapM"
+    rhs: "traverse"
+    note: "Use `traverse` from `Traversable` instead. It’s the exact same function."
+
+- hint:
+    lhs: "mapM_"
+    rhs: "traverse_"
+    note: "Use `traverse_` from `Traversable` instead. It’s the exact same function."
+
+- hint:
+    lhs: "forM"
+    rhs: "for"
+    note: "Use `for` from `Traversable` instead. It’s the exact same function."
+
+- hint:
+    lhs: "forM_"
+    rhs: "for_"
+    note: "Use `for_` from `Traversable` instead. It’s the exact same function."
+
+- hint:
+    lhs: "stringToText (show x)"
+    rhs: "showToText x"
+
+- hint:
+    lhs: "Data.Set.toList (Data.Set.fromList x)"
+    rhs: "List.nubOrd x"
+    note: "`nubOrd` removes duplicate elements from a list."
+
+- modules:
+    # Disallowed Modules
+    - name: Data.Map
+      within: []
+      message: "Lazy maps leak space, use `import Data.Map.Strict as Map` instead"
+    - name: Control.Monad.Writer
+      within: []
+      message: "Lazy writers leak space, use `Control.Monad.Trans.Writer.CPS` instead"
+    - name: Control.Monad.Trans.Writer.Lazy
+      within: []
+      message: "Lazy writers leak space, use `Control.Monad.Trans.Writer.CPS` instead"
+    - name: Control.Monad.Trans.Writer.Strict
+      within: []
+      message: "Even strict writers leak space, use `Control.Monad.Trans.Writer.CPS` instead"
+
+    # Qualified module imports
+    - { name: Data.Map.Strict, as: Map }
+    - { name: Data.HashMap.Strict, as: HashMap }
+    - { name: Data.Set, as: Set }
+    - { name: Data.ByteString.Char8, as: Char8 }
+    - { name: Data.ByteString.Lazy.Char8, as: Char8.Lazy }
+    - { name: Data.Text, as: Text }
+    - { name: Data.Vector, as: Vector }
+    - { name: Data.Vault.Lazy, as: Vault }
+    - { name: Data.Aeson, as: Json }
+    - { name: Data.Aeson.Types, as: Json }
+    - { name: Data.Aeson.BetterErrors as Json }
diff --git a/users/Profpatsch/.vscode/launch.json b/users/Profpatsch/.vscode/launch.json
new file mode 100644
index 0000000000..baa087d437
--- /dev/null
+++ b/users/Profpatsch/.vscode/launch.json
@@ -0,0 +1,18 @@
+{
+    // Use IntelliSense to learn about possible attributes.
+    // Hover to view descriptions of existing attributes.
+    // For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387
+    "version": "0.2.0",
+    "configurations": [
+        {
+            "name": "run declib",
+            "type": "node",
+            "cwd": "${workspaceFolder}/declib",
+            "request": "launch",
+            "runtimeExecutable": "ninja",
+            "runtimeArgs": [
+                "run",
+            ],
+        }
+    ]
+}
diff --git a/users/Profpatsch/.vscode/settings.json b/users/Profpatsch/.vscode/settings.json
new file mode 100644
index 0000000000..7984076c16
--- /dev/null
+++ b/users/Profpatsch/.vscode/settings.json
@@ -0,0 +1,25 @@
+{
+    "sqltools.connections": [
+        {
+            "previewLimit": 50,
+            "driver": "SQLite",
+            "name": "cas-serve",
+            "database": "${workspaceFolder:Profpatsch}/cas-serve/data.sqlite"
+        }
+    ],
+    "sqltools.useNodeRuntime": true,
+    "editor.formatOnSave": true,
+    "[typescript]": {
+        "editor.defaultFormatter": "esbenp.prettier-vscode"
+    },
+    "[javascript]": {
+        "editor.defaultFormatter": "esbenp.prettier-vscode"
+    },
+    "[json]": {
+        "editor.defaultFormatter": "esbenp.prettier-vscode"
+    },
+    "purescript.codegenTargets": [
+        "corefn"
+    ],
+    "purescript.foreignExt": "nix"
+}
diff --git a/users/Profpatsch/OWNERS b/users/Profpatsch/OWNERS
index 5a73d4c3a1..ac23e72256 100644
--- a/users/Profpatsch/OWNERS
+++ b/users/Profpatsch/OWNERS
@@ -1,4 +1,4 @@
-inherited: false
-owners:
-  - Profpatsch
-  - sterni
+set noparent
+
+Profpatsch
+sterni
diff --git a/users/Profpatsch/README.md b/users/Profpatsch/README.md
new file mode 100644
index 0000000000..5bb74cd758
--- /dev/null
+++ b/users/Profpatsch/README.md
@@ -0,0 +1,10 @@
+# Profpatsch’s assemblage of peculiarities and curiosities
+
+Welcome, Welcome.
+
+Welcome to my user dir, where we optimize f*** around, in order to optimize finding out.
+
+![fafo graph](./fafo.jpg)
+
+DISCLAIMER: All of this code is of the “do not try at work” sort, unless noted otherwise.
+You might try at home, however. Get inspired or get grossed out, whichever you like.
diff --git a/users/Profpatsch/alacritty.nix b/users/Profpatsch/alacritty.nix
new file mode 100644
index 0000000000..d3461c4aad
--- /dev/null
+++ b/users/Profpatsch/alacritty.nix
@@ -0,0 +1,27 @@
+{ depot, pkgs, lib, ... }:
+
+let
+  bins = depot.nix.getBins pkgs.alacritty [ "alacritty" ];
+
+  config =
+    {
+      alacritty-config = { font.size = 18; scrolling.history = 100000; };
+      #  This disables the dpi-sensitive scaling (cause otherwise the font will be humongous on my laptop screen)
+      alacritty-env.WINIT_X11_SCALE_FACTOR = 1;
+    };
+
+
+  config-file = (pkgs.formats.toml { }).generate "alacritty.conf" config.alacritty-config;
+
+  alacritty = depot.nix.writeExecline "alacritty" { } (
+    (lib.concatLists (lib.mapAttrsToList (k: v: [ "export" k (toString v) ]) config.alacritty-env))
+    ++ [
+      bins.alacritty
+      "--config-file"
+      config-file
+      "$@"
+    ]
+  );
+
+in
+alacritty
diff --git a/users/Profpatsch/aliases.nix b/users/Profpatsch/aliases.nix
new file mode 100644
index 0000000000..109de8ce33
--- /dev/null
+++ b/users/Profpatsch/aliases.nix
@@ -0,0 +1,88 @@
+{ depot, pkgs, lib, ... }:
+
+let
+  bins = depot.nix.getBins pkgs.findutils [ "find" ];
+
+in
+depot.nix.readTree.drvTargets {
+
+  findia = depot.nix.writeExecline "findia"
+    {
+      readNArgs = 1;
+      # TODO: comment out, thanks to sterni blocking the runExecline change
+      # meta.description = ''
+      #   Find case-insensitive anywhere (globbing)
+
+      #   Usage: findia <pattern> <more find(1) arguments>
+      # '';
+    } [
+    bins.find
+    "-iname"
+    "*\${1}*"
+    "$@"
+  ];
+
+  findial = depot.nix.writeExecline "findial"
+    {
+      readNArgs = 1;
+      # TODO: comment out, thanks to sterni blocking the runExecline change
+      # meta.description = ''
+      #   Find case-insensitive anywhere (globbing), follow symlinks";
+
+      #   Usage: findial <pattern> <more find(1) arguments>
+      # '';
+    } [
+    bins.find
+    "-L"
+    "-iname"
+    "*\${1}*"
+    "$@"
+  ];
+
+  findian = depot.nix.writeExecline "findian"
+    {
+      readNArgs = 2;
+      # TODO: comment out, thanks to sterni blocking the runExecline change
+      # meta.description = ''
+      #   Find case-insensitive anywhere (globbing) in directory
+
+      #   Usage: findian <directory> <pattern> <more find(1) arguments>
+      # '';
+    } [
+    bins.find
+    "$1"
+    "-iname"
+    "*\${2}*"
+    "$@"
+  ];
+
+  findiap = depot.nix.writeExecline "findiap"
+    {
+      readNArgs = 2;
+      # TODO: comment out, thanks to sterni blocking the runExecline change
+      # meta.description = ''
+      #   Find case-insensitive anywhere (globbing) in directory, the pattern allows for paths.
+
+      #   Usage: findiap <directory> <pattern> <more find(1) arguments>
+      # '';
+    } [
+    bins.find
+    "$1"
+    "-ipath"
+    "*\${2}*"
+    "$@"
+  ];
+
+  bell = depot.nix.writeExecline "bell" { } [
+    "if"
+    [
+      "pactl"
+      "upload-sample"
+      "${pkgs.sound-theme-freedesktop}/share/sounds/freedesktop/stereo/complete.oga"
+      "bell-window-system"
+    ]
+    "pactl"
+    "play-sample"
+    "bell-window-system"
+  ];
+}
diff --git a/users/Profpatsch/arglib/ArglibNetencode.hs b/users/Profpatsch/arglib/ArglibNetencode.hs
new file mode 100644
index 0000000000..4531151ca2
--- /dev/null
+++ b/users/Profpatsch/arglib/ArglibNetencode.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module ArglibNetencode where
+
+import Data.Attoparsec.ByteString qualified as Atto
+import ExecHelpers
+import Label
+import Netencode qualified
+import PossehlAnalyticsPrelude
+import System.Posix.Env.ByteString qualified as ByteEnv
+
+arglibNetencode :: CurrentProgramName -> Maybe (Label "arglibEnvvar" Text) -> IO Netencode.T
+arglibNetencode progName mEnvvar = do
+  let envvar = mEnvvar <&> (.arglibEnvvar) & fromMaybe "ARGLIB_NETENCODE" & textToBytesUtf8
+  ByteEnv.getEnv envvar >>= \case
+    Nothing -> dieUserError progName [fmt|could not read args, envvar {envvar} not set|]
+    Just bytes ->
+      case Atto.parseOnly (Netencode.netencodeParser <* Atto.endOfInput) bytes of
+        Left err -> dieEnvironmentProblem progName [fmt|arglib parsing error: {err}|]
+        Right t -> do
+          ByteEnv.unsetEnv envvar
+          pure t
diff --git a/users/Profpatsch/arglib/arglib-netencode.cabal b/users/Profpatsch/arglib/arglib-netencode.cabal
new file mode 100644
index 0000000000..42b524f405
--- /dev/null
+++ b/users/Profpatsch/arglib/arglib-netencode.cabal
@@ -0,0 +1,65 @@
+cabal-version:      3.0
+name:               arglib-netencode
+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
+
+
+library
+    import: common-options
+    exposed-modules:          ArglibNetencode
+
+    build-depends:
+        base >=4.15 && <5,
+        pa-prelude,
+        pa-label,
+        netencode,
+        exec-helpers,
+        attoparsec,
+        unix
diff --git a/users/Profpatsch/arglib/netencode.nix b/users/Profpatsch/arglib/netencode.nix
index 7712bbd5bb..83a94ddd6c 100644
--- a/users/Profpatsch/arglib/netencode.nix
+++ b/users/Profpatsch/arglib/netencode.nix
@@ -1,40 +1,81 @@
 { depot, pkgs, lib, ... }:
 
 let
-  netencode = {
-    rust = depot.nix.writers.rustSimpleLib {
+
+  # Add the given nix arguments to the program as ARGLIB_NETENCODE envvar
+  #
+  # Calls `netencode.gen.dwim` on the provided nix args value.
+  with-args = name: args: prog: depot.nix.writeExecline "${name}-with-args" { } [
+    "export"
+    "ARGLIB_NETENCODE"
+    (depot.users.Profpatsch.netencode.gen.dwim args)
+    prog
+  ];
+
+  rust = depot.nix.writers.rustSimpleLib
+    {
       name = "arglib-netencode";
       dependencies = [
         depot.users.Profpatsch.execline.exec-helpers
         depot.users.Profpatsch.netencode.netencode-rs
       ];
     } ''
-      extern crate netencode;
-      extern crate exec_helpers;
-
-      use netencode::{T};
-      use std::os::unix::ffi::OsStrExt;
-
-      pub fn arglib_netencode(prog_name: &str, env: Option<&std::ffi::OsStr>) -> T {
-          let env = match env {
-              None => std::ffi::OsStr::from_bytes("ARGLIB_NETENCODE".as_bytes()),
-              Some(a) => a
-          };
-          let t = match std::env::var_os(env) {
-              None => exec_helpers::die_user_error(prog_name, format!("could not read args, envvar {} not set", env.to_string_lossy())),
-              // TODO: good error handling for the different parser errors
-              Some(soup) => match netencode::parse::t_t(soup.as_bytes()) {
-                  Ok((remainder, t)) => match remainder.is_empty() {
-                      true => t,
-                      false => exec_helpers::die_environment_problem(prog_name, format!("arglib: there was some unparsed bytes remaining: {:?}", remainder))
-                  },
-                  Err(err) => exec_helpers::die_environment_problem(prog_name, format!("arglib parsing error: {:?}", err))
-              }
-          };
-          std::env::remove_var(env);
-          t
-      }
-    '';
+    extern crate netencode;
+    extern crate exec_helpers;
+
+    use netencode::{T};
+    use std::os::unix::ffi::OsStrExt;
+
+    pub fn arglib_netencode(prog_name: &str, env: Option<&std::ffi::OsStr>) -> T {
+        let env = match env {
+            None => std::ffi::OsStr::from_bytes("ARGLIB_NETENCODE".as_bytes()),
+            Some(a) => a
+        };
+        let t = match std::env::var_os(env) {
+            None => exec_helpers::die_user_error(prog_name, format!("could not read args, envvar {} not set", env.to_string_lossy())),
+            // TODO: good error handling for the different parser errors
+            Some(soup) => match netencode::parse::t_t(soup.as_bytes()) {
+                Ok((remainder, t)) => match remainder.is_empty() {
+                    true => t,
+                    false => exec_helpers::die_environment_problem(prog_name, format!("arglib: there was some unparsed bytes remaining: {:?}", remainder))
+                },
+                Err(err) => exec_helpers::die_environment_problem(prog_name, format!("arglib parsing error: {:?}", err))
+            }
+        };
+        std::env::remove_var(env);
+        t
+    }
+  '';
+
+  haskell = pkgs.haskellPackages.mkDerivation {
+    pname = "arglib-netencode";
+    version = "0.1.0";
+
+    src = depot.users.Profpatsch.exactSource ./. [
+      ./arglib-netencode.cabal
+      ./ArglibNetencode.hs
+    ];
+
+    libraryHaskellDepends = [
+      pkgs.haskellPackages.pa-prelude
+      pkgs.haskellPackages.pa-label
+      pkgs.haskellPackages.pa-error-tree
+      depot.users.Profpatsch.netencode.netencode-hs
+      depot.users.Profpatsch.execline.exec-helpers-hs
+    ];
+
+    isLibrary = true;
+    license = lib.licenses.mit;
+
+
   };
 
-in depot.nix.utils.drvTargets netencode
+
+in
+depot.nix.readTree.drvTargets {
+  inherit
+    with-args
+    rust
+    haskell
+    ;
+}
diff --git a/users/Profpatsch/atomically-write.nix b/users/Profpatsch/atomically-write.nix
new file mode 100644
index 0000000000..c4d07cfbb1
--- /dev/null
+++ b/users/Profpatsch/atomically-write.nix
@@ -0,0 +1,29 @@
+{ depot, pkgs, ... }:
+# Atomically write a file (just `>` redirection in bash
+# empties a file even if the command crashes).
+#
+# Maybe there is an existing tool for that?
+# But it’s easy enough to implement.
+#
+# Example:
+#   atomically-write
+#     ./to
+#     echo "foo"
+#
+# will atomically write the string "foo" into ./to
+let
+  atomically-write = pkgs.writers.writeDash "atomically-write" ''
+    set -e
+    to=$1
+    shift
+    # assumes that the tempfile is on the same file system, (or in memory)
+    # for the `mv` at the end to be more-or-less atomic.
+    tmp=$(${pkgs.coreutils}/bin/mktemp -d)
+    trap 'rm -r "$tmp"' EXIT
+    "$@" \
+      > "$tmp/out"
+    mv "$tmp/out" "$to"
+  '';
+
+in
+atomically-write
diff --git a/users/Profpatsch/blog/README.md b/users/Profpatsch/blog/README.md
new file mode 100644
index 0000000000..0753ebdea5
--- /dev/null
+++ b/users/Profpatsch/blog/README.md
@@ -0,0 +1,7 @@
+# (Parts of) my website
+
+This is a part of https://profpatsch.de/, notably the blog posts.
+
+The other parts can be found in [vuizvui](https://github.com/openlab-aux/vuizvui/tree/master/pkgs/profpatsch/profpatsch.de). It’s a mess.
+
+And yes, this implements a webserver & routing engine with nix, execline & s6 utils. “Bis einer weint”, as we say in German.
diff --git a/users/Profpatsch/blog/default.nix b/users/Profpatsch/blog/default.nix
index 9d22e7f770..f233eda9bb 100644
--- a/users/Profpatsch/blog/default.nix
+++ b/users/Profpatsch/blog/default.nix
@@ -2,128 +2,366 @@
 
 let
   bins = depot.nix.getBins pkgs.lowdown [ "lowdown" ]
-      // depot.nix.getBins pkgs.cdb [ "cdbget" "cdbmake" "cdbdump" ]
-      // depot.nix.getBins pkgs.coreutils [ "mv" "cat" "printf" "tee" "env" "test" "echo" "printenv" ]
-      // depot.nix.getBins pkgs.bash [ "bash" ]
-      // depot.nix.getBins pkgs.s6-networking [ "s6-tcpserver" ]
-      // depot.nix.getBins pkgs.time [ "time" ]
-      ;
-
-  me = depot.users.Profpatsch;
-
-  renderNote = name: note: depot.nix.runExecline "${name}.html" {} [
-    "importas" "out" "out"
-    bins.lowdown "-s" "-Thtml" "-o" "$out" note
+    // depot.nix.getBins pkgs.cdb [ "cdbget" "cdbmake" "cdbdump" ]
+    // depot.nix.getBins pkgs.coreutils [ "mv" "cat" "printf" "test" ]
+    // depot.nix.getBins pkgs.s6-networking [ "s6-tcpserver" ]
+    // depot.nix.getBins pkgs.time [ "time" ]
+  ;
+
+  # /
+  # TODO: use
+  toplevel = [
+    {
+      route = [ "notes" ];
+      name = "Notes";
+      page = { cssFile }: router cssFile;
+    }
+    {
+      route = [ "projects" ];
+      name = "Projects";
+      # page = projects;
+    }
   ];
 
+  # /notes/*
   notes = [
     {
-      route = [ "notes" "preventing-oom" ];
-      name = "Preventing OOM";
-      page = renderNote "preventing-oom" ./notes/preventing-oom.md;
+      route = [ "notes" "private-trackers-are-markets" ];
+      name = "Private bittorrent trackers are markets";
+      page = { cssFile }: markdownToHtml {
+        name = "private-trackers-are-markets";
+        markdown = ./notes/private-trackers-are-markets.md;
+        inherit cssFile;
+      };
+    }
+    {
+      route = [ "notes" "an-idealized-conflang" ];
+      name = "An Idealized Configuration Language";
+      page = { cssFile }: markdownToHtml {
+        name = "an-idealized-conflang";
+        markdown = ./notes/an-idealized-conflang.md;
+        inherit cssFile;
+      };
     }
     {
       route = [ "notes" "rust-string-conversions" ];
       name = "Converting between different String types in Rust";
-      page = renderNote "rust-string-conversions" ./notes/rust-string-conversions.md;
+      page = { cssFile }: markdownToHtml {
+        name = "rust-string-conversions";
+        markdown = ./notes/rust-string-conversions.md;
+        inherit cssFile;
+      };
+    }
+    {
+      route = [ "notes" "preventing-oom" ];
+      name = "Preventing out-of-memory (OOM) errors on Linux";
+      page = { cssFile }: markdownToHtml {
+        name = "preventing-oom";
+        markdown = ./notes/preventing-oom.md;
+        inherit cssFile;
+      };
+    }
+  ];
+
+  projects = [
+    {
+      name = "lorri";
+      description = "<code>nix-shell</code> replacement for projects";
+      link = "https://github.com/nix-community/lorri";
     }
+    {
+      name = "netencode";
+      description = ''A human-readble nested data exchange format inspired by <a href="https://en.wikipedia.org/wiki/Netstring">netstrings</a> and <a href="https://en.wikipedia.org/wiki/Bencode">bencode</a>.'';
+      link = depotCgitLink { relativePath = "users/Profpatsch/netencode/README.md"; };
+    }
+    {
+      name = "yarn2nix";
+      description = ''nix dependency generator for the <a href="https://yarnpkg.com/"><code>yarn</code> Javascript package manager</a>'';
+      link = "https://github.com/Profpatsch/yarn2nix";
+    }
+  ];
+
+  posts = [
+    {
+      date = "2017-05-04";
+      title = "Ligature Emulation in Emacs";
+      subtitle = "It’s not pretty, but the results are";
+      description = "How to set up ligatures using <code>prettify-symbols-mode</code> and the Hasklig/FiraCode fonts.";
+      page = { cssFile }: markdownToHtml {
+        name = "2017-05-04-ligature-emluation-in-emacs";
+        markdown = ./posts/2017-05-04-ligature-emulation-in-emacs.md;
+        inherit cssFile;
+      };
+      route = [ "posts" "2017-05-04-ligature-emluation-in-emacs" ];
+      tags = [ "emacs" ];
+    }
+  ];
+
+  # convert a markdown file to html via lowdown
+  markdownToHtml =
+    { name
+    , # the file to convert
+      markdown
+    , # css file to add to the final result, as { route }
+      cssFile
+    }:
+    depot.nix.runExecline "${name}.html" { } ([
+      "importas"
+      "out"
+      "out"
+      (depot.users.Profpatsch.lib.debugExec "")
+      bins.lowdown
+      "-s"
+      "-Thtml"
+    ] ++
+    (lib.optional (cssFile != null) ([ "-M" "css=${mkRoute cssFile.route}" ]))
+    ++ [
+      "-o"
+      "$out"
+      markdown
+    ]);
+
+  # takes a { route … } attrset and converts the route lists to an absolute path
+  fullRoute = attrs: lib.pipe attrs [
+    (map (x@{ route, ... }: x // { route = mkRoute route; }))
   ];
 
-  router = lib.pipe notes [
-    (map (x@{route, ...}: x // { route = mkRoute route; }))
+  # a cdb from route to a netencoded version of data for each route
+  router = cssFile: lib.pipe (notes ++ posts) [
+    (map (r: with depot.users.Profpatsch.lens;
+    lib.pipe r [
+      (over (field "route") mkRoute)
+      (over (field "page") (_ { inherit cssFile; }))
+    ]))
     (map (x: {
       name = x.route;
-      value = me.netencode.gen.dwim x;
+      value = depot.users.Profpatsch.netencode.gen.dwim x;
     }))
     lib.listToAttrs
-    (cdbMake "notes-router")
+    (cdbMake "router")
   ];
 
-  router-lookup = depot.nix.writeExecline "router-lookup" { readNArgs = 1; } [
-    cdbLookup router "$1"
+  # Create a link to the given source file/directory, given the relative path in the depot repo.
+  # Checks that the file exists at evaluation time.
+  depotCgitLink =
+    {
+      # relative path from the depot root (without leading /).
+      relativePath
+    }:
+      assert
+      (lib.assertMsg
+        (builtins.pathExists (depot.path.origSrc + ("/" + relativePath)))
+        "depotCgitLink: path /${relativePath} does not exist in depot, and depot.path was ${toString depot.path}");
+      "https://code.tvl.fyi/tree/${relativePath}";
+
+  # look up a route by path ($1)
+  router-lookup = cssFile: depot.nix.writeExecline "router-lookup" { readNArgs = 1; } [
+    cdbLookup
+    (router cssFile)
+    "$1"
   ];
 
   runExeclineStdout = name: args: cmd: depot.nix.runExecline name args ([
-    "importas" "-ui" "out" "out"
-    "redirfd" "-w" "1" "$out"
+    "importas"
+    "-ui"
+    "out"
+    "out"
+    "redirfd"
+    "-w"
+    "1"
+    "$out"
   ] ++ cmd);
 
-  index = runExeclineStdout "index" {} [
-    "backtick" "-in" "TEMPLATE_DATA" [ cdbDumpNetencode router ]
-    "pipeline" [
-      bins.printf ''
-        <ul>
-        {{#.}}
-          <li><a href="{{key}}">{{val}}<a></li>
-        {{/.}}
-        </ul>
-      ''
-    ]
-    me.netencode.netencode-mustache
-  ];
+  notes-index-html =
+    let o = fullRoute notes;
+    in ''
+      <ul>
+      ${scope o (o: ''
+        <li><a href="${str o.route}">${esc o.name}</a></li>
+      '')}
+      </ul>
+    '';
+
+  notes-index = pkgs.writeText "notes-index.html" notes-index-html;
+
+  # A simple mustache-inspired string interpolation combinator
+  # that takes an object and a template (a function from o to string)
+  # and returns a string.
+  scope = o: tpl:
+    if builtins.typeOf o == "list" then
+      lib.concatMapStringsSep "\n" tpl o
+    else if builtins.typeOf o == "set" then
+      tpl o
+    else throw "${lib.generators.toPretty {} o} not allowed in template";
+
+  # string-escape html (TODO)
+  str = s: s;
+  # html-escape (TODO)
+  esc = s: s;
+  html = s: s;
+
+  projects-index-html =
+    let o = projects;
+    in ''
+      <dl>
+      ${scope o (o: ''
+        <dt><a href="${str o.link}">${esc o.name}</a></dt>
+        <dd>${html o.description}</dd>
+      '')}
+      </dl>
+    '';
+
+  projects-index = pkgs.writeText "projects-index.html" projects-index-html;
+
+  posts-index-html =
+    let o = fullRoute posts;
+    in ''
+      <dl>
+      ${scope o (o: ''
+        <dt>${str o.date} <a href="${str o.route}">${esc o.title}</a></dt>
+        <dd>${html o.description}</dd>
+      '')}
+      </dl>
+    '';
+
+  posts-index = pkgs.writeText "projects-index.html" posts-index-html;
 
   arglibNetencode = val: depot.nix.writeExecline "arglib-netencode" { } [
-    "export" "ARGLIB_NETENCODE" (me.netencode.gen.dwim val)
+    "export"
+    "ARGLIB_NETENCODE"
+    (depot.users.Profpatsch.netencode.gen.dwim val)
     "$@"
   ];
 
-  notes-server = { port }: depot.nix.writeExecline "blog-server" {} [
-    (me.lib.runInEmptyEnv [ "PATH" ])
-    bins.s6-tcpserver "127.0.0.1" port
-    bins.time "--format=time: %es" "--"
-    runOr return400
-    "pipeline" [
+  # A simple http server that serves the site. Yes, it’s horrible.
+  site-server = { cssFile, port }: depot.nix.writeExecline "blog-server" { } [
+    (depot.users.Profpatsch.lib.runInEmptyEnv [ "PATH" ])
+    bins.s6-tcpserver
+    "127.0.0.1"
+    port
+    bins.time
+    "--format=time: %es"
+    "--"
+    runOr
+    return400
+    "pipeline"
+    [
       (arglibNetencode {
         what = "request";
       })
-      me.read-http
+      depot.users.Profpatsch.read-http
     ]
-    me.netencode.record-splice-env
-    runOr return500
-    "importas" "-i" "path" "path"
-    "if" [ depot.tools.eprintf "GET \${path}\n" ]
-    runOr return404
-    "backtick" "-ni" "TEMPLATE_DATA" [
-      "ifelse" [ bins.test "$path" "=" "/notes" ]
-        [ "export" "content-type" "text/html"
-          "export" "serve-file" index
-          me.netencode.env-splice-record
-        ]
+    depot.users.Profpatsch.netencode.record-splice-env
+    runOr
+    return500
+    "importas"
+    "-i"
+    "path"
+    "path"
+    "if"
+    [ depot.tools.eprintf "GET \${path}\n" ]
+    runOr
+    return404
+    "backtick"
+    "-ni"
+    "TEMPLATE_DATA"
+    [
+      # TODO: factor this out of here, this is routing not serving
+      "ifelse"
+      [ bins.test "$path" "=" "/notes" ]
+      [
+        "export"
+        "content-type"
+        "text/html"
+        "export"
+        "serve-file"
+        notes-index
+        depot.users.Profpatsch.netencode.env-splice-record
+      ]
+      "ifelse"
+      [ bins.test "$path" "=" "/projects" ]
+      [
+        "export"
+        "content-type"
+        "text/html"
+        "export"
+        "serve-file"
+        projects-index
+        depot.users.Profpatsch.netencode.env-splice-record
+      ]
+      "ifelse"
+      [ bins.test "$path" "=" "/posts" ]
+      [
+        "export"
+        "content-type"
+        "text/html"
+        "export"
+        "serve-file"
+        posts-index
+        depot.users.Profpatsch.netencode.env-splice-record
+      ]
       # TODO: ignore potential query arguments. See 404 message
-      "pipeline" [ router-lookup "$path" ]
-      me.netencode.record-splice-env
-      "importas" "-ui" "page" "page"
-      "export" "content-type" "text/html"
-      "export" "serve-file" "$page"
-      me.netencode.env-splice-record
+      "pipeline"
+      [ (router-lookup cssFile) "$path" ]
+      depot.users.Profpatsch.netencode.record-splice-env
+      "importas"
+      "-ui"
+      "page"
+      "page"
+      "export"
+      "content-type"
+      "text/html"
+      "export"
+      "serve-file"
+      "$page"
+      depot.users.Profpatsch.netencode.env-splice-record
     ]
-    runOr return500
-    "if" [
-      "pipeline" [ bins.printf ''
-        HTTP/1.1 200 OK
-        Content-Type: {{{content-type}}}; charset=UTF-8
-        Connection: close
-
-      '' ]
-      me.netencode.netencode-mustache
+    runOr
+    return500
+    "if"
+    [
+      "pipeline"
+      [
+        bins.printf
+        ''
+          HTTP/1.1 200 OK
+          Content-Type: {{{content-type}}}; charset=UTF-8
+          Connection: close
+
+        ''
+      ]
+      depot.users.Profpatsch.netencode.netencode-mustache
     ]
-    "pipeline" [ "importas" "t" "TEMPLATE_DATA" bins.printf "%s" "$t" ]
-    me.netencode.record-splice-env
-    "importas" "-ui" "serve-file" "serve-file"
-    bins.cat "$serve-file"
+    "pipeline"
+    [ "importas" "t" "TEMPLATE_DATA" bins.printf "%s" "$t" ]
+    depot.users.Profpatsch.netencode.record-splice-env
+    "importas"
+    "-ui"
+    "serve-file"
+    "serve-file"
+    bins.cat
+    "$serve-file"
   ];
 
+  # run argv or $1 if argv returns a failure status code.
   runOr = depot.nix.writeExecline "run-or" { readNArgs = 1; } [
-    "foreground" [ "$@" ]
-    "importas" "?" "?"
-    "ifelse" [ bins.test "$?" "-eq" "0" ]
-    []
-    "if" [ depot.tools.eprintf "runOr: exited \${?}, running \${1}\n" ]
+    "foreground"
+    [ "$@" ]
+    "importas"
+    "?"
+    "?"
+    "ifelse"
+    [ bins.test "$?" "-eq" "0" ]
+    [ ]
+    "if"
+    [ depot.tools.eprintf "runOr: exited \${?}, running \${1}\n" ]
     "$1"
   ];
 
-  return400 = depot.nix.writeExecline "return400" {} [
-    bins.printf "%s" ''
+  return400 = depot.nix.writeExecline "return400" { } [
+    bins.printf
+    "%s"
+    ''
       HTTP/1.1 400 Bad Request
       Content-Type: text/plain; charset=UTF-8
       Connection: close
@@ -131,8 +369,10 @@ let
     ''
   ];
 
-  return404 = depot.nix.writeExecline "return404" {} [
-    bins.printf "%s" ''
+  return404 = depot.nix.writeExecline "return404" { } [
+    bins.printf
+    "%s"
+    ''
       HTTP/1.1 404 Not Found
       Content-Type: text/plain; charset=UTF-8
       Connection: close
@@ -141,8 +381,10 @@ let
     ''
   ];
 
-  return500 = depot.nix.writeExecline "return500" {} [
-    bins.printf "%s" ''
+  return500 = depot.nix.writeExecline "return500" { } [
+    bins.printf
+    "%s"
+    ''
       HTTP/1.1 500 Internal Server Error
       Content-Type: text/plain; charset=UTF-8
       Connection: close
@@ -151,15 +393,11 @@ let
     ''
   ];
 
-  split-stdin = depot.nix.writeExecline "split-stdin" { argMode = "env"; } [
-    "pipeline" [ "runblock" "1" bins.bash "-c" ''${bins.tee} >("$@")'' "bash-split-stdin" ]
-    "runblock" "-r" "1"
-  ];
-
-  capture-stdin = depot.nix.writers.rustSimple {
-    name = "capture-stdin";
-    dependencies = [ me.execline.exec-helpers ];
-  } ''
+  capture-stdin = depot.nix.writers.rustSimple
+    {
+      name = "capture-stdin";
+      dependencies = [ depot.users.Profpatsch.execline.exec-helpers ];
+    } ''
     extern crate exec_helpers;
     use std::io::Read;
     fn main() {
@@ -171,11 +409,7 @@ let
     }
   '';
 
-  on-stdin = depot.nix.writeExecline "on-stdin" { readNArgs = 1; } [
-    "pipeline" [ bins.printf "%s" "$1" ]
-    "$@"
-  ];
-
+  # go from a list of path elements to an absolute route string
   mkRoute = route: "/" + lib.concatMapStringsSep "/" urlencodeAscii route;
 
   # urlencodes, but only ASCII characters
@@ -191,132 +425,57 @@ let
     builtins.replaceStrings raw enc urlPiece;
 
 
+  # create a cdb record entry, as required by the cdbmake tool
   cdbRecord = key: val:
     "+${toString (builtins.stringLength key)},${toString (builtins.stringLength val)}:"
     + "${key}->${val}\n";
+
+  # create a full cdbmake input from an attribute set of keys to values (strings)
   cdbRecords =
     with depot.nix.yants;
     defun [ (attrs (either drv string)) string ]
-    (attrs:
-      (lib.concatStrings (lib.mapAttrsToList cdbRecord attrs)) + "\n");
-
-  cdbMake = name: attrs: depot.nix.runExecline "${name}.cdb" {
-    stdin = cdbRecords attrs;
-  } [
-    "importas" "out" "out"
-    me.lib.eprint-stdin
-    "if" [ bins.cdbmake "db" "tmp" ]
-    bins.mv "db" "$out"
+      (attrs:
+        (lib.concatStrings (lib.mapAttrsToList cdbRecord attrs)) + "\n");
+
+  # run cdbmake on a list of key/value pairs (strings
+  cdbMake = name: attrs: depot.nix.runExecline "${name}.cdb"
+    {
+      stdin = cdbRecords attrs;
+    } [
+    "importas"
+    "out"
+    "out"
+    depot.users.Profpatsch.lib.eprint-stdin
+    "if"
+    [ bins.cdbmake "db" "tmp" ]
+    bins.mv
+    "db"
+    "$out"
   ];
 
+  # look up a key ($2) in the given cdb ($1)
   cdbLookup = depot.nix.writeExecline "cdb-lookup" { readNArgs = 2; } [
     # cdb ($1) on stdin
-    "redirfd" "-r" "0" "$1"
+    "redirfd"
+    "-r"
+    "0"
+    "$1"
     # key ($2) lookup
-    bins.cdbget "$2"
-  ];
-
-  cdbDumpNetencode = depot.nix.writeExecline "cdb-dump-netencode" { readNArgs = 1; } [
-    # cdb ($1) on stdin
-    "pipeline" [
-      "redirfd" "-r" "0" "$1"
-      bins.cdbdump
-    ]
-    cdbListToNetencode
+    bins.cdbget
+    "$2"
   ];
 
-  cdbListToNetencode = depot.nix.writers.rustSimple {
-    name = "cdb-list-to-netencode";
-    dependencies = [
-      depot.third_party.rust-crates.nom
-      me.execline.exec-helpers
-      me.netencode.netencode-rs
-    ];
-  } ''
-    extern crate nom;
-    extern crate exec_helpers;
-    extern crate netencode;
-    use std::collections::HashMap;
-    use std::io::BufRead;
-    use nom::{IResult};
-    use nom::sequence::{tuple};
-    use nom::bytes::complete::{tag, take};
-    use nom::character::complete::{digit1, char};
-    use nom::error::{context, ErrorKind, ParseError};
-    use nom::combinator::{map_res};
-    use netencode::{T, Tag};
-
-    fn usize_t(s: &[u8]) -> IResult<&[u8], usize> {
-        context(
-            "usize",
-            map_res(
-                map_res(digit1, |n| std::str::from_utf8(n)),
-                |s| s.parse::<usize>())
-        )(s)
-    }
-
-    fn parse_cdb_record(s: &[u8]) -> IResult<&[u8], (&[u8], &[u8])> {
-        let (s, (_, klen, _, vlen, _)) = tuple((
-            char('+'),
-            usize_t,
-            char(','),
-            usize_t,
-            char(':')
-        ))(s)?;
-        let (s, (key, _, val)) = tuple((
-            take(klen),
-            tag("->"),
-            take(vlen),
-        ))(s)?;
-        Ok((s, (key, val)))
-    }
-
-    fn main() {
-        let mut res = vec![];
-        let stdin = std::io::stdin();
-        let mut lines = stdin.lock().split(b'\n');
-        loop {
-            match lines.next() {
-                None => exec_helpers::die_user_error("cdb-list-to-netencode", "stdin ended but we didn’t receive the empty line to signify the end of the cdbdump input!"),
-                Some(Err(err)) => exec_helpers::die_temporary("cdb-list-to-netencode", format!("could not read from stdin: {}", err)),
-                Some(Ok(line)) =>
-                    if &line == b"" {
-                        // the cdbdump input ends after an empty line (double \n)
-                        break;
-                    } else {
-                        match parse_cdb_record(&line) {
-                            Ok((b"", (key, val))) => {
-                                let (key, val) = match
-                                    std::str::from_utf8(key)
-                                    .and_then(|k| std::str::from_utf8(val).map(|v| (k, v))) {
-                                    Ok((key, val)) => (key.to_owned(), val.to_owned()),
-                                    Err(err) => exec_helpers::die_user_error("cdb-list-to-netencode", format!("cannot decode line {:?}, we only support utf8-encoded key/values pairs for now: {}", String::from_utf8_lossy(&line), err)),
-                                };
-                                let _ = res.push((key, val));
-                            },
-                            Ok((rest, _)) => exec_helpers::die_user_error("cdb-list-to-netencode", format!("could not decode record line {:?}, had some trailing bytes", String::from_utf8_lossy(&line))),
-                            Err(err) => exec_helpers::die_user_error("cdb-list-to-netencode", format!("could not decode record line {:?}: {:?}", String::from_utf8_lossy(&line), err)),
-                        }
-                    }
-            }
-        }
-        let list = T::List(res.into_iter().map(
-            |(k, v)| T::Record(vec![(String::from("key"), T::Text(k)), (String::from("val"), T::Text(v))].into_iter().collect())
-        ).collect());
-        netencode::encode(&mut std::io::stdout(), &list.to_u());
-    }
-
-  '';
-
-
-in depot.nix.utils.drvTargets {
-   inherit
+in
+depot.nix.readTree.drvTargets {
+  inherit
     router
-    notes-server
-    split-stdin
-    cdbListToNetencode
-    index
-    router-lookup
+    depotCgitLink
+    site-server
+    notes-index
+    notes-index-html
+    projects-index
+    projects-index-html
+    posts-index-html
     ;
 
 }
diff --git a/users/Profpatsch/blog/notes/an-idealized-conflang.md b/users/Profpatsch/blog/notes/an-idealized-conflang.md
new file mode 100644
index 0000000000..5c6b39f6e8
--- /dev/null
+++ b/users/Profpatsch/blog/notes/an-idealized-conflang.md
@@ -0,0 +1,298 @@
+tags: netencode, json
+date: 2022-03-31
+certainty: likely
+status: initial
+title: An idealized Configuration Language
+
+# An Idealized Configuration Language
+
+JSON brought us one step closer to what an idealized configuration language is,
+which I define as “data, stripped of all externalities of the system it is working in”.
+
+Specifically, JSON is very close to what I consider the minimal properties to represent structured data.
+
+## A short history, according to me
+
+In the beginning, Lisp defined s-expressions as a stand-in for an actual syntax.
+Then, people figured out that it’s also a way to represent structured data.
+It has scalars, which can be nested into lists, recursively.
+
+```
+(this is (a (list) (of lists)))
+```
+
+This provides the first three rules of our idealized language:
+
+1. A **scalar** is a primitive value that is domain-specific.
+   We can assume a bunch of bytes here, or a text or an integer.
+   
+2. A **list** gives an ordering to `0..n` (or `1..n`) values
+   
+3. Both a scalar and a list are the *same kind* of “thing” (from here on called **value**),
+   lists can be created from arbitrary values *recursively*
+   (for example scalars, or lists of scalars and other lists)
+
+
+Later, ASN.1 came and had the important insight that the same idealized data structure
+can be represented in different fashions,
+for example as a binary-efficient version and a human-readable format.
+
+Then, XML “graced” the world for a decade or two, and the main lesson from it was
+that you don’t want to mix markup languages and configuration languages,
+and that you don’t want a committee to design these things.
+
+---
+
+In the meantime, Brendan Eich designed Javascript. Its prototype-based object system
+arguably stripped down the rituals of existing OO-systems.
+Douglas Crockford later extracted the object format (minus functions) into a syntax, and we got JSON.
+
+```
+{
+  "foo": [
+    { "nested": "attrs" },
+    "some text"
+  ],
+  "bar": 42
+}
+```
+
+JSON adds another fundamental idea into the mix:
+
+4. **Records** are unordered collections of `name`/`value` pairs.
+   A `name` is defined to be a unicode string, so a semantic descriptor of the nested `value`.
+
+Unfortunately, the JSON syntax does not actually specify any semantics of records (`objects` in JSON lingo),
+in particular it does not mention what the meaning is if a `name` appears twice in one record.
+
+If records can have multiple entries with the same `name`, suddenly ordering becomes important!
+But wait, remember earlier we defined *lists* to impose ordering on two values.
+So in order to rectify that problem, we say that
+
+5. A `name` can only appear in a record *once*, names must be unique.
+
+This is the current state of the programming community at large,
+where most “modern” configuration languages basically use a version of the JSON model
+as their underlying data structure. (However not all of them use the same version.)
+
+## Improving JSON’s data model
+
+We are not yet at the final “idealized” configuration language, though.
+
+Modern languages like Standard ML define their data types as a mixture of 
+
+* *records* (“structs” in the C lingo)
+* and *sums* (which you can think about as enums that can hold more `value`s inside them)
+
+This allows to express the common pattern where some fields in a record are only meaningful
+if another field—the so-called `tag`-field—is set to a specific value.
+
+An easy example: if a request can fail with an error message or succeed with a result.
+
+You could model that as 
+
+```
+{
+  "was_error": true,
+  "error_message": "there was an error"
+}
+```
+
+or
+
+```
+{
+  "was_error": false,
+  "result": 42
+}
+```
+
+in your JSON representation.
+
+But in a ML-like language (like, for example, Rust), you would instead model it as
+
+```
+type RequestResult 
+  = Error { error_message: String }
+  | Success { result: i64 }
+```
+
+where the distinction in `Error` or `Success` makes it clear that `error_message` and `result`
+only exist in one of these cases, not the other.
+
+We *can* encode exactly that idea into JSON in multiple ways, but not a “blessed” way.
+
+For example, another way to encode the above would be
+
+```
+{ 
+  "Error": { 
+    "error_message": "there was an error"
+  }
+}
+```
+
+and
+
+```
+{ 
+  "Success": { 
+    "result": 42
+  }
+}
+```
+
+Particularly notice the difference between the language representation, where the type is “closed”only `Success` or `Error` can happen—
+and the data representation where the type is “open”, more cases could potentially exist.
+
+This is an important differentiation from a type system:
+Our idealized configuration language just gives more structure to a bag of data,
+it does not restrict which value can be where.
+Think of a value in an unityped language, like Python.
+
+
+So far we have the notion of 
+
+1. a scalar (a primitive)
+2. a list (ordering on values)
+3. a record (unordered collection of named values)
+
+and in order to get the “open” `tag`ged enumeration values, we introduce
+
+4. a `tag`, which gives a name to a value
+
+We can then redefine `record` to mean “an unordered collection of `tag`ged values”,
+which further reduces the amount of concepts needed.
+
+And that’s it, this is the full idealized configuration language.
+
+
+## Some examples of data modelling with tags
+
+This is all well and good, but what does it look like in practice?
+
+For these examples I will be using JSON with a new `< "tag": value >` syntax
+to represent `tag`s.
+
+From a compatibility standpoint, `tag`s (or sum types) have dual properties to record types.
+
+With a record, when you have a producer that *adds* a field to it, the consumer will still be able to handle the record (provided the semantics of the existing fields is not changed by the new field).
+
+With a tag, *removing* a tag from the producer will mean that the consumer will still be able to handle the tag. It might do one “dead” check on the removed `tag`, but can still handle the remaining ones just fine.
+
+<!-- TODO: some illustration here -->
+    
+An example of how that is applied in practice is that in `protobuf3`, fields of a record are *always* optional fields.
+
+We can model optional fields by wrapping them in `< "Some": value >` or `< "None": {} >` (where the actual value of the `None` is ignored or always an empty record).
+
+So a protobuf with the fields `foo: int` and `bar: string` has to be parsed by the receiver als containing *four* possibilities:
+
+№|foo|bar|
+|--:|---|---|
+|1|`<"None":{}>`|`<"None":{}>`|
+|2|`<"Some":42>`|`<"None":{}>`|
+|3|`<"None":{}>`|`<"Some":"x">`|
+|4|`<"Some":42>`|`<"Some":"x">`|
+
+Now, iff the receiver actually handles all four possibilities
+(and doesn’t just crash if a field is not set, as customary in million-dollar-mistake languages),
+it’s easy to see how removing a field from the producer is semantically equal to always setting it to `<"None":{}>`.
+Since all receivers should be ready to receive `None` for every field, this provides a simple forward-compatibility scheme.
+
+We can abstract this to any kind of tag value:
+If you start with “more” tags, you give yourself space to remove them later without breaking compatibility, typically called “forward compatibility”.
+
+
+## To empty list/record or not to
+
+Something to think about is whether records and fields should be defined
+to always contain at least one element.
+
+As it stands, JSON has multiple ways of expressing the “empty value”:
+
+* `null`
+* `[]`
+* `{}`
+* `""`
+* *leave out the field*
+
+and two of those come from the possibility of having empty structured values.
+
+## Representations of this language
+
+This line of thought originally fell out of me designing [`netencode`](https://code.tvl.fyi/tree/users/Profpatsch/netencode/README.md)
+as a small human-debuggable format for pipeline serialization.
+
+In addition to the concepts mentioned here (especially tags),
+it provides a better set of scalars than JSON (specifically arbitrary bytestrings),
+but it cannot practically be written or modified by hand,
+which might be a good thing depending on how you look at it.
+
+---
+
+The way that is compatible with the rest of the ecosystem is probably to use a subset of json
+to represent our idealized language.
+
+There is multiple ways of encoding tags in json, which each have their pros and cons.
+
+The most common is probably the “tag field” variant, where the tag is pulled into the nested record:
+
+```
+{
+  "_tag": "Success",
+  "result": 42
+}
+```
+
+Which has the advantage that people know how to deal with it and that it’s easy to “just add another field”,
+plus it is backward-compatible when you had a record in the first place.
+
+It has multiple disadvantages however:
+
+* If your value wasn’t a record (e.g. an int) before, you have to put it in a record and assign an arbitrary name to its field
+* People are not forced to “unwrap” the tag first, so they are going to forget to check it
+* The magic “_tag” name cannot be used by any of the record’s fields
+
+
+An in-between version of this with less downsides is to always push a json record onto the stack:
+
+```
+{
+  "tag": "Success",
+  "value": {
+    "result": 42
+  }
+}
+```
+
+This makes it harder for people to miss checking the `tag`, but still possible of course.
+It also makes it easily possible to inspect the contents of `value` without knowing the
+exhaustive list of `tag`s, which can be useful in practice (though often not sound!).
+It also gets rid of the “_tag” field name clash problem.
+
+Disadvantages:
+
+* Breaks the backwards-compatibility with an existing record-based approach if you want to introduce `tag`s
+* Verbosity of representation
+* hard to distinguish a record with the `tag` and `value` fields from a `tag`ed value (though you know the type layout of your data on a higher level, don’t you? ;) )
+
+
+The final, “most pure” representation is the one I gave in the original introduction:
+
+```
+{
+  "Success": {
+    "result": 42
+  }
+}
+```
+
+Now you *have* to match on the `tag` name first, before you can actually access your data,
+and it’s less verbose than the above representation.
+
+Disavantages:
+
+* You also have to *know* what `tag`s to expect, it’s harder to query cause you need to extract the keys and values from the dict and then take the first one.
+* Doing a “tag backwards compat” check is harder,
+  because you can’t just check whether `_tag` or `tag`/`value` are the keys in the dict.
diff --git a/users/Profpatsch/blog/notes/private-trackers-are-markets.md b/users/Profpatsch/blog/notes/private-trackers-are-markets.md
new file mode 100644
index 0000000000..88fe5f07e5
--- /dev/null
+++ b/users/Profpatsch/blog/notes/private-trackers-are-markets.md
@@ -0,0 +1,46 @@
+# Private bittorrent trackers are markets
+
+Private bittorrent trackers have a currency called ratio,
+which is the bits you upload divided the bits you download.
+
+You have to keep the ratio above a certain lower limit,
+otherwise you get banned from the market or have to cut a deal with the moderators → bancruptcy
+
+New liquidity (?) is introduced to the market by so-called “freeleech” events or tokens,
+which essentially allow you to exchange a token (or some time in the case of time-restricted freeleech)
+for some data, which can then be seeded to generate future profits without spending ratio.
+
+Sometimes, ratio is pulled from the market by allowing to exchange it into website perks,
+like forum titles or other benefits like chat-memberships. This has a deflationary effect.
+It could be compared to “vanity items” in MMOs, which don’t grant a mechanical advantage in the market.
+Is there a real-world equivalent? i.e. allowing rich people to exchange some of their worth
+for vanity items instead of investing it for future gain?
+
+Sometimes, ratio can be traded for more than just transferred bits,
+for example by requesting a torrent for a certain album or movie,
+paying some ratio for the fulfillment of the request.
+
+---
+
+Based on how bittorrent works, usually multiple people “seed” a torrent.
+This means multiple people can answer a request for trading ratio.
+Part of the request (i.e. the first 30% of a movie)
+can be fulfilled by one party, part of it by a second or even more parties.
+
+For small requests (e.g. albums), often the time between announcing the trade
+and filling the trade is important for who is able to fill it.
+Getting a 1 second head-start vastly increases your chance of a handshake
+and starting the transmission, so on average you get a vastly higher ratio gain from that torrent.
+Meaning that using a bittorrent client which is fast to answer as a seeder will lead to better outcomes.
+This could be compared to mechanisms seen in high-speed trading.
+
+---
+
+Of course these market-mechanisms are in service of a wider policy goal,
+which is to ensure the constant availability of as much high-quality data as possible.
+There is more mechanisms at play on these trackers that all contribute to this goal
+(possible keywords to research: trumping, freeleech for underseeded torrents).
+
+In general, it is important to remember that markets are only a tool,
+never an end in themselves, as neoliberalists would like us to believe.
+They always are in service of a wider goal or policy. We live in a society.
diff --git a/users/Profpatsch/blog/notes/rust-string-conversions.md b/users/Profpatsch/blog/notes/rust-string-conversions.md
index ac8c8f8925..99071ef9d3 100644
--- a/users/Profpatsch/blog/notes/rust-string-conversions.md
+++ b/users/Profpatsch/blog/notes/rust-string-conversions.md
@@ -14,6 +14,7 @@ From       To         Use                                    Comment
 &str     -> String    String::from(st)
 &str     -> &[u8]     st.as_bytes()
 &str     -> Vec<u8>   st.as_bytes().to_owned()               via &[u8]
+&str     -> &OsStr    OsStr::new(st)
 
 String   -> &str      &s                                     alt. s.as_str()
 String   -> &[u8]     s.as_bytes()
diff --git a/users/Profpatsch/blog/posts/2017-05-04-ligature-emulation-in-emacs.md b/users/Profpatsch/blog/posts/2017-05-04-ligature-emulation-in-emacs.md
new file mode 100644
index 0000000000..ba80888bad
--- /dev/null
+++ b/users/Profpatsch/blog/posts/2017-05-04-ligature-emulation-in-emacs.md
@@ -0,0 +1,123 @@
+title: Ligature Emulation in Emacs
+date: 2017-05-04
+
+Monday was (yet another)
+[NixOS hackathon][hackathon] at [OpenLab Augsburg][ola].
+[Maximilian][mhuber] was there and to my amazement
+he got working ligatures in his Haskell files in Emacs! Ever since Hasklig
+updated its format to use ligatures and private Unicode code points a while ago,
+the hack I had used in my config stopped working.
+
+Encouraged by that I decided to take a look on Tuesday. Long story short, I was
+able to [get it working in a pretty satisfying way][done].
+
+[hackathon]: https://www.meetup.com/Munich-NixOS-Meetup/events/239077247/
+[mhuber]: https://github.com/maximilianhuber
+[ola]: https://openlab-augsburg.de
+[done]: https://github.com/i-tu/Hasklig/issues/84#issuecomment-298803495
+
+What’s left to do is package it into a module and push to melpa.
+
+
+### elisp still sucks, but it’s bearable, sometimes
+
+I’m the kind of person who, when trying to fix something elisp related, normally
+gives up two hours later and three macro calls deep. Yes, homoiconic,
+non-lexically-scoped, self-rewriting code is not exactly my fetish.
+This time the task and the library (`prettify-symbols-mode`) were simple enough
+for that to not happen.
+
+Some interesting technical trivia:
+
+- elisp literal character syntax is `?c`. `?\t` is the tab character
+- You join characters by `(string c1 c2 c3 ...)`
+- [dash.el][dash] is pretty awesome and does what a functional programmer
+  expects. Also, Rainbow Dash.
+- Hasklig and FiraCode multi-column symbols actually [only occupy one column, on
+  the far right of the glyph][glyph]. `my-correct-symbol-bounds` fixes emacs’
+  rendering in that case.
+
+
+[dash]: https://github.com/magnars/dash.el
+[glyph]: https://github.com/tonsky/FiraCode/issues/211#issuecomment-239082368
+
+
+## Appendix A
+
+For reference, here’s the complete code as it stands now. Feel free to paste
+into your config; let’s make it [MIT][mit]. Maybe link to this site, in case there are
+updates.
+
+[mit]: https://opensource.org/licenses/MIT
+
+```elisp
+ (defun my-correct-symbol-bounds (pretty-alist)
+    "Prepend a TAB character to each symbol in this alist,
+this way compose-region called by prettify-symbols-mode
+will use the correct width of the symbols
+instead of the width measured by char-width."
+    (mapcar (lambda (el)
+              (setcdr el (string ?\t (cdr el)))
+              el)
+            pretty-alist))
+
+  (defun my-ligature-list (ligatures codepoint-start)
+    "Create an alist of strings to replace with
+codepoints starting from codepoint-start."
+    (let ((codepoints (-iterate '1+ codepoint-start (length ligatures))))
+      (-zip-pair ligatures codepoints)))
+
+  ; list can be found at https://github.com/i-tu/Hasklig/blob/master/GlyphOrderAndAliasDB#L1588
+  (setq my-hasklig-ligatures
+    (let* ((ligs '("&&" "***" "*>" "\\\\" "||" "|>" "::"
+                   "==" "===" "==>" "=>" "=<<" "!!" ">>"
+                   ">>=" ">>>" ">>-" ">-" "->" "-<" "-<<"
+                   "<*" "<*>" "<|" "<|>" "<$>" "<>" "<-"
+                   "<<" "<<<" "<+>" ".." "..." "++" "+++"
+                   "/=" ":::" ">=>" "->>" "<=>" "<=<" "<->")))
+      (my-correct-symbol-bounds (my-ligature-list ligs #Xe100))))
+
+  ;; nice glyphs for haskell with hasklig
+  (defun my-set-hasklig-ligatures ()
+    "Add hasklig ligatures for use with prettify-symbols-mode."
+    (setq prettify-symbols-alist
+          (append my-hasklig-ligatures prettify-symbols-alist))
+    (prettify-symbols-mode))
+
+  (add-hook 'haskell-mode-hook 'my-set-hasklig-ligatures)
+```
+
+## Appendix B (Update 1): FiraCode integration
+
+I also created a mapping for [FiraCode][fira]. You need to grab the [additional
+symbol font][symbol] that adds (most) ligatures to the unicode private use area.
+Consult your system documentation on how to add it to your font cache.
+Next add `"Fira Code"` and `"Fira Code Symbol"` to your font preferences. Symbol
+only contains the additional characters, so you need both.
+
+If you are on NixOS, the font package should be on the main branch shortly, [I
+added a package][symbol-pkg].
+
+[fira]: https://github.com/tonsky/FiraCode/
+[symbol]: https://github.com/tonsky/FiraCode/issues/211#issuecomment-239058632
+[symbol-pkg]: https://github.com/NixOS/nixpkgs/pull/25517
+
+Here’s the mapping adjusted for FiraCode:
+
+```elisp
+  (setq my-fira-code-ligatures
+    (let* ((ligs '("www" "**" "***" "**/" "*>" "*/" "\\\\" "\\\\\\"
+                  "{-" "[]" "::" ":::" ":=" "!!" "!=" "!==" "-}"
+                  "--" "---" "-->" "->" "->>" "-<" "-<<" "-~"
+                  "#{" "#[" "##" "###" "####" "#(" "#?" "#_" "#_("
+                  ".-" ".=" ".." "..<" "..." "?=" "??" ";;" "/*"
+                  "/**" "/=" "/==" "/>" "//" "///" "&&" "||" "||="
+                  "|=" "|>" "^=" "$>" "++" "+++" "+>" "=:=" "=="
+                  "===" "==>" "=>" "=>>" "<=" "=<<" "=/=" ">-" ">="
+                  ">=>" ">>" ">>-" ">>=" ">>>" "<*" "<*>" "<|" "<|>"
+                  "<$" "<$>" "<!--" "<-" "<--" "<->" "<+" "<+>" "<="
+                  "<==" "<=>" "<=<" "<>" "<<" "<<-" "<<=" "<<<" "<~"
+                  "<~~" "</" "</>" "~@" "~-" "~=" "~>" "~~" "~~>" "%%"
+                  "x" ":" "+" "+" "*")))
+      (my-correct-symbol-bounds (my-ligature-list ligs #Xe100))))
+```
diff --git a/users/Profpatsch/cabal.project b/users/Profpatsch/cabal.project
new file mode 100644
index 0000000000..26b6186969
--- /dev/null
+++ b/users/Profpatsch/cabal.project
@@ -0,0 +1,14 @@
+packages:
+  ./my-prelude/my-prelude.cabal
+  ./my-webstuff/my-webstuff.cabal
+  ./netencode/netencode.cabal
+  ./arglib/arglib-netencode.cabal
+  ./execline/exec-helpers.cabal
+  ./htmx-experiment/htmx-experiment.cabal
+  ./mailbox-org/mailbox-org.cabal
+  ./cas-serve/cas-serve.cabal
+  ./jbovlaste-sqlite/jbovlaste-sqlite.cabal
+  ./whatcd-resolver/whatcd-resolver.cabal
+  ./openlab-tools/openlab-tools.cabal
+  ./httzip/httzip.cabal
+  ./my-xmonad/my-xmonad.cabal
diff --git a/users/Profpatsch/cas-serve/CasServe.hs b/users/Profpatsch/cas-serve/CasServe.hs
new file mode 100644
index 0000000000..62636fe9c1
--- /dev/null
+++ b/users/Profpatsch/cas-serve/CasServe.hs
@@ -0,0 +1,247 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Main where
+
+import ArglibNetencode (arglibNetencode)
+import Control.Applicative
+import Control.Monad.Reader
+import Crypto.Hash qualified as Crypto
+import Data.ByteArray qualified as ByteArray
+import Data.ByteString.Lazy qualified as ByteString.Lazy
+import Data.ByteString.Lazy qualified as Lazy
+import Data.Functor.Compose
+import Data.Int (Int64)
+import Data.List qualified as List
+import Data.Text qualified as Text
+import Data.Text.IO qualified as Text
+import Database.SQLite.Simple (NamedParam ((:=)))
+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 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 ->
+    Warp.runSettings
+      (Warp.defaultSettings & Warp.setPort 7070)
+      (api env)
+
+withEnv :: (Env -> IO a) -> IO a
+withEnv inner = do
+  withSqlite "./data.sqlite" $ \envData -> do
+    withSqlite "./wordlist.sqlite" $ \envWordlist -> inner Env {..}
+
+withSqlite :: String -> (Sqlite.Connection -> IO a) -> IO a
+withSqlite fileName inner = Sqlite.withConnection fileName $ \conn -> do
+  Sqlite.setTrace conn (Just (\msg -> Text.hPutStrLn stderr [fmt|{fileName}: {msg}|]))
+  Sqlite.execute conn [Sqlite.sql|PRAGMA foreign_keys = ON|] ()
+  inner conn
+
+api :: Env -> Wai.Application
+api env req respond = do
+  case runHandler (getById <|> insertById) req env of
+    Nothing -> respond $ Wai.responseLBS Http.status404 [] "endpoint does not exist."
+    Just handler' -> do
+      handler' >>= \case
+        Left (status, err) -> respond $ Wai.responseLBS status [] (err & toLazyBytes)
+        Right (headers, body) ->
+          respond $
+            Wai.responseLBS
+              Http.status200
+              headers
+              (body & toLazyBytes)
+
+data Env = Env
+  { envWordlist :: Sqlite.Connection,
+    envData :: Sqlite.Connection
+  }
+
+-- | I don’t need any fancy routing in this, so a handler is just something that returns a @Just (IO a)@ if it wants to handle the request.
+newtype Handler a
+  = Handler (ReaderT (Wai.Request, Env) (Compose Maybe IO) a)
+  deriving newtype (Functor, Applicative, Alternative)
+
+handler :: ((Wai.Request, Env) -> Maybe (IO a)) -> Handler a
+handler f = Handler (ReaderT (Compose . f))
+
+runHandler :: Handler a -> Wai.Request -> Env -> Maybe (IO a)
+runHandler (Handler handler') req env = getCompose $ handler' & (\readerT -> runReaderT readerT (req, env))
+
+getById ::
+  Handler
+    ( Either
+        (Http.Status, ByteString)
+        ([(Http.HeaderName, ByteString)], ByteString)
+    )
+getById = handler $ \(req, env) -> do
+  guard ((req & Wai.requestMethod) == Http.methodGet)
+  case req & Wai.pathInfo of
+    ["v0", "by-id", filename] -> Just $ do
+      Sqlite.queryNamed
+        @( T3
+             "mimetype"
+             Text
+             "content"
+             ByteString
+             "size"
+             Int
+         )
+        (env.envData)
+        [Sqlite.sql|
+        SELECT
+          mimetype,
+          cast (content AS blob) as content,
+          size
+        FROM file_content
+        JOIN file_references
+          ON file_references.file_content = file_content.hash_sha256
+        WHERE
+          file_references.reference_type = 'by-id'
+          AND (file_references.name || file_references.extension) = :filename
+       |]
+        [":filename" Sqlite.:= filename]
+        <&> \case
+          [] -> Left (Http.status404, "File not found.")
+          [res] ->
+            Right
+              ( [ ("Content-Type", res.mimetype & textToBytesUtf8),
+                  ("Content-Length", res.size & showToText & textToBytesUtf8)
+                ],
+                -- TODO: should this be lazy/streamed?
+                res.content
+              )
+          _more -> Left "file_references must be unique (in type and name)" & unwrapError
+    _ -> Nothing
+
+insertById :: Handler (Either a ([(Http.HeaderName, ByteString)], ByteString))
+insertById = handler $ \(req, env) -> do
+  guard ((req & Wai.requestMethod) == Http.methodPost)
+  case req & Wai.pathInfo of
+    ["v0", "by-id"] -> Just $ do
+      let maybeText bytes = case bytesToTextUtf8 bytes of
+            Left _err -> Nothing
+            Right t -> Just t
+      let mimeType =
+            ( (req & Wai.requestHeaders & List.lookup "X-Cas-Serve-Mimetype" >>= maybeText)
+                <|> (req & Wai.requestHeaders & List.lookup "Content-Type" >>= maybeText)
+            )
+              & fromMaybe "application/octet-stream"
+
+      let magicFileEnding mimeType' = case Text.split (== '/') mimeType' of
+            [_, ""] -> Nothing
+            ["", _] -> Nothing
+            [_, "any"] -> Nothing
+            ["image", ty] -> Just (Text.cons '.' ty)
+            ["video", ty] -> Just (Text.cons '.' ty)
+            ["text", "plain"] -> Just ".txt"
+            ["text", "html"] -> Just ".html"
+            ["application", "pdf"] -> Just ".pdf"
+            ["application", "json"] -> Just ".json"
+            _ -> Nothing
+
+      let extension =
+            ( (req & Wai.requestHeaders & List.lookup "X-Cas-Serve-FileExtension" >>= maybeText)
+                <|> ( (req & Wai.requestHeaders & List.lookup "Content-Type")
+                        >>= maybeText
+                        >>= magicFileEnding
+                    )
+            )
+              -- Just the empty extension if we can’t figure it out.
+              & fromMaybe ""
+
+      body <- Wai.consumeRequestBodyStrict req
+      let hash :: Crypto.Digest Crypto.SHA256 = Crypto.hashlazy body
+      let hashBytes = hash & ByteArray.convert @(Crypto.Digest Crypto.SHA256) @ByteString
+      let len = ByteString.Lazy.length body
+      name <- getNameFromWordlist env
+      let fullname = name <> extension
+
+      let conn = env.envData
+      Sqlite.withTransaction conn $ do
+        Sqlite.executeNamed
+          conn
+          [Sqlite.sql|
+            INSERT INTO file_content
+              (content, hash_sha256, size)
+              VALUES
+              (:content, :hash_sha256, :size)
+              ON CONFLICT (hash_sha256) DO NOTHING
+          |]
+          [ ":content" := (body :: Lazy.ByteString),
+            ":hash_sha256" := (hashBytes :: ByteString),
+            ":size" := (len :: Int64)
+          ]
+
+        -- TODO: we are not checking if the name already exists,
+        -- we just assume that 1633^3 is enough to not get any collisions for now.
+        -- If the name exists, the user gets a 500.
+        Sqlite.executeNamed
+          conn
+          [Sqlite.sql|
+            INSERT INTO file_references
+              (file_content, reference_type, name, extension, mimetype)
+            VALUES
+              (:file_content, :reference_type, :name, :extension, :mimetype)
+          |]
+          [ ":file_content" := (hashBytes :: ByteString),
+            ":reference_type" := ("by-id" :: Text),
+            ":name" := name,
+            ":extension" := (extension :: Text),
+            ":mimetype" := (mimeType :: Text)
+          ]
+      pure $
+        Right
+          ( [("Content-Type", "text/plain")],
+            [fmt|/v0/by-id/{fullname}|]
+          )
+    _ -> Nothing
+
+-- Get a random name from a wordlist, that is three words connected by @-@.
+getNameFromWordlist :: Env -> IO Text
+getNameFromWordlist env =
+  do
+    let numberOfWords = 3 :: Int
+    Sqlite.queryNamed @(Sqlite.Only Text)
+      (env.envWordlist)
+      [Sqlite.sql|SELECT word FROM wordlist ORDER BY RANDOM() LIMIT :words|]
+      [":words" Sqlite.:= numberOfWords]
+    <&> map Sqlite.fromOnly
+    <&> Text.intercalate "-"
+
+-- | We can use a Rec with a named list of types to parse a returning row of sqlite!!
+instance
+  ( Sqlite.FromField t1,
+    Sqlite.FromField t2,
+    Sqlite.FromField t3
+  ) =>
+  Sqlite.FromRow (T3 l1 t1 l2 t2 l3 t3)
+  where
+  fromRow = do
+    T3
+      <$> (label @l1 <$> Sqlite.field)
+      <*> (label @l2 <$> Sqlite.field)
+      <*> (label @l3 <$> Sqlite.field)
diff --git a/users/Profpatsch/cas-serve/cas-serve.cabal b/users/Profpatsch/cas-serve/cas-serve.cabal
new file mode 100644
index 0000000000..d14776700a
--- /dev/null
+++ b/users/Profpatsch/cas-serve/cas-serve.cabal
@@ -0,0 +1,73 @@
+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,
+        wai,
+        warp,
+        mtl,
+        bytestring,
+        memory,
+        crypton,
diff --git a/users/Profpatsch/cas-serve/default.nix b/users/Profpatsch/cas-serve/default.nix
new file mode 100644
index 0000000000..14c3e4aa13
--- /dev/null
+++ b/users/Profpatsch/cas-serve/default.nix
@@ -0,0 +1,38 @@
+{ depot, pkgs, lib, ... }:
+
+let
+  bins = depot.nix.getBins pkgs.sqlite [ "sqlite3" ];
+
+  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.crypton
+      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
diff --git a/users/Profpatsch/cas-serve/schema.sql b/users/Profpatsch/cas-serve/schema.sql
new file mode 100644
index 0000000000..b61a7a1ad5
--- /dev/null
+++ b/users/Profpatsch/cas-serve/schema.sql
@@ -0,0 +1,38 @@
+-- SQLite
+.dump
+
+PRAGMA foreign_keys = ON;
+
+BEGIN transaction;
+
+create table if not exists file_content (
+  content blob NOT NULL,
+  hash_sha256 blob PRIMARY KEY,
+  size integer NOT NULL
+) WITHOUT ROWID;
+
+
+create table if not exists file_references (
+  rowid integer PRIMARY KEY,
+  file_content NOT NULL REFERENCES file_content ON DELETE CASCADE,
+  reference_type text NOT NULL,
+  name text NOT NULL,
+  extension text NOT NULL,
+  mimetype text NOT NULL
+);
+
+create unique index if not exists file_references_type_name_unique on file_references (reference_type, name);
+
+-- insert into file_content values ('mycontent', 'myhash', 9);
+-- insert into file_references values (NULL, 'myhash', 'by-id', 'myschranz', '.txt', 'text/plain');
+-- insert into file_content values (readfile('/home/philip/Pictures/screenshot.png'), 'anotherhash', 999);
+-- insert into file_references values (NULL, 'anotherhash', 'by-id', 'img', '.png', 'image/png');
+
+select * from file_content;
+
+select * from file_references;
+
+COMMIT;
+
+-- drop table file_content;
+-- drop table file_references;
diff --git a/users/Profpatsch/cas-serve/wordlist.json b/users/Profpatsch/cas-serve/wordlist.json
new file mode 100644
index 0000000000..cc4bc62ad1
--- /dev/null
+++ b/users/Profpatsch/cas-serve/wordlist.json
@@ -0,0 +1 @@
+ [ "acrobat", "africa", "alaska", "albert", "albino", "album", "alcohol", "alex", "alpha", "amadeus", "amanda", "amazon", "america", "analog", "animal", "antenna", "antonio", "apollo", "april", "aroma", "artist", "aspirin", "athlete", "atlas", "banana", "bandit", "banjo", "bikini", "bingo", "bonus", "camera", "canada", "carbon", "casino", "catalog", "cinema", "citizen", "cobra", "comet", "compact", "complex", "context", "credit", "critic", "crystal", "culture", "david", "delta", "dialog", "diploma", "doctor", "domino", "dragon", "drama", "extra", "fabric", "final", "focus", "forum", "galaxy", "gallery", "global", "harmony", "hotel", "humor", "index", "japan", "kilo", "lemon", "liter", "lotus", "mango", "melon", "menu", "meter", "metro", "mineral", "model", "music", "object", "piano", "pirate", "plastic", "radio", "report", "signal", "sport", "studio", "subject", "super", "tango", "taxi", "tempo", "tennis", "textile", "tokyo", "total", "tourist", "video", "visa", "academy", "alfred", "atlanta", "atomic", "barbara", "bazaar", "brother", "budget", "cabaret", "cadet", "candle", "capsule", "caviar", "channel", "chapter", "circle", "cobalt", "comrade", "condor", "crimson", "cyclone", "darwin", "declare", "denver", "desert", "divide", "dolby", "domain", "double", "eagle", "echo", "eclipse", "editor", "educate", "edward", "effect", "electra", "emerald", "emotion", "empire", "eternal", "evening", "exhibit", "expand", "explore", "extreme", "ferrari", "forget", "freedom", "friday", "fuji", "galileo", "genesis", "gravity", "habitat", "hamlet", "harlem", "helium", "holiday", "hunter", "ibiza", "iceberg", "imagine", "infant", "isotope", "jackson", "jamaica", "jasmine", "java", "jessica", "kitchen", "lazarus", "letter", "license", "lithium", "loyal", "lucky", "magenta", "manual", "marble", "maxwell", "mayor", "monarch", "monday", "money", "morning", "mother", "mystery", "native", "nectar", "nelson", "network", "nikita", "nobel", "nobody", "nominal", "norway", "nothing", "number", "october", "office", "oliver", "opinion", "option", "order", "outside", "package", "pandora", "panther", "papa", "pattern", "pedro", "pencil", "people", "phantom", "philips", "pioneer", "pluto", "podium", "portal", "potato", "process", "proxy", "pupil", "python", "quality", "quarter", "quiet", "rabbit", "radical", "radius", "rainbow", "ramirez", "ravioli", "raymond", "respect", "respond", "result", "resume", "richard", "river", "roger", "roman", "rondo", "sabrina", "salary", "salsa", "sample", "samuel", "saturn", "savage", "scarlet", "scorpio", "sector", "serpent", "shampoo", "sharon", "silence", "simple", "society", "sonar", "sonata", "soprano", "sparta", "spider", "sponsor", "abraham", "action", "active", "actor", "adam", "address", "admiral", "adrian", "agenda", "agent", "airline", "airport", "alabama", "aladdin", "alarm", "algebra", "alibi", "alice", "alien", "almond", "alpine", "amber", "amigo", "ammonia", "analyze", "anatomy", "angel", "annual", "answer", "apple", "archive", "arctic", "arena", "arizona", "armada", "arnold", "arsenal", "arthur", "asia", "aspect", "athena", "audio", "august", "austria", "avenue", "average", "axiom", "aztec", "bagel", "baker", "balance", "ballad", "ballet", "bambino", "bamboo", "baron", "basic", "basket", "battery", "belgium", "benefit", "berlin", "bermuda", "bernard", "bicycle", "binary", "biology", "bishop", "blitz", "block", "blonde", "bonjour", "boris", "boston", "bottle", "boxer", "brandy", "bravo", "brazil", "bridge", "british", "bronze", "brown", "bruce", "bruno", "brush", "burger", "burma", "cabinet", "cactus", "cafe", "cairo", "calypso", "camel", "campus", "canal", "cannon", "canoe", "cantina", "canvas", "canyon", "capital", "caramel", "caravan", "career", "cargo", "carlo", "carol", "carpet", "cartel", "cartoon", "castle", "castro", "cecilia", "cement", "center", "century", "ceramic", "chamber", "chance", "change", "chaos", "charlie", "charm", "charter", "cheese", "chef", "chemist", "cherry", "chess", "chicago", "chicken", "chief", "china", "cigar", "circus", "city", "clara", "classic", "claudia", "clean", "client", "climax", "clinic", "clock", "club", "cockpit", "coconut", "cola", "collect", "colombo", "colony", "color", "combat", "comedy", "command", "company", "concert", "connect", "consul", "contact", "contour", "control", "convert", "copy", "corner", "corona", "correct", "cosmos", "couple", "courage", "cowboy", "craft", "crash", "cricket", "crown", "cuba", "dallas", "dance", "daniel", "decade", "decimal", "degree", "delete", "deliver", "delphi", "deluxe", "demand", "demo", "denmark", "derby", "design", "detect", "develop", "diagram", "diamond", "diana", "diego", "diesel", "diet", "digital", "dilemma", "direct", "disco", "disney", "distant", "dollar", "dolphin", "donald", "drink", "driver", "dublin", "duet", "dynamic", "earth", "east", "ecology", "economy", "edgar", "egypt", "elastic", "elegant", "element", "elite", "elvis", "email", "empty", "energy", "engine", "english", "episode", "equator", "escape", "escort", "ethnic", "europe", "everest", "evident", "exact", "example", "exit", "exotic", "export", "express", "factor", "falcon", "family", "fantasy", "fashion", "fiber", "fiction", "fidel", "fiesta", "figure", "film", "filter", "finance", "finish", "finland", "first", "flag", "flash", "florida", "flower", "fluid", "flute", "folio", "ford", "forest", "formal", "formula", "fortune", "forward", "fragile", "france", "frank", "fresh", "friend", "frozen", "future", "gabriel", "gamma", "garage", "garcia", "garden", "garlic", "gemini", "general", "genetic", "genius", "germany", "gloria", "gold", "golf", "gondola", "gong", "good", "gordon", "gorilla", "grand", "granite", "graph", "green", "group", "guide", "guitar", "guru", "hand", "happy", "harbor", "harvard", "havana", "hawaii", "helena", "hello", "henry", "hilton", "history", "horizon", "house", "human", "icon", "idea", "igloo", "igor", "image", "impact", "import", "india", "indigo", "input", "insect", "instant", "iris", "italian", "jacket", "jacob", "jaguar", "janet", "jargon", "jazz", "jeep", "john", "joker", "jordan", "judo", "jumbo", "june", "jungle", "junior", "jupiter", "karate", "karma", "kayak", "kermit", "king", "koala", "korea", "labor", "lady", "lagoon", "laptop", "laser", "latin", "lava", "lecture", "left", "legal", "level", "lexicon", "liberal", "libra", "lily", "limbo", "limit", "linda", "linear", "lion", "liquid", "little", "llama", "lobby", "lobster", "local", "logic", "logo", "lola", "london", "lucas", "lunar", "machine", "macro", "madam", "madonna", "madrid", "maestro", "magic", "magnet", "magnum", "mailbox", "major", "mama", "mambo", "manager", "manila", "marco", "marina", "market", "mars", "martin", "marvin", "mary", "master", "matrix", "maximum", "media", "medical", "mega", "melody", "memo", "mental", "mentor", "mercury", "message", "metal", "meteor", "method", "mexico", "miami", "micro", "milk", "million", "minimum", "minus", "minute", "miracle", "mirage", "miranda", "mister", "mixer", "mobile", "modem", "modern", "modular", "moment", "monaco", "monica", "monitor", "mono", "monster", "montana", "morgan", "motel", "motif", "motor", "mozart", "multi", "museum", "mustang", "natural", "neon", "nepal", "neptune", "nerve", "neutral", "nevada", "news", "next", "ninja", "nirvana", "normal", "nova", "novel", "nuclear", "numeric", "nylon", "oasis", "observe", "ocean", "octopus", "olivia", "olympic", "omega", "opera", "optic", "optimal", "orange", "orbit", "organic", "orient", "origin", "orlando", "oscar", "oxford", "oxygen", "ozone", "pablo", "pacific", "pagoda", "palace", "pamela", "panama", "pancake", "panda", "panel", "panic", "paradox", "pardon", "paris", "parker", "parking", "parody", "partner", "passage", "passive", "pasta", "pastel", "patent", "patient", "patriot", "patrol", "pegasus", "pelican", "penguin", "pepper", "percent", "perfect", "perfume", "period", "permit", "person", "peru", "phone", "photo", "picasso", "picnic", "picture", "pigment", "pilgrim", "pilot", "pixel", "pizza", "planet", "plasma", "plaza", "pocket", "poem", "poetic", "poker", "polaris", "police", "politic", "polo", "polygon", "pony", "popcorn", "popular", "postage", "precise", "prefix", "premium", "present", "price", "prince", "printer", "prism", "private", "prize", "product", "profile", "program", "project", "protect", "proton", "public", "pulse", "puma", "pump", "pyramid", "queen", "radar", "ralph", "random", "rapid", "rebel", "record", "recycle", "reflex", "reform", "regard", "regular", "relax", "reptile", "reverse", "ricardo", "right", "ringo", "risk", "ritual", "robert", "robot", "rocket", "rodeo", "romeo", "royal", "russian", "safari", "salad", "salami", "salmon", "salon", "salute", "samba", "sandra", "santana", "sardine", "school", "scoop", "scratch", "screen", "script", "scroll", "second", "secret", "section", "segment", "select", "seminar", "senator", "senior", "sensor", "serial", "service", "shadow", "sharp", "sheriff", "shock", "short", "shrink", "sierra", "silicon", "silk", "silver", "similar", "simon", "single", "siren", "slang", "slogan", "smart", "smoke", "snake", "social", "soda", "solar", "solid", "solo", "sonic", "source", "soviet", "special", "speed", "sphere", "spiral", "spirit", "spring", "static", "status", "stereo", "stone", "stop", "street", "strong", "student", "style", "sultan", "susan", "sushi", "suzuki", "switch", "symbol", "system", "tactic", "tahiti", "talent", "tarzan", "telex", "texas", "theory", "thermos", "tiger", "titanic", "tomato", "topic", "tornado", "toronto", "torpedo", "totem", "tractor", "traffic", "transit", "trapeze", "travel", "tribal", "trick", "trident", "trilogy", "tripod", "tropic", "trumpet", "tulip", "tuna", "turbo", "twist", "ultra", "uniform", "union", "uranium", "vacuum", "valid", "vampire", "vanilla", "vatican", "velvet", "ventura", "venus", "vertigo", "veteran", "victor", "vienna", "viking", "village", "vincent", "violet", "violin", "virtual", "virus", "vision", "visitor", "visual", "vitamin", "viva", "vocal", "vodka", "volcano", "voltage", "volume", "voyage", "water", "weekend", "welcome", "western", "window", "winter", "wizard", "wolf", "world", "xray", "yankee", "yoga", "yogurt", "yoyo", "zebra", "zero", "zigzag", "zipper", "zodiac", "zoom", "acid", "adios", "agatha", "alamo", "alert", "almanac", "aloha", "andrea", "anita", "arcade", "aurora", "avalon", "baby", "baggage", "balloon", "bank", "basil", "begin", "biscuit", "blue", "bombay", "botanic", "brain", "brenda", "brigade", "cable", "calibre", "carmen", "cello", "celtic", "chariot", "chrome", "citrus", "civil", "cloud", "combine", "common", "cool", "copper", "coral", "crater", "cubic", "cupid", "cycle", "depend", "door", "dream", "dynasty", "edison", "edition", "enigma", "equal", "eric", "event", "evita", "exodus", "extend", "famous", "farmer", "food", "fossil", "frog", "fruit", "geneva", "gentle", "george", "giant", "gilbert", "gossip", "gram", "greek", "grille", "hammer", "harvest", "hazard", "heaven", "herbert", "heroic", "hexagon", "husband", "immune", "inca", "inch", "initial", "isabel", "ivory", "jason", "jerome", "joel", "joshua", "journal", "judge", "juliet", "jump", "justice", "kimono", "kinetic", "leonid", "leopard", "lima", "maze", "medusa", "member", "memphis", "michael", "miguel", "milan", "mile", "miller", "mimic", "mimosa", "mission", "monkey", "moral", "moses", "mouse", "nancy", "natasha", "nebula", "nickel", "nina", "noise", "orchid", "oregano", "origami", "orinoco", "orion", "othello", "paper", "paprika", "prelude", "prepare", "pretend", "promise", "prosper", "provide", "puzzle", "remote", "repair", "reply", "rival", "riviera", "robin", "rose", "rover", "rudolf", "saga", "sahara", "scholar", "shelter", "ship", "shoe", "sigma", "sister", "sleep", "smile", "spain", "spark", "split", "spray", "square", "stadium", "star", "storm", "story", "strange", "stretch", "stuart", "subway", "sugar", "sulfur", "summer", "survive", "sweet", "swim", "table", "taboo", "target", "teacher", "telecom", "temple", "tibet", "ticket", "tina", "today", "toga", "tommy", "tower", "trivial", "tunnel", "turtle", "twin", "uncle", "unicorn", "unique", "update", "valery", "vega", "version", "voodoo", "warning", "william", "wonder", "year", "yellow", "young", "absent", "absorb", "absurd", "accent", "alfonso", "alias", "ambient", "anagram", "andy", "anvil", "appear", "apropos", "archer", "ariel", "armor", "arrow", "austin", "avatar", "axis", "baboon", "bahama", "bali", "balsa", "barcode", "bazooka", "beach", "beast", "beatles", "beauty", "before", "benny", "betty", "between", "beyond", "billy", "bison", "blast", "bless", "bogart", "bonanza", "book", "border", "brave", "bread", "break", "broken", "bucket", "buenos", "buffalo", "bundle", "button", "buzzer", "byte", "caesar", "camilla", "canary", "candid", "carrot", "cave", "chant", "child", "choice", "chris", "cipher", "clarion", "clark", "clever", "cliff", "clone", "conan", "conduct", "congo", "costume", "cotton", "cover", "crack", "current", "danube", "data", "decide", "deposit", "desire", "detail", "dexter", "dinner", "donor", "druid", "drum", "easy", "eddie", "enjoy", "enrico", "epoxy", "erosion", "except", "exile", "explain", "fame", "fast", "father", "felix", "field", "fiona", "fire", "fish", "flame", "flex", "flipper", "float", "flood", "floor", "forbid", "forever", "fractal", "frame", "freddie", "front", "fuel", "gallop", "game", "garbo", "gate", "gelatin", "gibson", "ginger", "giraffe", "gizmo", "glass", "goblin", "gopher", "grace", "gray", "gregory", "grid", "griffin", "ground", "guest", "gustav", "gyro", "hair", "halt", "harris", "heart", "heavy", "herman", "hippie", "hobby", "honey", "hope", "horse", "hostel", "hydro", "imitate", "info", "ingrid", "inside", "invent", "invest", "invite", "ivan", "james", "jester", "jimmy", "join", "joseph", "juice", "julius", "july", "kansas", "karl", "kevin", "kiwi", "ladder", "lake", "laura", "learn", "legacy", "legend", "lesson", "life", "light", "list", "locate", "lopez", "lorenzo", "love", "lunch", "malta", "mammal", "margin", "margo", "marion", "mask", "match", "mayday", "meaning", "mercy", "middle", "mike", "mirror", "modest", "morph", "morris", "mystic", "nadia", "nato", "navy", "needle", "neuron", "never", "newton", "nice", "night", "nissan", "nitro", "nixon", "north", "oberon", "octavia", "ohio", "olga", "open", "opus", "orca", "oval", "owner", "page", "paint", "palma", "parent", "parlor", "parole", "paul", "peace", "pearl", "perform", "phoenix", "phrase", "pierre", "pinball", "place", "plate", "plato", "plume", "pogo", "point", "polka", "poncho", "powder", "prague", "press", "presto", "pretty", "prime", "promo", "quest", "quick", "quiz", "quota", "race", "rachel", "raja", "ranger", "region", "remark", "rent", "reward", "rhino", "ribbon", "rider", "road", "rodent", "round", "rubber", "ruby", "rufus", "sabine", "saddle", "sailor", "saint", "salt", "scale", "scuba", "season", "secure", "shake", "shallow", "shannon", "shave", "shelf", "sherman", "shine", "shirt", "side", "sinatra", "sincere", "size", "slalom", "slow", "small", "snow", "sofia", "song", "sound", "south", "speech", "spell", "spend", "spoon", "stage", "stamp", "stand", "state", "stella", "stick", "sting", "stock", "store", "sunday", "sunset", "support", "supreme", "sweden", "swing", "tape", "tavern", "think", "thomas", "tictac", "time", "toast", "tobacco", "tonight", "torch", "torso", "touch", "toyota", "trade", "tribune", "trinity", "triton", "truck", "trust", "type", "under", "unit", "urban", "urgent", "user", "value", "vendor", "venice", "verona", "vibrate", "virgo", "visible", "vista", "vital", "voice", "vortex", "waiter", "watch", "wave", "weather", "wedding", "wheel", "whiskey", "wisdom", "android", "annex", "armani", "cake", "confide", "deal", "define", "dispute", "genuine", "idiom", "impress", "include", "ironic", "null", "nurse", "obscure", "prefer", "prodigy", "ego", "fax", "jet", "job", "rio", "ski", "yes" ]
diff --git a/users/Profpatsch/cas-serve/wordlist.sqlite b/users/Profpatsch/cas-serve/wordlist.sqlite
new file mode 100644
index 0000000000..5074474ba0
--- /dev/null
+++ b/users/Profpatsch/cas-serve/wordlist.sqlite
Binary files differdiff --git a/users/Profpatsch/cdb.nix b/users/Profpatsch/cdb.nix
new file mode 100644
index 0000000000..86e0a2d58f
--- /dev/null
+++ b/users/Profpatsch/cdb.nix
@@ -0,0 +1,93 @@
+{ depot, pkgs, ... }:
+
+let
+  cdbListToNetencode = depot.nix.writers.rustSimple
+    {
+      name = "cdb-list-to-netencode";
+      dependencies = [
+        depot.third_party.rust-crates.nom
+        depot.users.Profpatsch.execline.exec-helpers
+        depot.users.Profpatsch.netencode.netencode-rs
+      ];
+    } ''
+    extern crate nom;
+    extern crate exec_helpers;
+    extern crate netencode;
+    use std::collections::HashMap;
+    use std::io::BufRead;
+    use nom::{IResult};
+    use nom::sequence::{tuple};
+    use nom::bytes::complete::{tag, take};
+    use nom::character::complete::{digit1, char};
+    use nom::error::{context, ErrorKind, ParseError};
+    use nom::combinator::{map_res};
+    use netencode::{T, Tag};
+
+    fn usize_t(s: &[u8]) -> IResult<&[u8], usize> {
+        context(
+            "usize",
+            map_res(
+                map_res(digit1, |n| std::str::from_utf8(n)),
+                |s| s.parse::<usize>())
+        )(s)
+    }
+
+    fn parse_cdb_record(s: &[u8]) -> IResult<&[u8], (&[u8], &[u8])> {
+        let (s, (_, klen, _, vlen, _)) = tuple((
+            char('+'),
+            usize_t,
+            char(','),
+            usize_t,
+            char(':')
+        ))(s)?;
+        let (s, (key, _, val)) = tuple((
+            take(klen),
+            tag("->"),
+            take(vlen),
+        ))(s)?;
+        Ok((s, (key, val)))
+    }
+
+    fn main() {
+        let mut res = vec![];
+        let stdin = std::io::stdin();
+        let mut lines = stdin.lock().split(b'\n');
+        loop {
+            match lines.next() {
+                None => exec_helpers::die_user_error("cdb-list-to-netencode", "stdin ended but we didn’t receive the empty line to signify the end of the cdbdump input!"),
+                Some(Err(err)) => exec_helpers::die_temporary("cdb-list-to-netencode", format!("could not read from stdin: {}", err)),
+                Some(Ok(line)) =>
+                    if &line == b"" {
+                        // the cdbdump input ends after an empty line (double \n)
+                        break;
+                    } else {
+                        match parse_cdb_record(&line) {
+                            Ok((b"", (key, val))) => {
+                                let (key, val) = match
+                                    std::str::from_utf8(key)
+                                    .and_then(|k| std::str::from_utf8(val).map(|v| (k, v))) {
+                                    Ok((key, val)) => (key.to_owned(), val.to_owned()),
+                                    Err(err) => exec_helpers::die_user_error("cdb-list-to-netencode", format!("cannot decode line {:?}, we only support utf8-encoded key/values pairs for now: {}", String::from_utf8_lossy(&line), err)),
+                                };
+                                let _ = res.push((key, val));
+                            },
+                            Ok((rest, _)) => exec_helpers::die_user_error("cdb-list-to-netencode", format!("could not decode record line {:?}, had some trailing bytes", String::from_utf8_lossy(&line))),
+                            Err(err) => exec_helpers::die_user_error("cdb-list-to-netencode", format!("could not decode record line {:?}: {:?}", String::from_utf8_lossy(&line), err)),
+                        }
+                    }
+            }
+        }
+        let list = T::List(res.into_iter().map(
+            |(k, v)| T::Record(vec![(String::from("key"), T::Text(k)), (String::from("val"), T::Text(v))].into_iter().collect())
+        ).collect());
+        netencode::encode(&mut std::io::stdout(), &list.to_u());
+    }
+
+  '';
+
+in
+{
+  inherit
+    cdbListToNetencode
+    ;
+}
diff --git a/users/Profpatsch/declib/.eslintrc.json b/users/Profpatsch/declib/.eslintrc.json
new file mode 100644
index 0000000000..9cffc711db
--- /dev/null
+++ b/users/Profpatsch/declib/.eslintrc.json
@@ -0,0 +1,14 @@
+{
+  "extends": ["eslint:recommended", "plugin:@typescript-eslint/strict-type-checked"],
+  "parser": "@typescript-eslint/parser",
+  "plugins": ["@typescript-eslint"],
+  "parserOptions": {
+    "project": true
+  },
+  "root": true,
+  "rules": {
+    "no-unused-vars": "warn",
+    "prefer-const": "warn",
+    "@typescript-eslint/no-unused-vars": "warn"
+  }
+}
diff --git a/users/Profpatsch/declib/.gitignore b/users/Profpatsch/declib/.gitignore
new file mode 100644
index 0000000000..8b56bf4ede
--- /dev/null
+++ b/users/Profpatsch/declib/.gitignore
@@ -0,0 +1,6 @@
+/node_modules/
+/.ninja/
+/output/
+
+# ignore for now
+/package.lock.json
diff --git a/users/Profpatsch/declib/.prettierrc b/users/Profpatsch/declib/.prettierrc
new file mode 100644
index 0000000000..7258fb81e0
--- /dev/null
+++ b/users/Profpatsch/declib/.prettierrc
@@ -0,0 +1,8 @@
+{
+  "trailingComma": "all",
+  "tabWidth": 2,
+  "semi": true,
+  "singleQuote": true,
+  "printWidth": 100,
+  "arrowParens": "avoid"
+}
diff --git a/users/Profpatsch/declib/README.md b/users/Profpatsch/declib/README.md
new file mode 100644
index 0000000000..11a8bf21a5
--- /dev/null
+++ b/users/Profpatsch/declib/README.md
@@ -0,0 +1,4 @@
+# Decentralized Library
+
+https://en.wikipedia.org/wiki/Distributed_library
+https://faculty.ist.psu.edu/jjansen/academic/pubs/ride98/ride98.html
diff --git a/users/Profpatsch/declib/build.ninja b/users/Profpatsch/declib/build.ninja
new file mode 100644
index 0000000000..f8844fc9be
--- /dev/null
+++ b/users/Profpatsch/declib/build.ninja
@@ -0,0 +1,16 @@
+
+builddir = .ninja
+
+outdir = ./output
+jsdir = $outdir/js
+
+rule tsc
+  command = node_modules/.bin/tsc
+
+build $outdir/index.js: tsc | index.ts tsconfig.json
+
+rule run
+  command = node $in
+
+build run: run $outdir/index.js
+  pool = console
diff --git a/users/Profpatsch/declib/index.ts b/users/Profpatsch/declib/index.ts
new file mode 100644
index 0000000000..c6a26f0922
--- /dev/null
+++ b/users/Profpatsch/declib/index.ts
@@ -0,0 +1,245 @@
+import generator, { MegalodonInterface } from 'megalodon';
+import { Account } from 'megalodon/lib/src/entities/account';
+import * as masto from 'megalodon/lib/src/entities/notification';
+import { Status } from 'megalodon/lib/src/entities/status';
+import * as rxjs from 'rxjs';
+import { Observable } from 'rxjs';
+import { NodeEventHandler } from 'rxjs/internal/observable/fromEvent';
+import * as sqlite from 'sqlite';
+import sqlite3 from 'sqlite3';
+import * as parse5 from 'parse5';
+import { mergeMap } from 'rxjs/operators';
+
+type Events =
+  | { type: 'connect'; event: [] }
+  | { type: 'update'; event: Status }
+  | { type: 'notification'; event: Notification }
+  | { type: 'delete'; event: number }
+  | { type: 'error'; event: Error }
+  | { type: 'heartbeat'; event: [] }
+  | { type: 'close'; event: [] }
+  | { type: 'parser-error'; event: Error };
+
+type Notification = masto.Notification & {
+  type: 'favourite' | 'reblog' | 'status' | 'mention' | 'poll' | 'update';
+  status: NonNullable<masto.Notification['status']>;
+  account: NonNullable<masto.Notification['account']>;
+};
+
+class Main {
+  private client: MegalodonInterface;
+  private socket: Observable<Events>;
+  private state!: State;
+  private config: {
+    databaseFile?: string;
+    baseServer: string;
+  };
+
+  private constructor() {
+    this.config = {
+      databaseFile: process.env['DECLIB_DATABASE_FILE'],
+      baseServer: process.env['DECLIB_MASTODON_SERVER'] ?? 'mastodon.xyz',
+    };
+    const ACCESS_TOKEN = process.env['DECLIB_MASTODON_ACCESS_TOKEN'];
+
+    if (!ACCESS_TOKEN) {
+      console.error('Please set DECLIB_MASTODON_ACCESS_TOKEN');
+      process.exit(1);
+    }
+    this.client = generator('mastodon', `https://${this.config.baseServer}`, ACCESS_TOKEN);
+    const websocket = this.client.publicSocket();
+    function mk<Name extends string, Type>(name: Name): Observable<{ type: Name; event: Type }> {
+      const wrap =
+        (h: NodeEventHandler) =>
+        (event: Type): void => {
+          h({ type: name, event });
+        };
+      return rxjs.fromEventPattern<{ type: Name; event: Type }>(
+        hdl => websocket.on(name, wrap(hdl)),
+        hdl => websocket.removeListener(name, wrap(hdl)),
+      );
+    }
+    this.socket = rxjs.merge(
+      mk<'connect', []>('connect'),
+      mk<'update', Status>('update'),
+      mk<'notification', Notification>('notification'),
+      mk<'delete', number>('delete'),
+      mk<'error', Error>('error'),
+      mk<'heartbeat', []>('heartbeat'),
+      mk<'close', []>('close'),
+      mk<'parser-error', Error>('parser-error'),
+    );
+  }
+
+  static async init(): Promise<Main> {
+    const self = new Main();
+    self.state = await State.init(self.config);
+    return self;
+  }
+
+  public main() {
+    // const res = await this.getAcc({ username: 'grindhold', server: 'chaos.social' });
+    // const res = await this.getAcc({ username: 'Profpatsch', server: 'mastodon.xyz' });
+    // const res = await this.getStatus('111862170899069698');
+    this.socket
+      .pipe(
+        mergeMap(async event => {
+          switch (event.type) {
+            case 'update': {
+              await this.state.addStatus(event.event);
+              console.log(`${event.event.account.acct}: ${event.event.content}`);
+              console.log(await this.state.databaseInternal.all(`SELECT * from status`));
+              break;
+            }
+            case 'notification': {
+              console.log(`NOTIFICATION (${event.event.type}):`);
+              console.log(event.event);
+              console.log(event.event.status.content);
+              const content = parseContent(event.event.status.content);
+              if (content) {
+                switch (content.command) {
+                  case 'addbook': {
+                    if (content.content[0]) {
+                      const book = {
+                        $owner: event.event.account.acct,
+                        $bookid: content.content[0],
+                      };
+                      console.log('adding book', book);
+                      await this.state.addBook(book);
+                      await this.client.postStatus(
+                        `@${event.event.account.acct} I have inserted book "${book.$bookid}" for you.`,
+                        {
+                          in_reply_to_id: event.event.status.id,
+                          visibility: 'direct',
+                        },
+                      );
+                    }
+                  }
+                }
+              }
+              break;
+            }
+            default: {
+              console.log(event);
+            }
+          }
+        }),
+      )
+      .subscribe();
+  }
+
+  private async getStatus(id: string): Promise<Status | null> {
+    return (await this.client.getStatus(id)).data;
+  }
+
+  private async getAcc(user: { username: string; server: string }): Promise<Account | null> {
+    const fullAccount = `${user.username}@${user.server}`;
+    const res = await this.client.searchAccount(fullAccount, {
+      limit: 10,
+    });
+    const accs = res.data.filter(acc =>
+      this.config.baseServer === user.server
+        ? (acc.acct = user.username)
+        : acc.acct === fullAccount,
+    );
+    return accs[0] ?? null;
+  }
+}
+
+type Interaction = {
+  originalStatus: { id: string };
+  lastStatus: { id: string };
+};
+
+class State {
+  db!: sqlite.Database;
+  private constructor() {}
+
+  static async init(config: { databaseFile?: string }): Promise<State> {
+    const s = new State();
+    s.db = await sqlite.open({
+      filename: config.databaseFile ?? ':memory:',
+      driver: sqlite3.Database,
+    });
+    await s.db.run('CREATE TABLE books (owner text, bookid text)');
+    await s.db.run('CREATE TABLE status (id text primary key, content json)');
+    return s;
+  }
+
+  async addBook(opts: { $owner: string; $bookid: string }) {
+    return await this.db.run('INSERT INTO books (owner, bookid) VALUES ($owner, $bookid)', opts);
+  }
+
+  async addStatus($status: Status) {
+    return await this.db.run(
+      `
+      INSERT INTO status (id, content) VALUES ($id, $status)
+      ON CONFLICT (id) DO UPDATE SET id = $id, content = $status
+      `,
+      {
+        $id: $status.id,
+        $status: JSON.stringify($status),
+      },
+    );
+  }
+
+  get databaseInternal() {
+    return this.db;
+  }
+}
+
+/** Parse the message; take the plain text, first line is the command any any successive lines are content */
+function parseContent(html: string): { command: string; content: string[] } | null {
+  const plain = contentToPlainText(html).split('\n');
+  if (plain[0]) {
+    return { command: plain[0].replace(' ', '').trim(), content: plain.slice(1) };
+  } else {
+    return null;
+  }
+}
+
+/** Convert the Html content to a plain text (best effort), keeping line breaks */
+function contentToPlainText(html: string): string {
+  const queue: parse5.DefaultTreeAdapterMap['childNode'][] = [];
+  queue.push(...parse5.parseFragment(html).childNodes);
+  let res = '';
+  let endOfP = false;
+  for (const el of queue) {
+    switch (el.nodeName) {
+      case '#text': {
+        res += (el as parse5.DefaultTreeAdapterMap['textNode']).value;
+        break;
+      }
+      case 'br': {
+        res += '\n';
+        break;
+      }
+      case 'p': {
+        if (endOfP) {
+          res += '\n';
+          endOfP = false;
+        }
+        queue.push(...el.childNodes);
+        endOfP = true;
+        break;
+      }
+      case 'span': {
+        break;
+      }
+      default: {
+        console.warn('unknown element in message: ', el);
+        break;
+      }
+    }
+  }
+  return res.trim();
+}
+
+Main.init().then(
+  m => {
+    m.main();
+  },
+  rej => {
+    throw rej;
+  },
+);
diff --git a/users/Profpatsch/declib/package.json b/users/Profpatsch/declib/package.json
new file mode 100644
index 0000000000..93176e8581
--- /dev/null
+++ b/users/Profpatsch/declib/package.json
@@ -0,0 +1,25 @@
+{
+  "name": "declib",
+  "version": "1.0.0",
+  "description": "",
+  "main": "index.ts",
+  "type": "commonjs",
+  "scripts": {
+    "run": "ninja run"
+  },
+  "author": "",
+  "license": "MIT",
+  "dependencies": {
+    "megalodon": "^9.2.2",
+    "parse5": "^7.1.2",
+    "rxjs": "^7.8.1",
+    "sqlite": "^5.1.1",
+    "sqlite3": "^5.1.7"
+  },
+  "devDependencies": {
+    "@typescript-eslint/eslint-plugin": "^6.21.0",
+    "@typescript-eslint/parser": "^6.21.0",
+    "eslint": "^8.56.0",
+    "typescript": "^5.3.3"
+  }
+}
diff --git a/users/Profpatsch/declib/tsconfig.json b/users/Profpatsch/declib/tsconfig.json
new file mode 100644
index 0000000000..b7f2f4c18b
--- /dev/null
+++ b/users/Profpatsch/declib/tsconfig.json
@@ -0,0 +1,25 @@
+{
+  "compilerOptions": {
+    "strict": true,
+    "module": "NodeNext",
+    "sourceMap": true,
+    "outDir": "output",
+    "target": "ES6",
+    "lib": [],
+    "typeRoots": ["node_modules/@types", "shims/@types"],
+    "moduleResolution": "NodeNext",
+
+    // importHelpers & downlevelIteration will reduce the generated javascript for new language features.
+    // `importHelpers` requires the `tslib` dependency.
+    // "downlevelIteration": true,
+    // "importHelpers": true
+    "noFallthroughCasesInSwitch": true,
+    "noImplicitOverride": true,
+    "noImplicitReturns": true,
+    "noPropertyAccessFromIndexSignature": true,
+    "noUncheckedIndexedAccess": true,
+
+  },
+
+  "files": ["index.ts"]
+}
diff --git a/users/Profpatsch/dhall/lib.dhall b/users/Profpatsch/dhall/lib.dhall
new file mode 100644
index 0000000000..fb97ba6070
--- /dev/null
+++ b/users/Profpatsch/dhall/lib.dhall
@@ -0,0 +1,84 @@
+let List/map
+    : ∀(a : Type) → ∀(b : Type) → (a → b) → List a → List b
+    = λ(a : Type) →
+      λ(b : Type) →
+      λ(f : a → b) →
+      λ(xs : List a) →
+        List/build
+          b
+          ( λ(list : Type) →
+            λ(cons : b → list → list) →
+              List/fold a xs list (λ(x : a) → cons (f x))
+          )
+
+let
+
+    --| Concatenate a `List` of `List`s into a single `List`
+    List/concat
+    : ∀(a : Type) → List (List a) → List a
+    = λ(a : Type) →
+      λ(xss : List (List a)) →
+        List/build
+          a
+          ( λ(list : Type) →
+            λ(cons : a → list → list) →
+            λ(nil : list) →
+              List/fold
+                (List a)
+                xss
+                list
+                (λ(xs : List a) → λ(ys : list) → List/fold a xs list cons ys)
+                nil
+          )
+
+let
+
+
+    -- Transform a list by applying a function to each element and flattening the results
+    List/concatMap
+    : ∀(a : Type) → ∀(b : Type) → (a → List b) → List a → List b
+    = λ(a : Type) →
+      λ(b : Type) →
+      λ(f : a → List b) →
+      λ(xs : List a) →
+        List/build
+          b
+          ( λ(list : Type) →
+            λ(cons : b → list → list) →
+              List/fold a xs list (λ(x : a) → List/fold b (f x) list cons)
+          )
+
+let Status = < Empty | NonEmpty : Text >
+
+let
+
+    {-|
+    Transform each value in a `List` to `Text` and then concatenate them with a
+    separator in between each value
+    -}
+    Text/concatMapSep
+    : ∀(separator : Text) → ∀(a : Type) → (a → Text) → List a → Text
+    = λ(separator : Text) →
+      λ(a : Type) →
+      λ(f : a → Text) →
+      λ(elements : List a) →
+        let status =
+              List/fold
+                a
+                elements
+                Status
+                ( λ(x : a) →
+                  λ(status : Status) →
+                    merge
+                      { Empty = Status.NonEmpty (f x)
+                      , NonEmpty =
+                          λ(result : Text) →
+                            Status.NonEmpty (f x ++ separator ++ result)
+                      }
+                      status
+                )
+                Status.Empty
+
+        in  merge { Empty = "", NonEmpty = λ(result : Text) → result } status
+
+in  { List/map, List/concat, List/concatMap, Text/concatMapSep }
diff --git a/users/Profpatsch/emacs-tree-sitter-move/README.md b/users/Profpatsch/emacs-tree-sitter-move/README.md
new file mode 100644
index 0000000000..ae8d763d61
--- /dev/null
+++ b/users/Profpatsch/emacs-tree-sitter-move/README.md
@@ -0,0 +1,5 @@
+# emacs-tree-sitter-move
+
+An experiment in whether we can implement structural editing in emacs using the tree-sitter parser.
+
+What currently works: loading a tree-sitter gramma, navigating the AST left/right/up/down.
diff --git a/users/Profpatsch/emacs-tree-sitter-move/default.nix b/users/Profpatsch/emacs-tree-sitter-move/default.nix
index fdc059c089..a9f259d96d 100644
--- a/users/Profpatsch/emacs-tree-sitter-move/default.nix
+++ b/users/Profpatsch/emacs-tree-sitter-move/default.nix
@@ -1,3 +1,3 @@
 # nothing yet (TODO: expose shell & tool)
-{...}:
-{}
+{ ... }:
+{ }
diff --git a/users/Profpatsch/emacs-tree-sitter-move/shell.nix b/users/Profpatsch/emacs-tree-sitter-move/shell.nix
index 81d622ac73..f400d5c021 100644
--- a/users/Profpatsch/emacs-tree-sitter-move/shell.nix
+++ b/users/Profpatsch/emacs-tree-sitter-move/shell.nix
@@ -1,14 +1,15 @@
-{ pkgs ? import ../../../third_party {}, ... }:
+{ pkgs ? import ../../../third_party { }, ... }:
 let
   inherit (pkgs) lib;
 
-  treeSitterGrammars = pkgs.runCommandLocal "grammars" {} ''
+  treeSitterGrammars = pkgs.runCommandLocal "grammars" { } ''
     mkdir -p $out/bin
     ${lib.concatStringsSep "\n"
       (lib.mapAttrsToList (name: src: "ln -s ${src}/parser $out/bin/${name}.so") pkgs.tree-sitter.builtGrammars)};
   '';
 
-in pkgs.mkShell {
+in
+pkgs.mkShell {
   buildInputs = [
     pkgs.tree-sitter.builtGrammars.python
   ];
diff --git a/users/Profpatsch/exactSource.nix b/users/Profpatsch/exactSource.nix
new file mode 100644
index 0000000000..5c713b5b1c
--- /dev/null
+++ b/users/Profpatsch/exactSource.nix
@@ -0,0 +1,90 @@
+{ ... }:
+# SPDX-License-Identifier: MIT
+# Created by Graham Christensen
+# version from https://github.com/grahamc/mayday/blob/c48f7583e622fe2e695a2a929de34679e5818816/exact-source.nix
+
+let
+  # Require that every path specified does exist.
+  #
+  # By default, Nix won't complain if you refer to a missing file
+  # if you don't actually use it:
+  #
+  #     nix-repl> ./bogus
+  #     /home/grahamc/playground/bogus
+  #
+  #     nix-repl> toString ./bogus
+  #     "/home/grahamc/playground/bogus"
+  #
+  # so in order for this interface to be *exact*, we must
+  # specifically require every provided path exists:
+  #
+  #     nix-repl> "${./bogus}"
+  #     error: getting attributes of path
+  #     '/home/grahamc/playground/bogus': No such file or
+  #     directory
+  requireAllPathsExist = paths:
+    let
+      validation = builtins.map (path: "${path}") paths;
+    in
+    builtins.deepSeq validation paths;
+
+  # Break down a given path in to a list of all of the path and
+  # its parent directories.
+  #
+  # `builtins.path` / `builtins.filterSource` will ask about
+  # a containing directory, and we must say YES otherwise it will
+  # not include anything below it.
+  #
+  # Concretely, convert: "/foo/baz/tux" in to:
+  #     [ "/foo/baz/tux" "/foo/baz" "/foo" ]
+  recursivelyPopDir = path:
+    if path == "/" then [ ]
+    else [ path ] ++ (recursivelyPopDir (builtins.dirOf path));
+
+  # Given a list of of strings, dedup the list and return a
+  # list of all unique strings.
+  #
+  # Note: only works on strings ;):
+  #
+  # First convert [ "foo" "foo" "bar" ] in to:
+  #     [
+  #       { name = "foo"; value = ""; }
+  #       { name = "foo"; value = ""; }
+  #       { name = "bar"; value = ""; }
+  #     ]
+  # then convert that to { "foo" = ""; "bar" = ""; }
+  # then get the attribute names, "foo" and "bar".
+  dedup = strings:
+    let
+      name_value_pairs = builtins.map
+        (string: { name = string; value = ""; })
+        strings;
+      attrset_of_strings = builtins.listToAttrs name_value_pairs;
+    in
+    builtins.attrNames attrset_of_strings;
+
+  exactSource = source_root: paths:
+    let
+      all_possible_paths =
+        let
+          # Convert all the paths in to relative paths on disk.
+          # ie: stringPaths will contain [ "/home/grahamc/playground/..." ];
+          # instead of /nix/store paths.
+          string_paths = builtins.map toString
+            (requireAllPathsExist paths);
+
+          all_paths_with_duplicates = builtins.concatMap
+            recursivelyPopDir
+            string_paths;
+        in
+        dedup all_paths_with_duplicates;
+
+      pathIsSpecified = path:
+        builtins.elem path all_possible_paths;
+    in
+    builtins.path {
+      path = source_root;
+      filter = (path: _type: pathIsSpecified path);
+    };
+in
+exactSource
diff --git a/users/Profpatsch/execline/ExecHelpers.hs b/users/Profpatsch/execline/ExecHelpers.hs
new file mode 100644
index 0000000000..438047b2b9
--- /dev/null
+++ b/users/Profpatsch/execline/ExecHelpers.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TypeApplications #-}
+
+module ExecHelpers where
+
+import Data.String (IsString)
+import MyPrelude
+import qualified System.Exit as Sys
+
+newtype CurrentProgramName = CurrentProgramName { unCurrentProgramName :: Text }
+  deriving newtype (Show, Eq, Ord, IsString)
+
+-- | Exit 1 to signify a generic expected error
+-- (e.g. something that sometimes just goes wrong, like a nix build).
+dieExpectedError :: CurrentProgramName -> Text -> IO a
+dieExpectedError = dieWith 1
+
+-- | Exit 100 to signify a user error (“the user is holding it wrong”).
+--  This is a permanent error, if the program is executed the same way
+-- it should crash with 100 again.
+dieUserError :: CurrentProgramName -> Text -> IO a
+dieUserError = dieWith 100
+
+-- |  Exit 101 to signify an unexpected crash (failing assertion or panic).
+diePanic :: CurrentProgramName -> Text -> IO a
+diePanic = dieWith 101
+
+-- | Exit 111 to signify a temporary error (such as resource exhaustion)
+dieTemporary :: CurrentProgramName -> Text -> IO a
+dieTemporary = dieWith 111
+
+-- |  Exit 126 to signify an environment problem
+-- (the user has set up stuff incorrectly so the program cannot work)
+dieEnvironmentProblem :: CurrentProgramName -> Text -> IO a
+dieEnvironmentProblem = dieWith 126
+
+-- | Exit 127 to signify a missing executable.
+dieMissingExecutable :: CurrentProgramName -> Text -> IO a
+dieMissingExecutable = dieWith 127
+
+dieWith :: Natural -> CurrentProgramName -> Text -> IO a
+dieWith status currentProgramName msg = do
+  putStderrLn [fmt|{currentProgramName & unCurrentProgramName}: {msg}|]
+  Sys.exitWith
+    (Sys.ExitFailure (status & fromIntegral @Natural @Int))
diff --git a/users/Profpatsch/execline/default.nix b/users/Profpatsch/execline/default.nix
index 2d1b911373..04d07895c6 100644
--- a/users/Profpatsch/execline/default.nix
+++ b/users/Profpatsch/execline/default.nix
@@ -1,12 +1,70 @@
 { depot, pkgs, lib, ... }:
 
 let
-  exec-helpers = depot.nix.writers.rustSimpleLib {
-    name = "exec-helpers";
-  } (builtins.readFile ./exec_helpers.rs);
+  exec-helpers-hs = pkgs.haskellPackages.mkDerivation {
+    pname = "exec-helpers";
+    version = "0.1.0";
 
-in depot.nix.utils.drvTargets {
+    src = depot.users.Profpatsch.exactSource ./. [
+      ./exec-helpers.cabal
+      ./ExecHelpers.hs
+    ];
+
+    libraryHaskellDepends = [
+      depot.users.Profpatsch.my-prelude
+    ];
+
+    isLibrary = true;
+    license = lib.licenses.mit;
+  };
+
+  print-one-env = depot.nix.writers.rustSimple
+    {
+      name = "print-one-env";
+      dependencies = [
+        depot.users.Profpatsch.execline.exec-helpers
+      ];
+    } ''
+    extern crate exec_helpers;
+    use std::os::unix::ffi::OsStrExt;
+    use std::io::Write;
+
+    fn main() {
+      let args = exec_helpers::args("print-one-env", 1);
+      let valname = std::ffi::OsStr::from_bytes(&args[0]);
+      match std::env::var_os(&valname) {
+        None => exec_helpers::die_user_error("print-one-env", format!("Env variable `{:?}` is not set", valname)),
+        Some(val) => std::io::stdout().write_all(&val.as_bytes()).unwrap()
+      }
+    }
+  '';
+
+  setsid = depot.nix.writers.rustSimple
+    {
+      name = "setsid";
+      dependencies = [
+        depot.users.Profpatsch.execline.exec-helpers
+        depot.third_party.rust-crates.libc
+      ];
+    } ''
+    use std::os::unix::ffi::OsStrExt;
+    use std::ffi::OsStr;
+
+    fn main() {
+      let (args, prog) = exec_helpers::args_for_exec("setsid", 1);
+      let envvar = OsStr::from_bytes(&args.get(0).expect("first argument must be envvar name to set"));
+      let sid: i32 = unsafe { libc::setsid() };
+      std::env::set_var(envvar, format!("{}", sid));
+      let env: Vec<(&[u8], &[u8])> = vec![];
+      exec_helpers::exec_into_args("getid", prog, env);
+    }
+  '';
+
+in
+depot.nix.readTree.drvTargets {
   inherit
-    exec-helpers
+    exec-helpers-hs
+    print-one-env
+    setsid
     ;
 }
diff --git a/users/Profpatsch/execline/exec-helpers.cabal b/users/Profpatsch/execline/exec-helpers.cabal
new file mode 100644
index 0000000000..b472ff6bd5
--- /dev/null
+++ b/users/Profpatsch/execline/exec-helpers.cabal
@@ -0,0 +1,14 @@
+cabal-version:      3.0
+name:               exec-helpers
+version:            0.1.0.0
+author:             Profpatsch
+maintainer:         mail@profpatsch.de
+
+library
+    exposed-modules:          ExecHelpers
+
+    build-depends:
+        base >=4.15 && <5,
+        my-prelude
+
+    default-language: Haskell2010
diff --git a/users/Profpatsch/execline/exec-helpers/Cargo.lock b/users/Profpatsch/execline/exec-helpers/Cargo.lock
new file mode 100644
index 0000000000..1753cc949d
--- /dev/null
+++ b/users/Profpatsch/execline/exec-helpers/Cargo.lock
@@ -0,0 +1,7 @@
+# This file is automatically @generated by Cargo.
+# It is not intended for manual editing.
+version = 3
+
+[[package]]
+name = "exec_helpers"
+version = "0.1.0"
diff --git a/users/Profpatsch/execline/exec-helpers/Cargo.toml b/users/Profpatsch/execline/exec-helpers/Cargo.toml
new file mode 100644
index 0000000000..6642b66ee3
--- /dev/null
+++ b/users/Profpatsch/execline/exec-helpers/Cargo.toml
@@ -0,0 +1,8 @@
+[package]
+name = "exec_helpers"
+version = "0.1.0"
+edition = "2021"
+
+[lib]
+name = "exec_helpers"
+path = "exec_helpers.rs"
diff --git a/users/Profpatsch/execline/exec-helpers/default.nix b/users/Profpatsch/execline/exec-helpers/default.nix
new file mode 100644
index 0000000000..5545d41d9d
--- /dev/null
+++ b/users/Profpatsch/execline/exec-helpers/default.nix
@@ -0,0 +1,6 @@
+{ depot, ... }:
+depot.nix.writers.rustSimpleLib
+{
+  name = "exec-helpers";
+}
+  (builtins.readFile ./exec_helpers.rs)
diff --git a/users/Profpatsch/execline/exec_helpers.rs b/users/Profpatsch/execline/exec-helpers/exec_helpers.rs
index b9e1f57973..a57cbca353 100644
--- a/users/Profpatsch/execline/exec_helpers.rs
+++ b/users/Profpatsch/execline/exec-helpers/exec_helpers.rs
@@ -1,13 +1,16 @@
-use std::os::unix::process::CommandExt;
 use std::ffi::OsStr;
-use std::os::unix::ffi::{OsStringExt, OsStrExt};
+use std::os::unix::ffi::{OsStrExt, OsStringExt};
+use std::os::unix::process::CommandExt;
 
 pub fn no_args(current_prog_name: &str) -> () {
     let mut args = std::env::args_os();
     // remove argv[0]
     let _ = args.nth(0);
     if args.len() > 0 {
-        die_user_error(current_prog_name, format!("Expected no arguments, got {:?}", args.collect::<Vec<_>>()))
+        die_user_error(
+            current_prog_name,
+            format!("Expected no arguments, got {:?}", args.collect::<Vec<_>>()),
+        )
     }
 }
 
@@ -16,31 +19,46 @@ pub fn args(current_prog_name: &str, no_of_positional_args: usize) -> Vec<Vec<u8
     // remove argv[0]
     let _ = args.nth(0);
     if args.len() != no_of_positional_args {
-        die_user_error(current_prog_name, format!("Expected {} arguments, got {}, namely {:?}", no_of_positional_args, args.len(), args.collect::<Vec<_>>()))
+        die_user_error(
+            current_prog_name,
+            format!(
+                "Expected {} arguments, got {}, namely {:?}",
+                no_of_positional_args,
+                args.len(),
+                args.collect::<Vec<_>>()
+            ),
+        )
     }
     args.map(|arg| arg.into_vec()).collect()
 }
 
-pub fn args_for_exec(current_prog_name: &str, no_of_positional_args: usize) -> (Vec<Vec<u8>>, Vec<Vec<u8>>) {
+pub fn args_for_exec(
+    current_prog_name: &str,
+    no_of_positional_args: usize,
+) -> (Vec<Vec<u8>>, Vec<Vec<u8>>) {
     let mut args = std::env::args_os();
     // remove argv[0]
     let _ = args.nth(0);
     let mut args = args.map(|arg| arg.into_vec());
     let mut pos_args = vec![];
     // get positional args
-    for i in 1..no_of_positional_args+1 {
-            pos_args.push(
-                args.nth(0).expect(
-                    &format!("{}: expects {} positional args, only got {}", current_prog_name, no_of_positional_args, i))
-            );
+    for i in 1..no_of_positional_args + 1 {
+        pos_args.push(args.nth(0).expect(&format!(
+            "{}: expects {} positional args, only got {}",
+            current_prog_name, no_of_positional_args, i
+        )));
     }
     // prog... is the rest of the iterator
-    let prog : Vec<Vec<u8>> = args.collect();
+    let prog: Vec<Vec<u8>> = args.collect();
     (pos_args, prog)
 }
 
-pub fn exec_into_args<'a, 'b, Args, Arg, Env, Key, Val>(current_prog_name: &str, args: Args, env_additions: Env) -> !
-    where
+pub fn exec_into_args<'a, 'b, Args, Arg, Env, Key, Val>(
+    current_prog_name: &str,
+    args: Args,
+    env_additions: Env,
+) -> !
+where
     Args: IntoIterator<Item = Arg>,
     Arg: AsRef<[u8]>,
     Env: IntoIterator<Item = (Key, Val)>,
@@ -50,27 +68,40 @@ pub fn exec_into_args<'a, 'b, Args, Arg, Env, Key, Val>(current_prog_name: &str,
     // TODO: is this possible without collecting into a Vec first, just leaving it an IntoIterator?
     let args = args.into_iter().collect::<Vec<Arg>>();
     let mut args = args.iter().map(|v| OsStr::from_bytes(v.as_ref()));
-    let prog = args.nth(0).expect(&format!("{}: first argument must be an executable", current_prog_name));
+    let prog = args.nth(0).expect(&format!(
+        "{}: first argument must be an executable",
+        current_prog_name
+    ));
     // TODO: same here
     let env = env_additions.into_iter().collect::<Vec<(Key, Val)>>();
-    let env = env.iter().map(|(k,v)| (OsStr::from_bytes(k.as_ref()), OsStr::from_bytes(v.as_ref())));
+    let env = env
+        .iter()
+        .map(|(k, v)| (OsStr::from_bytes(k.as_ref()), OsStr::from_bytes(v.as_ref())));
     let err = std::process::Command::new(prog).args(args).envs(env).exec();
-    die_missing_executable(current_prog_name, format!("exec failed: {}, while trying to execing into {:?}", err, prog));
+    die_missing_executable(
+        current_prog_name,
+        format!(
+            "exec failed: {}, while trying to execing into {:?}",
+            err, prog
+        ),
+    );
 }
 
 /// Exit 1 to signify a generic expected error
 /// (e.g. something that sometimes just goes wrong, like a nix build).
 pub fn die_expected_error<S>(current_prog_name: &str, msg: S) -> !
-where S: AsRef<str>
+where
+    S: AsRef<str>,
 {
-  die_with(1, current_prog_name, msg)
+    die_with(1, current_prog_name, msg)
 }
 
 /// Exit 100 to signify a user error (“the user is holding it wrong”).
 /// This is a permanent error, if the program is executed the same way
 /// it should crash with 100 again.
 pub fn die_user_error<S>(current_prog_name: &str, msg: S) -> !
-where S: AsRef<str>
+where
+    S: AsRef<str>,
 {
     die_with(100, current_prog_name, msg)
 }
@@ -78,14 +109,16 @@ where S: AsRef<str>
 /// Exit 101 to signify an unexpected crash (failing assertion or panic).
 /// This is the same exit code that `panic!()` emits.
 pub fn die_panic<S>(current_prog_name: &str, msg: S) -> !
-where S: AsRef<str>
+where
+    S: AsRef<str>,
 {
     die_with(101, current_prog_name, msg)
 }
 
 /// Exit 111 to signify a temporary error (such as resource exhaustion)
 pub fn die_temporary<S>(current_prog_name: &str, msg: S) -> !
-where S: AsRef<str>
+where
+    S: AsRef<str>,
 {
     die_with(111, current_prog_name, msg)
 }
@@ -93,20 +126,23 @@ where S: AsRef<str>
 /// Exit 126 to signify an environment problem
 /// (the user has set up stuff incorrectly so the program cannot work)
 pub fn die_environment_problem<S>(current_prog_name: &str, msg: S) -> !
-where S: AsRef<str>
+where
+    S: AsRef<str>,
 {
     die_with(126, current_prog_name, msg)
 }
 
 /// Exit 127 to signify a missing executable.
 pub fn die_missing_executable<S>(current_prog_name: &str, msg: S) -> !
-where S: AsRef<str>
+where
+    S: AsRef<str>,
 {
     die_with(127, current_prog_name, msg)
 }
 
 fn die_with<S>(status: i32, current_prog_name: &str, msg: S) -> !
-    where S: AsRef<str>
+where
+    S: AsRef<str>,
 {
     eprintln!("{}: {}", current_prog_name, msg.as_ref());
     std::process::exit(status)
diff --git a/users/Profpatsch/fafo.jpg b/users/Profpatsch/fafo.jpg
new file mode 100644
index 0000000000..78f11d208e
--- /dev/null
+++ b/users/Profpatsch/fafo.jpg
Binary files differdiff --git a/users/Profpatsch/git-db/default.nix b/users/Profpatsch/git-db/default.nix
new file mode 100644
index 0000000000..ad5d927677
--- /dev/null
+++ b/users/Profpatsch/git-db/default.nix
@@ -0,0 +1,10 @@
+{ depot, pkgs, lib, ... }:
+
+depot.nix.writers.rustSimple
+{
+  name = "git-db";
+  dependencies = [
+    depot.third_party.rust-crates.git2
+  ];
+}
+  (builtins.readFile ./git-db.rs)
diff --git a/users/Profpatsch/git-db/git-db.rs b/users/Profpatsch/git-db/git-db.rs
new file mode 100644
index 0000000000..c8019bf036
--- /dev/null
+++ b/users/Profpatsch/git-db/git-db.rs
@@ -0,0 +1,90 @@
+extern crate git2;
+use std::os::unix::ffi::OsStrExt;
+use std::path::PathBuf;
+
+const DEFAULT_BRANCH: &str = "refs/heads/main";
+
+fn main() {
+    let git_db_dir = std::env::var_os("GIT_DB_DIR").expect("set GIT_DB_DIR");
+    let git_db = PathBuf::from(git_db_dir).join("git");
+
+    std::fs::create_dir_all(&git_db).unwrap();
+
+    let repo = git2::Repository::init_opts(
+        &git_db,
+        git2::RepositoryInitOptions::new()
+            .bare(true)
+            .mkpath(true)
+            .description("git-db database")
+            .initial_head(DEFAULT_BRANCH),
+    )
+    .expect(&format!(
+        "unable to create or open bare git repo at {}",
+        &git_db.display()
+    ));
+
+    let mut index = repo.index().expect("cannot get the git index file");
+    eprintln!("{:#?}", index.version());
+    index.clear().expect("could not clean the index");
+
+    let now = std::time::SystemTime::now()
+        .duration_since(std::time::SystemTime::UNIX_EPOCH)
+        .expect("unable to get system time");
+
+    let now_git_time = git2::IndexTime::new(
+        now.as_secs() as i32, // lol
+        u32::from(now.subsec_nanos()),
+    );
+
+    let data = "hi, it’s me".as_bytes();
+
+    index
+        .add_frombuffer(
+            &git2::IndexEntry {
+            mtime: now_git_time,
+            ctime: now_git_time,
+            // don’t make sense
+            dev: 0,
+            ino: 0,
+            mode: /*libc::S_ISREG*/ 0b1000 << (3+9) | /* read write for owner */ 0o644,
+            uid: 0,
+            gid: 0,
+            file_size: data.len() as u32, // lol again
+            id: git2::Oid::zero(),
+            flags: 0,
+            flags_extended: 0,
+            path: "hi.txt".as_bytes().to_owned(),
+        },
+            data,
+        )
+        .expect("could not add data to index");
+
+    let oid = index.write_tree().expect("could not write index tree");
+
+    let to_add_tree = repo
+        .find_tree(oid)
+        .expect("we just created this tree, where did it go?");
+
+    let parent_commits = match repo.find_reference(DEFAULT_BRANCH) {
+        Ok(ref_) => vec![ref_.peel_to_commit().expect(&format!(
+            "reference {} does not point to a commit",
+            DEFAULT_BRANCH
+        ))],
+        Err(err) => match err.code() {
+            // no commit exists yet
+            git2::ErrorCode::NotFound => vec![],
+            _ => panic!("could not read latest commit from {}", DEFAULT_BRANCH),
+        },
+    };
+    repo.commit(
+        Some(DEFAULT_BRANCH),
+        &git2::Signature::now("Mr. Authorboy", "author@example.com").unwrap(),
+        &git2::Signature::now("Mr. Commiterboy", "committer@example.com").unwrap(),
+        "This is my first commit!\n\
+         \n\
+         I wonder if it supports extended commit descriptions?\n",
+        &to_add_tree,
+        &parent_commits.iter().collect::<Vec<_>>()[..],
+    )
+    .expect("could not commit the index we just wrote");
+}
diff --git a/users/Profpatsch/haskell-module-deps/README.md b/users/Profpatsch/haskell-module-deps/README.md
new file mode 100644
index 0000000000..b4f35beac5
--- /dev/null
+++ b/users/Profpatsch/haskell-module-deps/README.md
@@ -0,0 +1,5 @@
+# haskell-module-deps
+
+An executable that when run in a project directory containing `.hs` files in `./src` will output a png/graph of how those modules import each other, transitively.
+
+Useful for getting an overview, finding weird import edges, figuring out how to get more compilation parallelism into your Haskell project.
diff --git a/users/Profpatsch/haskell-module-deps/default.nix b/users/Profpatsch/haskell-module-deps/default.nix
new file mode 100644
index 0000000000..71cc0a5b0d
--- /dev/null
+++ b/users/Profpatsch/haskell-module-deps/default.nix
@@ -0,0 +1,55 @@
+{ depot, pkgs, lib, ... }:
+
+let
+  bins = depot.nix.getBins pkgs.zathura [ "zathura" ]
+    // depot.nix.getBins pkgs.haskellPackages.graphmod [ "graphmod" ]
+    // depot.nix.getBins pkgs.graphviz [ "dot" ]
+  ;
+
+  # Display a graph of all modules in a project and how they depend on each other.
+  # Takes the project directory as argument.
+  # Open in zathura.
+  haskell-module-deps = depot.nix.writeExecline "haskell-module-deps" { } [
+    "pipeline"
+    [ haskell-module-deps-with-filetype "pdf" "$@" ]
+    bins.zathura
+    "-"
+  ];
+
+  # Display a graph of all modules in a project and how they depend on each other.
+  # Takes the project directory as argument.
+  # Print a png to stdout.
+  haskell-module-deps-png = depot.nix.writeExecline "haskell-module-deps-png" { } [
+    haskell-module-deps-with-filetype
+    "png"
+    "$@"
+  ];
+
+  # Display a graph of all modules in a project and how they depend on each other.
+  # Takes the file type to generate as first argument
+  # and the project directory as second argument.
+  haskell-module-deps-with-filetype = pkgs.writers.writeBash "haskell-module-deps-with-filetype" ''
+    set -euo pipefail
+    shopt -s globstar
+    filetype="$1"
+    rootDir="$2"
+    ${bins.graphmod} \
+      ${/*silence warnings for missing external dependencies*/""} \
+      --quiet \
+      ${/*applies some kind of import simplification*/""} \
+      --prune-edges \
+      "$rootDir"/src/**/*.hs \
+      | ${bins.dot} \
+          ${/*otherwise it’s a bit cramped*/""} \
+          -Gsize="20,20!" \
+          -T"$filetype"
+  '';
+
+in
+depot.nix.readTree.drvTargets {
+  inherit
+    haskell-module-deps
+    haskell-module-deps-png
+    haskell-module-deps-with-filetype
+    ;
+}
diff --git a/users/Profpatsch/haskell-module-deps/example-output-dhall-haskell.png b/users/Profpatsch/haskell-module-deps/example-output-dhall-haskell.png
new file mode 100644
index 0000000000..53725c49e8
--- /dev/null
+++ b/users/Profpatsch/haskell-module-deps/example-output-dhall-haskell.png
Binary files differdiff --git a/users/Profpatsch/hie.yaml b/users/Profpatsch/hie.yaml
new file mode 100644
index 0000000000..1b5ae942ad
--- /dev/null
+++ b/users/Profpatsch/hie.yaml
@@ -0,0 +1,36 @@
+cradle:
+  cabal:
+    - path: "./my-prelude"
+      component: "lib:my-prelude"
+    - path: "./my-webstuff"
+      component: "lib:my-webstuff"
+    - path: "./netencode"
+      component: "lib:netencode"
+    - path: "./arglib"
+      component: "lib:arglib-netencode"
+    - path: "./execline"
+      component: "lib:exec-helpers"
+    - path: "./htmx-experiment/src"
+      component: "lib:htmx-experiment"
+    - path: "./htmx-experiment/Main.hs"
+      component: "htmx-experiment:exe:htmx-experiment"
+    - path: "./mailbox-org/src"
+      component: "lib:mailbox-org"
+    - path: "./mailbox-org/MailboxOrg.hs"
+      component: "mailbox-org:exe:mailbox-org"
+    - path: "./cas-serve/CasServe.hs"
+      component: "cas-serve:exe:cas-serve"
+    - path: "./jbovlaste-sqlite/JbovlasteSqlite.hs"
+      component: "jbovlaste-sqlite:exe:jbovlaste-sqlite"
+    - path: "./whatcd-resolver/src"
+      component: "lib:whatcd-resolver"
+    - path: "./whatcd-resolver/Main.hs"
+      component: "whatcd-resolver:exe:whatcd-resolver"
+    - path: "./openlab-tools/src"
+      component: "lib:openlab-tools"
+    - path: "./openlab-tools/Main.hs"
+      component: "openlab-tools:exe:openlab-tools"
+    - path: "./httzip/Httzip.hs"
+      component: "httzip:exe:httzip"
+    - path: "./my-xmonad/Xmonad.hs"
+      component: "my-xmonad:exe:xmonad"
diff --git a/users/Profpatsch/htmx-experiment/Main.hs b/users/Profpatsch/htmx-experiment/Main.hs
new file mode 100644
index 0000000000..29ce8610ff
--- /dev/null
+++ b/users/Profpatsch/htmx-experiment/Main.hs
@@ -0,0 +1,4 @@
+import HtmxExperiment qualified
+
+main :: IO ()
+main = HtmxExperiment.main
diff --git a/users/Profpatsch/htmx-experiment/default.nix b/users/Profpatsch/htmx-experiment/default.nix
new file mode 100644
index 0000000000..ef1a28bd2b
--- /dev/null
+++ b/users/Profpatsch/htmx-experiment/default.nix
@@ -0,0 +1,46 @@
+{ depot, pkgs, lib, ... }:
+
+let
+  htmx-experiment = pkgs.haskellPackages.mkDerivation {
+    pname = "htmx-experiment";
+    version = "0.1.0";
+
+    src = depot.users.Profpatsch.exactSource ./. [
+      ./htmx-experiment.cabal
+      ./Main.hs
+      ./src/HtmxExperiment.hs
+      ./src/ServerErrors.hs
+      ./src/ValidationParseT.hs
+    ];
+
+    libraryHaskellDepends = [
+      depot.users.Profpatsch.my-webstuff
+      pkgs.haskellPackages.pa-label
+      pkgs.haskellPackages.pa-error-tree
+      pkgs.haskellPackages.blaze-html
+      pkgs.haskellPackages.blaze-markup
+      pkgs.haskellPackages.bytestring
+      pkgs.haskellPackages.dlist
+      pkgs.haskellPackages.http-types
+      pkgs.haskellPackages.ihp-hsx
+      pkgs.haskellPackages.monad-logger
+      pkgs.haskellPackages.pa-error-tree
+      pkgs.haskellPackages.pa-field-parser
+      pkgs.haskellPackages.pa-label
+      pkgs.haskellPackages.pa-prelude
+      pkgs.haskellPackages.selective
+      pkgs.haskellPackages.text
+      pkgs.haskellPackages.unliftio
+      pkgs.haskellPackages.wai
+      pkgs.haskellPackages.warp
+
+    ];
+
+    isLibrary = false;
+    isExecutable = true;
+    license = lib.licenses.mit;
+  };
+
+
+in
+htmx-experiment
diff --git a/users/Profpatsch/htmx-experiment/htmx-experiment.cabal b/users/Profpatsch/htmx-experiment/htmx-experiment.cabal
new file mode 100644
index 0000000000..e9a0d93614
--- /dev/null
+++ b/users/Profpatsch/htmx-experiment/htmx-experiment.cabal
@@ -0,0 +1,89 @@
+cabal-version:      3.0
+name:               htmx-experiment
+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
+
+library
+    import: common-options
+    exposed-modules:
+      HtmxExperiment,
+      ServerErrors,
+      ValidationParseT
+    hs-source-dirs: ./src
+
+    build-depends:
+        base >=4.15 && <5,
+        -- http-api-data
+        blaze-html,
+        blaze-markup,
+        bytestring,
+        dlist,
+        http-types,
+        ihp-hsx,
+        monad-logger,
+        pa-error-tree,
+        pa-field-parser,
+        pa-label,
+        pa-prelude,
+        my-webstuff,
+        selective,
+        text,
+        unliftio,
+        wai,
+        warp
+
+
+executable htmx-experiment
+    import: common-options
+    main-is: Main.hs
+
+    build-depends:
+        htmx-experiment,
+        base >=4.15 && <5,
diff --git a/users/Profpatsch/htmx-experiment/src/HtmxExperiment.hs b/users/Profpatsch/htmx-experiment/src/HtmxExperiment.hs
new file mode 100644
index 0000000000..225206a584
--- /dev/null
+++ b/users/Profpatsch/htmx-experiment/src/HtmxExperiment.hs
@@ -0,0 +1,377 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module HtmxExperiment where
+
+import Control.Category qualified as Cat
+import Control.Exception qualified as Exc
+import Control.Monad.Logger
+import Control.Selective (Selective (select))
+import Control.Selective qualified as Selective
+import Data.ByteString qualified as Bytes
+import Data.DList (DList)
+import Data.Functor.Compose
+import Data.List qualified as List
+import Data.Maybe (maybeToList)
+import Data.Maybe qualified as Maybe
+import Data.Monoid qualified as Monoid
+import Data.Text qualified as Text
+import FieldParser hiding (nonEmpty)
+import GHC.TypeLits (KnownSymbol, symbolVal)
+import IHP.HSX.QQ (hsx)
+import Label
+import Multipart2 (FormValidation (FormValidation), FormValidationResult, MultipartParseT, failFormValidation)
+import Multipart2 qualified as Multipart
+import Network.HTTP.Types qualified as Http
+import Network.Wai qualified as Wai
+import Network.Wai.Handler.Warp qualified as Warp
+import PossehlAnalyticsPrelude
+import ServerErrors (ServerError (..), throwUserErrorTree)
+import Text.Blaze.Html5 (Html, docTypeHtml)
+import Text.Blaze.Renderer.Utf8 (renderMarkup)
+import UnliftIO (MonadUnliftIO (withRunInIO))
+import Prelude hiding (compare)
+
+-- data Routes
+--   = Root
+--   | Register
+--   | RegisterSubmit
+
+-- data Router url = Router
+--   { parse :: Routes.URLParser url,
+--     print :: url -> [Text]
+--   }
+
+-- routerPathInfo :: Routes.PathInfo a => Router a
+-- routerPathInfo =
+--   Router
+--     { parse = Routes.fromPathSegments,
+--       print = Routes.toPathSegments
+--     }
+
+-- subroute :: Text -> Router subUrl -> Router subUrl
+-- subroute path inner =
+--   Router
+--     { parse = Routes.segment path *> inner.parse,
+--       print = \url -> path : inner.print url
+--     }
+
+-- routerLeaf :: a -> Router a
+-- routerLeaf a =
+--   Router
+--     { parse = pure a,
+--       print = \_ -> []
+--     }
+
+-- routerToSite ::
+--   ((url -> [(Text, Maybe Text)] -> Text) -> url -> a) ->
+--   Router url ->
+--   Routes.Site url a
+-- routerToSite handler router =
+--   Routes.Site
+--     { handleSite = handler,
+--       formatPathSegments = (\x -> (x, [])) . router.print,
+--       parsePathSegments = Routes.parseSegments router.parse
+--     }
+
+-- handlers queryParams = \case
+--   Root -> "root"
+--   Register -> "register"
+--   RegisterSubmit -> "registersubmit"
+
+newtype Router handler from to = Router {unRouter :: from -> [Text] -> (Maybe handler, to)}
+  deriving
+    (Functor, Applicative)
+    via ( Compose
+            ((->) from)
+            ( Compose
+                ((->) [Text])
+                ((,) (Monoid.First handler))
+            )
+        )
+
+data Routes r handler = Routes
+  { users :: r (Label "register" handler)
+  }
+
+data Endpoint handler subroutes = Endpoint
+  { root :: handler,
+    subroutes :: subroutes
+  }
+  deriving stock (Show, Eq)
+
+data Handler = Handler {url :: Text}
+
+-- myRoute :: Router () from (Endpoint (Routes (Endpoint ()) Handler) b)
+-- myRoute =
+--   root $ do
+--     users <- fixed "users" () $ fixedFinal @"register" ()
+--     pure $ Routes {..}
+
+-- -- | the root and its children
+-- root :: routes from a -> routes from (Endpoint a b)
+-- root = todo
+
+-- | A fixed sub-route with children
+fixed :: Text -> handler -> Router handler from a -> Router handler from (Endpoint handler a)
+fixed route handler inner = Router $ \from -> \case
+  [final]
+    | route == final ->
+        ( Just handler,
+          Endpoint
+            { root = handler,
+              subroutes = (inner.unRouter from []) & snd
+            }
+        )
+  (this : more)
+    | route == this ->
+        ( (inner.unRouter from more) & fst,
+          Endpoint
+            { root = handler,
+              subroutes = (inner.unRouter from more) & snd
+            }
+        )
+  _ -> (Nothing, Endpoint {root = handler, subroutes = (inner.unRouter from []) & snd})
+
+-- integer ::
+--   forall routeName routes from a.
+--   Router (T2 routeName Integer "more" from) a ->
+--   Router from (Endpoint () a)
+-- integer inner = Router $ \case
+--   (path, []) ->
+--     runFieldParser Field.signedDecimal path
+--   (path, more) ->
+--     inner.unRouter more (runFieldParser Field.signedDecimal path)
+
+-- -- | A leaf route
+-- fixedFinal :: forall route handler from. (KnownSymbol route) => handler -> Router handler from (Label route Handler)
+-- fixedFinal handler = do
+--   let route = symbolText @route
+--   Rounter $ \from -> \case
+--     [final] | route == final -> (Just handler, label @route (Handler from))
+--     _ -> (Nothing, label @route handler)
+
+-- | Get the text of a symbol via TypeApplications
+symbolText :: forall sym. KnownSymbol sym => Text
+symbolText = do
+  symbolVal (Proxy :: Proxy sym)
+    & stringToText
+
+main :: IO ()
+main = runStderrLoggingT @IO $ do
+  withRunInIO @(LoggingT IO) $ \runInIO -> do
+    Warp.run 8080 $ \req respond -> catchServerError respond $ do
+      let respondOk res = Wai.responseLBS Http.ok200 [] (renderMarkup res)
+      let htmlRoot inner =
+            docTypeHtml
+              [hsx|
+            <head>
+              <script src="https://unpkg.com/htmx.org@1.9.2" integrity="sha384-L6OqL9pRWyyFU3+/bjdSri+iIphTN/bvYyM37tICVyOJkWZLpP2vGn6VUEXgzg6h" crossorigin="anonymous"></script>
+            </head>
+            <body>
+              {inner}
+            </body>
+        |]
+      res <-
+        case req & Wai.pathInfo of
+          [] ->
+            pure $
+              respondOk $
+                htmlRoot
+                  [hsx|
+                      <div id="register_buttons">
+                        <button hx-get="/register" hx-target="body" hx-push-url="/register">Register an account</button>
+                        <button hx-get="/login" hx-target="body">Login</button>
+                      </div>
+              |]
+          ["register"] ->
+            pure $ respondOk $ fullEndpoint req $ \case
+              FullPage -> htmlRoot $ registerForm mempty
+              Snippet -> registerForm mempty
+          ["register", "submit"] -> do
+            FormValidation body <-
+              req
+                & parsePostBody
+                  registerFormValidate
+                & runInIO
+            case body of
+              -- if the parse succeeds, ignore any of the data
+              (_, Just a) -> pure $ respondOk $ htmlRoot [hsx|{a}|]
+              (errs, Nothing) -> pure $ respondOk $ htmlRoot $ registerForm errs
+          other ->
+            pure $ respondOk [hsx|no route here at {other}|]
+      respond $ res
+  where
+    catchServerError respond io =
+      Exc.catch io (\(ex :: ServerError) -> respond $ Wai.responseLBS ex.status [] ex.errBody)
+
+parsePostBody ::
+  (MonadIO m, MonadThrow m, MonadLogger m) =>
+  MultipartParseT backend m b ->
+  Wai.Request ->
+  m b
+parsePostBody parser req =
+  Multipart.parseMultipartOrThrow throwUserErrorTree parser req
+
+-- migrate :: IO (Label "numberOfRowsAffected" Natural)
+-- migrate =
+--   Init.runAppTest $ do
+--     runTransaction $
+--       execute
+--         [sql|
+--         CREATE TABLE IF NOT EXISTS experiments.users (
+--           id SERIAL PRIMARY KEY,
+--           email TEXT NOT NULL,
+--           registration_pending_token TEXT NULL
+--         )
+--         |]
+--         ()
+
+data HsxRequest
+  = Snippet
+  | FullPage
+
+fullEndpoint :: Wai.Request -> (HsxRequest -> t) -> t
+fullEndpoint req act = do
+  let isHxRequest = req & Wai.requestHeaders & List.find (\h -> (h & fst) == "HX-Request") & Maybe.isJust
+  if isHxRequest
+    then act Snippet
+    else act FullPage
+
+data FormField = FormField
+  { label_ :: Html,
+    required :: Bool,
+    id_ :: Text,
+    name :: ByteString,
+    type_ :: Text,
+    placeholder :: Maybe Text
+  }
+
+inputHtml ::
+  FormField ->
+  DList FormValidationResult ->
+  Html
+inputHtml (FormField {..}) validationResults = do
+  let validation =
+        validationResults
+          & toList
+          & mapMaybe
+            ( \v ->
+                if v.formFieldName == name
+                  then
+                    Just
+                      ( T2
+                          (label @"errors" (maybeToList v.hasError))
+                          (label @"originalValue" (Monoid.First (Just v.originalValue)))
+                      )
+                  else Nothing
+            )
+          & mconcat
+  let isFirstError =
+        validationResults
+          & List.find (\res -> Maybe.isJust res.hasError && res.formFieldName == name)
+          & Maybe.isJust
+  [hsx|
+      <label for={id_}>{label_}
+        <input
+          autofocus={isFirstError}
+          onfocus="this.select()"
+          required={required}
+          id={id_}
+          name={name}
+          type={type_}
+          placeholder={placeholder}
+          value={validation.originalValue.getFirst}
+        />
+        <p id="{id_}.validation">{validation.errors & nonEmpty <&> toList <&> map prettyError <&> Text.intercalate "; "}</p>
+      </label>
+  |]
+
+registerForm :: DList FormValidationResult -> Html
+registerForm validationErrors =
+  let fields =
+        mconcat
+          [ inputHtml $
+              FormField
+                { label_ = "Your Email:",
+                  required = True,
+                  id_ = "register_email",
+                  name = "email",
+                  type_ = "email",
+                  placeholder = Just "your@email.com"
+                },
+            inputHtml $
+              FormField
+                { label_ = "New password:",
+                  required = True,
+                  id_ = "register_password",
+                  name = "password",
+                  type_ = "password",
+                  placeholder = Just "hunter2"
+                },
+            inputHtml $
+              FormField
+                { label_ = "Repeated password:",
+                  required = True,
+                  id_ = "register_password_repeated",
+                  name = "password_repeated",
+                  type_ = "password",
+                  placeholder = Just "hunter2"
+                }
+          ]
+   in [hsx|
+  <form hx-post="/register/submit">
+    <fieldset>
+      <legend>Register user</legend>
+      {fields validationErrors}
+      <button id="register_submit_button" name="register">
+        Register
+      </button>
+    </fieldset>
+  </form>
+  |]
+
+registerFormValidate ::
+  Applicative m =>
+  MultipartParseT
+    w
+    m
+    (FormValidation (T2 "email" ByteString "password" ByteString))
+registerFormValidate = do
+  let emailFP = FieldParser $ \b ->
+        if
+            | Bytes.elem (charToWordUnsafe '@') b -> Right b
+            | otherwise -> Left [fmt|This is not an email address: "{b & bytesToTextUtf8Unsafe}"|]
+
+  getCompose @(MultipartParseT _ _) @FormValidation $ do
+    email <- Compose $ Multipart.fieldLabel' @"email" "email" emailFP
+    password <-
+      aEqB
+        "password_repeated"
+        "The two password fields must be the same"
+        (Compose $ Multipart.field' "password" Cat.id)
+        (\field -> Compose $ Multipart.field' field Cat.id)
+    pure $ T2 email (label @"password" password)
+  where
+    aEqB field validateErr fCompare fValidate =
+      Selective.fromMaybeS
+        -- TODO: this check only reached if the field itself is valid. Could we combine those errors?
+        (Compose $ pure $ failFormValidation (T2 (label @"formFieldName" field) (label @"originalValue" "")) validateErr)
+        $ do
+          compare <- fCompare
+          validate <- fValidate field
+          pure $ if compare == validate then Just validate else Nothing
+
+-- | A lifted version of 'Data.Maybe.fromMaybe'.
+fromMaybeS :: Selective f => f a -> f (Maybe a) -> f a
+fromMaybeS ifNothing fma =
+  select
+    ( fma <&> \case
+        Nothing -> Left ()
+        Just a -> Right a
+    )
+    ( do
+        a <- ifNothing
+        pure (\() -> a)
+    )
diff --git a/users/Profpatsch/htmx-experiment/src/ServerErrors.hs b/users/Profpatsch/htmx-experiment/src/ServerErrors.hs
new file mode 100644
index 0000000000..0fca7ab464
--- /dev/null
+++ b/users/Profpatsch/htmx-experiment/src/ServerErrors.hs
@@ -0,0 +1,244 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module ServerErrors where
+
+import Control.Exception (Exception)
+import Control.Monad.Logger (MonadLogger, logError, logWarn)
+import Data.ByteString.Lazy qualified as Bytes.Lazy
+import Data.Error.Tree
+import Network.HTTP.Types qualified as Http
+import PossehlAnalyticsPrelude
+
+data ServerError = ServerError
+  { status :: Http.Status,
+    errBody :: Bytes.Lazy.ByteString
+  }
+  deriving stock (Show)
+  deriving anyclass (Exception)
+
+emptyServerError :: Http.Status -> ServerError
+emptyServerError status = ServerError {status, errBody = ""}
+
+-- | Throw a user error.
+--
+-- “User” here is a client using our API, not a human user.
+-- So we throw a `HTTP 400` error, which means the API was used incorrectly.
+--
+-- We also log the error as a warning, because it probably signifies a programming bug in our client.
+--
+-- If you need to display a message to a human user, return a `FrontendResponse`
+-- or a structured type with translation keys (so we can localize the errors).
+throwUserError ::
+  (MonadLogger m, MonadThrow m) =>
+  -- | The error to log & throw to the user
+  Error ->
+  m b
+throwUserError err = do
+  -- TODO: should we make this into a macro to keep the line numbers?
+  $logWarn (err & errorContext "There was a “user holding it wrong” error, check the client code" & prettyError)
+  throwM
+    ServerError
+      { status = Http.badRequest400,
+        errBody = err & prettyError & textToBytesUtf8 & toLazyBytes
+      }
+
+-- | Throw a user error.
+--
+-- “User” here is a client using our API, not a human user.
+-- So we throw a `HTTP 400` error, which means the API was used incorrectly.
+--
+-- We also log the error as a warning, because it probably signifies a programming bug in our client.
+--
+-- If you need to display a message to a human user, return a `FrontendResponse`
+-- or a structured type with translation keys (so we can localize the errors).
+throwUserErrorTree ::
+  (MonadLogger m, MonadThrow m) =>
+  -- | The error to log & throw to the user
+  ErrorTree ->
+  m b
+throwUserErrorTree err = do
+  -- TODO: should we make this into a macro to keep the line numbers?
+  $logWarn (err & nestedError "There was a “user holding it wrong” error, check the client code" & prettyErrorTree)
+  throwM
+    ServerError
+      { status = Http.badRequest400,
+        errBody = err & prettyErrorTree & textToBytesUtf8 & toLazyBytes
+      }
+
+-- | Unwrap the `Either` and if `Left` throw a user error.
+--
+-- Intended to use in a pipeline, e.g.:
+--
+-- @@
+-- doSomething
+--   >>= orUserError "Oh no something did not work"
+--   >>= doSomethingElse
+-- @@
+--
+-- “User” here is a client using our API, not a human user.
+-- So we throw a `HTTP 400` error, which means the API was used incorrectly.
+--
+-- We also log the error as a warning, because it probably signifies a programming bug in our client.
+--
+-- If you need to display a message to a human user, return a `FrontendResponse`
+-- or a structured type with translation keys (so we can localize the errors).
+orUserError ::
+  (MonadThrow m, MonadLogger m) =>
+  -- | The message to add as a context to the error being thrown
+  Text ->
+  -- | Result to unwrap and potentially throw
+  Either Error a ->
+  m a
+orUserError outerMsg eErrA =
+  orUserErrorTree outerMsg (first singleError eErrA)
+
+-- | Unwrap the `Either` and if `Left` throw a user error. Will pretty-print the 'ErrorTree'
+--
+-- Intended to use in a pipeline, e.g.:
+--
+-- @@
+-- doSomething
+--   >>= orUserErrorTree "Oh no something did not work"
+--   >>= doSomethingElse
+-- @@
+--
+-- “User” here is a client using our API, not a human user.
+-- So we throw a `HTTP 400` error, which means the API was used incorrectly.
+--
+-- We also log the error as a warning, because it probably signifies a programming bug in our client.
+--
+-- If you need to display a message to a human user, return a `FrontendResponse`
+-- or a structured type with translation keys (so we can localize the errors).
+orUserErrorTree ::
+  (MonadThrow m, MonadLogger m) =>
+  -- | The message to add as a context to the 'ErrorTree' being thrown
+  Text ->
+  -- | Result to unwrap and potentially throw
+  Either ErrorTree a ->
+  m a
+orUserErrorTree outerMsg = \case
+  Right a -> pure a
+  Left err -> do
+    -- TODO: this outer message should probably be added as a separate root instead of adding to the root error?
+    let tree = errorTreeContext outerMsg err
+    -- TODO: should we make this into a macro to keep the line numbers?
+    $logWarn (errorTreeContext "There was a “user holding it wrong” error, check the client code" tree & prettyErrorTree)
+    throwM
+      ServerError
+        { status = Http.badRequest400,
+          errBody = tree & prettyErrorTree & textToBytesUtf8 & toLazyBytes
+        }
+
+-- | Throw an internal error.
+--
+-- “Internal” here means some assertion that we depend on failed,
+-- e.g. some database request returned a wrong result/number of results
+-- or some invariant that we expect to hold failed.
+--
+-- This prints the full error to the log,
+-- and returns a “HTTP 500” error without the message.
+--
+-- If you want to signify a mishandling of the API (e.g. a wrong request), throw a `userError`.
+-- If you need to display a message to a human user, return a `FrontendResponse`
+-- or a structured type with translation keys (so we can localize the errors).
+throwInternalError ::
+  (MonadLogger m, MonadThrow m) =>
+  -- | The error to log internally
+  Error ->
+  m b
+throwInternalError err = do
+  -- TODO: should we make this into a macro to keep the line numbers?
+  $logError
+    (err & prettyError)
+  throwM $ emptyServerError Http.internalServerError500
+
+-- | Throw an internal error.
+--
+-- “Internal” here means some assertion that we depend on failed,
+-- e.g. some database request returned a wrong result/number of results
+-- or some invariant that we expect to hold failed.
+--
+-- This prints the full error to the log,
+-- and returns a “HTTP 500” error without the message.
+--
+-- If you want to signify a mishandling of the API (e.g. a wrong request), throw a `userError`.
+-- If you need to display a message to a human user, return a `FrontendResponse`
+-- or a structured type with translation keys (so we can localize the errors).
+throwInternalErrorTree ::
+  (MonadLogger m, MonadThrow m) =>
+  -- | The error to log internally
+  ErrorTree ->
+  m b
+throwInternalErrorTree err = do
+  -- TODO: should we make this into a macro to keep the line numbers?
+  $logError
+    (err & prettyErrorTree)
+  throwM $ emptyServerError   Http.internalServerError500
+
+-- | Unwrap the `Either` and if `Left` throw an internal error.
+--
+-- Intended to use in a pipeline, e.g.:
+--
+-- @@
+-- doSomething
+--   >>= orInternalError "Oh no something did not work"
+--   >>= doSomethingElse
+-- @@
+--
+-- “Internal” here means some assertion that we depend on failed,
+-- e.g. some database request returned a wrong result/number of results
+-- or some invariant that we expect to hold failed.
+--
+-- This prints the full error to the log,
+-- and returns a “HTTP 500” error without the message.
+--
+-- If you want to signify a mishandling of the API (e.g. a wrong request), throw a `userError`.
+-- If you need to display a message to a human user, return a `FrontendResponse`
+-- or a structured type with translation keys (so we can localize the errors).
+orInternalError ::
+  (MonadThrow m, MonadLogger m) =>
+  -- | The message to add as a context to the error being thrown
+  Text ->
+  -- | Result to unwrap and potentially throw
+  Either Error a ->
+  m a
+orInternalError outerMsg eErrA = orInternalErrorTree outerMsg (first singleError eErrA)
+
+-- | Unwrap the `Either` and if `Left` throw an internal error. Will pretty-print the 'ErrorTree'.
+--
+-- Intended to use in a pipeline, e.g.:
+--
+-- @@
+-- doSomething
+--   >>= orInternalErrorTree "Oh no something did not work"
+--   >>= doSomethingElse
+-- @@
+--
+-- “Internal” here means some assertion that we depend on failed,
+-- e.g. some database request returned a wrong result/number of results
+-- or some invariant that we expect to hold failed.
+--
+-- This prints the full error to the log,
+-- and returns a “HTTP 500” error without the message.
+--
+-- If you want to signify a mishandling of the API (e.g. a wrong request), throw a `userError`.
+-- If you need to display a message to a human user, return a `FrontendResponse`
+-- or a structured type with translation keys (so we can localize the errors).
+orInternalErrorTree ::
+  (MonadThrow m, MonadLogger m) =>
+  -- | The message to add as a context to the 'ErrorTree' being thrown
+  Text ->
+  -- | Result to unwrap and potentially throw
+  Either ErrorTree a ->
+  m a
+orInternalErrorTree outerMsg = \case
+  Right a -> pure a
+  Left err -> do
+    -- TODO: this outer message should probably be added as a separate root instead of adding to the root error?
+    let tree = errorTreeContext outerMsg err
+    -- TODO: should we make this into a macro to keep the line numbers?
+    $logError (tree & prettyErrorTree)
+    throwM $ emptyServerError   Http.internalServerError500
diff --git a/users/Profpatsch/htmx-experiment/src/ValidationParseT.hs b/users/Profpatsch/htmx-experiment/src/ValidationParseT.hs
new file mode 100644
index 0000000000..ffb6c2f395
--- /dev/null
+++ b/users/Profpatsch/htmx-experiment/src/ValidationParseT.hs
@@ -0,0 +1,40 @@
+module ValidationParseT where
+
+import Control.Monad.Logger (MonadLogger)
+import Control.Selective (Selective)
+import Data.Error.Tree
+import Data.Functor.Compose (Compose (..))
+import PossehlAnalyticsPrelude
+import ServerErrors
+
+-- | A simple way to create an Applicative parser that parses from some environment.
+--
+-- Use with DerivingVia. Grep codebase for examples.
+newtype ValidationParseT env m a = ValidationParseT {unValidationParseT :: env -> m (Validation (NonEmpty Error) a)}
+  deriving
+    (Functor, Applicative, Selective)
+    via ( Compose
+            ((->) env)
+            (Compose m (Validation (NonEmpty Error)))
+        )
+
+-- | Helper that runs the given parser and throws a user error if the parsing failed.
+runValidationParseTOrUserError ::
+  forall validationParseT env m a.
+  ( Coercible validationParseT (ValidationParseT env m a),
+    MonadLogger m,
+    MonadThrow m
+  ) =>
+  -- | toplevel error message to throw if the parsing fails
+  Error ->
+  -- | The parser which should be run
+  validationParseT ->
+  -- | input to the parser
+  env ->
+  m a
+{-# INLINE runValidationParseTOrUserError #-}
+runValidationParseTOrUserError contextError parser env =
+  (coerce @_ @(ValidationParseT _ _ _) parser).unValidationParseT env
+    >>= \case
+      Failure errs -> throwUserErrorTree (errorTree contextError errs)
+      Success a -> pure a
diff --git a/users/Profpatsch/httzip/Httzip.hs b/users/Profpatsch/httzip/Httzip.hs
new file mode 100644
index 0000000000..761cd1d2ea
--- /dev/null
+++ b/users/Profpatsch/httzip/Httzip.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Main where
+
+import Conduit ((.|))
+import Data.Binary.Builder qualified as Builder
+import Data.Conduit qualified as Cond
+import Data.Conduit.Combinators qualified as Cond
+import Data.Conduit.Process.Typed qualified as Cond
+import Data.Conduit.Process.Typed qualified as Proc
+import Data.List qualified as List
+import Data.Text qualified as Text
+import Network.HTTP.Types qualified as Http
+import Network.Wai qualified as Wai
+import Network.Wai.Conduit qualified as Wai.Conduit
+import Network.Wai.Handler.Warp qualified as Warp
+import PossehlAnalyticsPrelude
+import System.Directory qualified as Dir
+import System.FilePath ((</>))
+import System.FilePath qualified as File
+import System.Posix qualified as Unix
+
+-- Webserver that returns folders under CWD as .zip archives (recursively)
+main :: IO ()
+main = do
+  currentDirectory <- Dir.getCurrentDirectory >>= Dir.canonicalizePath
+  run currentDirectory
+
+run :: FilePath -> IO ()
+run dir = do
+  currentDirectory <- Dir.canonicalizePath dir
+  putStderrLn $ [fmt|current {show currentDirectory}|]
+  Warp.run 7070 $ \req respond -> do
+    let respondHtml status content = respond $ Wai.responseLBS status [("Content-Type", "text/html")] content
+    case req & Wai.pathInfo of
+      [] -> respond $ Wai.responseLBS Http.status200 [("Content-Type", "text/html")] "any directory will be returned as .zip!"
+      filePath -> do
+        absoluteWantedFilepath <- Dir.canonicalizePath (currentDirectory </> (File.joinPath (filePath <&> textToString)))
+        -- I hope this prevents any shenanigans lol
+        let noCurrentDirPrefix = List.stripPrefix (File.addTrailingPathSeparator currentDirectory) absoluteWantedFilepath
+        if
+            | (any (Text.elem '/') filePath) -> putStderrLn "tried %2F encoding" >> respondHtml Http.status400 "no"
+            | Nothing <- noCurrentDirPrefix -> putStderrLn "tried parent dir with .." >> respondHtml Http.status400 "no^2"
+            | Just wantedFilePath <- noCurrentDirPrefix -> do
+                putStderrLn $ [fmt|wanted {show wantedFilePath}|]
+                ex <- Unix.fileExist wantedFilePath
+                if ex
+                  then do
+                    status <- Unix.getFileStatus wantedFilePath
+                    if status & Unix.isDirectory
+                      then do
+                        zipDir <- zipDirectory wantedFilePath
+                        Proc.withProcessWait zipDir $ \process -> do
+                          let stream =
+                                Proc.getStdout process
+                                  .| Cond.map (\bytes -> Cond.Chunk $ Builder.fromByteString bytes)
+                          -- TODO: how to handle broken zip? Is it just gonna return a 500? But the stream is already starting, so hard!
+                          respond $ Wai.Conduit.responseSource Http.ok200 [("Content-Type", "application/zip")] stream
+                      else respondHtml Http.status404 "not found"
+                  else respondHtml Http.status404 "not found"
+  where
+    zipDirectory toZipDir = do
+      putStderrLn [fmt|running $ zip {show ["--recurse-paths", "-", toZipDir]}|]
+      pure $
+        Proc.proc "zip" ["--recurse-paths", "-", toZipDir]
+          & Proc.setStdout Cond.createSource
diff --git a/users/Profpatsch/httzip/default.nix b/users/Profpatsch/httzip/default.nix
new file mode 100644
index 0000000000..35d8a69d56
--- /dev/null
+++ b/users/Profpatsch/httzip/default.nix
@@ -0,0 +1,40 @@
+{ depot, pkgs, lib, ... }:
+
+let
+
+  httzip = pkgs.haskellPackages.mkDerivation {
+    pname = "httzip";
+    version = "0.1.0";
+
+    src = depot.users.Profpatsch.exactSource ./. [
+      ./httzip.cabal
+      ./Httzip.hs
+    ];
+
+    libraryHaskellDepends = [
+      pkgs.haskellPackages.pa-prelude
+      pkgs.haskellPackages.warp
+      pkgs.haskellPackages.wai
+      pkgs.haskellPackages.wai-conduit
+      pkgs.haskellPackages.conduit-extra
+      pkgs.haskellPackages.conduit
+    ];
+
+    isExecutable = true;
+    isLibrary = false;
+    license = lib.licenses.mit;
+  };
+
+  bins = depot.nix.getBins httzip [ "httzip" ];
+
+in
+depot.nix.writeExecline "httzip-wrapped" { } [
+  "importas"
+  "-i"
+  "PATH"
+  "PATH"
+  "export"
+  "PATH"
+  "${pkgs.zip}/bin:$${PATH}"
+  bins.httzip
+]
diff --git a/users/Profpatsch/httzip/httzip.cabal b/users/Profpatsch/httzip/httzip.cabal
new file mode 100644
index 0000000000..c463a6a5fe
--- /dev/null
+++ b/users/Profpatsch/httzip/httzip.cabal
@@ -0,0 +1,73 @@
+cabal-version:      3.0
+name:               httzip
+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 httzip
+    import: common-options
+
+    main-is:          Httzip.hs
+
+    build-depends:
+        base >=4.15 && <5,
+        pa-prelude,
+        bytestring,
+        text,
+        warp,
+        wai,
+        http-types,
+        directory,
+        filepath,
+        unix,
+        wai-conduit,
+        conduit,
+        conduit-extra,
+        binary
diff --git a/users/Profpatsch/ical-smolify/IcalSmolify.hs b/users/Profpatsch/ical-smolify/IcalSmolify.hs
new file mode 100644
index 0000000000..77264d1693
--- /dev/null
+++ b/users/Profpatsch/ical-smolify/IcalSmolify.hs
@@ -0,0 +1,124 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# OPTIONS_GHC -Wall #-}
+
+module Main where
+
+import qualified Data.ByteString.Lazy as Bytes.Lazy
+import qualified Data.CaseInsensitive as CaseInsensitive
+import qualified Data.Default as Default
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import ExecHelpers (dieUserError, CurrentProgramName)
+import MyPrelude
+import qualified System.Environment as Env
+import Text.ICalendar
+import Prelude hiding (log)
+
+main :: IO ()
+main = do
+  Env.getArgs >>= \case
+    [] -> dieUserError progName "First argument must be the ics file name"
+    (file : _) ->
+      do
+        parse file
+        >>= traverse_
+          ( \vcal ->
+              vcal
+                & stripSingleTimezone
+                & minify
+                & printICalendar Default.def
+                & Bytes.Lazy.putStr
+          )
+
+progName :: CurrentProgramName
+progName = "ical-smolify"
+
+log :: Error -> IO ()
+log err = do
+  putStderrLn (errorContext "ical-smolify" err & prettyError)
+
+parse :: FilePath -> IO [VCalendar]
+parse file = do
+  parseICalendarFile Default.def file >>= \case
+    Left err -> do
+      dieUserError progName [fmt|Cannot parse ical file: {err}|]
+    Right (cals, warnings) -> do
+      for_ warnings (\warn -> log [fmt|Warning: {warn}|])
+      pure cals
+
+-- | Converts a single timezone definition to the corresponding X-WR-Timezone field.
+stripSingleTimezone :: VCalendar -> VCalendar
+stripSingleTimezone vcal =
+  case vcal & vcTimeZones & Map.toList of
+    [] -> vcal
+    [(_, tz)] -> do
+      let xtz =
+            OtherProperty
+              { otherName = CaseInsensitive.mk "X-WR-TIMEZONE",
+                otherValue = tz & vtzId & tzidValue & textToBytesUtf8Lazy,
+                otherParams = OtherParams Set.empty
+              }
+      vcal
+        { vcOther =
+            vcal & vcOther
+              -- remove any existing x-wr-timezone fields
+              & Set.filter (\prop -> (prop & otherName) /= (xtz & otherName))
+              & Set.insert xtz,
+          vcTimeZones = Map.empty
+        }
+    _more -> vcal
+
+-- | Minify the vcalendar event by throwing away everything that’s not an event.
+minify :: VCalendar -> VCalendar
+minify vcal =
+  vcal
+    { vcProdId = ProdId "" (OtherParams Set.empty),
+      -- , vcVersion    :: ICalVersion
+      -- , vcScale      :: Scale
+      -- , vcMethod     :: Maybe Method
+      -- , vcOther      :: …
+      -- , vcTimeZones  :: Map Text VTimeZone
+      vcEvents = Map.map minifyEvent (vcal & vcEvents),
+      vcTodos = Map.empty,
+      vcJournals = Map.empty,
+      vcFreeBusys = Map.empty,
+      vcOtherComps = Set.empty
+    }
+
+minifyEvent :: VEvent -> VEvent
+minifyEvent vev =
+  vev
+--  { veDTStamp       :: DTStamp
+--   , veUID           :: UID
+--   , veClass         :: Class -- ^ 'def' = 'Public'
+--   , veDTStart       :: Maybe DTStart
+--   , veCreated       :: Maybe Created
+--   , veDescription   :: Maybe Description
+--   , veGeo           :: Maybe Geo
+--   , veLastMod       :: Maybe LastModified
+--   , veLocation      :: Maybe Location
+--   , veOrganizer     :: Maybe Organizer
+--   , vePriority      :: Priority -- ^ 'def' = 0
+--   , veSeq           :: Sequence -- ^ 'def' = 0
+--   , veStatus        :: Maybe EventStatus
+--   , veSummary       :: Maybe Summary
+--   , veTransp        :: TimeTransparency -- ^ 'def' = 'Opaque'
+--   , veUrl           :: Maybe URL
+--   , veRecurId       :: Maybe RecurrenceId
+--   , veRRule         :: Set RRule
+--   , veDTEndDuration :: Maybe (Either DTEnd DurationProp)
+--   , veAttach        :: Set Attachment
+--   , veAttendee      :: Set Attendee
+--   , veCategories    :: Set Categories
+--   , veComment       :: Set Comment
+--   , veContact       :: Set Contact
+--   , veExDate        :: Set ExDate
+--   , veRStatus       :: Set RequestStatus
+--   , veRelated       :: Set RelatedTo
+--   , veResources     :: Set Resources
+--   , veRDate         :: Set RDate
+--   , veAlarms        :: Set VAlarm
+--   , veOther         :: Set OtherProperty
+--   }
diff --git a/users/Profpatsch/ical-smolify/README.md b/users/Profpatsch/ical-smolify/README.md
new file mode 100644
index 0000000000..86c166d3c1
--- /dev/null
+++ b/users/Profpatsch/ical-smolify/README.md
@@ -0,0 +1,5 @@
+# ical-smolify
+
+Ensmallen an `ical` by stripping out redundant information like timezone definitions.
+
+The idea here was that after running through this preprocessor, it fits into a QR code (~2000bits) that can be scanned with your phone (for automatically adding to mobile calendar).
diff --git a/users/Profpatsch/ical-smolify/default.nix b/users/Profpatsch/ical-smolify/default.nix
new file mode 100644
index 0000000000..bf766db0e9
--- /dev/null
+++ b/users/Profpatsch/ical-smolify/default.nix
@@ -0,0 +1,23 @@
+{ depot, pkgs, lib, ... }:
+
+let
+  ical-smolify = pkgs.writers.writeHaskell "ical-smolify"
+    {
+      libraries = [
+        pkgs.haskellPackages.iCalendar
+        depot.users.Profpatsch.my-prelude
+        depot.users.Profpatsch.execline.exec-helpers-hs
+
+      ];
+      ghcArgs = [ "-threaded" ];
+    } ./IcalSmolify.hs;
+
+in
+
+ical-smolify.overrideAttrs (old: {
+  meta = lib.recursiveUpdate old.meta or { } {
+    # Dependency iCalendar no longer builds in nixpkgs due to a lack of maintenance upstream
+    # https://github.com/nixos/nixpkgs/commit/13d10cc6e302e7d5800c6a08c1728b14c3801e26
+    ci.skip = true;
+  };
+})
diff --git a/users/Profpatsch/ical-smolify/ical-smolify.cabal b/users/Profpatsch/ical-smolify/ical-smolify.cabal
new file mode 100644
index 0000000000..d7a46c581d
--- /dev/null
+++ b/users/Profpatsch/ical-smolify/ical-smolify.cabal
@@ -0,0 +1,18 @@
+cabal-version:      3.0
+name:               ical-smolify
+version:            0.1.0.0
+author:             Profpatsch
+maintainer:         mail@profpatsch.de
+
+executable ical-smolify
+    main-is: IcalSmolify.hs
+
+    build-depends:
+        base >=4.15 && <5,
+        my-prelude,
+        exec-helpers
+        data-default
+        case-insensitive
+        iCalendar
+
+    default-language: Haskell2010
diff --git a/users/Profpatsch/imap-idle.nix b/users/Profpatsch/imap-idle.nix
index 3ad5375d89..84af5d0e54 100644
--- a/users/Profpatsch/imap-idle.nix
+++ b/users/Profpatsch/imap-idle.nix
@@ -1,14 +1,17 @@
 { depot, pkgs, lib, ... }:
 
 let
-  imap-idle = depot.nix.writers.rustSimple {
-    name = "imap-idle";
-    dependencies = [
-      depot.users.Profpatsch.arglib.netencode.rust
-      depot.third_party.rust-crates.imap
-      depot.third_party.rust-crates.epoll
-      depot.users.Profpatsch.execline.exec-helpers
-    ];
-  } (builtins.readFile ./imap-idle.rs);
+  imap-idle = depot.nix.writers.rustSimple
+    {
+      name = "imap-idle";
+      dependencies = [
+        depot.users.Profpatsch.arglib.netencode.rust
+        depot.third_party.rust-crates.imap
+        depot.third_party.rust-crates.epoll
+        depot.users.Profpatsch.execline.exec-helpers
+      ];
+    }
+    (builtins.readFile ./imap-idle.rs);
 
-in imap-idle
+in
+imap-idle
diff --git a/users/Profpatsch/imap-idle.rs b/users/Profpatsch/imap-idle.rs
index 9dce736d0d..937847b879 100644
--- a/users/Profpatsch/imap-idle.rs
+++ b/users/Profpatsch/imap-idle.rs
@@ -1,16 +1,16 @@
 extern crate exec_helpers;
 // extern crate arglib_netencode;
 // extern crate netencode;
-extern crate imap;
 extern crate epoll;
+extern crate imap;
 
 // use netencode::dec;
+use imap::extensions::idle::SetReadTimeout;
 use std::convert::TryFrom;
-use std::io::{Read, Write};
 use std::fs::File;
-use std::os::unix::io::{FromRawFd, AsRawFd, RawFd};
+use std::io::{Read, Write};
+use std::os::unix::io::{AsRawFd, FromRawFd, RawFd};
 use std::time::Duration;
-use imap::extensions::idle::SetReadTimeout;
 
 /// Implements an UCSPI client that wraps fd 6 & 7
 /// and implements Write and Read with a timeout.
@@ -33,7 +33,7 @@ impl UcspiClient {
                 read: File::from_raw_fd(6),
                 read_epoll_fd,
                 read_timeout: None,
-                write: File::from_raw_fd(7)
+                write: File::from_raw_fd(7),
             })
         }
     }
@@ -54,21 +54,23 @@ impl SetReadTimeout for UcspiClient {
 impl Read for UcspiClient {
     // TODO: test the epoll code with a short timeout
     fn read(&mut self, buf: &mut [u8]) -> std::io::Result<usize> {
-        const NO_DATA : u64 = 0;
+        const NO_DATA: u64 = 0;
         // in order to implement the read_timeout,
         // we use epoll to wait for either data or time out
         epoll::ctl(
             self.read_epoll_fd,
             epoll::ControlOptions::EPOLL_CTL_ADD,
             self.read.as_raw_fd(),
-            epoll::Event::new(epoll::Events::EPOLLIN, NO_DATA)
+            epoll::Event::new(epoll::Events::EPOLLIN, NO_DATA),
         )?;
         let UNUSED = epoll::Event::new(epoll::Events::EPOLLIN, NO_DATA);
         let wait = epoll::wait(
             self.read_epoll_fd,
             match self.read_timeout {
-                Some(duration) => i32::try_from(duration.as_millis()).expect("duration too big for epoll"),
-                None => -1 // infinite
+                Some(duration) => {
+                    i32::try_from(duration.as_millis()).expect("duration too big for epoll")
+                }
+                None => -1, // infinite
             },
             // event that was generated; but we don’t care
             &mut vec![UNUSED; 1][..],
@@ -79,11 +81,14 @@ impl Read for UcspiClient {
             self.read_epoll_fd,
             epoll::ControlOptions::EPOLL_CTL_DEL,
             self.read.as_raw_fd(),
-            UNUSED
+            UNUSED,
         )?;
         match wait {
             // timeout happened (0 events)
-            Ok(0) => Err(std::io::Error::new(std::io::ErrorKind::TimedOut, "ucspi read timeout")),
+            Ok(0) => Err(std::io::Error::new(
+                std::io::ErrorKind::TimedOut,
+                "ucspi read timeout",
+            )),
             // its ready for reading, we can read
             Ok(_) => self.read.read(buf),
             // error
@@ -110,18 +115,21 @@ fn main() {
     let username = std::env::var("IMAP_USERNAME").expect("username");
     let password = std::env::var("IMAP_PASSWORD").expect("password");
 
-    let net = unsafe {
-        UcspiClient::new_from_6_and_7().expect("no ucspi client for you")
-    };
+    let net = unsafe { UcspiClient::new_from_6_and_7().expect("no ucspi client for you") };
     let client = imap::Client::new(net);
-    let mut session = client.login(username, password).map_err(|(err, _)| err).expect("unable to login");
+    let mut session = client
+        .login(username, password)
+        .map_err(|(err, _)| err)
+        .expect("unable to login");
     eprintln!("{:#?}", session);
     let list = session.list(None, Some("*"));
     eprintln!("{:#?}", list);
     let mailbox = session.examine("INBOX");
     eprintln!("{:#?}", mailbox);
     fn now() -> String {
-        String::from_utf8_lossy(&std::process::Command::new("date").output().unwrap().stdout).trim_right().to_string()
+        String::from_utf8_lossy(&std::process::Command::new("date").output().unwrap().stdout)
+            .trim_right()
+            .to_string()
     }
     loop {
         eprintln!("{}: idling on INBOX", now());
diff --git a/users/Profpatsch/importDhall.nix b/users/Profpatsch/importDhall.nix
new file mode 100644
index 0000000000..1947ad1ce1
--- /dev/null
+++ b/users/Profpatsch/importDhall.nix
@@ -0,0 +1,93 @@
+{ pkgs, depot, lib, ... }:
+let
+
+  # import the dhall file as nix expression via dhall-nix.
+  # Converts the normalized dhall expression to a nix file,
+  # puts it in the store and imports it.
+  # Types are erased, functions are converted to nix functions,
+  # unions values are nix functions that take a record of match
+  # functions for their alternatives.
+  # TODO: document better
+  importDhall =
+    {
+      # Root path of the dhall file tree to import (will be filtered by files)
+      root
+    , # A list of files which should be taken from `root` (relative paths).
+      # This is for minimizing the amount of things that have to be copied to the store.
+      # TODO: can you have directory prefixes?
+      files
+    , # The path of the dhall file which should be evaluated, relative to `root`, has to be in `files`
+      main
+    , # List of dependencies (TODO: what is a dependency?)
+      deps
+    , # dhall type of `main`, or `null` if anything should be possible.
+      type ? null
+    }:
+    let
+      absRoot = path: toString root + "/" + path;
+      src =
+        depot.users.Profpatsch.exactSource
+          root
+          # exactSource wants nix paths, but I think relative paths
+          # as strings are more intuitive.
+          ([ (absRoot main) ] ++ (map absRoot files));
+
+      cache = ".cache";
+      cacheDhall = "${cache}/dhall";
+
+      hadTypeAnnot = type != null;
+      typeAnnot = lib.optionalString hadTypeAnnot ": ${type}";
+
+      convert = pkgs.runCommandLocal "dhall-to-nix" { inherit deps; } ''
+        mkdir -p ${cacheDhall}
+        for dep in $deps; do
+          ${pkgs.xorg.lndir}/bin/lndir -silent $dep/${cacheDhall} ${cacheDhall}
+        done
+
+        export XDG_CACHE_HOME=$(pwd)/${cache}
+        # go into the source directory, so that the type can import files.
+        # TODO: This is a bit of a hack hrm.
+        cd "${src}"
+        printf 'Generating dhall nix code. Run
+        %s --file %s
+        to reproduce
+        ' \
+          ${pkgs.dhall}/bin/dhall \
+          ${absRoot main}
+        ${if hadTypeAnnot then ''
+            printf '%s' ${lib.escapeShellArg "${src}/${main} ${typeAnnot}"} \
+              | ${pkgs.dhall-nix}/bin/dhall-to-nix \
+              > $out
+          ''
+          else ''
+            printf 'No type annotation given, the dhall expression type was:\n'
+            ${pkgs.dhall}/bin/dhall type --file "${src}/${main}"
+            printf '%s' ${lib.escapeShellArg "${src}/${main}"} \
+              | ${pkgs.dhall-nix}/bin/dhall-to-nix \
+              > $out
+          ''}
+
+      '';
+    in
+    import convert;
+
+
+  # read dhall file in as JSON, then import as nix expression.
+  # The dhall file must not try to import from non-local URLs!
+  readDhallFileAsJson = dhallType: file:
+    let
+      convert = pkgs.runCommandLocal "dhall-to-json" { } ''
+        printf '%s' ${lib.escapeShellArg "${file} : ${dhallType}"} \
+          | ${pkgs.dhall-json}/bin/dhall-to-json \
+          > $out
+      '';
+    in
+    builtins.fromJSON (builtins.readFile convert);
+
+in
+{
+  inherit
+    importDhall
+    readDhallFileAsJson
+    ;
+}
diff --git a/users/Profpatsch/ini/default.nix b/users/Profpatsch/ini/default.nix
new file mode 100644
index 0000000000..e1a7a1a7b6
--- /dev/null
+++ b/users/Profpatsch/ini/default.nix
@@ -0,0 +1,6 @@
+{ depot, ... }:
+{
+  externs = {
+    renderIni = depot.users.Profpatsch.toINI { };
+  };
+}
diff --git a/users/Profpatsch/ini/ini.dhall b/users/Profpatsch/ini/ini.dhall
new file mode 100644
index 0000000000..f2efbc0af4
--- /dev/null
+++ b/users/Profpatsch/ini/ini.dhall
@@ -0,0 +1,36 @@
+let lib = ../dhall/lib.dhall
+
+let NameVal = λ(T : Type) → { name : Text, value : T }
+
+let ValueList = λ(T : Type) → List (NameVal T)
+
+let Section = ValueList Text
+
+let Sections = ValueList Section
+
+let Ini = { globalSection : Section, sections : Sections }
+
+let
+    -- Takes to INI files and merges their global sections and their section lists,
+    -- without duplicating by section name.
+    appendInis =
+      λ(inis : List Ini) →
+          { globalSection =
+              lib.List/concat
+                (NameVal Text)
+                (lib.List/map Ini Section (λ(i : Ini) → i.globalSection) inis)
+          , sections =
+              lib.List/concat
+                (NameVal Section)
+                (lib.List/map Ini Sections (λ(i : Ini) → i.sections) inis)
+          }
+        : Ini
+
+let
+    -- Signatures of functions that are input via FFI.
+    Externs =
+      { -- given a dsl of functions to create an Ini, render the ini file
+        renderIni : Ini → Text
+      }
+
+in  { NameVal, ValueList, Section, Sections, Ini, appendInis, Externs }
diff --git a/users/Profpatsch/jaeger.nix b/users/Profpatsch/jaeger.nix
new file mode 100644
index 0000000000..374e40df1a
--- /dev/null
+++ b/users/Profpatsch/jaeger.nix
@@ -0,0 +1,46 @@
+{ depot, pkgs, ... }:
+let
+  drv =
+    pkgs.stdenv.mkDerivation {
+      pname = "jaeger";
+      version = "1.49.0";
+      src = pkgs.fetchurl {
+        url = "https://github.com/jaegertracing/jaeger/releases/download/v1.49.0/jaeger-1.49.0-linux-amd64.tar.gz";
+        hash = "sha256-QhxISDlk/t431EesgVkHWTe7yiw2B+yyfq//GLP0As4=";
+      };
+      phases = [ "unpackPhase" "installPhase" "fixupPhase" ];
+      installPhase = ''
+        mkdir -p $out/bin
+        install ./jaeger-all-in-one $out/bin
+      '';
+    };
+  image =
+    pkgs.dockerTools.buildImage {
+      name = "jaeger";
+      tag = "1.49.0";
+      copyToRoot = drv;
+      config = {
+        Cmd = [ "/bin/jaeger-all-in-one" ];
+      };
+
+    };
+
+  runner =
+    depot.nix.writeExecline "jaeger-docker-run" { } [
+      "if"
+      [ "docker" "load" "-i" image ]
+      "docker"
+      "run"
+      "--rm"
+      "--name"
+      "jaeger"
+      # Web UI
+      "-p"
+      "16686:16686"
+      # Opentelemetry
+      "-p"
+      "4318:4318"
+      "jaeger:1.49.0"
+    ];
+in
+runner
diff --git a/users/Profpatsch/jbovlaste-sqlite/JbovlasteSqlite.hs b/users/Profpatsch/jbovlaste-sqlite/JbovlasteSqlite.hs
new file mode 100644
index 0000000000..8dae9cd026
--- /dev/null
+++ b/users/Profpatsch/jbovlaste-sqlite/JbovlasteSqlite.hs
@@ -0,0 +1,389 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Main where
+
+import Conduit ((.|))
+import Conduit qualified as Cond
+import Control.Category qualified as Cat
+import Control.Foldl qualified as Fold
+import Data.ByteString.Internal qualified as Bytes
+import Data.Error.Tree
+import Data.Int (Int64)
+import Data.List qualified as List
+import Data.Map.Strict qualified as Map
+import Data.Maybe (catMaybes)
+import Data.Text qualified as Text
+import Data.Text.IO qualified as Text
+import Database.SQLite.Simple qualified as Sqlite
+import Database.SQLite.Simple.FromField qualified as Sqlite
+import Database.SQLite.Simple.QQ qualified as Sqlite
+import FieldParser qualified as Field
+import Label
+import Parse
+import PossehlAnalyticsPrelude
+import Text.XML (def)
+import Text.XML qualified as Xml
+import Prelude hiding (init, maybe)
+
+main :: IO ()
+main = do
+  f <- file
+  f.documentRoot
+    & filterDown
+    & toTree
+    & prettyErrorTree
+    & Text.putStrLn
+
+test :: IO ()
+test = do
+  withEnv $ \env -> do
+    migrate env
+    f <- file
+    parseJbovlasteXml f
+      & \case
+        Left errs -> Text.putStrLn $ prettyErrorTree errs
+        Right valsi -> insertValsi env valsi
+
+filterDown :: Xml.Element -> Xml.Element
+filterDown el =
+  el
+    & filterElementsRec noUsers
+    & downTo (T2 (label @"maxdepth" 5) (label @"maxlistitems" 30))
+
+data Valsi = Valsi
+  { word :: Text,
+    definition :: Text,
+    definitionId :: Natural,
+    typ :: Text,
+    selmaho :: Maybe Text,
+    notes :: Maybe Text,
+    glosswords :: [T2 "word" Text "sense" (Maybe Text)],
+    keywords :: [T3 "word" Text "place" Natural "sense" (Maybe Text)]
+  }
+  deriving stock (Show)
+
+insertValsi :: Env -> [Valsi] -> IO ()
+insertValsi env vs = do
+  Sqlite.withTransaction env.envData $
+    do
+      valsiIds <-
+        Cond.yieldMany vs
+          .| Cond.mapMC
+            ( \v ->
+                Sqlite.queryNamed
+                  @(Sqlite.Only Int64)
+                  env.envData
+                  [Sqlite.sql|
+                     INSERT INTO valsi
+                       (word , definition , type , selmaho , notes )
+                       VALUES
+                       (:word, :definition, :type, :selmaho, :notes)
+                       RETURNING (id)
+                   |]
+                  [ ":word" Sqlite.:= v.word,
+                    ":definition" Sqlite.:= v.definition,
+                    ":type" Sqlite.:= v.typ,
+                    ":selmaho" Sqlite.:= v.selmaho,
+                    ":notes" Sqlite.:= v.notes
+                  ]
+                  >>= \case
+                    [one] -> pure one
+                    _ -> error "more or less than one result"
+            )
+          .| Cond.sinkList
+          & Cond.runConduit
+      for_ (zip valsiIds vs) $ \(Sqlite.Only vId, v) -> do
+        for_ v.glosswords $ \g -> do
+          Sqlite.executeNamed
+            env.envData
+            [Sqlite.sql|
+                      INSERT INTO glosswords
+                        (valsi_id , word , sense )
+                        VALUES
+                        (:valsi_id, :word, :sense)
+                    |]
+            [ ":valsi_id" Sqlite.:= vId,
+              ":word" Sqlite.:= g.word,
+              ":sense" Sqlite.:= g.sense
+            ]
+      for_ (zip valsiIds vs) $ \(Sqlite.Only vId, v) -> do
+        for_ v.keywords $ \g -> do
+          Sqlite.executeNamed
+            env.envData
+            [Sqlite.sql|
+                      INSERT INTO keywords
+                        (valsi_id , word , place , sense )
+                        VALUES
+                        (:valsi_id, :word, :place, :sense)
+                    |]
+            [ ":valsi_id" Sqlite.:= vId,
+              ":word" Sqlite.:= g.word,
+              ":place" Sqlite.:= (g.place & fromIntegral @Natural @Int),
+              ":sense" Sqlite.:= g.sense
+            ]
+
+migrate :: (HasField "envData" p Sqlite.Connection) => p -> IO ()
+migrate env = do
+  let x q = Sqlite.execute env.envData q ()
+  x
+    [Sqlite.sql|
+      CREATE TABLE IF NOT EXISTS valsi (
+        id integer PRIMARY KEY,
+        word text NOT NULL,
+        definition text NOT NULL,
+        type text NOT NULL,
+        selmaho text NULL,
+        notes text NULL
+      )
+     |]
+  x
+    [Sqlite.sql|
+      CREATE TABLE IF NOT EXISTS glosswords (
+        id integer PRIMARY KEY,
+        valsi_id integer NOT NULL,
+        word text NOT NULL,
+        sense text NULL,
+        FOREIGN KEY(valsi_id) REFERENCES valsi(id)
+      )
+    |]
+  x
+    [Sqlite.sql|
+      CREATE TABLE IF NOT EXISTS keywords (
+        id integer PRIMARY KEY,
+        valsi_id integer NOT NULL,
+        word text NOT NULL,
+        place integer NOT NULL,
+        sense text NULL,
+        FOREIGN KEY(valsi_id) REFERENCES valsi(id)
+      )
+    |]
+
+data Env = Env
+  { envData :: Sqlite.Connection
+  }
+
+withEnv :: (Env -> IO a) -> IO a
+withEnv inner = do
+  withSqlite "./jbovlaste.sqlite" $ \envData -> inner Env {..}
+
+withSqlite :: String -> (Sqlite.Connection -> IO a) -> IO a
+withSqlite fileName inner = Sqlite.withConnection fileName $ \conn -> do
+  -- Sqlite.setTrace conn (Just (\msg -> Text.hPutStrLn IO.stderr [fmt|{fileName}: {msg}|]))
+  Sqlite.execute conn [Sqlite.sql|PRAGMA foreign_keys = ON|] ()
+  inner conn
+
+parseJbovlasteXml :: (HasField "documentRoot" r Xml.Element) => r -> Either ErrorTree [Valsi]
+parseJbovlasteXml xml =
+  xml.documentRoot
+    & runParse
+      "cannot parse jbovlaste.xml"
+      parser
+  where
+    parser =
+      (element "dictionary" <&> (.elementNodes) <&> mapMaybe nodeElementMay)
+        >>> ( find
+                ( element "direction"
+                    >>> do
+                      (attribute "from" >>> exactly showToText "lojban")
+                      *> (attribute "to" >>> exactly showToText "English")
+                      *> Cat.id
+                )
+                <&> (\x -> x.elementNodes <&> nodeElementMay)
+            )
+        >>> (multiple (maybe valsi) <&> catMaybes)
+    valsi =
+      element "valsi"
+        >>> do
+          let subNodes =
+                ( Cat.id
+                    <&> (.elementNodes)
+                    <&> mapMaybe nodeElementMay
+                )
+
+          let subElementContent elName =
+                subNodes
+                  >>> ( (find (element elName))
+                          <&> (.elementNodes)
+                      )
+                  >>> exactlyOne
+                  >>> content
+          let optionalSubElementContent elName =
+                subNodes
+                  >>> ((findAll (element elName) >>> zeroOrOne))
+                  >>> (maybe (lmap (.elementNodes) exactlyOne >>> content))
+
+          word <- attribute "word"
+          typ <- attribute "type"
+          selmaho <- optionalSubElementContent "selmaho"
+          definition <- subElementContent "definition"
+          definitionId <- subElementContent "definitionid" >>> fieldParser Field.decimalNatural
+          notes <- optionalSubElementContent "notes"
+          glosswords <-
+            (subNodes >>> findAll (element "glossword"))
+              >>> ( multiple $ do
+                      word' <- label @"word" <$> (attribute "word")
+                      sense <- label @"sense" <$> (attributeMay "sense")
+                      pure $ T2 word' sense
+                  )
+          keywords <-
+            (subNodes >>> findAll (element "keyword"))
+              >>> ( multiple $ do
+                      word' <- label @"word" <$> (attribute "word")
+                      place <- label @"place" <$> (attribute "place" >>> fieldParser Field.decimalNatural)
+                      sense <- label @"sense" <$> (attributeMay "sense")
+                      pure $ T3 word' place sense
+                  )
+
+          pure $ Valsi {..}
+
+file :: IO Xml.Document
+file = Xml.readFile def "./jbovlaste-en.xml"
+
+-- | Filter XML elements recursively based on the given predicate
+filterElementsRec :: (Xml.Element -> Bool) -> Xml.Element -> Xml.Element
+filterElementsRec f el =
+  el
+    { Xml.elementNodes =
+        mapMaybe
+          ( \case
+              Xml.NodeElement el' ->
+                if f el'
+                  then Just $ Xml.NodeElement $ filterElementsRec f el'
+                  else Nothing
+              other -> Just other
+          )
+          el.elementNodes
+    }
+
+-- | no <user> allowed
+noUsers :: Xml.Element -> Bool
+noUsers el = el.elementName.nameLocalName /= "user"
+
+downTo :: (T2 "maxdepth" Int "maxlistitems" Int) -> Xml.Element -> Xml.Element
+downTo n el =
+  if n.maxdepth > 0
+    then
+      el
+        { Xml.elementNodes =
+            ( do
+                let eleven = take (n.maxlistitems + 1) $ map down el.elementNodes
+                if List.length eleven == (n.maxlistitems + 1)
+                  then eleven <> [Xml.NodeComment "snip!"]
+                  else eleven
+            )
+        }
+    else el {Xml.elementNodes = [Xml.NodeComment "snip!"]}
+  where
+    down =
+      \case
+        Xml.NodeElement el' ->
+          Xml.NodeElement $
+            downTo
+              ( T2
+                  (label @"maxdepth" $ n.maxdepth - 1)
+                  (label @"maxlistitems" n.maxlistitems)
+              )
+              el'
+        more -> more
+
+toTree :: Xml.Element -> ErrorTree
+toTree el = do
+  case el.elementNodes & filter (not . isEmptyContent) & nonEmpty of
+    Nothing -> singleError (newError (prettyXmlElement el))
+    Just (n :| []) | not $ isElementNode n -> singleError $ errorContext (prettyXmlElement el) (nodeErrorNoElement n)
+    Just nodes -> nestedMultiError (newError (prettyXmlElement el)) (nodes <&> node)
+  where
+    isEmptyContent = \case
+      Xml.NodeContent c -> c & Text.all Bytes.isSpaceChar8
+      _ -> False
+    isElementNode = \case
+      Xml.NodeElement _ -> True
+      _ -> False
+
+    node :: Xml.Node -> ErrorTree
+    node = \case
+      Xml.NodeElement el' -> toTree el'
+      other -> singleError $ nodeErrorNoElement other
+
+    nodeErrorNoElement :: Xml.Node -> Error
+    nodeErrorNoElement = \case
+      Xml.NodeInstruction i -> [fmt|Instruction: {i & show}|]
+      Xml.NodeContent c -> [fmt|"{c & Text.replace "\"" "\\\""}"|]
+      Xml.NodeComment c -> [fmt|<!-- {c} -->|]
+      Xml.NodeElement _ -> error "NodeElement not allowed here"
+
+prettyXmlName :: Xml.Name -> Text
+prettyXmlName n = [fmt|{n.namePrefix & fromMaybe ""}{n.nameLocalName}|]
+
+prettyXmlElement :: Xml.Element -> Text
+prettyXmlElement el =
+  if not $ null el.elementAttributes
+    then [fmt|<{prettyXmlName el.elementName}: {attrs el.elementAttributes}>|]
+    else [fmt|<{prettyXmlName el.elementName}>|]
+  where
+    attrs :: Map Xml.Name Text -> Text
+    attrs a = a & Map.toList <&> (\(k, v) -> [fmt|{prettyXmlName k}={v}|]) & Text.intercalate ", " & \s -> [fmt|({s})|]
+
+nodeElementMay :: Xml.Node -> Maybe Xml.Element
+nodeElementMay = \case
+  Xml.NodeElement el -> Just el
+  _ -> Nothing
+
+element :: Text -> Parse Xml.Element Xml.Element
+element name = Parse $ \(ctx, el) ->
+  if el.elementName.nameLocalName == name
+    then Success (ctx & addContext (prettyXmlName el.elementName), el)
+    else Failure $ singleton [fmt|Expected element named <{name}> but got {el & prettyXmlElement} at {showContext ctx}|]
+
+content :: Parse Xml.Node Text
+content = Parse $ \(ctx, node) -> case node of
+  Xml.NodeContent t -> Success (ctx, t)
+  -- TODO: give an example of the node content?
+  n -> Failure $ singleton [fmt|Expected a content node, but got a {n & nodeType} node, at {showContext ctx}|]
+    where
+      nodeType = \case
+        Xml.NodeContent _ -> "content" :: Text
+        Xml.NodeComment _ -> "comment"
+        Xml.NodeInstruction _ -> "instruction"
+        Xml.NodeElement _ -> "element"
+
+attribute :: Text -> Parse Xml.Element Text
+attribute name = Parse $ \(ctx, el) ->
+  case el.elementAttributes & Map.mapKeys (.nameLocalName) & Map.lookup name of
+    Just a -> Success (ctx & addContext [fmt|{{attr:{name}}}|], a)
+    Nothing -> Failure $ singleton [fmt|Attribute "{name}" missing at {showContext ctx}|]
+
+attributeMay :: Text -> Parse Xml.Element (Maybe Text)
+attributeMay name = Parse $ \(ctx, el) ->
+  case el.elementAttributes & Map.mapKeys (.nameLocalName) & Map.lookup name of
+    Just a -> Success (ctx & addContext [fmt|{{attr:{name}}}|], Just a)
+    Nothing -> Success (ctx, Nothing)
+
+instance
+  ( Sqlite.FromField t1,
+    Sqlite.FromField t2,
+    Sqlite.FromField t3
+  ) =>
+  Sqlite.FromRow (T3 l1 t1 l2 t2 l3 t3)
+  where
+  fromRow = do
+    T3
+      <$> (label @l1 <$> Sqlite.field)
+      <*> (label @l2 <$> Sqlite.field)
+      <*> (label @l3 <$> Sqlite.field)
+
+foldRows ::
+  forall row params b.
+  (Sqlite.FromRow row, Sqlite.ToRow params) =>
+  Sqlite.Connection ->
+  Sqlite.Query ->
+  params ->
+  Fold.Fold row b ->
+  IO b
+foldRows conn qry params = Fold.purely f
+  where
+    f :: forall x. (x -> row -> x) -> x -> (x -> b) -> IO b
+    f acc init extract = do
+      x <- Sqlite.fold conn qry params init (\a r -> pure $ acc a r)
+      pure $ extract x
diff --git a/users/Profpatsch/jbovlaste-sqlite/default.nix b/users/Profpatsch/jbovlaste-sqlite/default.nix
new file mode 100644
index 0000000000..ea59fdec39
--- /dev/null
+++ b/users/Profpatsch/jbovlaste-sqlite/default.nix
@@ -0,0 +1,33 @@
+{ depot, pkgs, lib, ... }:
+
+let
+  #   bins = depot.nix.getBins pkgs.sqlite ["sqlite3"];
+
+  jbovlaste-sqlite = pkgs.haskellPackages.mkDerivation {
+    pname = "jbovlaste-sqlite";
+    version = "0.1.0";
+
+    src = depot.users.Profpatsch.exactSource ./. [
+      ./jbovlaste-sqlite.cabal
+      ./JbovlasteSqlite.hs
+    ];
+
+    libraryHaskellDepends = [
+      pkgs.haskellPackages.pa-prelude
+      pkgs.haskellPackages.pa-label
+      pkgs.haskellPackages.pa-error-tree
+      pkgs.haskellPackages.pa-field-parser
+      depot.users.Profpatsch.my-prelude
+      pkgs.haskellPackages.foldl
+      pkgs.haskellPackages.sqlite-simple
+      pkgs.haskellPackages.xml-conduit
+
+    ];
+
+    isExecutable = true;
+    isLibrary = false;
+    license = lib.licenses.mit;
+  };
+
+in
+jbovlaste-sqlite
diff --git a/users/Profpatsch/jbovlaste-sqlite/jbovlaste-sqlite.cabal b/users/Profpatsch/jbovlaste-sqlite/jbovlaste-sqlite.cabal
new file mode 100644
index 0000000000..f677615a16
--- /dev/null
+++ b/users/Profpatsch/jbovlaste-sqlite/jbovlaste-sqlite.cabal
@@ -0,0 +1,76 @@
+cabal-version:      3.0
+name:               jbovlaste-sqlite
+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 jbovlaste-sqlite
+    import: common-options
+
+    main-is:          JbovlasteSqlite.hs
+
+    build-depends:
+        base >=4.15 && <5,
+        pa-prelude,
+        pa-label,
+        pa-error-tree,
+        pa-field-parser,
+        my-prelude,
+        containers,
+        selective,
+        semigroupoids,
+        validation-selective,
+        sqlite-simple,
+        foldl,
+        conduit,
+        bytestring,
+        text,
+        sqlite-simple,
+        xml-conduit,
diff --git a/users/Profpatsch/lens.nix b/users/Profpatsch/lens.nix
new file mode 100644
index 0000000000..28f7506bdd
--- /dev/null
+++ b/users/Profpatsch/lens.nix
@@ -0,0 +1,137 @@
+{ ... }:
+let
+  id = x: x;
+
+  const = x: y: x;
+
+  comp = f: g: x: f (g x);
+
+  _ = v: f: f v;
+
+  # Profunctor (p :: Type -> Type -> Type)
+  Profunctor = rec {
+    # dimap :: (a -> b) -> (c -> d) -> p b c -> p a d
+    dimap = f: g: x: lmap f (rmap g x);
+    # lmap :: (a -> b) -> p b c -> p a c
+    lmap = f: dimap f id;
+    # rmap :: (c -> d) -> p b c -> p b d
+    rmap = g: dimap id g;
+  };
+
+  # Profunctor (->)
+  profunctorFun = Profunctor // {
+    # dimap :: (a -> b) -> (c -> d) -> (b -> c) -> a -> d
+    dimap = ab: cd: bc: a: cd (bc (ab a));
+    # lmap :: (a -> b) -> (b -> c) -> (a -> c)
+    lmap = ab: bc: a: bc (ab a);
+    # rmap :: (c -> d) -> (b -> c) -> (b -> d)
+    rmap = cd: bc: b: cd (bc b);
+  };
+
+  tuple = fst: snd: {
+    inherit fst snd;
+  };
+
+  swap = { fst, snd }: {
+    fst = snd;
+    snd = fst;
+  };
+
+  # Profunctor p => Strong (p :: Type -> Type -> Type)
+  Strong = pro: pro // rec {
+    # firstP :: p a b -> p (a, c) (b, c)
+    firstP = pab: pro.dimap swap swap (pro.secondP pab);
+    # secondP :: p a b -> p (c, a) (c, b)
+    secondP = pab: pro.dimap swap swap (pro.firstP pab);
+  };
+
+  # Strong (->)
+  strongFun = Strong profunctorFun // {
+    # firstP :: (a -> b) -> (a, c) -> (b, c)
+    firstP = f: { fst, snd }: { fst = f fst; inherit snd; };
+    # secondP :: (a -> b) -> (c, a) -> (c, b)
+    secondP = f: { snd, fst }: { snd = f snd; inherit fst; };
+  };
+
+  # Iso s t a b :: forall p. Profunctor p -> p a b -> p s t
+
+  # iso :: (s -> a) -> (b -> t) -> Iso s t a b
+  iso = pro: pro.dimap;
+
+  # Lens s t a b :: forall p. Strong p -> p a b -> p s t
+
+  # lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
+  lens = strong: get: set: pab:
+    lensP
+      strong
+      (s: tuple (get s) (b: set s b))
+      pab;
+
+  # lensP :: (s -> (a, b -> t)) -> Lens s t a b
+  lensP = strong: to: pab:
+    strong.dimap
+      to
+      ({ fst, snd }: snd fst)
+      (strong.firstP pab);
+
+  # first element of a tuple
+  # _1 :: Lens (a, c) (b, c) a b
+  _1 = strong: strong.firstP;
+
+  # second element of a tuple
+  # _2 :: Lens (c, a) (c, b) a b
+  _2 = strong: strong.secondP;
+
+  # a the given field in the record
+  # field :: (f :: String) -> Lens { f :: a; ... } { f :: b; ... } a b
+  field = name: strong:
+    lens
+      strong
+      (attrs: attrs.${name})
+      (attrs: a: attrs // { ${name} = a; });
+
+  # Setter :: (->) a b -> (->) s t
+  # Setter :: (a -> b) -> (s -> t)
+
+
+  # Subclasses of profunctor for (->).
+  # We only have Strong for now, but when we implement Choice we need to add it here.
+  profunctorSubclassesFun = strongFun;
+
+  # over :: Setter s t a b -> (a -> b) -> s -> t
+  over = setter:
+    # A setter needs to be instanced to the profunctor-subclass instances of (->).
+    (setter profunctorSubclassesFun);
+
+  # set :: Setter s t a b -> b -> s -> t
+  set = setter: b: over setter (const b);
+
+  # combine a bunch of optics, for the subclass instance of profunctor you give it.
+  optic = accessors: profunctorSubclass:
+    builtins.foldl' comp id
+      (map (accessor: accessor profunctorSubclass) accessors);
+
+
+in
+{
+  inherit
+    id
+    _
+    const
+    comp
+    Profunctor
+    profunctorFun
+    Strong
+    strongFun
+    iso
+    lens
+    optic
+    _1
+    _2
+    field
+    tuple
+    swap
+    over
+    set
+    ;
+}
diff --git a/users/Profpatsch/lib.nix b/users/Profpatsch/lib.nix
index 5d5fb01294..879d87755d 100644
--- a/users/Profpatsch/lib.nix
+++ b/users/Profpatsch/lib.nix
@@ -1,58 +1,108 @@
 { depot, pkgs, ... }:
 let
-  bins = depot.nix.getBins pkgs.coreutils [ "printf" "echo" "cat" "printenv" ]
-      // depot.nix.getBins pkgs.fdtools [ "multitee" ]
-      ;
-
-  debugExec = msg: depot.nix.writeExecline "debug-exec" {} [
-    "if" [
-      "fdmove" "-c" "1" "2"
-      "if" [ bins.printf "%s: " msg ]
-      "if" [ bins.echo "$@" ]
+  bins = depot.nix.getBins pkgs.coreutils [ "printf" "echo" "cat" "printenv" "tee" ]
+    // depot.nix.getBins pkgs.bash [ "bash" ]
+    // depot.nix.getBins pkgs.fdtools [ "multitee" ]
+  ;
+
+  # Print `msg` and and argv to stderr, then execute into argv
+  debugExec = msg: depot.nix.writeExecline "debug-exec" { } [
+    "if"
+    [
+      "fdmove"
+      "-c"
+      "1"
+      "2"
+      "if"
+      [ bins.printf "%s: " msg ]
+      "if"
+      [ bins.echo "$@" ]
     ]
     "$@"
   ];
 
-  eprint-stdin = depot.nix.writeExecline "eprint-stdin" {} [
-    "pipeline" [ bins.multitee "0-1,2" ] "$@"
+  # Print stdin to stderr and stdout
+  eprint-stdin = depot.nix.writeExecline "eprint-stdin" { } [
+    "pipeline"
+    [ bins.multitee "0-1,2" ]
+    "$@"
   ];
 
-  eprint-stdin-netencode = depot.nix.writeExecline "eprint-stdin-netencode" {} [
-    "pipeline" [
+  # Assume the input on stdin is netencode, pretty print it to stderr and forward it to stdout
+  eprint-stdin-netencode = depot.nix.writeExecline "eprint-stdin-netencode" { } [
+    "pipeline"
+    [
       # move stdout to 3
-      "fdmove" "3" "1"
+      "fdmove"
+      "3"
+      "1"
       # the multitee copies stdin to 1 (the other pipeline end) and 3 (the stdout of the outer pipeline block)
-      "pipeline" [ bins.multitee "0-1,3" ]
+      "pipeline"
+      [ bins.multitee "0-1,3" ]
       # make stderr the stdout of pretty, merging with the stderr of pretty
-      "fdmove" "-c" "1" "2"
+      "fdmove"
+      "-c"
+      "1"
+      "2"
       depot.users.Profpatsch.netencode.pretty
     ]
     "$@"
   ];
 
+  # print the given environment variable in $1 to stderr, then execute into the rest of argv
   eprintenv = depot.nix.writeExecline "eprintenv" { readNArgs = 1; } [
-    "ifelse" [ "fdmove" "-c" "1" "2" bins.printenv "$1" ]
+    "ifelse"
+    [ "fdmove" "-c" "1" "2" bins.printenv "$1" ]
     [ "$@" ]
-    "if" [ depot.tools.eprintf "eprintenv: could not find \"\${1}\" in the environment\n" ]
+    "if"
+    [ depot.tools.eprintf "eprintenv: could not find \"\${1}\" in the environment\n" ]
     "$@"
   ];
 
+  # Split stdin into two commands, given by a block and the rest of argv
+  #
+  # Example (execline):
+  #
+  #   pipeline [ echo foo ]
+  #   split-stdin [ fdmove 1 2 foreground [ cat ] echo "bar" ] cat
+  #
+  #   stdout: foo\n
+  #   stderr: foo\nbar\n
+  split-stdin = depot.nix.writeExecline "split-stdin" { argMode = "env"; } [
+    "pipeline"
+    [
+      # this is horrible yes but the quickest way I knew how to implement it
+      "runblock"
+      "1"
+      bins.bash
+      "-c"
+      ''${bins.tee} >("$@")''
+      "bash-split-stdin"
+    ]
+    "runblock"
+    "-r"
+    "1"
+  ];
+
   # remove everything but a few selected environment variables
   runInEmptyEnv = keepVars:
     let
-        importas = pkgs.lib.concatMap (var: [ "importas" "-i" var var ]) keepVars;
-        # we have to explicitely call export here, because PATH is probably empty
-        export = pkgs.lib.concatMap (var: [ "${pkgs.execline}/bin/export" var ''''${${var}}'' ]) keepVars;
-    in depot.nix.writeExecline "empty-env" {}
-         (importas ++ [ "emptyenv" ] ++ export ++ [ "${pkgs.execline}/bin/exec" "$@" ]);
+      importas = pkgs.lib.concatMap (var: [ "importas" "-i" var var ]) keepVars;
+      # we have to explicitely call export here, because PATH is probably empty
+      export = pkgs.lib.concatMap (var: [ "${pkgs.execline}/bin/export" var ''''${${var}}'' ]) keepVars;
+    in
+    depot.nix.writeExecline "empty-env" { }
+      (importas ++ [ "emptyenv" ] ++ export ++ [ "${pkgs.execline}/bin/exec" "$@" ]);
 
 
-in {
+in
+{
   inherit
     debugExec
     eprint-stdin
     eprint-stdin-netencode
     eprintenv
+    split-stdin
     runInEmptyEnv
     ;
 }
diff --git a/users/Profpatsch/lorri-wait-for-eval/LorriWaitForEval.hs b/users/Profpatsch/lorri-wait-for-eval/LorriWaitForEval.hs
new file mode 100644
index 0000000000..a1a4586401
--- /dev/null
+++ b/users/Profpatsch/lorri-wait-for-eval/LorriWaitForEval.hs
@@ -0,0 +1,173 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wall #-}
+
+module Main where
+
+import Conduit
+import Conduit qualified as Cond
+import Control.Concurrent
+import Control.Concurrent.Async qualified as Async
+import Control.Monad
+import Data.Aeson.BetterErrors qualified as Json
+import Data.Bifunctor
+import Data.Conduit.Binary qualified as Conduit.Binary
+import Data.Conduit.Combinators qualified as Cond
+import Data.Conduit.Process
+import Data.Error
+import Data.Function
+import Data.Functor
+import Data.Text.IO (hPutStrLn)
+import MyPrelude
+import System.Directory qualified as Dir
+import System.Environment qualified as Env
+import System.Exit qualified as Exit
+import System.FilePath (takeDirectory)
+import System.FilePath.Posix qualified as FilePath
+import System.IO (stderr)
+import System.Posix qualified as Posix
+import Prelude hiding (log)
+
+data LorriEvent = LorriEvent
+  { nixFile :: Text,
+    eventType :: LorriEventType
+  }
+  deriving stock (Show)
+
+data LorriEventType
+  = Completed
+  | Started
+  | EvalFailure
+  deriving stock (Show)
+
+main :: IO ()
+main = do
+  argv <- Env.getArgs <&> nonEmpty
+
+  dir <- Dir.getCurrentDirectory
+  shellNix <-
+    findShellNix dir >>= \case
+      Nothing -> Exit.die [fmt|could not find any shell.nix in or above the directory {dir}|]
+      Just s -> pure s
+  getEventChan :: MVar (Chan LorriEvent) <- newEmptyMVar
+  Async.race_
+    ( do
+        sendEventChan :: Chan LorriEvent <- newChan
+        (exitCode, ()) <-
+          sourceProcessWithConsumer
+            (proc "lorri" ["internal", "stream-events"])
+            $
+            -- first, we want to send a message over the chan that the process is running (for timeout)
+            liftIO (putMVar getEventChan sendEventChan)
+              *> Conduit.Binary.lines
+              .| Cond.mapC
+                ( \jsonBytes ->
+                    (jsonBytes :: ByteString)
+                      & Json.parseStrict
+                        ( Json.key
+                            "Completed"
+                            ( do
+                                nixFile <- Json.key "nix_file" Json.asText
+                                pure LorriEvent {nixFile, eventType = Completed}
+                            )
+                            Json.<|> Json.key
+                              "Started"
+                              ( do
+                                  nixFile <- Json.key "nix_file" Json.asText
+                                  pure LorriEvent {nixFile, eventType = Started}
+                              )
+                            Json.<|> Json.key
+                              "Failure"
+                              ( do
+                                  nixFile <- Json.key "nix_file" Json.asText
+                                  pure LorriEvent {nixFile, eventType = EvalFailure}
+                              )
+                        )
+                      & first Json.displayError'
+                      & first (map newError)
+                      & first (smushErrors [fmt|Cannot parse line returned by lorri: {jsonBytes & bytesToTextUtf8Lenient}|])
+                      & unwrapError
+                )
+              .| (Cond.mapM_ (\ev -> writeChan sendEventChan ev))
+
+        log [fmt|lorri internal stream-events exited {show exitCode}|]
+    )
+    ( do
+        let waitMs ms = threadDelay (ms * 1000)
+
+        -- log [fmt|Waiting for lorri event for {shellNix}|]
+
+        eventChan <- takeMVar getEventChan
+
+        let isOurEvent ev = FilePath.normalise (ev & nixFile & textToString) == FilePath.normalise shellNix
+
+        let handleEvent ev =
+              case ev & eventType of
+                Started ->
+                  log [fmt|waiting for lorri build to finish|]
+                Completed -> do
+                  log [fmt|build completed|]
+                  exec (inDirenvDir (takeDirectory shellNix) <$> argv)
+                EvalFailure -> do
+                  log [fmt|evaluation failed! for path {ev & nixFile}|]
+                  Exit.exitWith (Exit.ExitFailure 111)
+
+        -- wait for 100ms for the first message from lorri,
+        -- or else assume lorri is not building the project yet
+        Async.race
+          (waitMs 100)
+          ( do
+              -- find the first event that we can use
+              let go = do
+                    ev <- readChan eventChan
+                    if isOurEvent ev then pure ev else go
+              go
+          )
+          >>= \case
+            Left () -> do
+              log [fmt|No event received from lorri, assuming this is the first evaluation|]
+              exec argv
+            Right ch -> handleEvent ch
+
+        runConduit $
+          repeatMC (readChan eventChan)
+            .| filterC isOurEvent
+            .| mapM_C handleEvent
+    )
+  where
+    inDirenvDir dir' argv' = ("direnv" :| ["exec", dir']) <> argv'
+    exec = \case
+      Just (exe :| args') -> Posix.executeFile exe True args' Nothing
+      Nothing -> Exit.exitSuccess
+
+log :: Text -> IO ()
+log msg = hPutStrLn stderr [fmt|lorri-wait-for-eval: {msg}|]
+
+-- | Searches from the current directory upwards, until it finds the `shell.nix`.
+findShellNix :: FilePath -> IO (Maybe FilePath)
+findShellNix curDir = do
+  let go :: (FilePath -> IO (Maybe FilePath))
+      go dir = do
+        let file = dir FilePath.</> "shell.nix"
+        Dir.doesFileExist file >>= \case
+          True -> pure (Just file)
+          False -> do
+            let parent = FilePath.takeDirectory dir
+            if parent == dir
+              then pure Nothing
+              else go parent
+  go (FilePath.normalise curDir)
+
+smushErrors :: Foldable t => Text -> t Error -> Error
+smushErrors msg errs =
+  errs
+    -- hrm, pretty printing and then creating a new error is kinda shady
+    & foldMap (\err -> "\n- " <> prettyError err)
+    & newError
+    & errorContext msg
diff --git a/users/Profpatsch/lorri-wait-for-eval/README.md b/users/Profpatsch/lorri-wait-for-eval/README.md
new file mode 100644
index 0000000000..9c5d8ef9e3
--- /dev/null
+++ b/users/Profpatsch/lorri-wait-for-eval/README.md
@@ -0,0 +1,7 @@
+# lorri-wait-for-eval
+
+A helper script for [lorri](https://github.com/nix-community/lorri), which wraps a command and executes it once lorri is finished evaluating the current `shell.nix`, and uses the new environment.
+
+This is useful when you need the new shell environment to be in scope of the command, but don’t want to waste time waiting for it to finish.
+
+This should really be a feature of lorri, but I couldn’t be assed to touch rust :P
diff --git a/users/Profpatsch/lorri-wait-for-eval/default.nix b/users/Profpatsch/lorri-wait-for-eval/default.nix
new file mode 100644
index 0000000000..90c6365fed
--- /dev/null
+++ b/users/Profpatsch/lorri-wait-for-eval/default.nix
@@ -0,0 +1,20 @@
+{ depot, pkgs, lib, ... }:
+
+let
+  lorri-wait-for-eval = pkgs.writers.writeHaskell "lorri-wait-for-eval"
+    {
+      libraries = [
+        depot.users.Profpatsch.my-prelude
+        pkgs.haskellPackages.async
+        pkgs.haskellPackages.aeson-better-errors
+        pkgs.haskellPackages.conduit-extra
+        pkgs.haskellPackages.error
+        pkgs.haskellPackages.PyF
+        pkgs.haskellPackages.unliftio
+      ];
+      ghcArgs = [ "-threaded" ];
+
+    } ./LorriWaitForEval.hs;
+
+in
+lorri-wait-for-eval
diff --git a/users/Profpatsch/mailbox-org/MailboxOrg.hs b/users/Profpatsch/mailbox-org/MailboxOrg.hs
new file mode 100644
index 0000000000..6c5820080c
--- /dev/null
+++ b/users/Profpatsch/mailbox-org/MailboxOrg.hs
@@ -0,0 +1,523 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NoFieldSelectors #-}
+{-# OPTIONS_GHC -Wall #-}
+
+module Main where
+
+import Aeson (parseErrorTree)
+import AesonQQ (aesonQQ)
+import ArglibNetencode
+import Control.Exception (try)
+import Control.Monad (replicateM)
+import Data.Aeson qualified as Json
+import Data.Aeson.BetterErrors qualified as Json
+import Data.Aeson.KeyMap qualified as KeyMap
+import Data.ByteString qualified as ByteString
+import Data.ByteString.Lazy qualified as Lazy
+import Data.Char qualified as Char
+import "pa-error-tree" Data.Error.Tree
+import Data.Functor.Compose
+import Data.List qualified as List
+import Data.Map.Strict qualified as Map
+import Data.Text qualified as Text
+import ExecHelpers
+import Label
+import Netencode qualified
+import Netencode.Parse qualified as NetParse
+import Network.HTTP.Conduit qualified as Client
+import Network.HTTP.Simple qualified as Client
+import PossehlAnalyticsPrelude
+import Pretty
+import System.Directory qualified as File
+import System.Environment qualified as Env
+import System.Exit (ExitCode (ExitFailure, ExitSuccess))
+import System.Exit qualified as Exit
+import System.FilePath ((</>))
+import System.Process.Typed qualified as Process
+import System.Random qualified as Random
+import System.Random.Stateful qualified as Random
+import Prelude hiding (log)
+
+secret :: Tools -> IO (T2 "email" ByteString "password" ByteString)
+secret tools = do
+  T2
+    (label @"email" "mail@profpatsch.de")
+    <$> (label @"password" <$> fromPass "email/mailbox.org")
+  where
+    fromPass name =
+      tools.pass & runToolExpect0 [name]
+
+progName :: CurrentProgramName
+progName = "mailbox-org"
+
+log :: Error -> IO ()
+log err = do
+  putStderrLn (errorContext progName.unCurrentProgramName err & prettyError)
+
+data Tools = Tools
+  { pass :: Tool
+  }
+  deriving stock (Show)
+
+newtype Tool = Tool {unTool :: FilePath}
+  deriving stock (Show)
+
+parseTools :: Applicative m => (Text -> m (Either Error Tool)) -> m (Either ErrorTree Tools)
+parseTools getTool = do
+  let parser =
+        ( do
+            pass <- get "pass"
+            pure Tools {..}
+        )
+  parser & finalize
+  where
+    get name = name & getTool <&> eitherToListValidation & Compose
+    finalize p =
+      p.getCompose
+        <&> first (errorTree "Error reading tools")
+        <&> validationToEither
+
+main :: IO ()
+main =
+  arglibNetencode progName Nothing
+    >>= parseToolsArglib
+    >>= secret
+    >>= run applyFilters
+
+run ::
+  ( HasField "email" dat ByteString,
+    HasField "password" dat ByteString
+  ) =>
+  (Session -> IO ()) ->
+  dat ->
+  IO ()
+run act loginData = do
+  session <- login loginData
+  act session
+
+listFilterConfig :: Session -> IO ()
+listFilterConfig session = do
+  mailfilter
+    session
+    "config"
+    mempty
+    (Json.key "data" Json.asObject)
+    ()
+    >>= printPretty
+
+applyFilterRule ::
+  (HasField "folderId" dat Text) =>
+  dat ->
+  Session ->
+  IO ()
+applyFilterRule dat session = do
+  mailfilter
+    session
+    "apply"
+    ( T2
+        (label @"extraQueryParams" [("folderId", Just (dat.folderId & textToBytesUtf8))])
+        mempty
+    )
+    (Json.key "data" Json.asArray >> pure ())
+    (Json.Object mempty)
+
+data FilterRule = FilterRule
+  { actioncmds :: NonEmpty Json.Object,
+    test :: NonEmpty Json.Object
+  }
+
+data MailfilterList = MailfilterList
+  { id_ :: Json.Value,
+    rulename :: Text
+  }
+  deriving stock (Show, Eq)
+
+simpleRule ::
+  ( HasField "rulename" r Text,
+    HasField "id" r Natural,
+    HasField "emailContains" r Text,
+    HasField "subjectStartsWith" r Text
+  ) =>
+  r ->
+  Json.Value
+simpleRule dat = do
+  [aesonQQ|{
+    "id": |dat.id & enc @Natural|,
+    "position": 3,
+    "rulename": |dat.rulename & enc @Text|,
+    "active": true,
+    "flags": [],
+    "test": {
+      "id": "allof",
+      "tests": [
+        {
+          "id": "from",
+          "comparison": "contains",
+          "values": [
+            |dat.emailContains & enc @Text|
+          ]
+        },
+        {
+          "id": "subject",
+          "comparison": "startswith",
+          "values": [
+            |dat.subjectStartsWith & enc @Text|
+          ]
+        }
+      ]
+    },
+    "actioncmds": [
+      {
+        "id": "move",
+        "into": "default0/Archive"
+      },
+      {
+        "id": "stop"
+      }
+    ]
+  }|]
+  where
+    enc :: forall a. Json.ToJSON a => a -> Lazy.ByteString
+    enc val = val & Json.toJSON & Json.encode
+
+applyFilters :: Session -> IO ()
+applyFilters session = do
+  filters <-
+    mailfilter
+      session
+      "list"
+      mempty
+      ( Json.key "data" $ do
+          ( Json.eachInArray $ asDat @"mailfilter" $ do
+              id_ <- Json.key "id" Json.asValue
+              rulename <- Json.key "rulename" Json.asText
+              pure MailfilterList {..}
+            )
+            <&> mapFromListOn (\dat -> getLabel @"rulename" dat.parsed)
+      )
+      ([] :: [()])
+  let goal = Map.fromList [(label @"rulename" "another", 32 :: Integer), (label @"rulename" "xyz", 23)]
+  let actions = declarativeUpdate goal filters
+  log [fmt|To * create: {actions.toCreate & Map.keys & show}, * update: {actions.toUpdate & Map.keys & show}, * delete: {actions.toDelete & Map.keys & show}|]
+
+-- where
+-- filters
+--   & Map.elems
+--   & traverse_
+--     ( updateIfDifferent
+--         session
+--         ( \el ->
+--             pure $
+--               el.original.mailfilter
+--                 & KeyMap.insert "active" (Json.Bool False)
+--         )
+--         (pure ())
+--     )
+
+-- updateIfDifferent ::
+--   forall label parsed.
+--   ( HasField "id_" parsed Json.Value,
+--     HasField "rulename" parsed Text
+--   ) =>
+--   Session ->
+--   (Dat label Json.Object parsed -> IO Json.Object) ->
+--   Json.Parse Error () ->
+--   Dat label Json.Object parsed ->
+--   IO ()
+-- updateIfDifferent session switcheroo parser dat = do
+--   new <- switcheroo dat
+--   if new /= getField @label dat.original
+--     then do
+--       log [fmt|Updating filter "{dat.parsed.rulename}" (id {dat.parsed.id_ & show @Json.Value})|]
+--       mailfilter
+--         session
+--         "update"
+--         mempty
+--         parser
+--         new
+--     else do
+--       log [fmt|Skipping updating filter "{dat.parsed.rulename}" (id {dat.parsed.id_ & show @Json.Value}) because nothing changed.|]
+
+-- | https://oxpedia.org/wiki/index.php?title=HTTP_API_MailFilter
+mailfilter ::
+  ( Json.ToJSON a,
+    Show b
+  ) =>
+  Session ->
+  ByteString ->
+  T2
+    "extraQueryParams"
+    Client.Query
+    "httpMethod"
+    (Maybe ByteString) ->
+  Json.Parse Error b ->
+  a ->
+  IO b
+mailfilter session action opts parser body = do
+  req <-
+    Client.parseRequest "https://office.mailbox.org/appsuite/api/mailfilter/v2"
+      <&> Client.setQueryString
+        ( [ ("action", Just action),
+            ("colums", Just "1")
+          ]
+            <> opts.extraQueryParams
+        )
+      <&> Client.setRequestMethod (opts.httpMethod & fromMaybe "PUT")
+      <&> Client.setRequestBodyJSON body
+      <&> addSession session
+  req
+    & httpJSON [fmt|Cannot parse result for {req & prettyRequestShort}|] parser
+    >>= okOrDie
+    -- >>= (\resp -> printPretty resp >> pure resp)
+    <&> Client.responseBody
+  where
+    prettyRequestShort :: Client.Request -> Text
+    prettyRequestShort req = [fmt|request {req & Client.method}: {req & Client.host}{req & Client.path}{req & Client.queryString}|]
+
+-- | Given a goal and the actual state, return which elements to delete, update and create.
+declarativeUpdate ::
+  Ord k =>
+  -- | goal map
+  Map k a ->
+  -- | actual map
+  Map k b ->
+  T3
+    "toCreate"
+    (Map k a)
+    "toDelete"
+    (Map k b)
+    "toUpdate"
+    (Map k a)
+declarativeUpdate goal actual =
+  T3
+    (label @"toCreate" $ goal `Map.difference` actual)
+    (label @"toDelete" $ actual `Map.difference` goal)
+    (label @"toUpdate" $ goal `Map.intersection` actual)
+
+newtype Session = Session Client.CookieJar
+
+httpJSON ::
+  Error ->
+  Json.Parse Error b ->
+  Client.Request ->
+  IO (Client.Response b)
+httpJSON errMsg parser req = do
+  req
+    & Client.httpJSON @_ @Json.Value
+    >>= traverse
+      ( \val -> do
+          case val of
+            Json.Object obj
+              | "error" `KeyMap.member` obj
+                  && "error_desc" `KeyMap.member` obj -> do
+                  printPretty obj
+                  diePanic' "Server returned above inline error"
+            _ -> pure ()
+          val & Json.parseValue parser & \case
+            Left errs ->
+              errs
+                & parseErrorTree errMsg
+                & diePanic'
+            Right a -> pure a
+      )
+
+data Dat label orig parsed = Dat
+  { original :: Label label orig,
+    parsed :: parsed
+  }
+  deriving stock (Show, Eq)
+
+asDat ::
+  forall label err m a.
+  Monad m =>
+  Json.ParseT err m a ->
+  Json.ParseT err m (Dat label Json.Object a)
+asDat parser = do
+  original <- label @label <$> Json.asObject
+  parsed <- parser
+  pure Dat {..}
+
+addSession :: Session -> Client.Request -> Client.Request
+addSession (Session jar) req = do
+  let sessionId =
+        jar
+          & Client.destroyCookieJar
+          & List.find (\c -> "open-xchange-session-" `ByteString.isPrefixOf` c.cookie_name)
+          & annotate "The cookie jar did not contain an open-exchange-session-*"
+          & unwrapError
+          & (.cookie_value)
+
+  let req' = req & Client.addToRequestQueryString [("session", Just sessionId)]
+  req' {Client.cookieJar = Just jar}
+
+-- | Log into the mailbox.org service, and return the session secret cookies.
+login :: (HasField "email" dat ByteString, HasField "password" dat ByteString) => dat -> IO Session
+login dat = do
+  rnd <- randomString
+  req <-
+    Client.parseRequest "https://office.mailbox.org/ajax/login"
+      <&> Client.setQueryString
+        [ ("action", Just "formlogin"),
+          ("authId", Just $ ("mbo-" <> rnd) & stringToText & textToBytesUtf8)
+        ]
+      <&> Client.urlEncodedBody
+        [ ("version", "Form+Login"),
+          ("autologin", "true"),
+          ("client", "open-xchange-appsuite"),
+          ("uiWebPath", "/appsuite/"),
+          ("login", dat.email),
+          ("password", dat.password)
+        ]
+  Client.httpNoBody req
+    >>= okOrDie
+    <&> Client.responseCookieJar
+    <&> Session
+  where
+    -- For some reason they want the client to pass a random string
+    -- which is used for the session?‽!?
+    randomString = do
+      gen <- Random.newIOGenM =<< Random.newStdGen
+      let chars = ['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9']
+      let len = 11
+      Random.uniformRM (0, List.length chars - 1) gen
+        & replicateM len
+        <&> map (\index -> chars !! index)
+
+okOrDie :: Show a => Client.Response a -> IO (Client.Response a)
+okOrDie resp =
+  case resp & Client.getResponseStatusCode of
+    200 -> pure resp
+    _ -> do
+      printPretty resp
+      diePanic' "non-200 result"
+
+diePanic' :: ErrorTree -> IO a
+diePanic' errs = errs & prettyErrorTree & diePanic progName
+
+-- | Parse the tools from the given arglib input, and check that the executables exist
+parseToolsArglib :: Netencode.T -> IO Tools
+parseToolsArglib t = do
+  let oneTool name =
+        NetParse.asText
+          <&> textToString
+          <&> ( \path ->
+                  path
+                    & File.getPermissions
+                    <&> File.executable
+                    <&> ( \case
+                            False -> Left $ [fmt|Tool "{name}" is not an executable|]
+                            True -> Right (Tool path)
+                        )
+              )
+  let allTools =
+        parseTools (\name -> Compose $ NetParse.key name >>> oneTool name)
+          & getCompose
+  t
+    & NetParse.runParse
+      "test"
+      -- TODO: a proper ParseT for netencode values
+      ( NetParse.asRecord
+          >>> NetParse.key "BINS"
+          >>> NetParse.asRecord
+          >>> allTools
+      )
+    & orDo diePanic'
+    & join @IO
+    >>= orDo (\errs -> errs & diePanic')
+
+-- | Just assume the tools exist by name in the environment.
+parseToolsToolname :: IO Tools
+parseToolsToolname =
+  parseTools
+    ( \name ->
+        checkInPath name <&> \case
+          False -> Left [fmt|"Cannot find "{name}" in PATH|]
+          True -> Right $ Tool (name & textToString)
+    )
+    >>= orDo diePanic'
+
+checkInPath :: Text -> IO Bool
+checkInPath name = do
+  Env.lookupEnv "PATH"
+    <&> annotate "No PATH set"
+    >>= orDo diePanic'
+    <&> stringToText
+    <&> Text.split (== ':')
+    <&> filter (/= "")
+    >>= traverse
+      ( \p ->
+          File.getPermissions ((textToString p) </> (textToString name))
+            <&> File.executable
+            & try @IOError
+            >>= \case
+              Left _ioError -> pure False
+              Right isExe -> pure isExe
+      )
+    <&> or
+
+orDo :: Applicative f => (t -> f a) -> Either t a -> f a
+orDo f = \case
+  Left e -> f e
+  Right a -> pure a
+
+runTool :: [Text] -> Tool -> IO (Exit.ExitCode, ByteString)
+runTool args tool = do
+  let bashArgs = prettyArgsForBash ((tool.unTool & stringToText) : args)
+  log [fmt|Running: $ {bashArgs}|]
+  Process.proc
+    tool.unTool
+    (args <&> textToString)
+    & Process.readProcessStdout
+    <&> second toStrictBytes
+    <&> second stripWhitespaceFromEnd
+
+-- | Like `runCommandExpect0`, run the given tool, given a tool accessor.
+runToolExpect0 :: [Text] -> Tool -> IO ByteString
+runToolExpect0 args tool =
+  tool & runTool args >>= \(ex, stdout) -> do
+    checkStatus0 tool.unTool ex
+    pure stdout
+
+-- | Check whether a command exited 0 or crash.
+checkStatus0 :: FilePath -> ExitCode -> IO ()
+checkStatus0 executable = \case
+  ExitSuccess -> pure ()
+  ExitFailure status -> do
+    diePanic' [fmt|Command `{executable}` did not exit with status 0 (success), but status {status}|]
+
+stripWhitespaceFromEnd :: ByteString -> ByteString
+stripWhitespaceFromEnd = ByteString.reverse . ByteString.dropWhile (\w -> w == charToWordUnsafe '\n') . ByteString.reverse
+
+-- | Pretty print a command line in a way that can be copied to bash.
+prettyArgsForBash :: [Text] -> Text
+prettyArgsForBash = Text.intercalate " " . map simpleBashEscape
+
+-- | Simple escaping for bash words. If they contain anything that’s not ascii chars
+-- and a bunch of often-used special characters, put the word in single quotes.
+simpleBashEscape :: Text -> Text
+simpleBashEscape t = do
+  case Text.find (not . isSimple) t of
+    Just _ -> escapeSingleQuote t
+    Nothing -> t
+  where
+    -- any word that is just ascii characters is simple (no spaces or control characters)
+    -- or contains a few often-used characters like - or .
+    isSimple c =
+      Char.isAsciiLower c
+        || Char.isAsciiUpper c
+        || Char.isDigit c
+        -- These are benign, bash will not interpret them as special characters.
+        || List.elem c ['-', '.', ':', '/']
+    -- Put the word in single quotes
+    -- If there is a single quote in the word,
+    -- close the single quoted word, add a single quote, open the word again
+    escapeSingleQuote t' = "'" <> Text.replace "'" "'\\''" t' <> "'"
diff --git a/users/Profpatsch/mailbox-org/README.md b/users/Profpatsch/mailbox-org/README.md
new file mode 100644
index 0000000000..b84e7b59c1
--- /dev/null
+++ b/users/Profpatsch/mailbox-org/README.md
@@ -0,0 +1,7 @@
+# mailbox-org
+
+Interfacing with the API of [https://mailbox.org/]().
+
+They use [open-xchange](https://www.open-xchange.com/resources/oxpedia) as their App Suite, so we have to work with/reverse engineer their weird API.
+
+Intended so I have a way of uploading Sieve rules into their system semi-automatically.
diff --git a/users/Profpatsch/mailbox-org/default.nix b/users/Profpatsch/mailbox-org/default.nix
new file mode 100644
index 0000000000..73bd28292d
--- /dev/null
+++ b/users/Profpatsch/mailbox-org/default.nix
@@ -0,0 +1,38 @@
+{ depot, pkgs, lib, ... }:
+
+let
+  mailbox-org = pkgs.haskellPackages.mkDerivation {
+    pname = "mailbox-org";
+    version = "0.1.0";
+
+    src = depot.users.Profpatsch.exactSource ./. [
+      ./mailbox-org.cabal
+      ./src/AesonQQ.hs
+      ./MailboxOrg.hs
+    ];
+
+    libraryHaskellDepends = [
+      depot.users.Profpatsch.my-prelude
+      depot.users.Profpatsch.execline.exec-helpers-hs
+      depot.users.Profpatsch.arglib.netencode.haskell
+      pkgs.haskellPackages.pa-prelude
+      pkgs.haskellPackages.pa-label
+      pkgs.haskellPackages.pa-error-tree
+      pkgs.haskellPackages.aeson
+      pkgs.haskellPackages.http-conduit
+      pkgs.haskellPackages.aeson-better-errors
+    ];
+
+    isLibrary = false;
+    isExecutable = true;
+    license = lib.licenses.mit;
+  };
+
+
+in
+lib.pipe mailbox-org [
+  (x: (depot.nix.getBins x [ "mailbox-org" ]).mailbox-org)
+  (depot.users.Profpatsch.arglib.netencode.with-args "mailbox-org" {
+    BINS = depot.nix.getBins pkgs.dovecot_pigeonhole [ "sieve-test" ];
+  })
+]
diff --git a/users/Profpatsch/mailbox-org/mailbox-org.cabal b/users/Profpatsch/mailbox-org/mailbox-org.cabal
new file mode 100644
index 0000000000..a1b041447b
--- /dev/null
+++ b/users/Profpatsch/mailbox-org/mailbox-org.cabal
@@ -0,0 +1,95 @@
+cabal-version:      3.0
+name:               mailbox-org
+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
+
+
+library
+    import: common-options
+
+    hs-source-dirs: src
+
+    exposed-modules:
+        AesonQQ
+
+    build-depends:
+        base >=4.15 && <5,
+        pa-prelude,
+        aeson,
+        PyF,
+        template-haskell
+
+
+
+executable mailbox-org
+    import: common-options
+    main-is: MailboxOrg.hs
+
+    build-depends:
+        base >=4.15 && <5,
+        mailbox-org,
+        my-prelude,
+        pa-prelude,
+        pa-label,
+        pa-error-tree,
+        exec-helpers,
+        netencode,
+        text,
+        directory,
+        filepath,
+        arglib-netencode,
+        random,
+        http-conduit,
+        aeson,
+        aeson-better-errors,
+        bytestring,
+        typed-process,
+        containers,
diff --git a/users/Profpatsch/mailbox-org/src/AesonQQ.hs b/users/Profpatsch/mailbox-org/src/AesonQQ.hs
new file mode 100644
index 0000000000..2ac3d533ae
--- /dev/null
+++ b/users/Profpatsch/mailbox-org/src/AesonQQ.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE TemplateHaskellQuotes #-}
+
+module AesonQQ where
+
+import Data.Aeson qualified as Json
+import Language.Haskell.TH.Quote (QuasiQuoter)
+import PossehlAnalyticsPrelude
+import PyF qualified
+import PyF.Internal.QQ qualified as PyFConf
+
+aesonQQ :: QuasiQuoter
+aesonQQ =
+  PyF.mkFormatter
+    "aesonQQ"
+    PyF.defaultConfig
+      { PyFConf.delimiters = Just ('|', '|'),
+        PyFConf.postProcess = \exp_ -> do
+          -- TODO: this does not throw an error at compilation time if the json does not parse
+          [|
+            case Json.eitherDecodeStrict' @Json.Value $ textToBytesUtf8 $ stringToText $(exp_) of
+              Left err -> error err
+              Right a -> a
+            |]
+      }
diff --git a/users/Profpatsch/my-prelude/README.md b/users/Profpatsch/my-prelude/README.md
new file mode 100644
index 0000000000..2cc068579a
--- /dev/null
+++ b/users/Profpatsch/my-prelude/README.md
@@ -0,0 +1,42 @@
+# My Haskell Prelude
+
+Contains various modules I’ve found useful when writing Haskell.
+
+## Contents
+
+A short overview:
+
+### `MyPrelude.hs`
+
+A collection of re-exports and extra functions. This does *not* replace the `Prelude` module from `base`, but rather should be imported *in addition* to `Prelude`.
+
+Stuff like bad functions from prelude (partial stuff, or plain horrible stuff) are handled by a custom `.hlint` file, which you can find in [../.hlint.yaml]().
+
+The common style of haskell they try to enable is what I call “left-to-right Haskell”,
+where one mostly prefers forward-chaining operators like `&`/`<&>`/`>>=` to backwards operators like `$`/`<$>`/`<=<`. In addition, all transformation function should follow the scheme of `aToB` instead of `B.fromA`, e.g. `Text.unpack`/`Text.pack` -> `textToString`/`stringToText`. Includes a bunch of text conversion functions one needs all the time, in the same style.
+
+These have been battle-tested in a production codebase of ~30k lines of Haskell.
+
+### `Label.hs`
+
+A very useful collection of anonymous labbeled tuples and enums of size 2 and 3. Assumes GHC >9.2 for `RecordDotSyntax` support.
+
+### `Pretty.hs`
+
+Colorful multiline pretty-printing of Haskell values.
+
+### `Test.hs`
+
+A wrapper around `hspec` which produces colorful test diffs.
+
+### `Aeson.hs`
+
+Helpers around Json parsing.
+
+### `Data.Error.Tree`
+
+Collect errors (from [`Data.Error`](https://hackage.haskell.org/package/error-1.0.0.0/docs/Data-Error.html)) into a tree, then display them in a nested fashion. Super useful for e.g. collecting and displaying nested parsing errors.
+
+### `RunCommand.hs`
+
+A module wrapping the process API with some helpful defaults for executing commands and printing what is executed to stderr.
diff --git a/users/Profpatsch/my-prelude/default.nix b/users/Profpatsch/my-prelude/default.nix
new file mode 100644
index 0000000000..e445115416
--- /dev/null
+++ b/users/Profpatsch/my-prelude/default.nix
@@ -0,0 +1,51 @@
+{ depot, pkgs, lib, ... }:
+
+pkgs.haskellPackages.mkDerivation {
+  pname = "my-prelude";
+  version = "0.0.1-unreleased";
+
+  src = depot.users.Profpatsch.exactSource ./. [
+    ./my-prelude.cabal
+    ./src/Aeson.hs
+    ./src/AtLeast.hs
+    ./src/MyPrelude.hs
+    ./src/Test.hs
+    ./src/Parse.hs
+    ./src/Pretty.hs
+    ./src/Seconds.hs
+    ./src/Tool.hs
+    ./src/ValidationParseT.hs
+    ./src/Postgres/Decoder.hs
+    ./src/Postgres/MonadPostgres.hs
+  ];
+
+  isLibrary = true;
+
+  libraryHaskellDepends = [
+    pkgs.haskellPackages.pa-prelude
+    pkgs.haskellPackages.pa-label
+    pkgs.haskellPackages.pa-error-tree
+    pkgs.haskellPackages.pa-json
+    pkgs.haskellPackages.pa-pretty
+    pkgs.haskellPackages.pa-field-parser
+    pkgs.haskellPackages.aeson-better-errors
+    pkgs.haskellPackages.foldl
+    pkgs.haskellPackages.resource-pool
+    pkgs.haskellPackages.error
+    pkgs.haskellPackages.hs-opentelemetry-api
+    pkgs.haskellPackages.hspec
+    pkgs.haskellPackages.hspec-expectations-pretty-diff
+    pkgs.haskellPackages.monad-logger
+    pkgs.haskellPackages.postgresql-simple
+    pkgs.haskellPackages.profunctors
+    pkgs.haskellPackages.PyF
+    pkgs.haskellPackages.semigroupoids
+    pkgs.haskellPackages.these
+    pkgs.haskellPackages.unliftio
+    pkgs.haskellPackages.validation-selective
+    pkgs.haskellPackages.vector
+  ];
+
+  license = lib.licenses.mit;
+
+}
diff --git a/users/Profpatsch/my-prelude/my-prelude.cabal b/users/Profpatsch/my-prelude/my-prelude.cabal
new file mode 100644
index 0000000000..95a8399f37
--- /dev/null
+++ b/users/Profpatsch/my-prelude/my-prelude.cabal
@@ -0,0 +1,120 @@
+cabal-version:      3.0
+name:               my-prelude
+version:            0.0.1.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
+
+    -- allows defining pattern synonyms, but also the `import Foo (pattern FooPattern)` import syntax
+    PatternSynonyms
+  default-language: GHC2021
+
+
+library
+    import: common-options
+    hs-source-dirs: src
+    exposed-modules:
+      MyPrelude
+      Aeson
+      AtLeast
+      Test
+      Postgres.Decoder
+      Postgres.MonadPostgres
+      ValidationParseT
+      Parse
+      Pretty
+      Seconds
+      Tool
+
+    -- Modules included in this executable, other than Main.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+    build-depends:
+       base >=4.15 && <5
+     , pa-prelude
+     , pa-label
+     , pa-error-tree
+     , pa-json
+     , pa-pretty
+     , pa-field-parser
+     , aeson
+     , aeson-better-errors
+     , bytestring
+     , containers
+     , foldl
+     , unordered-containers
+     , resource-pool
+     , resourcet
+     , scientific
+     , time
+     , error
+     , exceptions
+     , filepath
+     , hspec
+     , hspec-expectations-pretty-diff
+     , hs-opentelemetry-api
+     , monad-logger
+     , mtl
+     , postgresql-simple
+     , profunctors
+     , PyF
+     , semigroupoids
+     , selective
+     , template-haskell
+     , text
+     , these
+     , unix
+     , unliftio
+     , validation-selective
+     , vector
+     , ghc-boot
+     -- for Pretty
+     , aeson-pretty
+     , hscolour
+     , ansi-terminal
+     , nicify-lib
diff --git a/users/Profpatsch/my-prelude/src/Aeson.hs b/users/Profpatsch/my-prelude/src/Aeson.hs
new file mode 100644
index 0000000000..73d6116082
--- /dev/null
+++ b/users/Profpatsch/my-prelude/src/Aeson.hs
@@ -0,0 +1,176 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Aeson where
+
+import Data.Aeson (Value (..))
+import Data.Aeson.BetterErrors qualified as Json
+import Data.Aeson.KeyMap qualified as KeyMap
+import Data.Error.Tree
+import Data.Maybe (catMaybes)
+import Data.Vector qualified as Vector
+import Label
+import PossehlAnalyticsPrelude
+import Test.Hspec (describe, it, shouldBe)
+import Test.Hspec qualified as Hspec
+
+-- | Convert a 'Json.ParseError' to a corresponding 'ErrorTree'
+parseErrorTree :: Error -> Json.ParseError Error -> ErrorTree
+parseErrorTree contextMsg errs =
+  errs
+    & Json.displayError prettyError
+    <&> newError
+    & nonEmpty
+    & \case
+      Nothing -> singleError contextMsg
+      Just errs' -> errorTree contextMsg errs'
+
+-- | Parse a key from the object, à la 'Json.key', return a labelled value.
+--
+-- We don’t provide a version that infers the json object key,
+-- since that conflates internal naming with the external API, which is dangerous.
+--
+-- @@
+-- do
+--   txt <- keyLabel @"myLabel" "jsonKeyName" Json.asText
+--   pure (txt :: Label "myLabel" Text)
+-- @@
+keyLabel ::
+  forall label err m a.
+  Monad m =>
+  Text ->
+  Json.ParseT err m a ->
+  Json.ParseT err m (Label label a)
+keyLabel = do
+  keyLabel' (Proxy @label)
+
+-- | Parse a key from the object, à la 'Json.key', return a labelled value.
+-- Version of 'keyLabel' that requires a proxy.
+--
+-- @@
+-- do
+--   txt <- keyLabel' (Proxy @"myLabel") "jsonKeyName" Json.asText
+--   pure (txt :: Label "myLabel" Text)
+-- @@
+keyLabel' ::
+  forall label err m a.
+  Monad m =>
+  Proxy label ->
+  Text ->
+  Json.ParseT err m a ->
+  Json.ParseT err m (Label label a)
+keyLabel' Proxy key parser = label @label <$> Json.key key parser
+
+-- | Parse an optional key from the object, à la 'Json.keyMay', return a labelled value.
+--
+-- We don’t provide a version that infers the json object key,
+-- since that conflates internal naming with the external API, which is dangerous.
+--
+-- @@
+-- do
+--   txt <- keyLabelMay @"myLabel" "jsonKeyName" Json.asText
+--   pure (txt :: Label "myLabel" (Maybe Text))
+-- @@
+keyLabelMay ::
+  forall label err m a.
+  Monad m =>
+  Text ->
+  Json.ParseT err m a ->
+  Json.ParseT err m (Label label (Maybe a))
+keyLabelMay = do
+  keyLabelMay' (Proxy @label)
+
+-- | Parse an optional key from the object, à la 'Json.keyMay', return a labelled value.
+-- Version of 'keyLabelMay' that requires a proxy.
+--
+-- @@
+-- do
+--   txt <- keyLabelMay' (Proxy @"myLabel") "jsonKeyName" Json.asText
+--   pure (txt :: Label "myLabel" (Maybe Text))
+-- @@
+keyLabelMay' ::
+  forall label err m a.
+  Monad m =>
+  Proxy label ->
+  Text ->
+  Json.ParseT err m a ->
+  Json.ParseT err m (Label label (Maybe a))
+keyLabelMay' Proxy key parser = label @label <$> Json.keyMay key parser
+
+-- | Like 'Json.key', but allows a list of keys that are tried in order.
+--
+-- This is intended for renaming keys in an object.
+-- The first key is the most up-to-date version of a key, the others are for backward-compatibility.
+--
+-- If a key (new or old) exists, the inner parser will always be executed for that key.
+keyRenamed :: Monad m => NonEmpty Text -> Json.ParseT err m a -> Json.ParseT err m a
+keyRenamed (newKey :| oldKeys) inner =
+  keyRenamedTryOldKeys oldKeys inner >>= \case
+    Nothing -> Json.key newKey inner
+    Just parse -> parse
+
+-- | Like 'Json.keyMay', but allows a list of keys that are tried in order.
+--
+-- This is intended for renaming keys in an object.
+-- The first key is the most up-to-date version of a key, the others are for backward-compatibility.
+--
+-- If a key (new or old) exists, the inner parser will always be executed for that key.
+keyRenamedMay :: Monad m => NonEmpty Text -> Json.ParseT err m a -> Json.ParseT err m (Maybe a)
+keyRenamedMay (newKey :| oldKeys) inner =
+  keyRenamedTryOldKeys oldKeys inner >>= \case
+    Nothing -> Json.keyMay newKey inner
+    Just parse -> Just <$> parse
+
+-- | Helper function for 'keyRenamed' and 'keyRenamedMay' that returns the parser for the first old key that exists, if any.
+keyRenamedTryOldKeys :: Monad m => [Text] -> Json.ParseT err m a -> Json.ParseT err m (Maybe (Json.ParseT err m a))
+keyRenamedTryOldKeys oldKeys inner = do
+  oldKeys & traverse tryOld <&> catMaybes <&> nonEmpty <&> \case
+    Nothing -> Nothing
+    Just (old :| _moreOld) -> Just old
+  where
+    tryOld key =
+      Json.keyMay key (pure ()) <&> \case
+        Just () -> Just $ Json.key key inner
+        Nothing -> Nothing
+
+test_keyRenamed :: Hspec.Spec
+test_keyRenamed = do
+  describe "keyRenamed" $ do
+    let parser = keyRenamed ("new" :| ["old"]) Json.asText
+    let p = Json.parseValue @() parser
+    it "accepts the new key and the old key" $ do
+      p (Object (KeyMap.singleton "new" (String "text")))
+        `shouldBe` (Right "text")
+      p (Object (KeyMap.singleton "old" (String "text")))
+        `shouldBe` (Right "text")
+    it "fails with the old key in the error if the inner parser is wrong" $ do
+      p (Object (KeyMap.singleton "old" Null))
+        `shouldBe` (Left (Json.BadSchema [Json.ObjectKey "old"] (Json.WrongType Json.TyString Null)))
+    it "fails with the new key in the error if the inner parser is wrong" $ do
+      p (Object (KeyMap.singleton "new" Null))
+        `shouldBe` (Left (Json.BadSchema [Json.ObjectKey "new"] (Json.WrongType Json.TyString Null)))
+    it "fails if the key is missing" $ do
+      p (Object KeyMap.empty)
+        `shouldBe` (Left (Json.BadSchema [] (Json.KeyMissing "new")))
+  describe "keyRenamedMay" $ do
+    let parser = keyRenamedMay ("new" :| ["old"]) Json.asText
+    let p = Json.parseValue @() parser
+    it "accepts the new key and the old key" $ do
+      p (Object (KeyMap.singleton "new" (String "text")))
+        `shouldBe` (Right (Just "text"))
+      p (Object (KeyMap.singleton "old" (String "text")))
+        `shouldBe` (Right (Just "text"))
+    it "allows the old and new key to be missing" $ do
+      p (Object KeyMap.empty)
+        `shouldBe` (Right Nothing)
+
+-- | Create a json array from a list of json values.
+jsonArray :: [Value] -> Value
+jsonArray xs = xs & Vector.fromList & Array
diff --git a/users/Profpatsch/my-prelude/src/AtLeast.hs b/users/Profpatsch/my-prelude/src/AtLeast.hs
new file mode 100644
index 0000000000..3857c3a7cf
--- /dev/null
+++ b/users/Profpatsch/my-prelude/src/AtLeast.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module AtLeast where
+
+import Data.Aeson (FromJSON (parseJSON))
+import Data.Aeson.BetterErrors qualified as Json
+import FieldParser (FieldParser)
+import FieldParser qualified as Field
+import GHC.Records (HasField (..))
+import GHC.TypeLits (KnownNat, natVal)
+import PossehlAnalyticsPrelude
+  ( Natural,
+    Proxy (Proxy),
+    fmt,
+    prettyError,
+    (&),
+  )
+
+-- | A natural number that must be at least as big as the type literal.
+newtype AtLeast (min :: Natural) num = AtLeast num
+  -- Just use the instances of the wrapped number type
+  deriving newtype (Eq, Show)
+
+-- | This is the “destructor” for `AtLeast`, because of the phantom type (@min@) it cannot be inferred automatically.
+instance HasField "unAtLeast" (AtLeast min num) num where
+  getField (AtLeast num) = num
+
+parseAtLeast ::
+  forall min num.
+  (KnownNat min, Integral num, Show num) =>
+  FieldParser num (AtLeast min num)
+parseAtLeast =
+  let minInt = natVal (Proxy @min)
+   in Field.FieldParser $ \from ->
+        if from >= (minInt & fromIntegral)
+          then Right (AtLeast from)
+          else Left [fmt|Must be at least {minInt & show} but was {from & show}|]
+
+instance
+  (KnownNat min, FromJSON num, Integral num, Bounded num, Show num) =>
+  FromJSON (AtLeast min num)
+  where
+  parseJSON =
+    Json.toAesonParser
+      prettyError
+      ( do
+          num <- Json.fromAesonParser @_ @num
+          case Field.runFieldParser (parseAtLeast @min @num) num of
+            Left err -> Json.throwCustomError err
+            Right a -> pure a
+      )
diff --git a/users/Profpatsch/my-prelude/src/MyPrelude.hs b/users/Profpatsch/my-prelude/src/MyPrelude.hs
new file mode 100644
index 0000000000..880983c47e
--- /dev/null
+++ b/users/Profpatsch/my-prelude/src/MyPrelude.hs
@@ -0,0 +1,776 @@
+{-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module MyPrelude
+  ( -- * Text conversions
+    Text,
+    ByteString,
+    Word8,
+    fmt,
+    textToString,
+    stringToText,
+    stringToBytesUtf8,
+    showToText,
+    textToBytesUtf8,
+    textToBytesUtf8Lazy,
+    bytesToTextUtf8,
+    bytesToTextUtf8Lazy,
+    bytesToTextUtf8Lenient,
+    bytesToTextUtf8LenientLazy,
+    bytesToTextUtf8Unsafe,
+    bytesToTextUtf8UnsafeLazy,
+    toStrict,
+    toLazy,
+    toStrictBytes,
+    toLazyBytes,
+    charToWordUnsafe,
+
+    -- * IO
+    putStrLn,
+    putStderrLn,
+    exitWithMessage,
+
+    -- * WIP code
+    todo,
+
+    -- * Records
+    HasField,
+
+    -- * Control flow
+    doAs,
+    (&),
+    (<&>),
+    (<|>),
+    foldMap1,
+    foldMap',
+    join,
+    when,
+    unless,
+    guard,
+    ExceptT (..),
+    runExceptT,
+    MonadThrow,
+    throwM,
+    MonadIO,
+    liftIO,
+    MonadReader,
+    asks,
+    Bifunctor,
+    first,
+    second,
+    bimap,
+    both,
+    foldMap,
+    fold,
+    foldl',
+    fromMaybe,
+    mapMaybe,
+    findMaybe,
+    Traversable,
+    for,
+    for_,
+    traverse,
+    traverse_,
+    traverseFold,
+    traverseFold1,
+    traverseFoldDefault,
+    MonadTrans,
+    lift,
+
+    -- * Data types
+    Coercible,
+    coerce,
+    Proxy (Proxy),
+    Map,
+    annotate,
+    Validation (Success, Failure),
+    failure,
+    successes,
+    failures,
+    traverseValidate,
+    traverseValidateM,
+    traverseValidateM_,
+    eitherToValidation,
+    eitherToListValidation,
+    validationToEither,
+    These (This, That, These),
+    eitherToThese,
+    eitherToListThese,
+    validationToThese,
+    thenThese,
+    thenValidate,
+    thenValidateM,
+    NonEmpty ((:|)),
+    pattern IsEmpty,
+    pattern IsNonEmpty,
+    singleton,
+    nonEmpty,
+    nonEmptyDef,
+    overNonEmpty,
+    zipNonEmpty,
+    zipWithNonEmpty,
+    zip3NonEmpty,
+    zipWith3NonEmpty,
+    zip4NonEmpty,
+    toList,
+    lengthNatural,
+    maximum1,
+    minimum1,
+    maximumBy1,
+    minimumBy1,
+    Vector,
+    Generic,
+    Lift,
+    Semigroup,
+    sconcat,
+    Monoid,
+    mconcat,
+    ifTrue,
+    ifExists,
+    Void,
+    absurd,
+    Identity (Identity, runIdentity),
+    Natural,
+    intToNatural,
+    Scientific,
+    Contravariant,
+    contramap,
+    (>$<),
+    (>&<),
+    Profunctor,
+    dimap,
+    lmap,
+    rmap,
+    Semigroupoid,
+    Category,
+    (>>>),
+    (&>>),
+    Any,
+
+    -- * Enum definition
+    inverseFunction,
+    inverseMap,
+    enumerateAll,
+
+    -- * Map helpers
+    mapFromListOn,
+    mapFromListOnMerge,
+
+    -- * Error handling
+    HasCallStack,
+    module Data.Error,
+  )
+where
+
+import Control.Applicative ((<|>))
+import Control.Category (Category, (>>>))
+import Control.Foldl.NonEmpty qualified as Foldl1
+import Control.Monad (guard, join, unless, when)
+import Control.Monad.Catch (MonadThrow (throwM))
+import Control.Monad.Except
+  ( ExceptT (..),
+    runExceptT,
+  )
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.Identity (Identity (Identity))
+import Control.Monad.Reader (MonadReader, asks)
+import Control.Monad.Trans (MonadTrans (lift))
+import Data.Bifunctor (Bifunctor, bimap, first, second)
+import Data.ByteString
+  ( ByteString,
+  )
+import Data.ByteString.Lazy qualified
+import Data.Char qualified
+import Data.Coerce (Coercible, coerce)
+import Data.Data (Proxy (Proxy))
+import Data.Error
+import Data.Foldable (Foldable (foldMap', toList), fold, foldl', for_, sequenceA_, traverse_)
+import Data.Foldable qualified as Foldable
+import Data.Function ((&))
+import Data.Functor ((<&>))
+import Data.Functor.Contravariant (Contravariant (contramap), (>$<))
+import Data.Functor.Identity (Identity (runIdentity))
+import Data.List (zip4)
+import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)
+import Data.List.NonEmpty qualified as NonEmpty
+import Data.Map.Strict
+  ( Map,
+  )
+import Data.Map.Strict qualified as Map
+import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Maybe qualified as Maybe
+import Data.Profunctor (Profunctor, dimap, lmap, rmap)
+import Data.Scientific (Scientific)
+import Data.Semigroup (sconcat)
+import Data.Semigroup.Foldable (Foldable1 (fold1), foldMap1)
+import Data.Semigroup.Traversable (Traversable1)
+import Data.Semigroupoid (Semigroupoid (o))
+import Data.Text
+  ( Text,
+  )
+import Data.Text qualified
+import Data.Text.Encoding qualified
+import Data.Text.Encoding.Error qualified
+import Data.Text.Lazy qualified
+import Data.Text.Lazy.Encoding qualified
+import Data.These (These (That, These, This))
+import Data.Traversable (for)
+import Data.Vector (Vector)
+import Data.Void (Void, absurd)
+import Data.Word (Word8)
+import GHC.Exception (errorCallWithCallStackException)
+import GHC.Exts (Any, RuntimeRep, TYPE, raise#)
+import GHC.Generics (Generic)
+import GHC.Natural (Natural)
+import GHC.Records (HasField)
+import GHC.Stack (HasCallStack)
+import GHC.Utils.Encoding qualified as GHC
+import Language.Haskell.TH.Syntax (Lift)
+import PyF (fmt)
+import System.Exit qualified
+import System.IO qualified
+import Validation
+  ( Validation (Failure, Success),
+    eitherToValidation,
+    failure,
+    failures,
+    successes,
+    validationToEither,
+  )
+
+-- | Mark a `do`-block with the type of the Monad/Applicativ it uses.
+-- Only intended for reading ease and making code easier to understand,
+-- especially do-blocks that use unconventional monads (like Maybe or List).
+--
+-- Example:
+--
+-- @
+-- doAs @Maybe $ do
+--  a <- Just 'a'
+--  b <- Just 'b'
+--  pure (a, b)
+-- @
+doAs :: forall m a. m a -> m a
+doAs = id
+
+-- | Forward-applying 'contramap', like '&'/'$' and '<&>'/'<$>' but for '>$<'.
+(>&<) :: (Contravariant f) => f b -> (a -> b) -> f a
+(>&<) = flip contramap
+
+infixl 5 >&<
+
+-- | Forward semigroupoid application. The same as '(>>>)', but 'Semigroupoid' is not a superclass of 'Category' (yet).
+--
+-- Specialized examples:
+--
+-- @
+-- for functions : (a -> b) -> (b -> c) -> (a -> c)
+-- for Folds: Fold a b -> Fold b c -> Fold a c
+-- @
+(&>>) :: (Semigroupoid s) => s a b -> s b c -> s a c
+(&>>) = flip Data.Semigroupoid.o
+
+-- like >>>
+infixr 1 &>>
+
+-- | encode a Text to a UTF-8 encoded Bytestring
+textToBytesUtf8 :: Text -> ByteString
+textToBytesUtf8 = Data.Text.Encoding.encodeUtf8
+
+-- | encode a lazy Text to a UTF-8 encoded lazy Bytestring
+textToBytesUtf8Lazy :: Data.Text.Lazy.Text -> Data.ByteString.Lazy.ByteString
+textToBytesUtf8Lazy = Data.Text.Lazy.Encoding.encodeUtf8
+
+bytesToTextUtf8 :: ByteString -> Either Error Text
+bytesToTextUtf8 = first exceptionToError . Data.Text.Encoding.decodeUtf8'
+
+bytesToTextUtf8Lazy :: Data.ByteString.Lazy.ByteString -> Either Error Data.Text.Lazy.Text
+bytesToTextUtf8Lazy = first exceptionToError . Data.Text.Lazy.Encoding.decodeUtf8'
+
+-- | decode a Text from a ByteString that is assumed to be UTF-8 (crash if that is not the case)
+bytesToTextUtf8Unsafe :: ByteString -> Text
+bytesToTextUtf8Unsafe = Data.Text.Encoding.decodeUtf8
+
+-- | decode a Text from a ByteString that is assumed to be UTF-8 (crash if that is not the case)
+bytesToTextUtf8UnsafeLazy :: Data.ByteString.Lazy.ByteString -> Data.Text.Lazy.Text
+bytesToTextUtf8UnsafeLazy = Data.Text.Lazy.Encoding.decodeUtf8
+
+-- | decode a Text from a ByteString that is assumed to be UTF-8,
+-- replace non-UTF-8 characters with the replacment char U+FFFD.
+bytesToTextUtf8Lenient :: Data.ByteString.ByteString -> Data.Text.Text
+bytesToTextUtf8Lenient =
+  Data.Text.Encoding.decodeUtf8With Data.Text.Encoding.Error.lenientDecode
+
+-- | decode a lazy Text from a lazy ByteString that is assumed to be UTF-8,
+-- replace non-UTF-8 characters with the replacment char U+FFFD.
+bytesToTextUtf8LenientLazy :: Data.ByteString.Lazy.ByteString -> Data.Text.Lazy.Text
+bytesToTextUtf8LenientLazy =
+  Data.Text.Lazy.Encoding.decodeUtf8With Data.Text.Encoding.Error.lenientDecode
+
+-- | Make a lazy 'Text' strict.
+toStrict :: Data.Text.Lazy.Text -> Text
+toStrict = Data.Text.Lazy.toStrict
+
+-- | Make a strict 'Text' lazy.
+toLazy :: Text -> Data.Text.Lazy.Text
+toLazy = Data.Text.Lazy.fromStrict
+
+-- | Make a lazy 'ByteString' strict.
+toStrictBytes :: Data.ByteString.Lazy.ByteString -> ByteString
+toStrictBytes = Data.ByteString.Lazy.toStrict
+
+-- | Make a strict 'ByteString' lazy.
+toLazyBytes :: ByteString -> Data.ByteString.Lazy.ByteString
+toLazyBytes = Data.ByteString.Lazy.fromStrict
+
+-- | Convert a (performant) 'Text' into an (imperformant) list-of-char 'String'.
+--
+-- Some libraries (like @time@ or @network-uri@) still use the `String` as their interface. We only want to convert to string at the edges, otherwise use 'Text'.
+--
+-- ATTN: Don’t use `String` in code if you can avoid it, prefer `Text` instead.
+textToString :: Text -> String
+textToString = Data.Text.unpack
+
+-- | Convert an (imperformant) list-of-char 'String' into a (performant) 'Text' .
+--
+-- Some libraries (like @time@ or @network-uri@) still use the `String` as their interface. We want to convert 'String' to 'Text' as soon as possible and only use 'Text' in our code.
+--
+-- ATTN: Don’t use `String` in code if you can avoid it, prefer `Text` instead.
+stringToText :: String -> Text
+stringToText = Data.Text.pack
+
+-- | Encode a String to an UTF-8 encoded Bytestring
+--
+-- ATTN: Don’t use `String` in code if you can avoid it, prefer `Text` instead.
+stringToBytesUtf8 :: String -> ByteString
+-- TODO(Profpatsch): use a stable interface
+stringToBytesUtf8 = GHC.utf8EncodeByteString
+
+-- | Like `show`, but generate a 'Text'
+--
+-- ATTN: This goes via `String` and thus is fairly inefficient.
+-- We should add a good display library at one point.
+--
+-- ATTN: unlike `show`, this forces the whole @'a
+-- so only use if you want to display the whole thing.
+showToText :: (Show a) => a -> Text
+showToText = stringToText . show
+
+-- | Unsafe conversion between 'Char' and 'Word8'. This is a no-op and
+-- silently truncates to 8 bits Chars > '\255'. It is provided as
+-- convenience for ByteString construction.
+--
+-- Use if you want to get the 'Word8' representation of a character literal.
+-- Don’t use on arbitrary characters!
+--
+-- >>> charToWordUnsafe ','
+-- 44
+charToWordUnsafe :: Char -> Word8
+{-# INLINE charToWordUnsafe #-}
+charToWordUnsafe = fromIntegral . Data.Char.ord
+
+pattern IsEmpty :: [a]
+pattern IsEmpty <- (null -> True)
+  where
+    IsEmpty = []
+
+pattern IsNonEmpty :: NonEmpty a -> [a]
+pattern IsNonEmpty n <- (nonEmpty -> Just n)
+  where
+    IsNonEmpty n = toList n
+
+{-# COMPLETE IsEmpty, IsNonEmpty #-}
+
+-- | Single element in a (non-empty) list.
+singleton :: a -> NonEmpty a
+singleton a = a :| []
+
+-- | If the given list is empty, use the given default element and return a non-empty list.
+nonEmptyDef :: a -> [a] -> NonEmpty a
+nonEmptyDef def xs =
+  xs & nonEmpty & \case
+    Nothing -> def :| []
+    Just ne -> ne
+
+-- | If the list is not empty, run the given function with a NonEmpty list, otherwise just return []
+overNonEmpty :: (Applicative f) => (NonEmpty a -> f [b]) -> [a] -> f [b]
+overNonEmpty f xs = case xs of
+  IsEmpty -> pure []
+  IsNonEmpty xs' -> f xs'
+
+-- | Zip two non-empty lists.
+zipNonEmpty :: NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
+{-# INLINE zipNonEmpty #-}
+zipNonEmpty ~(a :| as) ~(b :| bs) = (a, b) :| zip as bs
+
+-- | Zip two non-empty lists, combining them with the given function
+zipWithNonEmpty :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
+{-# INLINE zipWithNonEmpty #-}
+zipWithNonEmpty = NonEmpty.zipWith
+
+-- | Zip three non-empty lists.
+zip3NonEmpty :: NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty (a, b, c)
+{-# INLINE zip3NonEmpty #-}
+zip3NonEmpty ~(a :| as) ~(b :| bs) ~(c :| cs) = (a, b, c) :| zip3 as bs cs
+
+-- | Zip three non-empty lists, combining them with the given function
+zipWith3NonEmpty :: (a -> b -> c -> d) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d
+{-# INLINE zipWith3NonEmpty #-}
+zipWith3NonEmpty f ~(x :| xs) ~(y :| ys) ~(z :| zs) = f x y z :| zipWith3 f xs ys zs
+
+-- | Zip four non-empty lists
+zip4NonEmpty :: NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty (a, b, c, d)
+{-# INLINE zip4NonEmpty #-}
+zip4NonEmpty ~(a :| as) ~(b :| bs) ~(c :| cs) ~(d :| ds) = (a, b, c, d) :| zip4 as bs cs ds
+
+-- | We don’t want to use Foldable’s `length`, because it is too polymorphic and can lead to bugs.
+-- Only list-y things should have a length.
+class (Foldable f) => Lengthy f
+
+instance Lengthy []
+
+instance Lengthy NonEmpty
+
+instance Lengthy Vector
+
+lengthNatural :: (Lengthy f) => f a -> Natural
+lengthNatural xs =
+  xs
+    & Foldable.length
+    -- length can never be negative or something went really, really wrong
+    & fromIntegral @Int @Natural
+
+-- | @O(n)@. Get the maximum element from a non-empty structure (strict).
+maximum1 :: (Foldable1 f, Ord a) => f a -> a
+maximum1 = Foldl1.fold1 Foldl1.maximum
+
+-- | @O(n)@. Get the maximum element from a non-empty structure, using the given comparator (strict).
+maximumBy1 :: (Foldable1 f) => (a -> a -> Ordering) -> f a -> a
+maximumBy1 f = Foldl1.fold1 (Foldl1.maximumBy f)
+
+-- | @O(n)@. Get the minimum element from a non-empty structure (strict).
+minimum1 :: (Foldable1 f, Ord a) => f a -> a
+minimum1 = Foldl1.fold1 Foldl1.minimum
+
+-- | @O(n)@. Get the minimum element from a non-empty structure, using the given comparator (strict).
+minimumBy1 :: (Foldable1 f) => (a -> a -> Ordering) -> f a -> a
+minimumBy1 f = Foldl1.fold1 (Foldl1.minimumBy f)
+
+-- | Annotate a 'Maybe' with an error message and turn it into an 'Either'.
+annotate :: err -> Maybe a -> Either err a
+annotate err = \case
+  Nothing -> Left err
+  Just a -> Right a
+
+-- | Map the same function over both sides of a Bifunctor (e.g. a tuple).
+both :: (Bifunctor bi) => (a -> b) -> bi a a -> bi b b
+both f = bimap f f
+
+-- | Find the first element for which pred returns `Just a`, and return the `a`.
+--
+-- Example:
+-- @
+-- >>> :set -XTypeApplications
+-- >>> import qualified Text.Read
+--
+-- >>> findMaybe (Text.Read.readMaybe @Int) ["foo"]
+-- Nothing
+-- >>> findMaybe (Text.Read.readMaybe @Int) ["foo", "34.40", "34", "abc"]
+-- Just 34
+findMaybe :: (Foldable t) => (a -> Maybe b) -> t a -> Maybe b
+findMaybe mPred list =
+  let pred' x = Maybe.isJust $ mPred x
+   in case Foldable.find pred' list of
+        Just a -> mPred a
+        Nothing -> Nothing
+
+-- | 'traverse' with a function returning 'Either' and collect all errors that happen, if they happen.
+--
+-- Does not shortcut on error, so will always traverse the whole list/'Traversable' structure.
+--
+-- This is a useful error handling function in many circumstances,
+-- because it won’t only return the first error that happens, but rather all of them.
+traverseValidate :: forall t a err b. (Traversable t) => (a -> Either err b) -> t a -> Either (NonEmpty err) (t b)
+traverseValidate f as =
+  as
+    & traverse @t @(Validation _) (eitherToListValidation . f)
+    & validationToEither
+
+-- | 'traverse' with a function returning 'm Either' and collect all errors that happen, if they happen.
+--
+-- Does not shortcut on error, so will always traverse the whole list/'Traversable' structure.
+--
+-- This is a useful error handling function in many circumstances,
+-- because it won’t only return the first error that happens, but rather all of them.
+traverseValidateM :: forall t m a err b. (Traversable t, Applicative m) => (a -> m (Either err b)) -> t a -> m (Either (NonEmpty err) (t b))
+traverseValidateM f as =
+  as
+    & traverse @t @m (\a -> a & f <&> eitherToListValidation)
+    <&> sequenceA @t @(Validation _)
+    <&> validationToEither
+
+-- | 'traverse_' with a function returning 'm Either' and collect all errors that happen, if they happen.
+--
+-- Does not shortcut on error, so will always traverse the whole list/'Traversable' structure.
+--
+-- This is a useful error handling function in many circumstances,
+-- because it won’t only return the first error that happens, but rather all of them.
+traverseValidateM_ :: forall t m a err. (Traversable t, Applicative m) => (a -> m (Either err ())) -> t a -> m (Either (NonEmpty err) ())
+traverseValidateM_ f as =
+  as
+    & traverse @t @m (\a -> a & f <&> eitherToListValidation)
+    <&> sequenceA_ @t @(Validation _)
+    <&> validationToEither
+
+-- | Like 'eitherToValidation', but puts the Error side into a NonEmpty list
+-- to make it combine with other validations.
+--
+-- See also 'validateEithers', if you have a list of Either and want to collect all errors.
+eitherToListValidation :: Either a c -> Validation (NonEmpty a) c
+eitherToListValidation = first singleton . eitherToValidation
+
+-- | Convert an 'Either' to a 'These'.
+eitherToThese :: Either err a -> These err a
+eitherToThese (Left err) = This err
+eitherToThese (Right a) = That a
+
+-- | Like 'eitherToThese', but puts the Error side into a NonEmpty list
+-- to make it combine with other theses.
+eitherToListThese :: Either err a -> These (NonEmpty err) a
+eitherToListThese (Left e) = This (singleton e)
+eitherToListThese (Right a) = That a
+
+-- | Convert a 'Validation' to a 'These'.
+validationToThese :: Validation err a -> These err a
+validationToThese (Failure err) = This err
+validationToThese (Success a) = That a
+
+-- | Nested '>>=' of a These inside some other @m@.
+--
+-- Use if you want to collect errors and successes, and want to chain multiple function returning 'These'.
+thenThese ::
+  (Monad m, Semigroup err) =>
+  (a -> m (These err b)) ->
+  m (These err a) ->
+  m (These err b)
+thenThese f x = do
+  th <- x
+  join <$> traverse f th
+
+-- | Nested validating bind-like combinator.
+--
+-- Use if you want to collect errors, and want to chain multiple functions returning 'Validation'.
+thenValidate ::
+  (a -> Validation err b) ->
+  Validation err a ->
+  Validation err b
+thenValidate f = \case
+  Success a -> f a
+  Failure err -> Failure err
+
+-- | Nested validating bind-like combinator inside some other @m@.
+--
+-- Use if you want to collect errors, and want to chain multiple functions returning 'Validation'.
+thenValidateM ::
+  (Monad m) =>
+  (a -> m (Validation err b)) ->
+  m (Validation err a) ->
+  m (Validation err b)
+thenValidateM f x =
+  eitherToValidation <$> do
+    x' <- validationToEither <$> x
+    case x' of
+      Left err -> pure $ Left err
+      Right a -> validationToEither <$> f a
+
+-- | Put the text to @stderr@.
+putStderrLn :: Text -> IO ()
+putStderrLn msg =
+  System.IO.hPutStrLn System.IO.stderr $ textToString msg
+
+exitWithMessage :: Text -> IO a
+exitWithMessage msg = do
+  putStderrLn msg
+  System.Exit.exitWith $ System.Exit.ExitFailure (-1)
+
+-- | Run some function producing applicative over a traversable data structure,
+-- then collect the results in a Monoid.
+--
+-- Very helpful with side-effecting functions returning @(Validation err a)@:
+--
+-- @
+-- let
+--   f :: Text -> IO (Validation (NonEmpty Error) Text)
+--   f t = pure $ if t == "foo" then Success t else Failure (singleton ("not foo: " <> t))
+--
+-- in traverseFold f [ "foo", "bar", "baz" ]
+--   == Failure ("not foo bar" :| ["not foo baz"])
+-- @
+--
+-- … since @(Semigroup err => Validation err a)@ is a @Semigroup@/@Monoid@ itself.
+traverseFold :: (Applicative ap, Traversable t, Monoid m) => (a -> ap m) -> t a -> ap m
+{-# INLINE traverseFold #-}
+traverseFold f xs =
+  -- note: could be weakened to (Foldable t) via `getAp . foldMap (Ap . f)`
+  fold <$> traverse f xs
+
+-- | Like 'traverseFold', but fold over a semigroup instead of a Monoid, by providing a starting element.
+traverseFoldDefault :: (Applicative ap, Traversable t, Semigroup m) => m -> (a -> ap m) -> t a -> ap m
+{-# INLINE traverseFoldDefault #-}
+traverseFoldDefault def f xs = foldDef def <$> traverse f xs
+  where
+    foldDef = foldr (<>)
+
+-- | Same as 'traverseFold', but with a 'Semigroup' and 'Traversable1' restriction.
+traverseFold1 :: (Applicative ap, Traversable1 t, Semigroup s) => (a -> ap s) -> t a -> ap s
+{-# INLINE traverseFold1 #-}
+-- note: cannot be weakened to (Foldable1 t) because there is no `Ap` for Semigroup (No `Apply` typeclass)
+traverseFold1 f xs = fold1 <$> traverse f xs
+
+-- | Use this in places where the code is still to be implemented.
+--
+-- It always type-checks and will show a warning at compile time if it was forgotten in the code.
+--
+-- Use instead of 'error' and 'undefined' for code that hasn’t been written.
+--
+-- Uses the same trick as https://hackage.haskell.org/package/protolude-0.3.0/docs/src/Protolude.Error.html#error
+{-# WARNING todo "'todo' (undefined code) remains in code" #-}
+todo :: forall (r :: RuntimeRep). forall (a :: TYPE r). (HasCallStack) => a
+todo = raise# (errorCallWithCallStackException "This code was not yet implemented: TODO" ?callStack)
+
+-- | Convert an integer to a 'Natural' if possible
+--
+-- Named the same as the function from "GHC.Natural", but does not crash.
+intToNatural :: (Integral a) => a -> Maybe Natural
+intToNatural i =
+  if i < 0
+    then Nothing
+    else Just $ fromIntegral i
+
+-- | @inverseFunction f@ creates a function that is the inverse of a given function
+-- @f@. It does so by constructing 'M.Map' internally for each value @f a@. The
+-- implementation makes sure that the 'M.Map' is constructed only once and then
+-- shared for every call.
+--
+-- __Memory usage note:__ don't inverse functions that have types like 'Int'
+-- as their result. In this case the created 'M.Map' will have huge size.
+--
+-- The complexity of reversed mapping is \(\mathcal{O}(\log n)\).
+--
+-- __Performance note:__ make sure to specialize monomorphic type of your functions
+-- that use 'inverseFunction' to avoid 'M.Map' reconstruction.
+--
+-- One of the common 'inverseFunction' use-case is inverting the 'show' or a 'show'-like
+-- function.
+--
+-- >>> data Color = Red | Green | Blue deriving (Show, Enum, Bounded)
+-- >>> parse = inverseFunction show :: String -> Maybe Color
+-- >>> parse "Red"
+-- Just Red
+-- >>> parse "Black"
+-- Nothing
+--
+-- __Correctness note:__ 'inverseFunction' expects /injective function/ as its argument,
+-- i.e. the function must map distinct arguments to distinct values.
+--
+-- Typical usage of this function looks like this:
+--
+-- @
+-- __data__ GhcVer
+--    = Ghc802
+--    | Ghc822
+--    | Ghc844
+--    | Ghc865
+--    | Ghc881
+--    __deriving__ ('Eq', 'Ord', 'Show', 'Enum', 'Bounded')
+--
+-- showGhcVer :: GhcVer -> 'Text'
+-- showGhcVer = \\__case__
+--    Ghc802 -> "8.0.2"
+--    Ghc822 -> "8.2.2"
+--    Ghc844 -> "8.4.4"
+--    Ghc865 -> "8.6.5"
+--    Ghc881 -> "8.8.1"
+--
+-- parseGhcVer :: 'Text' -> 'Maybe' GhcVer
+-- parseGhcVer = 'inverseFunction' showGhcVer
+--
+-- Taken from relude’s @Relude.Extra.Enum@.
+inverseFunction ::
+  forall a k.
+  (Bounded a, Enum a, Ord k) =>
+  (a -> k) ->
+  (k -> Maybe a)
+inverseFunction f k = Map.lookup k $ inverseMap f
+
+-- | Like `inverseFunction`, but instead of returning the function
+-- it returns a mapping from all possible outputs to their possible inputs.
+--
+-- This has the same restrictions of 'inverseFunction'.
+inverseMap :: forall a k. (Bounded a, Enum a, Ord k) => (a -> k) -> Map k a
+inverseMap f = enumerateAll <&> (\a -> (f a, a)) & Map.fromList
+
+-- | All possible values in this enum.
+enumerateAll :: (Enum a, Bounded a) => [a]
+enumerateAll = [minBound .. maxBound]
+
+-- | Create a 'Map' from a list of values, extracting the map key from each value. Like 'Map.fromList'.
+--
+-- Attention: if the key is not unique, the earliest value with the key will be in the map.
+mapFromListOn :: (Ord key) => (a -> key) -> [a] -> Map key a
+mapFromListOn f xs = xs <&> (\x -> (f x, x)) & Map.fromList
+
+-- | Create a 'Map' from a list of values, merging multiple values at the same key with '<>' (left-to-right)
+--
+-- `f` has to extract the key and value. Value must be mergable.
+--
+-- Attention: if the key is not unique, the earliest value with the key will be in the map.
+mapFromListOnMerge :: (Ord key, Semigroup s) => (a -> (key, s)) -> [a] -> Map key s
+mapFromListOnMerge f xs =
+  xs
+    <&> (\x -> f x)
+    & Map.fromListWith
+      -- we have to flip (`<>`) because `Map.fromListWith` merges its values “the other way around”
+      (flip (<>))
+
+-- | If the predicate is true, return the @m@, else 'mempty'.
+--
+-- This can be used (together with `ifExists`) to e.g. create lists with optional elements:
+--
+-- >>> import Data.Monoid (Sum(..))
+--
+-- >>> :{ mconcat [
+--   ifTrue (1 == 1) [1],
+--   [2, 3, 4],
+--   ifTrue False [5],
+-- ]
+-- :}
+-- [1,2,3,4]
+--
+-- Or any other Monoid:
+--
+-- >>> mconcat [ Sum 1, ifTrue (1 == 1) (Sum 2), Sum 3 ]
+
+-- Sum {getSum = 6}
+
+ifTrue :: (Monoid m) => Bool -> m -> m
+ifTrue pred' m = if pred' then m else mempty
+
+-- | If the given @Maybe@ is @Just@, return the result of `f` wrapped in `pure`, else return `mempty`.
+
+-- This can be used (together with `ifTrue`) to e.g. create lists with optional elements:
+--
+-- >>> import Data.Monoid (Sum(..))
+--
+-- >>> :{ mconcat [
+-- unknown command '{'
+--
+-- Or any other Monoid:
+--
+-- >>> mconcat [ Sum 1, ifExists id (Just 2), Sum 3 ]
+-- Sum {getSum = 6}
+
+ifExists :: (Monoid (f b), Applicative f) => (a -> b) -> Maybe a -> f b
+ifExists f m = m & foldMap @Maybe (pure . f)
diff --git a/users/Profpatsch/my-prelude/src/Parse.hs b/users/Profpatsch/my-prelude/src/Parse.hs
new file mode 100644
index 0000000000..65a0b0d39e
--- /dev/null
+++ b/users/Profpatsch/my-prelude/src/Parse.hs
@@ -0,0 +1,174 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Parse where
+
+import Control.Category qualified
+import Control.Selective (Selective)
+import Data.Error.Tree
+import Data.Functor.Compose
+import Data.List qualified as List
+import Data.Monoid (First (..))
+import Data.Semigroup.Traversable
+import Data.Semigroupoid qualified as Semigroupoid
+import Data.Text qualified as Text
+import FieldParser (FieldParser)
+import FieldParser qualified as Field
+import PossehlAnalyticsPrelude
+import Validation (partitionValidations)
+import Prelude hiding (init, maybe)
+import Prelude qualified
+
+-- | A generic applicative “vertical” parser.
+-- Similar to `FieldParser`, but made for parsing whole structures and collect all errors in an `ErrorTree`.
+newtype Parse from to = Parse ((Context, from) -> Validation (NonEmpty ErrorTree) (Context, to))
+  deriving
+    (Functor, Applicative, Selective)
+    via ( Compose
+            ( Compose
+                ((->) (Context, from))
+                (Validation (NonEmpty ErrorTree))
+            )
+            ((,) Context)
+        )
+
+-- | Every parser can add to the context, like e.g. an element parser will add the name of the element it should be parsing.
+-- This should be added to the error message of each parser, with `showContext`.
+newtype Context = Context (Maybe [Text])
+  deriving stock (Show)
+  deriving (Semigroup, Monoid) via (First [Text])
+
+instance Semigroupoid Parse where
+  o p2 p1 = Parse $ \from -> case runParse' p1 from of
+    Failure err -> Failure err
+    Success to1 -> runParse' p2 to1
+
+instance Category Parse where
+  (.) = Semigroupoid.o
+  id = Parse $ \t -> Success t
+
+instance Profunctor Parse where
+  lmap f (Parse p) = Parse $ lmap (second f) p
+  rmap = (<$>)
+
+runParse :: Error -> Parse from to -> from -> Either ErrorTree to
+runParse errMsg parser t =
+  (Context (Just ["$"]), t)
+    & runParse' parser
+    <&> snd
+    & first (nestedMultiError errMsg)
+    & validationToEither
+
+runParse' :: Parse from to -> (Context, from) -> Validation (NonEmpty ErrorTree) (Context, to)
+runParse' (Parse f) from = f from
+
+showContext :: Context -> Text
+showContext (Context context) = context & fromMaybe [] & List.reverse & Text.intercalate "."
+
+addContext :: Text -> Context -> Context
+addContext x (Context mxs) = Context (Just $ x : (mxs & fromMaybe []))
+
+mkParsePushContext :: Text -> ((Context, from) -> Either ErrorTree to) -> Parse from to
+mkParsePushContext toPush f = Parse $ \(ctx, from) -> case f (ctx, from) of
+  Right to -> Success (addContext toPush ctx, to)
+  Left err -> Failure $ singleton err
+
+mkParseNoContext :: (from -> Either ErrorTree to) -> Parse from to
+mkParseNoContext f = Parse $ \(ctx, from) -> case f from of
+  Right to -> Success (ctx, to)
+  Left err -> Failure $ singleton err
+
+-- | Accept only exactly the given value
+exactly :: (Eq from) => (from -> Text) -> from -> Parse from from
+exactly errDisplay from = Parse $ \(ctx, from') ->
+  if from == from'
+    then Success (ctx, from')
+    else Failure $ singleton [fmt|Field has to be exactly {errDisplay from}, was: {errDisplay from'} at {showContext ctx}|]
+
+-- | Make a parser to parse the whole list
+multiple :: Parse a1 a2 -> Parse [a1] [a2]
+multiple inner = dimap nonEmpty (Prelude.maybe [] toList) (maybe $ multipleNE inner)
+
+-- | Make a parser to parse the whole non-empty list
+multipleNE :: Parse from to -> Parse (NonEmpty from) (NonEmpty to)
+multipleNE inner = Parse $ \(ctx, from) ->
+  from
+    & zipIndex
+    & traverse (\(idx, f) -> runParse' inner (ctx, f) & first (singleton . nestedMultiError [fmt|{idx}|]))
+    -- we assume that, since the same parser is used everywhere, the context will be the same as well (TODO: correct?)
+    & second (\((ctx', y) :| ys) -> (ctx', y :| (snd <$> ys)))
+
+-- | Like '(>>>)', but returns the intermediate result alongside the final parse result.
+andParse :: Parse to to2 -> Parse from to -> Parse from (to, to2)
+andParse outer inner = Parse $ \from -> case runParse' inner from of
+  Failure err -> Failure err
+  Success (ctx, to) -> runParse' outer (ctx, to) <&> (second (to,))
+
+-- | Lift a parser into an optional value
+maybe :: Parse from to -> Parse (Maybe from) (Maybe to)
+maybe inner = Parse $ \(ctx, m) -> case m of
+  Nothing -> Success (ctx, Nothing)
+  Just a -> runParse' inner (ctx, a) & second (fmap Just)
+
+-- | Assert that there is exactly one element in the list
+exactlyOne :: Parse [from] from
+exactlyOne = Parse $ \(ctx, xs) -> case xs of
+  [] -> Failure $ singleton [fmt|Expected exactly 1 element, but got 0, at {ctx & showContext}|]
+  [one] -> Success (ctx, one)
+  _more -> Failure $ singleton [fmt|Expected exactly 1 element, but got 2, at {ctx & showContext}|]
+
+-- | Assert that there is exactly zero or one element in the list
+zeroOrOne :: Parse [from] (Maybe from)
+zeroOrOne = Parse $ \(ctx, xs) -> case xs of
+  [] -> Success (ctx, Nothing)
+  [one] -> Success (ctx, Just one)
+  _more -> Failure $ singleton [fmt|Expected exactly 1 element, but got 2, at {ctx & showContext}|]
+
+-- | Find the first element on which the sub-parser succeeds; if there was no match, return all error messages.
+find :: Parse from to -> Parse [from] to
+find inner = Parse $ \(ctx, xs) -> case xs of
+  [] -> failure [fmt|Wanted to get the first sub-parser that succeeds, but there were no elements in the list, at {ctx & showContext}|]
+  (y : ys) -> runParse' (findNE' inner) (ctx, y :| ys)
+
+-- | Find the first element on which the sub-parser succeeds; if there was no match, return all error messages.
+findNE' :: Parse from to -> Parse (NonEmpty from) to
+findNE' inner = Parse $ \(ctx, xs) ->
+  xs
+    <&> (\x -> runParse' inner (ctx, x))
+    & traverse1
+      ( \case
+          Success a -> Left a
+          Failure e -> Right e
+      )
+    & \case
+      Left a -> Success a
+      Right errs ->
+        errs
+          & zipIndex
+          <&> (\(idx, errs') -> nestedMultiError [fmt|{idx}|] errs')
+          & nestedMultiError [fmt|None of these sub-parsers succeeded|]
+          & singleton
+          & Failure
+
+-- | Find all elements on which the sub-parser succeeds; if there was no match, return an empty list
+findAll :: Parse from to -> Parse [from] [to]
+findAll inner = Parse $ \(ctx, xs) ->
+  xs
+    <&> (\x -> runParse' inner (ctx, x))
+    & partitionValidations
+    & \case
+      (_miss, []) ->
+        -- in this case we just arbitrarily forward the original context …
+        Success (ctx, [])
+      (_miss, (hitCtx, hit) : hits) -> Success (hitCtx, hit : (hits <&> snd))
+
+-- | convert a 'FieldParser' into a 'Parse'.
+fieldParser :: FieldParser from to -> Parse from to
+fieldParser fp = Parse $ \(ctx, from) -> case Field.runFieldParser fp from of
+  Right a -> Success (ctx, a)
+  Left err -> Failure $ singleton (singleError err)
+
+zipNonEmpty :: NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
+zipNonEmpty (x :| xs) (y :| ys) = (x, y) :| zip xs ys
+
+zipIndex :: NonEmpty b -> NonEmpty (Natural, b)
+zipIndex = zipNonEmpty (1 :| [2 :: Natural ..])
diff --git a/users/Profpatsch/my-prelude/src/Postgres/Decoder.hs b/users/Profpatsch/my-prelude/src/Postgres/Decoder.hs
new file mode 100644
index 0000000000..008b89b4ba
--- /dev/null
+++ b/users/Profpatsch/my-prelude/src/Postgres/Decoder.hs
@@ -0,0 +1,94 @@
+module Postgres.Decoder where
+
+import Control.Applicative (Alternative)
+import Data.Aeson qualified as Json
+import Data.Aeson.BetterErrors qualified as Json
+import Data.Error.Tree
+import Data.Typeable (Typeable)
+import Database.PostgreSQL.Simple (Binary (fromBinary))
+import Database.PostgreSQL.Simple.FromField qualified as PG
+import Database.PostgreSQL.Simple.FromRow qualified as PG
+import Json qualified
+import Label
+import PossehlAnalyticsPrelude
+
+-- | A Decoder of postgres values. Allows embedding more complex parsers (like a 'Json.ParseT').
+newtype Decoder a = Decoder (PG.RowParser a)
+  deriving newtype (Functor, Applicative, Alternative, Monad)
+
+-- | Parse a `bytea` field, equivalent to @Binary ByteString@ but avoids the pitfall of having to use 'Binary'.
+bytea :: Decoder ByteString
+bytea = fromField @(Binary ByteString) <&> (.fromBinary)
+
+-- | Parse a nullable `bytea` field, equivalent to @Binary ByteString@ but avoids the pitfall of having to use 'Binary'.
+byteaMay :: Decoder (Maybe ByteString)
+byteaMay = fromField @(Maybe (Binary ByteString)) <&> fmap (.fromBinary)
+
+-- | Turn any type that implements 'PG.fromField' into a 'Decoder'. Use type applications to prevent accidental conversions:
+--
+-- @
+-- fromField @Text :: Decoder Text
+-- @
+fromField :: PG.FromField a => Decoder a
+fromField = Decoder $ PG.fieldWith PG.fromField
+
+-- | Turn any type that implements 'PG.fromField' into a 'Decoder' and wrap the result into the given 'Label'. Use type applications to prevent accidental conversions:
+--
+-- @
+-- fromField @"myField" @Text :: Decoder (Label "myField" Text)
+-- @
+fromFieldLabel :: forall lbl a. PG.FromField a => Decoder (Label lbl a)
+fromFieldLabel = label @lbl <$> fromField
+
+-- | Parse fields out of a json value returned from the database.
+--
+-- ATTN: The whole json record has to be transferred before it is parsed,
+-- so if you only need a tiny bit of it, use `->` and `->>` in your SQL statement
+-- and return only the fields you need from the query.
+--
+-- In that case pay attention to NULL though:
+--
+-- @
+-- SELECT '{"foo": {}}'::jsonb->>'foo' IS NULL
+-- → TRUE
+-- @
+--
+-- Also note: `->>` will coerce the json value to @text@, regardless of the content.
+-- So the JSON object @{"foo": {}}"@ would be returned as the text: @"{\"foo\": {}}"@.
+json :: Typeable a => Json.ParseT ErrorTree Identity a -> Decoder a
+json parser = Decoder $ PG.fieldWith $ \field bytes -> do
+  val <- PG.fromField @Json.Value field bytes
+  case Json.parseValue parser val of
+    Left err ->
+      PG.returnError
+        PG.ConversionFailed
+        field
+        (err & Json.parseErrorTree "Cannot decode jsonb column" & prettyErrorTree & textToString)
+    Right a -> pure a
+
+-- | Parse fields out of a nullable json value returned from the database.
+--
+-- ATTN: The whole json record has to be transferred before it is parsed,
+-- so if you only need a tiny bit of it, use `->` and `->>` in your SQL statement
+-- and return only the fields you need from the query.
+--
+-- In that case pay attention to NULL though:
+--
+-- @
+-- SELECT '{"foo": {}}'::jsonb->>'foo' IS NULL
+-- → TRUE
+-- @
+--
+-- Also note: `->>` will coerce the json value to @text@, regardless of the content.
+-- So the JSON object @{"foo": {}}"@ would be returned as the text: @"{\"foo\": {}}"@.
+jsonMay :: Typeable a => Json.ParseT ErrorTree Identity a -> Decoder (Maybe a)
+jsonMay parser = Decoder $ PG.fieldWith $ \field bytes -> do
+  val <- PG.fromField @(Maybe Json.Value) field bytes
+  case Json.parseValue parser <$> val of
+    Nothing -> pure Nothing
+    Just (Left err) ->
+      PG.returnError
+        PG.ConversionFailed
+        field
+        (err & Json.parseErrorTree "Cannot decode jsonb column" & prettyErrorTree & textToString)
+    Just (Right a) -> pure (Just a)
diff --git a/users/Profpatsch/my-prelude/src/Postgres/MonadPostgres.hs b/users/Profpatsch/my-prelude/src/Postgres/MonadPostgres.hs
new file mode 100644
index 0000000000..f83a6d7fcf
--- /dev/null
+++ b/users/Profpatsch/my-prelude/src/Postgres/MonadPostgres.hs
@@ -0,0 +1,760 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Postgres.MonadPostgres where
+
+import AtLeast (AtLeast)
+import Control.Exception
+import Control.Foldl qualified as Fold
+import Control.Monad.Logger.CallStack (MonadLogger, logDebug, logWarn)
+import Control.Monad.Reader (MonadReader (ask), ReaderT (..))
+import Control.Monad.Trans.Resource
+import Data.Aeson (FromJSON)
+import Data.Error.Tree
+import Data.HashMap.Strict qualified as HashMap
+import Data.Int (Int64)
+import Data.Kind (Type)
+import Data.List qualified as List
+import Data.Pool (Pool)
+import Data.Pool qualified as Pool
+import Data.Text qualified as Text
+import Data.Typeable (Typeable)
+import Database.PostgreSQL.Simple (Connection, FormatError, FromRow, Query, QueryError, ResultError, SqlError, ToRow)
+import Database.PostgreSQL.Simple qualified as PG
+import Database.PostgreSQL.Simple qualified as Postgres
+import Database.PostgreSQL.Simple.FromRow qualified as PG
+import Database.PostgreSQL.Simple.ToField (ToField)
+import Database.PostgreSQL.Simple.ToRow (ToRow (toRow))
+import Database.PostgreSQL.Simple.Types (Query (..))
+import GHC.Records (getField)
+import Label
+import OpenTelemetry.Trace.Core qualified as Otel hiding (inSpan, inSpan')
+import OpenTelemetry.Trace.Monad qualified as Otel
+import PossehlAnalyticsPrelude
+import Postgres.Decoder
+import Postgres.Decoder qualified as Dec
+import Pretty (showPretty)
+import Seconds
+import System.Exit (ExitCode (..))
+import Tool
+import UnliftIO (MonadUnliftIO (withRunInIO))
+import UnliftIO.Process qualified as Process
+import UnliftIO.Resource qualified as Resource
+import Prelude hiding (init, span)
+
+-- | Postgres queries/commands that can be executed within a running transaction.
+--
+-- These are implemented with the @postgresql-simple@ primitives of the same name
+-- and will behave the same unless othewise documented.
+class (Monad m) => MonadPostgres (m :: Type -> Type) where
+  -- | Execute an INSERT, UPDATE, or other SQL query that is not expected to return results.
+
+  -- Returns the number of rows affected.
+  execute ::
+    (ToRow params, Typeable params) =>
+    Query ->
+    params ->
+    Transaction m (Label "numberOfRowsAffected" Natural)
+
+  -- | Execute a multi-row INSERT, UPDATE, or other SQL query that is not expected to return results.
+  --
+  -- Returns the number of rows affected. If the list of parameters is empty,
+  -- this function will simply return 0 without issuing the query to the backend.
+  -- If this is not desired, consider using the 'PG.Values' constructor instead.
+  executeMany ::
+    (ToRow params, Typeable params) =>
+    Query ->
+    NonEmpty params ->
+    Transaction m (Label "numberOfRowsAffected" Natural)
+
+  -- | Execute INSERT ... RETURNING, UPDATE ... RETURNING,
+  -- or other SQL query that accepts multi-row input and is expected to return results.
+  -- Note that it is possible to write query conn "INSERT ... RETURNING ..." ...
+  -- in cases where you are only inserting a single row,
+  -- and do not need functionality analogous to 'executeMany'.
+  --
+  -- If the list of parameters is empty, this function will simply return [] without issuing the query to the backend. If this is not desired, consider using the 'PG.Values' constructor instead.
+  executeManyReturningWith :: (ToRow q) => Query -> NonEmpty q -> Decoder r -> Transaction m [r]
+
+  -- | Run a query, passing parameters and result row parser.
+  queryWith ::
+    (PG.ToRow params, Typeable params, Typeable r) =>
+    PG.Query ->
+    params ->
+    Decoder r ->
+    Transaction m [r]
+
+  -- | Run a query without any parameters and result row parser.
+  queryWith_ ::
+    (Typeable r) =>
+    PG.Query ->
+    Decoder r ->
+    Transaction m [r]
+
+  -- | Run a query, passing parameters, and fold over the resulting rows.
+  --
+  -- This doesn’t have to realize the full list of results in memory,
+  -- rather results are streamed incrementally from the database.
+  --
+  -- When dealing with small results, it may be simpler (and perhaps faster) to use query instead.
+  --
+  -- This fold is _not_ strict. The stream consumer is responsible
+  -- for forcing the evaluation of its result to avoid space leaks.
+  --
+  -- If you can, prefer aggregating in the database itself.
+  foldRowsWithAcc ::
+    (ToRow params, Typeable row, Typeable params) =>
+    Query ->
+    params ->
+    Decoder row ->
+    a ->
+    (a -> row -> Transaction m a) ->
+    Transaction m a
+
+  -- | Run a given transaction in a transaction block, rolling back the transaction
+  -- if any exception (postgres or Haskell Exception) is thrown during execution.
+  --
+  -- Re-throws the exception.
+  --
+  -- Don’t do any long-running things on the Haskell side during a transaction,
+  -- because it will block a database connection and potentially also lock
+  -- database tables from being written or read by other clients.
+  --
+  -- Nonetheless, try to push transactions as far out to the handlers as possible,
+  -- don’t do something like @runTransaction $ query …@, because it will lead people
+  -- to accidentally start nested transactions (the inner transaction is run on a new connections,
+  -- thus can’t see any changes done by the outer transaction).
+  -- Only handlers should run transactions.
+  runTransaction :: Transaction m a -> m a
+
+-- | Run a query, passing parameters. Prefer 'queryWith' if possible.
+query ::
+  forall m params r.
+  (PG.ToRow params, PG.FromRow r, Typeable params, Typeable r, MonadPostgres m) =>
+  PG.Query ->
+  params ->
+  Transaction m [r]
+query qry params = queryWith qry params (Decoder PG.fromRow)
+
+-- | Run a query without any parameters. Prefer 'queryWith' if possible.
+--
+-- TODO: I think(?) this can always be replaced by passing @()@ to 'query', remove?
+query_ ::
+  forall m r.
+  (Typeable r, PG.FromRow r, MonadPostgres m) =>
+  PG.Query ->
+  Transaction m [r]
+query_ qry = queryWith_ qry (Decoder PG.fromRow)
+
+-- TODO: implement via fold, so that the result doesn’t have to be realized in memory
+querySingleRow ::
+  ( MonadPostgres m,
+    ToRow qParams,
+    Typeable qParams,
+    FromRow a,
+    Typeable a,
+    MonadThrow m
+  ) =>
+  Query ->
+  qParams ->
+  Transaction m a
+querySingleRow qry params = do
+  query qry params >>= ensureSingleRow
+
+-- TODO: implement via fold, so that the result doesn’t have to be realized in memory
+querySingleRowWith ::
+  ( MonadPostgres m,
+    ToRow qParams,
+    Typeable qParams,
+    Typeable a,
+    MonadThrow m
+  ) =>
+  Query ->
+  qParams ->
+  Decoder a ->
+  Transaction m a
+querySingleRowWith qry params decoder = do
+  queryWith qry params decoder >>= ensureSingleRow
+
+-- TODO: implement via fold, so that the result doesn’t have to be realized in memory
+querySingleRowMaybe ::
+  ( MonadPostgres m,
+    ToRow qParams,
+    Typeable qParams,
+    FromRow a,
+    Typeable a,
+    MonadThrow m
+  ) =>
+  Query ->
+  qParams ->
+  Transaction m (Maybe a)
+querySingleRowMaybe qry params = do
+  rows <- query qry params
+  case rows of
+    [] -> pure Nothing
+    [one] -> pure (Just one)
+    -- TODO: Should we MonadThrow this here? It’s really an implementation detail of MonadPostgres
+    -- that a database function can error out, should probably handled by the instances.
+    more -> throwM $ SingleRowError {numberOfRowsReturned = (List.length more)}
+
+ensureSingleRow ::
+  (MonadThrow m) =>
+  [a] ->
+  m a
+ensureSingleRow = \case
+  -- TODO: Should we MonadThrow this here? It’s really an implementation detail of MonadPostgres
+  -- that a database function can error out, should probably handled by the instances.
+  [] -> throwM (SingleRowError {numberOfRowsReturned = 0})
+  [one] -> pure one
+  more ->
+    throwM $
+      SingleRowError
+        { numberOfRowsReturned =
+            -- TODO: this is VERY bad, because it requires to parse the full database output, even if there’s 10000000000 elements
+            List.length more
+        }
+
+ensureNoneOrSingleRow ::
+  (MonadThrow m) =>
+  [a] ->
+  m (Maybe a)
+ensureNoneOrSingleRow = \case
+  -- TODO: Should we MonadThrow this here? It’s really an implementation detail of MonadPostgres
+  -- that a database function can error out, should probably handled by the instances.
+  [] -> pure Nothing
+  [one] -> pure $ Just one
+  more ->
+    throwM $
+      SingleRowError
+        { numberOfRowsReturned =
+            -- TODO: this is VERY bad, because it requires to parse the full database output, even if there’s 10000000000 elements
+            List.length more
+        }
+
+-- | Run a query, passing parameters, and fold over the resulting rows.
+--
+-- This doesn’t have to realize the full list of results in memory,
+-- rather results are streamed incrementally from the database.
+--
+-- When dealing with small results, it may be simpler (and perhaps faster) to use query instead.
+--
+-- The results are folded strictly by the 'Fold.Fold' that is passed.
+--
+-- If you can, prefer aggregating in the database itself.
+foldRowsWith ::
+  forall row params m b.
+  ( MonadPostgres m,
+    PG.ToRow params,
+    Typeable row,
+    Typeable params
+  ) =>
+  PG.Query ->
+  params ->
+  Decoder row ->
+  Fold.Fold row b ->
+  Transaction m b
+foldRowsWith qry params decoder = Fold.purely f
+  where
+    f :: forall x. (x -> row -> x) -> x -> (x -> b) -> Transaction m b
+    f acc init extract = do
+      x <- foldRowsWithAcc qry params decoder init (\a r -> pure $ acc a r)
+      pure $ extract x
+
+newtype Transaction m a = Transaction {unTransaction :: (ReaderT Connection m a)}
+  deriving newtype
+    ( Functor,
+      Applicative,
+      Monad,
+      MonadThrow,
+      MonadLogger,
+      MonadIO,
+      MonadUnliftIO,
+      MonadTrans,
+      Otel.MonadTracer
+    )
+
+-- | [Resource Pool](http://hackage.haskell.org/package/resource-pool-0.2.3.2/docs/Data-Pool.html) configuration.
+data PoolingInfo = PoolingInfo
+  { -- | Minimal amount of resources that are
+    --   always available.
+    numberOfStripes :: AtLeast 1 Int,
+    -- | Time after which extra resources
+    --   (above minimum) can stay in the pool
+    --   without being used.
+    unusedResourceOpenTime :: Seconds,
+    -- | Max number of resources that can be
+    --   in the Pool at any time
+    maxOpenResourcesAcrossAllStripes :: AtLeast 1 Int
+  }
+  deriving stock (Generic, Eq, Show)
+  deriving anyclass (FromJSON)
+
+initMonadPostgres ::
+  (Text -> IO ()) ->
+  -- | Info describing the connection to the Postgres DB
+  Postgres.ConnectInfo ->
+  -- | Configuration info for pooling attributes
+  PoolingInfo ->
+  -- | Created Postgres connection pool
+  ResourceT IO (Pool Postgres.Connection)
+initMonadPostgres logInfoFn connectInfo poolingInfo = do
+  (_releaseKey, connPool) <-
+    Resource.allocate
+      (logInfoFn "Creating Postgres Connection Pool" >> createPGConnPool)
+      (\pool -> logInfoFn "Destroying Postgres Connection Pool" >> destroyPGConnPool pool)
+  pure connPool
+  where
+    -- \| Create a Postgres connection pool
+    createPGConnPool ::
+      IO (Pool Postgres.Connection)
+    createPGConnPool =
+      Pool.newPool $
+        Pool.defaultPoolConfig
+          {- resource init action -} poolCreateResource
+          {- resource destruction -} poolfreeResource
+          ( poolingInfo.unusedResourceOpenTime.unSeconds
+              & fromIntegral @Natural @Double
+          )
+          (poolingInfo.maxOpenResourcesAcrossAllStripes.unAtLeast)
+      where
+        poolCreateResource = Postgres.connect connectInfo
+        poolfreeResource = Postgres.close
+
+    -- \| Destroy a Postgres connection pool
+    destroyPGConnPool ::
+      -- \| Pool to be destroyed
+      (Pool Postgres.Connection) ->
+      IO ()
+    destroyPGConnPool p = Pool.destroyAllResources p
+
+-- | Improve a possible error message, by adding some context to it.
+--
+-- The given Exception type is caught, 'show'n and pretty-printed.
+--
+-- In case we get an `IOError`, we display it in a reasonable fashion.
+addErrorInformation ::
+  forall exc a.
+  (Exception exc) =>
+  Text.Text ->
+  IO a ->
+  IO a
+addErrorInformation msg io =
+  io
+    & try @exc
+    <&> first (showPretty >>> newError >>> errorContext msg)
+    & try @IOError
+    <&> first (showToError >>> errorContext "IOError" >>> errorContext msg)
+    <&> join @(Either Error)
+    >>= unwrapIOError
+
+-- | Catch any Postgres exception that gets thrown,
+-- print the query that was run and the query parameters,
+-- then rethrow inside an 'Error'.
+handlePGException ::
+  forall a params tools m.
+  ( ToRow params,
+    MonadUnliftIO m,
+    MonadLogger m,
+    HasField "pgFormat" tools Tool
+  ) =>
+  tools ->
+  Text ->
+  Query ->
+  -- | Depending on whether we used `format` or `formatMany`.
+  Either params (NonEmpty params) ->
+  IO a ->
+  Transaction m a
+handlePGException tools queryType query' params io = do
+  withRunInIO $ \unliftIO ->
+    io
+      `catches` [ Handler $ unliftIO . logQueryException @SqlError,
+                  Handler $ unliftIO . logQueryException @QueryError,
+                  Handler $ unliftIO . logQueryException @ResultError,
+                  Handler $ unliftIO . logFormatException
+                ]
+  where
+    -- TODO: use throwInternalError here (after pulling it into the MonadPostgres class)
+    throwAsError = unwrapIOError . Left . newError
+    throwErr err = liftIO $ throwAsError $ prettyErrorTree $ nestedMultiError "A Postgres query failed" err
+    logQueryException :: (Exception e) => e -> Transaction m a
+    logQueryException exc = do
+      formattedQuery <- case params of
+        Left one -> pgFormatQuery' tools query' one
+        Right many -> pgFormatQueryMany' tools query' many
+      throwErr
+        ( singleError [fmt|Query Type: {queryType}|]
+            :| [ nestedError "Exception" (exc & showPretty & newError & singleError),
+                 nestedError "Query" (formattedQuery & newError & singleError)
+               ]
+        )
+    logFormatException :: FormatError -> Transaction m a
+    logFormatException fe = throwErr (fe & showPretty & newError & singleError & singleton)
+
+-- | Perform a Postgres action within a transaction
+withPGTransaction ::
+  -- | Postgres connection pool to be used for the action
+  (Pool Postgres.Connection) ->
+  -- | DB-action to be performed
+  (Postgres.Connection -> IO a) ->
+  -- | Result of the DB-action
+  IO a
+withPGTransaction connPool f =
+  Pool.withResource
+    connPool
+    (\conn -> Postgres.withTransaction conn (f conn))
+
+runPGTransactionImpl ::
+  (MonadUnliftIO m) =>
+  m (Pool Postgres.Connection) ->
+  Transaction m a ->
+  m a
+{-# INLINE runPGTransactionImpl #-}
+runPGTransactionImpl zoom (Transaction transaction) = do
+  pool <- zoom
+  withRunInIO $ \unliftIO ->
+    withPGTransaction pool $ \conn -> do
+      unliftIO $ runReaderT transaction conn
+
+executeImpl ::
+  (ToRow params, MonadUnliftIO m, MonadLogger m, HasField "pgFormat" tools Tool, Otel.MonadTracer m) =>
+  m tools ->
+  m DebugLogDatabaseQueries ->
+  Query ->
+  params ->
+  Transaction m (Label "numberOfRowsAffected" Natural)
+{-# INLINE executeImpl #-}
+executeImpl zoomTools zoomDebugLogDatabaseQueries qry params =
+  Otel.inSpan' "Postgres Query (execute)" Otel.defaultSpanArguments $ \span -> do
+    tools <- lift @Transaction zoomTools
+    logDatabaseQueries <- lift @Transaction zoomDebugLogDatabaseQueries
+    traceQueryIfEnabled tools span logDatabaseQueries qry (HasSingleParam params)
+    conn <- Transaction ask
+    PG.execute conn qry params
+      & handlePGException tools "execute" qry (Left params)
+      >>= toNumberOfRowsAffected "executeImpl"
+
+executeImpl_ ::
+  (MonadUnliftIO m, MonadLogger m, HasField "pgFormat" tools Tool, Otel.MonadTracer m) =>
+  m tools ->
+  m DebugLogDatabaseQueries ->
+  Query ->
+  Transaction m (Label "numberOfRowsAffected" Natural)
+{-# INLINE executeImpl_ #-}
+executeImpl_ zoomTools zoomDebugLogDatabaseQueries qry =
+  Otel.inSpan' "Postgres Query (execute)" Otel.defaultSpanArguments $ \span -> do
+    tools <- lift @Transaction zoomTools
+    logDatabaseQueries <- lift @Transaction zoomDebugLogDatabaseQueries
+    traceQueryIfEnabled @() tools span logDatabaseQueries qry HasNoParams
+    conn <- Transaction ask
+    PG.execute_ conn qry
+      & handlePGException tools "execute_" qry (Left ())
+      >>= toNumberOfRowsAffected "executeImpl_"
+
+executeManyImpl ::
+  (ToRow params, MonadUnliftIO m, MonadLogger m, HasField "pgFormat" tools Tool, Otel.MonadTracer m) =>
+  m tools ->
+  m DebugLogDatabaseQueries ->
+  Query ->
+  NonEmpty params ->
+  Transaction m (Label "numberOfRowsAffected" Natural)
+executeManyImpl zoomTools zoomDebugLogDatabaseQueries qry params =
+  Otel.inSpan' "Postgres Query (execute)" Otel.defaultSpanArguments $ \span -> do
+    tools <- lift @Transaction zoomTools
+    logDatabaseQueries <- lift @Transaction zoomDebugLogDatabaseQueries
+    traceQueryIfEnabled tools span logDatabaseQueries qry (HasMultiParams params)
+    conn <- Transaction ask
+    PG.executeMany conn qry (params & toList)
+      & handlePGException tools "executeMany" qry (Right params)
+      >>= toNumberOfRowsAffected "executeManyImpl"
+
+toNumberOfRowsAffected :: (MonadIO m) => Text -> Int64 -> m (Label "numberOfRowsAffected" Natural)
+toNumberOfRowsAffected functionName i64 =
+  i64
+    & intToNatural
+    & annotate [fmt|{functionName}: postgres returned a negative number of rows affected: {i64}|]
+    -- we throw this directly in IO here, because we don’t want to e.g. have to propagate MonadThrow through user code (it’s an assertion)
+    & unwrapIOError
+    & liftIO
+    <&> label @"numberOfRowsAffected"
+
+executeManyReturningWithImpl ::
+  (ToRow params, MonadUnliftIO m, MonadLogger m, HasField "pgFormat" tools Tool, Otel.MonadTracer m) =>
+  m tools ->
+  m DebugLogDatabaseQueries ->
+  Query ->
+  NonEmpty params ->
+  Decoder r ->
+  Transaction m [r]
+{-# INLINE executeManyReturningWithImpl #-}
+executeManyReturningWithImpl zoomTools zoomDebugLogDatabaseQueries qry params (Decoder fromRow) = do
+  Otel.inSpan' "Postgres Query (execute)" Otel.defaultSpanArguments $ \span -> do
+    tools <- lift @Transaction zoomTools
+    logDatabaseQueries <- lift @Transaction zoomDebugLogDatabaseQueries
+    traceQueryIfEnabled tools span logDatabaseQueries qry (HasMultiParams params)
+    conn <- Transaction ask
+    PG.returningWith fromRow conn qry (params & toList)
+      & handlePGException tools "executeManyReturning" qry (Right params)
+
+foldRowsWithAccImpl ::
+  ( ToRow params,
+    MonadUnliftIO m,
+    MonadLogger m,
+    HasField "pgFormat" tools Tool,
+    Otel.MonadTracer m
+  ) =>
+  m tools ->
+  m DebugLogDatabaseQueries ->
+  Query ->
+  params ->
+  Decoder row ->
+  a ->
+  (a -> row -> Transaction m a) ->
+  Transaction m a
+{-# INLINE foldRowsWithAccImpl #-}
+foldRowsWithAccImpl zoomTools zoomDebugLogDatabaseQueries qry params (Decoder rowParser) accumulator f = do
+  Otel.inSpan' "Postgres Query (foldRowsWithAcc)" Otel.defaultSpanArguments $ \span -> do
+    tools <- lift @Transaction zoomTools
+    logDatabaseQueries <- lift @Transaction zoomDebugLogDatabaseQueries
+    traceQueryIfEnabled tools span logDatabaseQueries qry (HasSingleParam params)
+    conn <- Transaction ask
+    withRunInIO
+      ( \runInIO ->
+          do
+            PG.foldWithOptionsAndParser
+              PG.defaultFoldOptions
+              rowParser
+              conn
+              qry
+              params
+              accumulator
+              (\acc row -> runInIO $ f acc row)
+              & handlePGException tools "fold" qry (Left params)
+              & runInIO
+      )
+
+pgFormatQueryNoParams' ::
+  (MonadIO m, MonadLogger m, HasField "pgFormat" tools Tool) =>
+  tools ->
+  Query ->
+  Transaction m Text
+pgFormatQueryNoParams' tools q =
+  lift $ pgFormatQueryByteString tools q.fromQuery
+
+pgFormatQuery ::
+  (ToRow params, MonadIO m) =>
+  Query ->
+  params ->
+  Transaction m ByteString
+pgFormatQuery qry params = Transaction $ do
+  conn <- ask
+  liftIO $ PG.formatQuery conn qry params
+
+pgFormatQueryMany ::
+  (MonadIO m, ToRow params) =>
+  Query ->
+  NonEmpty params ->
+  Transaction m ByteString
+pgFormatQueryMany qry params = Transaction $ do
+  conn <- ask
+  liftIO $
+    PG.formatMany
+      conn
+      qry
+      ( params
+          -- upstream is partial on empty list, see https://github.com/haskellari/postgresql-simple/issues/129
+          & toList
+      )
+
+queryWithImpl ::
+  ( ToRow params,
+    MonadUnliftIO m,
+    MonadLogger m,
+    HasField "pgFormat" tools Tool,
+    Otel.MonadTracer m
+  ) =>
+  m tools ->
+  m DebugLogDatabaseQueries ->
+  Query ->
+  params ->
+  Decoder r ->
+  Transaction m [r]
+{-# INLINE queryWithImpl #-}
+queryWithImpl zoomTools zoomDebugLogDatabaseQueries qry params (Decoder fromRow) = do
+  Otel.inSpan' "Postgres Query (execute)" Otel.defaultSpanArguments $ \span -> do
+    tools <- lift @Transaction zoomTools
+    logDatabaseQueries <- lift @Transaction zoomDebugLogDatabaseQueries
+    traceQueryIfEnabled tools span logDatabaseQueries qry (HasSingleParam params)
+    conn <- Transaction ask
+    PG.queryWith fromRow conn qry params
+      & handlePGException tools "query" qry (Left params)
+
+queryWithImpl_ ::
+  ( MonadUnliftIO m,
+    MonadLogger m,
+    HasField "pgFormat" tools Tool
+  ) =>
+  m tools ->
+  Query ->
+  Decoder r ->
+  Transaction m [r]
+{-# INLINE queryWithImpl_ #-}
+queryWithImpl_ zoomTools qry (Decoder fromRow) = do
+  tools <- lift @Transaction zoomTools
+  conn <- Transaction ask
+  liftIO (PG.queryWith_ fromRow conn qry)
+    & handlePGException tools "query" qry (Left ())
+
+data SingleRowError = SingleRowError
+  { -- | How many columns were actually returned by the query
+    numberOfRowsReturned :: Int
+  }
+  deriving stock (Show)
+
+instance Exception SingleRowError where
+  displayException (SingleRowError {..}) = [fmt|Single row expected from SQL query result, {numberOfRowsReturned} rows were returned instead."|]
+
+pgFormatQuery' ::
+  ( MonadIO m,
+    ToRow params,
+    MonadLogger m,
+    HasField "pgFormat" tools Tool
+  ) =>
+  tools ->
+  Query ->
+  params ->
+  Transaction m Text
+pgFormatQuery' tools q p =
+  pgFormatQuery q p
+    >>= lift . pgFormatQueryByteString tools
+
+pgFormatQueryMany' ::
+  ( MonadIO m,
+    ToRow params,
+    MonadLogger m,
+    HasField "pgFormat" tools Tool
+  ) =>
+  tools ->
+  Query ->
+  NonEmpty params ->
+  Transaction m Text
+pgFormatQueryMany' tools q p =
+  pgFormatQueryMany q p
+    >>= lift . pgFormatQueryByteString tools
+
+-- | Read the executable name "pg_format"
+postgresToolsParser :: ToolParserT IO (Label "pgFormat" Tool)
+postgresToolsParser = label @"pgFormat" <$> readTool "pg_format"
+
+pgFormatQueryByteString ::
+  ( MonadIO m,
+    MonadLogger m,
+    HasField "pgFormat" tools Tool
+  ) =>
+  tools ->
+  ByteString ->
+  m Text
+pgFormatQueryByteString tools queryBytes = do
+  do
+    (exitCode, stdout, stderr) <-
+      Process.readProcessWithExitCode
+        tools.pgFormat.toolPath
+        ["-"]
+        (queryBytes & bytesToTextUtf8Lenient & textToString)
+    case exitCode of
+      ExitSuccess -> pure (stdout & stringToText)
+      ExitFailure status -> do
+        logWarn [fmt|pg_format failed with status {status} while formatting the query, using original query string. Is there a syntax error?|]
+        logDebug
+          ( prettyErrorTree
+              ( nestedMultiError
+                  "pg_format output"
+                  ( nestedError "stdout" (singleError (stdout & stringToText & newError))
+                      :| [(nestedError "stderr" (singleError (stderr & stringToText & newError)))]
+                  )
+              )
+          )
+        logDebug [fmt|pg_format stdout: stderr|]
+        pure (queryBytes & bytesToTextUtf8Lenient)
+
+data DebugLogDatabaseQueries
+  = -- | Do not log the database queries
+    DontLogDatabaseQueries
+  | -- | Log the database queries as debug output;
+    LogDatabaseQueries
+  | -- | Log the database queries as debug output and additionally the EXPLAIN output (from the query analyzer, not the actual values after execution cause that’s a bit harder to do)
+    LogDatabaseQueriesAndExplain
+  deriving stock (Show, Enum, Bounded)
+
+data HasQueryParams param
+  = HasNoParams
+  | HasSingleParam param
+  | HasMultiParams (NonEmpty param)
+
+-- | Log the postgres query depending on the given setting
+traceQueryIfEnabled ::
+  ( ToRow params,
+    MonadUnliftIO m,
+    MonadLogger m,
+    HasField "pgFormat" tools Tool,
+    Otel.MonadTracer m
+  ) =>
+  tools ->
+  Otel.Span ->
+  DebugLogDatabaseQueries ->
+  Query ->
+  HasQueryParams params ->
+  Transaction m ()
+traceQueryIfEnabled tools span logDatabaseQueries qry params = do
+  -- In case we have query logging enabled, we want to do that
+  let formattedQuery = case params of
+        HasNoParams -> pgFormatQueryNoParams' tools qry
+        HasSingleParam p -> pgFormatQuery' tools qry p
+        HasMultiParams ps -> pgFormatQueryMany' tools qry ps
+  let doLog errs =
+        Otel.addAttributes
+          span
+          $ HashMap.fromList
+          $ ( ("_.postgres.query", Otel.toAttribute @Text errs.query)
+                : ( errs.explain
+                      & foldMap
+                        ( \ex ->
+                            [("_.postgres.explain", Otel.toAttribute @Text ex)]
+                        )
+                  )
+            )
+  let doExplain = do
+        q <- formattedQuery
+        Otel.inSpan "Postgres EXPLAIN Query" Otel.defaultSpanArguments $ do
+          queryWithImpl_
+            (pure tools)
+            ( "EXPLAIN "
+                <> (
+                     -- TODO: this is not nice, but the only way to get the `executeMany` form to work with this
+                     -- because we need the query with all elements already interpolated.
+                     Query (q & textToBytesUtf8)
+                   )
+            )
+            (Dec.fromField @Text)
+            <&> Text.intercalate "\n"
+  case logDatabaseQueries of
+    DontLogDatabaseQueries -> pure ()
+    LogDatabaseQueries -> do
+      q <- formattedQuery
+      doLog (T2 (label @"query" q) (label @"explain" Nothing))
+    LogDatabaseQueriesAndExplain -> do
+      q <- formattedQuery
+      -- XXX: stuff like `CREATE SCHEMA` cannot be EXPLAINed, so we should catch exceptions here
+      -- and just ignore anything that errors (if it errors because of a problem with the query, it would have been caught by the query itself.
+      ex <- doExplain
+      doLog (T2 (label @"query" q) (label @"explain" (Just ex)))
+
+instance (ToField t1) => ToRow (Label l1 t1) where
+  toRow t2 = toRow $ PG.Only $ getField @l1 t2
+
+instance (ToField t1, ToField t2) => ToRow (T2 l1 t1 l2 t2) where
+  toRow t2 = toRow (getField @l1 t2, getField @l2 t2)
+
+instance (ToField t1, ToField t2, ToField t3) => ToRow (T3 l1 t1 l2 t2 l3 t3) where
+  toRow t3 = toRow (getField @l1 t3, getField @l2 t3, getField @l3 t3)
diff --git a/users/Profpatsch/my-prelude/src/Pretty.hs b/users/Profpatsch/my-prelude/src/Pretty.hs
new file mode 100644
index 0000000000..d9d4ce132b
--- /dev/null
+++ b/users/Profpatsch/my-prelude/src/Pretty.hs
@@ -0,0 +1,108 @@
+module Pretty
+  ( -- * Pretty printing for error messages
+    Err,
+    showPretty,
+    showPrettyJson,
+    showedStringPretty,
+    printPretty,
+    printShowedStringPretty,
+    -- constructors hidden
+    prettyErrs,
+    message,
+    messageString,
+    pretty,
+    prettyString,
+    hscolour',
+  )
+where
+
+import Data.Aeson qualified as Json
+import Data.Aeson.Encode.Pretty qualified as Aeson.Pretty
+import Data.List qualified as List
+import Data.Text.Lazy.Builder qualified as Text.Builder
+import Language.Haskell.HsColour
+  ( Output (TTYg),
+    hscolour,
+  )
+import Language.Haskell.HsColour.ANSI (TerminalType (..))
+import Language.Haskell.HsColour.Colourise
+  ( defaultColourPrefs,
+  )
+import PossehlAnalyticsPrelude
+import System.Console.ANSI (setSGRCode)
+import System.Console.ANSI.Types
+  ( Color (Red),
+    ColorIntensity (Dull),
+    ConsoleLayer (Foreground),
+    SGR (Reset, SetColor),
+  )
+import Text.Nicify (nicify)
+
+-- | Print any 'Show'able type to stderr, formatted nicely and in color. Very helpful for debugging.
+printPretty :: (Show a) => a -> IO ()
+printPretty a =
+  a & showPretty & putStderrLn
+
+showPretty :: (Show a) => a -> Text
+showPretty a = a & pretty & (: []) & prettyErrs & stringToText
+
+-- | Pretty-print a string that was produced by `show` to stderr, formatted nicely and in color.
+printShowedStringPretty :: String -> IO ()
+printShowedStringPretty s = s & showedStringPretty & putStderrLn
+
+-- | Pretty-print a string that was produced by `show`
+showedStringPretty :: String -> Text
+showedStringPretty s = s & ErrPrettyString & (: []) & prettyErrs & stringToText
+
+showPrettyJson :: Json.Value -> Text
+showPrettyJson val =
+  val
+    & Aeson.Pretty.encodePrettyToTextBuilder
+    & Text.Builder.toLazyText
+    & toStrict
+
+-- | Display a list of 'Err's as a colored error message
+-- and abort the test.
+prettyErrs :: [Err] -> String
+prettyErrs errs = res
+  where
+    res = List.intercalate "\n" $ map one errs
+    one = \case
+      ErrMsg s -> color Red s
+      ErrPrettyString s -> prettyShowString s
+    -- Pretty print a String that was produced by 'show'
+    prettyShowString :: String -> String
+    prettyShowString = hscolour' . nicify
+
+-- | Small DSL for pretty-printing errors
+data Err
+  = -- | Message to display in the error
+    ErrMsg String
+  | -- | Pretty print a String that was produced by 'show'
+    ErrPrettyString String
+
+-- | Plain message to display, as 'Text'
+message :: Text -> Err
+message = ErrMsg . textToString
+
+-- | Plain message to display, as 'String'
+messageString :: String -> Err
+messageString = ErrMsg
+
+-- | Any 'Show'able to pretty print
+pretty :: (Show a) => a -> Err
+pretty x = ErrPrettyString $ show x
+
+-- | Pretty print a String that was produced by 'show'
+prettyString :: String -> Err
+prettyString s = ErrPrettyString s
+
+-- Prettifying Helpers, mostly stolen from
+-- https://hackage.haskell.org/package/hspec-expectations-pretty-diff-0.7.2.5/docs/src/Test.Hspec.Expectations.Pretty.html#prettyColor
+
+hscolour' :: String -> String
+hscolour' =
+  hscolour (TTYg Ansi16Colour) defaultColourPrefs False False "" False
+
+color :: Color -> String -> String
+color c s = setSGRCode [SetColor Foreground Dull c] ++ s ++ setSGRCode [Reset]
diff --git a/users/Profpatsch/my-prelude/src/Seconds.hs b/users/Profpatsch/my-prelude/src/Seconds.hs
new file mode 100644
index 0000000000..8d05f30be8
--- /dev/null
+++ b/users/Profpatsch/my-prelude/src/Seconds.hs
@@ -0,0 +1,55 @@
+module Seconds where
+
+import Data.Aeson (FromJSON)
+import Data.Aeson qualified as Json
+import Data.Aeson.Types (FromJSON (parseJSON))
+import Data.Scientific
+import Data.Time (NominalDiffTime)
+import FieldParser
+import FieldParser qualified as Field
+import GHC.Natural (naturalToInteger)
+import PossehlAnalyticsPrelude
+
+-- | A natural number of seconds.
+newtype Seconds = Seconds {unSeconds :: Natural}
+  deriving stock (Eq, Show)
+
+-- | Parse a decimal number as a number of seconds
+textToSeconds :: FieldParser Text Seconds
+textToSeconds = Seconds <$> Field.decimalNatural
+
+scientificToSeconds :: FieldParser Scientific Seconds
+scientificToSeconds =
+  ( Field.boundedScientificIntegral @Int "Number of seconds"
+      >>> Field.integralToNatural
+  )
+    & rmap Seconds
+
+-- Microseconds, represented internally with a 64 bit Int
+newtype MicrosecondsInt = MicrosecondsInt {unMicrosecondsInt :: Int}
+  deriving stock (Eq, Show)
+
+-- | Try to fit a number of seconds into a MicrosecondsInt
+secondsToMicrosecondsInt :: FieldParser Seconds MicrosecondsInt
+secondsToMicrosecondsInt =
+  lmap
+    (\sec -> naturalToInteger sec.unSeconds * 1_000_000)
+    (Field.bounded "Could not fit into an Int after multiplying with 1_000_000 (seconds to microseconds)")
+    & rmap MicrosecondsInt
+
+secondsToNominalDiffTime :: Seconds -> NominalDiffTime
+secondsToNominalDiffTime sec =
+  sec.unSeconds
+    & naturalToInteger
+    & fromInteger @NominalDiffTime
+
+instance FromJSON Seconds where
+  parseJSON = Field.toParseJSON jsonNumberToSeconds
+
+-- | Parse a json number as a number of seconds.
+jsonNumberToSeconds :: FieldParser' Error Json.Value Seconds
+jsonNumberToSeconds = Field.jsonNumber >>> scientificToSeconds
+
+-- | Return the number of seconds in a week
+secondsInAWeek :: Seconds
+secondsInAWeek = Seconds (3600 * 24 * 7)
diff --git a/users/Profpatsch/my-prelude/src/Test.hs b/users/Profpatsch/my-prelude/src/Test.hs
new file mode 100644
index 0000000000..862ee16c25
--- /dev/null
+++ b/users/Profpatsch/my-prelude/src/Test.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE LambdaCase #-}
+
+{- Generate Test suites.
+
+Restricted version of hspec, introduction: http://hspec.github.io/getting-started.html
+-}
+module Test
+  ( Spec,
+    runTest,
+    testMain,
+
+    -- * Structure
+    describe,
+    it,
+
+    -- * Expectations
+    Expectation,
+    testOk,
+    testErr,
+    shouldBe,
+    shouldNotBe,
+    shouldSatisfy,
+    shouldNotSatisfy,
+
+    -- * Setup & Teardown (hooks http://hspec.github.io/writing-specs.html#using-hooks)
+    before,
+    before_,
+    beforeWith,
+    beforeAll,
+    beforeAll_,
+    beforeAllWith,
+    after,
+    after_,
+    afterAll,
+    afterAll_,
+    around,
+    around_,
+    aroundWith,
+    aroundAll,
+    aroundAllWith,
+
+    -- * Common helpful predicates (use with 'shouldSatisfy')
+    isRight,
+    isLeft,
+
+    -- * Pretty printing of errors
+    errColored,
+    module Pretty,
+  )
+where
+
+-- export more expectations if needed
+
+import Data.Either
+  ( isLeft,
+    isRight,
+  )
+import Pretty
+import Test.Hspec
+  ( Expectation,
+    HasCallStack,
+    Spec,
+    after,
+    afterAll,
+    afterAll_,
+    after_,
+    around,
+    aroundAll,
+    aroundAllWith,
+    aroundWith,
+    around_,
+    before,
+    beforeAll,
+    beforeAllWith,
+    beforeAll_,
+    beforeWith,
+    before_,
+    describe,
+    hspec,
+    it,
+  )
+import Test.Hspec.Expectations.Pretty
+  ( expectationFailure,
+    shouldBe,
+    shouldNotBe,
+    shouldNotSatisfy,
+    shouldSatisfy,
+  )
+
+-- | Run a test directly (e.g. from the repl)
+runTest :: Spec -> IO ()
+runTest = hspec
+
+-- | Run a testsuite
+testMain ::
+  -- | Name of the test suite
+  String ->
+  -- | The tests in this test module
+  Spec ->
+  IO ()
+testMain testSuiteName tests = hspec $ describe testSuiteName tests
+
+-- | test successful
+testOk :: Expectation
+testOk = pure ()
+
+-- | Abort the test with an error message.
+-- If you want to display a Haskell type, use `errColored`.
+testErr :: HasCallStack => String -> Expectation
+testErr = expectationFailure
+
+-- | Display a list of 'Err's as a colored error message
+-- and abort the test.
+errColored :: [Pretty.Err] -> Expectation
+errColored = testErr . Pretty.prettyErrs
diff --git a/users/Profpatsch/my-prelude/src/Tool.hs b/users/Profpatsch/my-prelude/src/Tool.hs
new file mode 100644
index 0000000000..b773f4444e
--- /dev/null
+++ b/users/Profpatsch/my-prelude/src/Tool.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Tool where
+
+import Data.Error.Tree
+import Label
+import PossehlAnalyticsPrelude
+import System.Environment qualified as Env
+import System.Exit qualified as Exit
+import System.FilePath ((</>))
+import System.Posix qualified as Posix
+import ValidationParseT
+
+data Tool = Tool
+  { -- | absolute path to the executable
+    toolPath :: FilePath
+  }
+  deriving stock (Show)
+
+-- | Reads all tools from the @toolsEnvVar@ variable or aborts.
+readTools ::
+  Label "toolsEnvVar" Text ->
+  -- | Parser for Tools we bring with us at build time.
+  --
+  -- These are executables that we need available, and that we have to ship with the distribution of @pa-cli@.
+  ToolParserT IO tools ->
+  IO tools
+readTools env toolParser =
+  Env.lookupEnv (env.toolsEnvVar & textToString) >>= \case
+    Nothing -> do
+      Exit.die [fmt|Please set {env.toolsEnvVar} to a directory with all tools we need (see `Tools` in the code).|]
+    Just toolsDir ->
+      (Posix.fileExist toolsDir & ifTrueOrErr () [fmt|{env.toolsEnvVar} directory does not exist: {toolsDir}|])
+        & thenValidateM
+          ( \() ->
+              (Posix.getFileStatus toolsDir <&> Posix.isDirectory)
+                & ifTrueOrErr () [fmt|{env.toolsEnvVar} does not point to a directory: {toolsDir}|]
+          )
+        & thenValidateM
+          (\() -> toolParser.unToolParser toolsDir)
+        <&> first (errorTree [fmt|Could not find all tools in {env.toolsEnvVar}|])
+        >>= \case
+          Failure err -> Exit.die (err & prettyErrorTree & textToString)
+          Success t -> pure t
+
+newtype ToolParserT m a = ToolParserT
+  { unToolParser ::
+      FilePath ->
+      m (Validation (NonEmpty Error) a)
+  }
+  deriving
+    (Functor, Applicative)
+    via (ValidationParseT FilePath m)
+
+-- | Given a file path and the name of the tool executable, see whether it is an executable and return its full path.
+readTool :: Text -> ToolParserT IO Tool
+readTool exeName = ToolParserT $ \toolDir -> do
+  let toolPath :: FilePath = toolDir </> (exeName & textToString)
+  let read' = True
+  let write = False
+  let exec = True
+  Posix.fileExist toolPath
+    & ifTrueOrErr () [fmt|Tool does not exist: {toolPath}|]
+    & thenValidateM
+      ( \() ->
+          Posix.fileAccess toolPath read' write exec
+            & ifTrueOrErr (Tool {..}) [fmt|Tool is not readable/executable: {toolPath}|]
+      )
+
+-- | helper
+ifTrueOrErr :: (Functor f) => a -> Text -> f Bool -> f (Validation (NonEmpty Error) a)
+ifTrueOrErr true err io =
+  io <&> \case
+    True -> Success true
+    False -> Failure $ singleton $ newError err
diff --git a/users/Profpatsch/my-prelude/src/ValidationParseT.hs b/users/Profpatsch/my-prelude/src/ValidationParseT.hs
new file mode 100644
index 0000000000..593b7ebf39
--- /dev/null
+++ b/users/Profpatsch/my-prelude/src/ValidationParseT.hs
@@ -0,0 +1,16 @@
+module ValidationParseT where
+
+import Control.Selective (Selective)
+import Data.Functor.Compose (Compose (..))
+import PossehlAnalyticsPrelude
+
+-- | A simple way to create an Applicative parser that parses from some environment.
+--
+-- Use with DerivingVia. Grep codebase for examples.
+newtype ValidationParseT env m a = ValidationParseT {unValidationParseT :: env -> m (Validation (NonEmpty Error) a)}
+  deriving
+    (Functor, Applicative, Selective)
+    via ( Compose
+            ((->) env)
+            (Compose m (Validation (NonEmpty Error)))
+        )
diff --git a/users/Profpatsch/my-webstuff/default.nix b/users/Profpatsch/my-webstuff/default.nix
new file mode 100644
index 0000000000..0067235be2
--- /dev/null
+++ b/users/Profpatsch/my-webstuff/default.nix
@@ -0,0 +1,27 @@
+{ depot, pkgs, lib, ... }:
+
+pkgs.haskellPackages.mkDerivation {
+  pname = "my-webstuff";
+  version = "0.0.1-unreleased";
+
+  src = depot.users.Profpatsch.exactSource ./. [
+    ./my-webstuff.cabal
+    ./src/Multipart2.hs
+  ];
+
+  isLibrary = true;
+
+  libraryHaskellDepends = [
+    depot.users.Profpatsch.my-prelude
+    pkgs.haskellPackages.dlist
+    pkgs.haskellPackages.monad-logger
+    pkgs.haskellPackages.pa-error-tree
+    pkgs.haskellPackages.pa-field-parser
+    pkgs.haskellPackages.pa-prelude
+    pkgs.haskellPackages.selective
+    pkgs.haskellPackages.wai-extra
+  ];
+
+  license = lib.licenses.mit;
+
+}
diff --git a/users/Profpatsch/my-webstuff/my-webstuff.cabal b/users/Profpatsch/my-webstuff/my-webstuff.cabal
new file mode 100644
index 0000000000..fb42d9f6a5
--- /dev/null
+++ b/users/Profpatsch/my-webstuff/my-webstuff.cabal
@@ -0,0 +1,72 @@
+cabal-version:      3.0
+name:               my-webstuff
+version:            0.0.1.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
+
+
+library
+    import: common-options
+    hs-source-dirs: src
+    exposed-modules:
+      Multipart2
+
+    build-depends:
+       base >=4.15 && <5
+     , my-prelude
+     , pa-prelude
+     , pa-label
+     , pa-error-tree
+     , pa-field-parser
+     , bytestring
+     , monad-logger
+     , dlist
+     , selective
+     , wai
+     , wai-extra
diff --git a/users/Profpatsch/my-webstuff/src/Multipart2.hs b/users/Profpatsch/my-webstuff/src/Multipart2.hs
new file mode 100644
index 0000000000..5c283a3c1b
--- /dev/null
+++ b/users/Profpatsch/my-webstuff/src/Multipart2.hs
@@ -0,0 +1,220 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Multipart2 where
+
+import Control.Monad.Logger (MonadLogger)
+import Control.Selective (Selective)
+import Data.ByteString.Lazy qualified as Lazy
+import Data.DList (DList)
+import Data.DList qualified as DList
+import Data.Error.Tree
+import Data.Functor.Compose
+import Data.List qualified as List
+import FieldParser
+import Label
+import Network.Wai qualified as Wai
+import Network.Wai.Parse qualified as Wai
+import PossehlAnalyticsPrelude
+import ValidationParseT
+
+data FormFields = FormFields
+  { inputs :: [Wai.Param],
+    files :: [MultipartFile Lazy.ByteString]
+  }
+
+-- | A parser for a HTTP multipart form (a form sent by the browser)
+newtype MultipartParseT backend m a = MultipartParseT
+  { unMultipartParseT ::
+      FormFields ->
+      m (Validation (NonEmpty Error) a)
+  }
+  deriving
+    (Functor, Applicative, Selective)
+    via (ValidationParseT FormFields m)
+
+-- | After parsing a form, either we get the result or a list of form fields that failed
+newtype FormValidation a
+  = FormValidation
+      (DList FormValidationResult, Maybe a)
+  deriving (Functor, Applicative, Selective) via (Compose ((,) (DList FormValidationResult)) Maybe)
+  deriving stock (Show)
+
+data FormValidationResult = FormValidationResult
+  { hasError :: Maybe Error,
+    formFieldName :: ByteString,
+    originalValue :: ByteString
+  }
+  deriving stock (Show)
+
+mkFormValidationResult ::
+  ( HasField "formFieldName" form ByteString,
+    HasField "originalValue" form ByteString
+  ) =>
+  form ->
+  Maybe Error ->
+  FormValidationResult
+mkFormValidationResult form err =
+  FormValidationResult
+    { hasError = err,
+      formFieldName = form.formFieldName,
+      originalValue = form.originalValue
+    }
+
+eitherToFormValidation ::
+  ( HasField "formFieldName" form ByteString,
+    HasField "originalValue" form ByteString
+  ) =>
+  form ->
+  Either Error a ->
+  FormValidation a
+eitherToFormValidation form = \case
+  Left err ->
+    FormValidation $ (DList.singleton $ mkFormValidationResult form (Just err), Nothing)
+  Right a ->
+    FormValidation $ ((DList.singleton $ mkFormValidationResult form Nothing), Just a)
+
+failFormValidation ::
+  ( HasField "formFieldName" form ByteString,
+    HasField "originalValue" form ByteString
+  ) =>
+  form ->
+  Error ->
+  FormValidation a
+failFormValidation form err =
+  FormValidation (DList.singleton $ mkFormValidationResult form (Just err), Nothing)
+
+-- | Parse the multipart form or throw a user error with a descriptive error message.
+parseMultipartOrThrow ::
+  (MonadLogger m, MonadIO m) =>
+  (ErrorTree -> m a) ->
+  MultipartParseT backend m a ->
+  Wai.Request ->
+  m a
+parseMultipartOrThrow throwF parser req = do
+  -- TODO: this throws all errors with `error`, so leads to 500 on bad input …
+  formFields <-
+    liftIO $
+      Wai.parseRequestBodyEx
+        Wai.defaultParseRequestBodyOptions
+        Wai.lbsBackEnd
+        req
+  parser.unMultipartParseT
+    FormFields
+      { inputs = fst formFields,
+        files = map fileDataToMultipartFile $ snd formFields
+      }
+    >>= \case
+      Failure errs -> throwF (errorTree "Cannot parse the multipart form" errs)
+      Success a -> pure a
+
+-- | Parse the field out of the multipart message
+field :: (Applicative m) => ByteString -> FieldParser ByteString a -> MultipartParseT backend m a
+field fieldName fieldParser = MultipartParseT $ \mp ->
+  mp.inputs
+    & findMaybe (\input -> if fst input == fieldName then Just (snd input) else Nothing)
+    & annotate [fmt|Field "{fieldName}" does not exist in the multipart form|]
+    >>= runFieldParser fieldParser
+    & eitherToListValidation
+    & pure
+
+-- | Parse the field out of the multipart message
+field' :: (Applicative m) => ByteString -> FieldParser ByteString a -> MultipartParseT backend m (FormValidation a)
+field' fieldName fieldParser = MultipartParseT $ \mp ->
+  mp.inputs
+    & findMaybe (\input -> if fst input == fieldName then Just $ snd input else Nothing)
+    & annotate [fmt|Field "{fieldName}" does not exist in the multipart form|]
+    <&> ( \originalValue ->
+            originalValue
+              & runFieldParser fieldParser
+              & eitherToFormValidation
+                ( T2
+                    (label @"formFieldName" fieldName)
+                    (label @"originalValue" originalValue)
+                )
+        )
+    & eitherToListValidation
+    & pure
+
+-- | Parse the field out of the multipart message, and into a 'Label' of the given name.
+fieldLabel :: forall lbl backend m a. (Applicative m) => ByteString -> FieldParser ByteString a -> MultipartParseT backend m (Label lbl a)
+fieldLabel fieldName fieldParser = label @lbl <$> field fieldName fieldParser
+
+-- | Parse the field out of the multipart message, and into a 'Label' of the given name.
+fieldLabel' :: forall lbl backend m a. (Applicative m) => ByteString -> FieldParser ByteString a -> MultipartParseT backend m (FormValidation (Label lbl a))
+fieldLabel' fieldName fieldParser = fmap (label @lbl) <$> field' fieldName fieldParser
+
+-- | parse all fields out of the multipart message, with the same parser
+allFields :: (Applicative m) => FieldParser (T2 "key" ByteString "value" ByteString) b -> MultipartParseT backend m [b]
+allFields fieldParser = MultipartParseT $ \mp ->
+  mp.inputs
+    <&> tupToT2 @"key" @"value"
+    & traverseValidate (runFieldParser fieldParser)
+    & eitherToValidation
+    & pure
+
+tupToT2 :: forall l1 l2 t1 t2. (t1, t2) -> T2 l1 t1 l2 t2
+tupToT2 (a, b) = T2 (label a) (label b)
+
+-- | Parse a file by name out of the multipart message
+file ::
+  (Applicative m) =>
+  ByteString ->
+  MultipartParseT backend m (MultipartFile Lazy.ByteString)
+file fieldName = MultipartParseT $ \mp ->
+  mp.files
+    & List.find (\input -> input.multipartNameAttribute == fieldName)
+    & annotate [fmt|File "{fieldName}" does not exist in the multipart form|]
+    & ( \case
+          Left err -> Failure (singleton err)
+          Right filePath -> Success filePath
+      )
+    & pure
+
+-- | Return all files from the multipart message
+allFiles ::
+  (Applicative m) =>
+  MultipartParseT backend m [MultipartFile Lazy.ByteString]
+allFiles = MultipartParseT $ \mp -> do
+  pure $ Success $ mp.files
+
+-- | Ensure there is exactly one file and return it (ignoring the field name)
+exactlyOneFile ::
+  (Applicative m) =>
+  MultipartParseT backend m (MultipartFile Lazy.ByteString)
+exactlyOneFile = MultipartParseT $ \mp ->
+  mp.files
+    & \case
+      [] -> pure $ failParse "Expected to receive a file, but the multipart form did not contain any files"
+      [file_] -> pure $ Success file_
+      more -> pure $ failParse [fmt|Expected to receive exactly one file, but the multipart form contained {List.length more} files|]
+  where
+    -- \| Fail to parse the multipart form with the given error message.
+    failParse :: Text -> Validation (NonEmpty Error) a
+    failParse = Failure . singleton . newError
+
+newtype GetFileContent backend m content = GetFileContent
+  {unGetFileContent :: (Wai.Request -> m (Either Error content))}
+
+-- | A file field in a multipart message.
+data MultipartFile content = MultipartFile
+  { -- | @name@ attribute of the corresponding HTML @\<input\>@
+    multipartNameAttribute :: ByteString,
+    -- | name of the file on the client's disk
+    fileNameOnDisk :: ByteString,
+    -- | MIME type for the file
+    fileMimeType :: ByteString,
+    -- | Content of the file
+    content :: content
+  }
+
+-- | Convert the multipart library struct of a multipart file to our own.
+fileDataToMultipartFile ::
+  Wai.File Lazy.ByteString ->
+  (MultipartFile Lazy.ByteString)
+fileDataToMultipartFile (multipartNameAttribute, file_) = do
+  MultipartFile
+    { multipartNameAttribute,
+      fileNameOnDisk = file_.fileName,
+      fileMimeType = file_.fileContentType,
+      content = file_.fileContent
+    }
diff --git a/users/Profpatsch/my-xmonad/Xmonad.hs b/users/Profpatsch/my-xmonad/Xmonad.hs
new file mode 100644
index 0000000000..bb727ac2f1
--- /dev/null
+++ b/users/Profpatsch/my-xmonad/Xmonad.hs
@@ -0,0 +1,127 @@
+module Main where
+
+import Data.Function ((&))
+import XMonad
+import XMonad qualified as Xmonad
+import XMonad.Hooks.EwmhDesktops (ewmh)
+import XMonad.Layout.Decoration
+import XMonad.Layout.MultiToggle
+import XMonad.Layout.MultiToggle.Instances (StdTransformers (..))
+import XMonad.Layout.Tabbed (TabbedDecoration)
+import XMonad.Layout.Tabbed qualified as Tabbed
+import XMonad.StackSet qualified as StackSet
+import XMonad.Util.Cursor (setDefaultCursor)
+import XMonad.Util.EZConfig (additionalKeys, additionalKeysP, removeKeysP)
+
+data Mode = Normal | Presentation
+
+main :: IO ()
+main = do
+  let config = ewmh myConfig
+  dirs <- Xmonad.getDirectories
+  Xmonad.launch config dirs
+
+myConfig ::
+  XConfig
+    ( MultiToggle
+        ( HCons
+            StdTransformers
+            XMonad.Layout.MultiToggle.EOT
+        )
+        ( ModifiedLayout
+            ( Decoration
+                TabbedDecoration
+                DefaultShrinker
+            )
+            Tall
+        )
+    )
+myConfig =
+  conf
+    { modMask = modKey,
+      terminal = term Normal,
+      focusedBorderColor = "#859900",
+      layoutHook = layout,
+      startupHook = setDefaultCursor xC_heart,
+      workspaces = workspaceNames
+    }
+    `additionalKeysP` ( [
+                          -- fullscreen
+                          ("M-e", sendMessage $ Toggle NBFULL),
+                          -- i3-like keybindings, because I’m spoiled
+                          ("M-S-x", kill),
+                          -- exchange M-Ret and M-S-Ret
+                          ("M-<Return>", spawn $ term Normal),
+                          ("C-M-<Return>", spawn $ term Presentation),
+                          ("M-S-<Return>", windows StackSet.swapMaster)
+                          -- open simple exec dmenu
+                        ]
+                          ++
+                          -- something something workspaces
+                          [ (otherModMasks ++ "M-" ++ [key], action tag)
+                            | (tag, key) <- zip workspaceNames "123456789",
+                              (otherModMasks, action) <-
+                                [ ("", windows . StackSet.greedyView),
+                                  ("S-", windows . StackSet.shift)
+                                ]
+                          ]
+                          ++
+                          -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3
+                          -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3
+                          [ ("M-v", focusToScreen 0),
+                            -- , ("M-l", focusToScreen 1)
+                            ("M-c", focusToScreen 2),
+                            ("M-S-v", windowToScreen 0),
+                            ("M-S-l", windowToScreen 1),
+                            ("M-S-c", windowToScreen 2)
+                          ]
+                          -- ((m .|. modMask, key), screenWorkspace sc >>= flip whenJust (windows . f))
+                          --   | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
+                          --    , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
+                      )
+    `additionalKeys`
+    -- arrow keys should move as well (hjkl blindness)
+    [ ((modKey, xK_Up), windows StackSet.focusUp),
+      ((modKey, xK_Down), windows StackSet.focusDown)
+    ]
+    `removeKeysP` [
+                    -- previous kill command
+                    "M-S-c",
+                    -- It is way to easy to kill everything by default
+                    "M-S-q",
+                    -- no idea, I want to use it for Mozc
+                    "M-n"
+                  ]
+  where
+    conf = def
+    workspaceNames = conf & workspaces
+    modKey = mod4Mask
+    -- TODO: meh
+    term :: Mode -> String
+    -- TODO: get terminal-emulator from the system config (currently alacritty)
+    term Normal = "terminal-emulator"
+    term Presentation = "notify-send TODO: currently not terminal presentation mode implemented" -- "terminal- -u ~/.config/lilyterm/pres.conf"
+    toScreen with _number = screenWorkspace 0 >>= \ws -> whenJust ws (windows . with)
+    focusToScreen = toScreen StackSet.view
+    windowToScreen = toScreen StackSet.shift
+
+-- copied from Xmonad.Config
+layout ::
+  MultiToggle
+    (HCons StdTransformers EOT)
+    (ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Tall)
+    Window
+layout =
+  tiled
+    & Tabbed.addTabsBottom Tabbed.shrinkText def
+    & toggleFullscreen
+  where
+    -- default tiling algorithm partitions the screen into two panes
+    tiled = Tall nmaster delta ratio
+    -- The default number of windows in the master pane
+    nmaster = 1
+    -- Default proportion of screen occupied by master pane
+    ratio = 1 / 2
+    -- Percent of screen to increment by when resizing panes
+    delta = 3 / 100
+    toggleFullscreen = mkToggle1 NBFULL
diff --git a/users/Profpatsch/my-xmonad/default.nix b/users/Profpatsch/my-xmonad/default.nix
new file mode 100644
index 0000000000..708d50e960
--- /dev/null
+++ b/users/Profpatsch/my-xmonad/default.nix
@@ -0,0 +1,25 @@
+{ depot, pkgs, lib, ... }:
+
+let
+  #   bins = depot.nix.getBins pkgs.sqlite ["sqlite3"];
+
+  my-xmonad = pkgs.haskellPackages.mkDerivation {
+    pname = "my-xmonad";
+    version = "0.1.0";
+
+    src = depot.users.Profpatsch.exactSource ./. [
+      ./my-xmonad.cabal
+      ./Xmonad.hs
+    ];
+
+    libraryHaskellDepends = [
+      pkgs.haskellPackages.xmonad-contrib
+    ];
+
+    isExecutable = true;
+    isLibrary = false;
+    license = lib.licenses.mit;
+  };
+
+in
+my-xmonad
diff --git a/users/Profpatsch/my-xmonad/my-xmonad.cabal b/users/Profpatsch/my-xmonad/my-xmonad.cabal
new file mode 100644
index 0000000000..175c6c1633
--- /dev/null
+++ b/users/Profpatsch/my-xmonad/my-xmonad.cabal
@@ -0,0 +1,62 @@
+cabal-version:      3.0
+name:               my-xmonad
+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 xmonad
+    import: common-options
+
+    main-is: Xmonad.hs
+
+    build-depends:
+        base >=4.15 && <5,
+        xmonad,
+        xmonad-contrib
diff --git a/users/Profpatsch/netencode/Netencode.hs b/users/Profpatsch/netencode/Netencode.hs
new file mode 100644
index 0000000000..ca93ab2fef
--- /dev/null
+++ b/users/Profpatsch/netencode/Netencode.hs
@@ -0,0 +1,433 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Netencode where
+
+import Control.Applicative (many)
+import Data.Attoparsec.ByteString qualified as Atto
+import Data.Attoparsec.ByteString.Char8 qualified as Atto.Char
+import Data.ByteString qualified as ByteString
+import Data.ByteString.Builder (Builder)
+import Data.ByteString.Builder qualified as Builder
+import Data.ByteString.Lazy qualified as ByteString.Lazy
+import Data.Fix (Fix (Fix))
+import Data.Fix qualified as Fix
+import Data.Functor.Classes (Eq1 (liftEq))
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Map.NonEmpty (NEMap)
+import Data.Map.NonEmpty qualified as NEMap
+import Data.Semigroup qualified as Semi
+import Data.String (IsString)
+import Data.Word (Word16, Word32, Word64)
+import GHC.Exts (fromString)
+import Hedgehog qualified as Hedge
+import Hedgehog.Gen qualified as Gen
+import Hedgehog.Range qualified as Range
+import PossehlAnalyticsPrelude
+import Text.Show.Deriving
+import Prelude hiding (sum)
+
+-- | Netencode type base functor.
+--
+-- Recursive elements have a @rec@.
+data TF rec
+  = -- | Unit value
+    Unit
+  | -- | Boolean (2^1)
+    N1 Bool
+  | -- | Byte (2^3)
+    N3 Word8
+  | -- | 64-bit Natural (2^6)
+    N6 Word64
+  | -- | 64-bit Integer (2^6)
+    I6 Int64
+  | -- | Unicode Text
+    Text Text
+  | -- | Arbitrary Bytestring
+    Bytes ByteString
+  | -- | A constructor of a(n open) Sum
+    Sum (Tag Text rec)
+  | -- | Record
+    Record (NEMap Text rec)
+  | -- | List
+    List [rec]
+  deriving stock (Show, Eq, Functor)
+
+instance Eq1 TF where
+  liftEq _ Unit Unit = True
+  liftEq _ (N1 b) (N1 b') = b == b'
+  liftEq _ (N3 w8) (N3 w8') = w8 == w8'
+  liftEq _ (N6 w64) (N6 w64') = w64 == w64'
+  liftEq _ (I6 i64) (I6 i64') = i64 == i64'
+  liftEq _ (Text t) (Text t') = t == t'
+  liftEq _ (Bytes b) (Bytes b') = b == b'
+  liftEq eq (Sum t) (Sum t') = eq (t.tagVal) (t'.tagVal)
+  liftEq eq (Record m) (Record m') = liftEq eq m m'
+  liftEq eq (List xs) (List xs') = liftEq eq xs xs'
+  liftEq _ _ _ = False
+
+-- | A tagged value
+data Tag tag val = Tag
+  { tagTag :: tag,
+    tagVal :: val
+  }
+  deriving stock (Show, Eq, Functor)
+
+$(Text.Show.Deriving.deriveShow1 ''Tag)
+$(Text.Show.Deriving.deriveShow1 ''TF)
+
+-- | The Netencode type
+newtype T = T {unT :: Fix TF}
+  deriving stock (Eq, Show)
+
+-- | Create a unit
+unit :: T
+unit = T $ Fix Unit
+
+-- | Create a boolean
+n1 :: Bool -> T
+n1 = T . Fix . N1
+
+-- | Create a byte
+n3 :: Word8 -> T
+n3 = T . Fix . N3
+
+-- | Create a 64-bit natural
+n6 :: Word64 -> T
+n6 = T . Fix . N6
+
+-- | Create a 64-bit integer
+i6 :: Int64 -> T
+i6 = T . Fix . I6
+
+-- | Create a UTF-8 unicode text
+text :: Text -> T
+text = T . Fix . Text
+
+-- | Create an arbitrary bytestring
+bytes :: ByteString -> T
+bytes = T . Fix . Bytes
+
+-- | Create a tagged value from a tag name and a value
+tag :: Text -> T -> T
+tag key val = T $ Fix $ Sum $ coerce @(Tag Text T) @(Tag Text (Fix TF)) $ Tag key val
+
+-- | Create a record from a non-empty map
+record :: NEMap Text T -> T
+record = T . Fix . Record . coerce @(NEMap Text T) @(NEMap Text (Fix TF))
+
+-- | Create a list
+list :: [T] -> T
+list = T . Fix . List . coerce @[T] @([Fix TF])
+
+-- | Stable encoding of a netencode value. Record keys will be sorted lexicographically ascending.
+netencodeEncodeStable :: T -> Builder
+netencodeEncodeStable (T fix) = Fix.foldFix (netencodeEncodeStableF id) fix
+
+-- | Stable encoding of a netencode functor value. Record keys will be sorted lexicographically ascending.
+--
+-- The given function is used for encoding the recursive values.
+netencodeEncodeStableF :: (rec -> Builder) -> TF rec -> Builder
+netencodeEncodeStableF inner tf = builder go
+  where
+    -- TODO: directly pass in BL?
+    innerBL = fromBuilder . inner
+    go = case tf of
+      Unit -> "u,"
+      N1 False -> "n1:0,"
+      N1 True -> "n1:1,"
+      N3 w8 -> "n3:" <> fromBuilder (Builder.word8Dec w8) <> ","
+      N6 w64 -> "n6:" <> fromBuilder (Builder.word64Dec w64) <> ","
+      I6 i64 -> "i6:" <> fromBuilder (Builder.int64Dec i64) <> ","
+      Text t ->
+        let b = fromText t
+         in "t" <> builderLenDec b <> ":" <> b <> ","
+      Bytes b -> "b" <> builderLenDec (fromByteString b) <> ":" <> fromByteString b <> ","
+      Sum (Tag key val) -> encTag key val
+      Record m ->
+        -- NEMap uses Map internally, and that folds in lexicographic ascending order over the key.
+        -- Since these are `Text` in our case, this is stable.
+        let mBuilder = m & NEMap.foldMapWithKey encTag
+         in "{" <> builderLenDec mBuilder <> ":" <> mBuilder <> "}"
+      List xs ->
+        let xsBuilder = xs <&> innerBL & mconcat
+         in "[" <> builderLenDec xsBuilder <> ":" <> xsBuilder <> "]"
+      where
+        encTag key val =
+          let bKey = fromText key
+           in "<" <> builderLenDec bKey <> ":" <> bKey <> "|" <> innerBL val
+
+-- | A builder that knows its own size in bytes
+newtype BL = BL (Builder, Semi.Sum Natural)
+  deriving newtype (Monoid, Semigroup)
+
+instance IsString BL where
+  fromString s =
+    BL
+      ( fromString @Builder s,
+        fromString @ByteString s
+          & ByteString.length
+          & intToNatural
+          & fromMaybe 0
+          & Semi.Sum
+      )
+
+-- | Retrieve the builder
+builder :: BL -> Builder
+builder (BL (b, _)) = b
+
+-- | Retrieve the bytestring length
+builderLen :: BL -> Natural
+builderLen (BL (_, len)) = Semi.getSum $ len
+
+-- | Take a 'BL' and create a new 'BL' that represents the length as a decimal integer
+builderLenDec :: BL -> BL
+builderLenDec (BL (_, len)) =
+  let b = Builder.intDec $ (len & Semi.getSum & fromIntegral @Natural @Int)
+   in b & fromBuilder
+
+-- | Create a 'BL' from a 'Builder'.
+--
+-- Not efficient, goes back to a lazy bytestring to get the length
+fromBuilder :: Builder -> BL
+fromBuilder b =
+  BL
+    ( b,
+      b
+        & Builder.toLazyByteString
+        & ByteString.Lazy.length
+        & fromIntegral @Int64 @Natural
+        & Semi.Sum
+    )
+
+-- | Create a 'BL' from a 'ByteString'.
+fromByteString :: ByteString -> BL
+fromByteString b =
+  BL
+    ( Builder.byteString b,
+      b
+        & ByteString.length
+        & fromIntegral @Int @Natural
+        & Semi.Sum
+    )
+
+-- | Create a 'BL' from a 'Text'.
+fromText :: Text -> BL
+fromText t = t & textToBytesUtf8 & fromByteString
+
+-- | Parser for a netencode value.
+netencodeParser :: Atto.Parser T
+netencodeParser = T <$> go
+  where
+    go = Fix <$> netencodeParserF go
+
+-- | Parser for one level of a netencode value. Requires a parser for the recursion.
+netencodeParserF :: Atto.Parser rec -> Atto.Parser (TF rec)
+netencodeParserF inner = do
+  typeTag <- Atto.Char.anyChar
+  case typeTag of
+    't' -> Text <$> textParser
+    'b' -> Bytes <$> bytesParser
+    'u' -> unitParser
+    '<' -> Sum <$> tagParser
+    '{' -> Record <$> recordParser
+    '[' -> List <$> listParser
+    'n' -> naturalParser
+    'i' -> I6 <$> intParser
+    c -> fail ([c] <> " is not a valid netencode tag")
+  where
+    bytesParser = do
+      len <- boundedDecimalFail Atto.<?> "bytes is missing a digit specifying the length"
+      _ <- Atto.Char.char ':' Atto.<?> "bytes did not have : after length"
+      bytes' <- Atto.take len
+      _ <- Atto.Char.char ',' Atto.<?> "bytes did not end with ,"
+      pure bytes'
+
+    textParser = do
+      len <- boundedDecimalFail Atto.<?> "text is missing a digit specifying the length"
+      _ <- Atto.Char.char ':' Atto.<?> "text did not have : after length"
+      text' <-
+        Atto.take len <&> bytesToTextUtf8 >>= \case
+          Left err -> fail [fmt|cannot decode text as utf8: {err & prettyError}|]
+          Right t -> pure t
+      _ <- Atto.Char.char ',' Atto.<?> "text did not end with ,"
+      pure text'
+
+    unitParser = do
+      _ <- Atto.Char.char ',' Atto.<?> "unit did not end with ,"
+      pure $ Unit
+
+    tagParser = do
+      len <- boundedDecimalFail Atto.<?> "tag is missing a digit specifying the length"
+      _ <- Atto.Char.char ':' Atto.<?> "tag did not have : after length"
+      tagTag <-
+        Atto.take len <&> bytesToTextUtf8 >>= \case
+          Left err -> fail [fmt|cannot decode tag key as utf8: {err & prettyError}|]
+          Right t -> pure t
+      _ <- Atto.Char.char '|' Atto.<?> "tag was missing the key/value separator (|)"
+      tagVal <- inner
+      pure $ Tag {..}
+
+    recordParser = do
+      -- TODO: the record does not use its inner length because we are descending into the inner parsers.
+      -- This is a smell! In theory it can be used to skip parsing the whole inner keys.
+      _len <- boundedDecimalFail Atto.<?> "record is missing a digit specifying the length"
+      _ <- Atto.Char.char ':' Atto.<?> "record did not have : after length"
+      record' <-
+        many (Atto.Char.char '<' >> tagParser) <&> nonEmpty >>= \case
+          Nothing -> fail "record is not allowed to have 0 elements"
+          Just tags ->
+            pure $
+              tags
+                <&> (\t -> (t.tagTag, t.tagVal))
+                -- later keys are preferred if they are duplicates, according to the standard
+                & NEMap.fromList
+      _ <- Atto.Char.char '}' Atto.<?> "record did not end with }"
+      pure record'
+
+    listParser = do
+      -- TODO: the list does not use its inner length because we are descending into the inner parsers.
+      -- This is a smell! In theory it can be used to skip parsing the whole inner keys.
+      _len <- boundedDecimalFail Atto.<?> "list is missing a digit specifying the length"
+      _ <- Atto.Char.char ':' Atto.<?> "list did not have : after length"
+      -- TODO: allow empty lists?
+      list' <- many inner
+      _ <- Atto.Char.char ']' Atto.<?> "list did not end with ]"
+      pure list'
+
+    intParser = do
+      let p :: forall parseSize. (Bounded parseSize, Integral parseSize) => (Integer -> Atto.Parser Int64)
+          p n = do
+            _ <- Atto.Char.char ':' Atto.<?> [fmt|i{n & show} did not have : after length|]
+            isNegative <- Atto.option False (Atto.Char.char '-' <&> \_c -> True)
+            int <-
+              boundedDecimal @parseSize >>= \case
+                Nothing -> fail [fmt|cannot parse into i{n & show}, the number is too big (would overflow)|]
+                Just i ->
+                  pure $
+                    if isNegative
+                      then -- TODO: this should alread be done in the decimal parser, @minBound@ cannot be parsed cause it’s one more than @(-maxBound)@!
+                        (-i)
+                      else i
+            _ <- Atto.Char.char ',' Atto.<?> [fmt|i{n & show} did not end with ,|]
+            pure $ fromIntegral @parseSize @Int64 int
+      digit <- Atto.Char.digit
+      case digit of
+        -- TODO: separate parser for i1 and i2 that makes sure the boundaries are right!
+        '1' -> p @Int8 1
+        '2' -> p @Int8 2
+        '3' -> p @Int8 3
+        '4' -> p @Int16 4
+        '5' -> p @Int32 5
+        '6' -> p @Int64 6
+        '7' -> fail [fmt|i parser only supports numbers up to size 6, was 7|]
+        '8' -> fail [fmt|i parser only supports numbers up to size 6, was 8|]
+        '9' -> fail [fmt|i parser only supports numbers up to size 6, was 9|]
+        o -> fail [fmt|i number with length {o & show} not possible|]
+
+    naturalParser = do
+      let p :: forall parseSize finalSize. (Bounded parseSize, Integral parseSize, Num finalSize) => (Integer -> Atto.Parser finalSize)
+          p n = do
+            _ <- Atto.Char.char ':' Atto.<?> [fmt|n{n & show} did not have : after length|]
+            int <-
+              boundedDecimal @parseSize >>= \case
+                Nothing -> fail [fmt|cannot parse into n{n & show}, the number is too big (would overflow)|]
+                Just i -> pure i
+
+            _ <- Atto.Char.char ',' Atto.<?> [fmt|n{n & show} did not end with ,|]
+            pure $ fromIntegral @parseSize @finalSize int
+      let b n = do
+            _ <- Atto.Char.char ':' Atto.<?> [fmt|n{n & show} did not have : after length|]
+            bool <-
+              (Atto.Char.char '0' >> pure False)
+                <|> (Atto.Char.char '1' >> pure True)
+            _ <- Atto.Char.char ',' Atto.<?> [fmt|n{n & show} did not end with ,|]
+            pure bool
+
+      digit <- Atto.Char.digit
+      case digit of
+        -- TODO: separate parser for n1 and n2 that makes sure the boundaries are right!
+        '1' -> N1 <$> b 1
+        '2' -> N3 <$> p @Word8 @Word8 2
+        '3' -> N3 <$> p @Word8 @Word8 3
+        '4' -> N6 <$> p @Word16 @Word64 4
+        '5' -> N6 <$> p @Word32 @Word64 5
+        '6' -> N6 <$> p @Word64 @Word64 6
+        '7' -> fail [fmt|n parser only supports numbers up to size 6, was 7|]
+        '8' -> fail [fmt|n parser only supports numbers up to size 6, was 8|]
+        '9' -> fail [fmt|n parser only supports numbers up to size 6, was 9|]
+        o -> fail [fmt|n number with length {o & show} not possible|]
+
+-- | Parser for a bounded decimal that does not overflow the decimal.
+--
+--  via https://www.extrema.is/blog/2021/10/20/parsing-bounded-integers
+boundedDecimal :: forall a. (Bounded a, Integral a) => Atto.Parser (Maybe a)
+boundedDecimal = do
+  i :: Integer <- decimal
+  pure $
+    if (i :: Integer) > fromIntegral (maxBound :: a)
+      then Nothing
+      else Just $ fromIntegral i
+  where
+    -- Copied from @Attoparsec.Text@ and adjusted to bytestring
+    decimal :: (Integral a2) => Atto.Parser a2
+    decimal = ByteString.foldl' step 0 <$> Atto.Char.takeWhile1 Atto.Char.isDigit
+      where
+        step a c = a * 10 + fromIntegral (c - 48)
+{-# SPECIALIZE boundedDecimal :: Atto.Parser (Maybe Int) #-}
+{-# SPECIALIZE boundedDecimal :: Atto.Parser (Maybe Int64) #-}
+{-# SPECIALIZE boundedDecimal :: Atto.Parser (Maybe Word8) #-}
+{-# SPECIALIZE boundedDecimal :: Atto.Parser (Maybe Word64) #-}
+
+-- | 'boundedDecimal', but fail the parser if the decimal overflows.
+boundedDecimalFail :: Atto.Parser Int
+boundedDecimalFail =
+  boundedDecimal >>= \case
+    Nothing -> fail "decimal out of range"
+    Just a -> pure a
+
+-- | Hedgehog generator for a netencode value.
+genNetencode :: Hedge.MonadGen m => m T
+genNetencode =
+  Gen.recursive
+    Gen.choice
+    [ -- these are bundled into one Gen, so that scalar elements get chosen less frequently, and the generator produces nicely nested examples
+      Gen.frequency
+        [ (1, pure unit),
+          (1, n1 <$> Gen.bool),
+          (1, n3 <$> Gen.element [0, 1, 5]),
+          (1, n6 <$> Gen.element [0, 1, 5]),
+          (1, i6 <$> Gen.element [-1, 1, 5]),
+          (2, text <$> Gen.text (Range.linear 1 10) Gen.lower),
+          (2, bytes <$> Gen.bytes (Range.linear 1 10))
+        ]
+    ]
+    [ do
+        key <- Gen.text (Range.linear 3 10) Gen.lower
+        val <- genNetencode
+        pure $ tag key val,
+      record
+        <$> ( let k = Gen.text (Range.linear 3 10) Gen.lower
+                  v = genNetencode
+               in NEMap.insertMap
+                    <$> k
+                    <*> v
+                    <*> ( (Gen.map (Range.linear 0 3)) $
+                            (,) <$> k <*> v
+                        )
+            )
+    ]
+
+-- | Hedgehog property: encoding a netencode value and parsing it again returns the same result.
+prop_netencodeRoundtrip :: Hedge.Property
+prop_netencodeRoundtrip = Hedge.property $ do
+  enc <- Hedge.forAll genNetencode
+  ( Atto.parseOnly
+      netencodeParser
+      ( netencodeEncodeStable enc
+          & Builder.toLazyByteString
+          & toStrictBytes
+      )
+    )
+    Hedge.=== (Right enc)
diff --git a/users/Profpatsch/netencode/Netencode/Parse.hs b/users/Profpatsch/netencode/Netencode/Parse.hs
new file mode 100644
index 0000000000..184fb5f912
--- /dev/null
+++ b/users/Profpatsch/netencode/Netencode/Parse.hs
@@ -0,0 +1,102 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Netencode.Parse where
+
+import Control.Category qualified
+import Control.Selective (Selective)
+import Data.Error.Tree
+import Data.Fix (Fix (..))
+import Data.Functor.Compose
+import Data.List qualified as List
+import Data.Map.NonEmpty (NEMap)
+import Data.Map.NonEmpty qualified as NEMap
+import Data.Semigroupoid qualified as Semigroupiod
+import Data.Semigroupoid qualified as Semigroupoid
+import Data.Text qualified as Text
+import Netencode qualified
+import PossehlAnalyticsPrelude
+import Prelude hiding (log)
+
+newtype Parse from to
+  = -- TODO: the way @Context = [Text]@ has to be forwarded to everything is kinda shitty.
+    -- This is essentially just a difference list, and can probably be treated as a function in the output?
+    Parse (([Text], from) -> Validation (NonEmpty ErrorTree) ([Text], to))
+  deriving
+    (Functor, Applicative, Selective)
+    via ( Compose
+            ( Compose
+                ((->) ([Text], from))
+                (Validation (NonEmpty ErrorTree))
+            )
+            ((,) [Text])
+        )
+
+instance Semigroupoid Parse where
+  o p2 p1 = Parse $ \from -> case runParse' p1 from of
+    Failure err -> Failure err
+    Success to1 -> runParse' p2 to1
+
+instance Category Parse where
+  (.) = Semigroupoid.o
+  id = Parse $ \t -> Success t
+
+runParse :: Error -> Parse from to -> from -> Either ErrorTree to
+runParse errMsg parser t =
+  (["$"], t)
+    & runParse' parser
+    <&> snd
+    & first (nestedMultiError errMsg)
+    & validationToEither
+
+runParse' :: Parse from to -> ([Text], from) -> Validation (NonEmpty ErrorTree) ([Text], to)
+runParse' (Parse f) from = f from
+
+parseEither :: (([Text], from) -> Either ErrorTree ([Text], to)) -> Parse from to
+parseEither f = Parse $ \from -> f from & eitherToListValidation
+
+tAs :: (Netencode.TF (Fix Netencode.TF) -> Either ([Text] -> ErrorTree) to) -> Parse Netencode.T to
+tAs f = parseEither ((\(context, Netencode.T (Fix tf)) -> f tf & bimap ($ context) (context,)))
+
+key :: Text -> Parse (NEMap Text to) to
+key name = parseEither $ \(context, rec) ->
+  rec
+    & NEMap.lookup name
+    & annotate (errorTreeContext (showContext context) [fmt|Key "{name}" does not exist|])
+    <&> (addContext name context,)
+
+showContext :: [Text] -> Text
+showContext context = context & List.reverse & Text.intercalate "."
+
+addContext :: a -> [a] -> [a]
+addContext = (:)
+
+asText :: Parse Netencode.T Text
+asText = tAs $ \case
+  Netencode.Text t -> pure t
+  other -> typeError "of text" other
+
+asBytes :: Parse Netencode.T ByteString
+asBytes = tAs $ \case
+  Netencode.Bytes b -> pure b
+  other -> typeError "of bytes" other
+
+asRecord :: Parse Netencode.T (NEMap Text (Netencode.T))
+asRecord = tAs $ \case
+  Netencode.Record rec -> pure (rec <&> Netencode.T)
+  other -> typeError "a record" other
+
+typeError :: Text -> Netencode.TF ignored -> (Either ([Text] -> ErrorTree) b)
+typeError should is = do
+  let otherS = is <&> (\_ -> ("…" :: String)) & show
+  Left $ \context -> errorTreeContext (showContext context) [fmt|Value is not {should}, but a {otherS}|]
+
+orThrowParseError ::
+  Parse (Either Error to) to
+orThrowParseError = Parse $ \case
+  (context, Left err) ->
+    err
+      & singleError
+      & errorTreeContext (showContext context)
+      & singleton
+      & Failure
+  (context, Right to) -> Success (context, to)
diff --git a/users/Profpatsch/netencode/README.md b/users/Profpatsch/netencode/README.md
index 3058e36eaf..3538a110a6 100644
--- a/users/Profpatsch/netencode/README.md
+++ b/users/Profpatsch/netencode/README.md
@@ -1,6 +1,6 @@
 # netencode 0.1-unreleased
 
-[bencode][] and [netstring][]-inspired pipe format that should be trivial go generate correctly in every context (only requires a `byte_length()` and a `printf()`), easy to parse (100 lines of code or less), mostly human-decipherable for easy debugging, and support nested record and sum types.
+[bencode][] and [netstring][]-inspired pipe format that should be trivial to generate correctly in every context (only requires a `byte_length()` and a `printf()`), easy to parse (100 lines of code or less), mostly human-decipherable for easy debugging, and support nested record and sum types.
 
 
 ## scalars
@@ -73,7 +73,11 @@ A tag (`<`) gives a value a name. The tag is UTF-8 encoded, starting with its le
 ### records (products/records), also maps
 
 A record (`{`) is a concatenation of tags (`<`). It needs to be closed with `}`.
-If tag names repeat the later ones should be ignored. Ordering does not matter.
+
+If tag names repeat the *earlier* ones should be ignored.
+Using the last tag corresponds with the way most languages handle converting a list of tuples to Maps, by using a for-loop and Map.insert without checking the contents first. Otherwise you’d have to revert the list first or remember which keys you already inserted.
+
+Ordering of tags in a record does not matter.
 
 Similar to text, records start with the length of their *whole encoded content*, in bytes. This makes it possible to treat their contents as opaque bytestrings.
 
@@ -81,7 +85,7 @@ Similar to text, records start with the length of their *whole encoded content*,
 * A record with one empty field, `foo`: `{9:<3:foo|u,}`
 * A record with two fields, `foo` and `x`: `{21:<3:foo|u,<1:x|t3:baz,}`
 * The same record: `{21:<1:x|t3:baz,<3:foo|u,}`
-* The same record (later occurences of fields are ignored): `{28:<1:x|t3:baz,<3:foo|u,<1:x|u,}`
+* The same record (earlier occurences of fields are ignored): `{<1:x|u,28:<1:x|t3:baz,<3:foo|u,}`
 
 ### sums (tagged unions)
 
@@ -98,6 +102,24 @@ Similar to records, lists start with the length of their whole encoded content.
 * The list with text `foo` followed by i3 `-42`: `[14:t3:foo,i3:-42,]`
 * The list with `Some` and `None` tags: `[33:<4:Some|t3:foo,<4None|u,<4None|u,]`
 
+## parser security considerations
+
+The length field is a decimal number that is not length-restricted,
+meaning an attacker could give an infinitely long length (or extremely long)
+thus overflowing your parser if you are not careful.
+
+You should thus put a practical length limit to the length of length fields,
+which implicitely enforces a length limit on how long the value itself can be.
+
+Start by defining a max value length in bytes.
+Then count the number of decimals in that number.
+
+So if your max length is 1024 bytes, your length field can be a maximum `count_digits(1024) == 4` bytes long.
+
+Thus, if you restrict your parser to a length field of 4 bytes,
+it should also never parse anything longer than 1024 bytes for the value
+(plus 1 byte for the type tag, 4 bytes for the length, and 2 bytes for the separator & ending character).
+
 ## motivation
 
 TODO
diff --git a/users/Profpatsch/netencode/default.nix b/users/Profpatsch/netencode/default.nix
index db892cc9de..6e7dce489a 100644
--- a/users/Profpatsch/netencode/default.nix
+++ b/users/Profpatsch/netencode/default.nix
@@ -1,101 +1,133 @@
 { depot, pkgs, lib, ... }:
 
 let
-  netencode-rs = depot.nix.writers.rustSimpleLib {
+  netencode-rs = depot.nix.writers.rustSimpleLib
+    {
       name = "netencode";
       dependencies = [
         depot.third_party.rust-crates.nom
         depot.users.Profpatsch.execline.exec-helpers
       ];
-    } (builtins.readFile ./netencode.rs);
+    }
+    (builtins.readFile ./netencode.rs);
 
-  gen = import ./gen.nix { inherit lib; };
+  netencode-hs = pkgs.haskellPackages.mkDerivation {
+    pname = "netencode";
+    version = "0.1.0";
 
-  pretty-rs = depot.nix.writers.rustSimpleLib {
-    name = "netencode-pretty";
-    dependencies = [
-      netencode-rs
+    src = depot.users.Profpatsch.exactSource ./. [
+      ./netencode.cabal
+      ./Netencode.hs
+      ./Netencode/Parse.hs
     ];
-  } (builtins.readFile ./pretty.rs);
-
-  pretty = depot.nix.writers.rustSimple {
-    name = "netencode-pretty";
-    dependencies = [
-      netencode-rs
-      pretty-rs
-      depot.users.Profpatsch.execline.exec-helpers
+
+    libraryHaskellDepends = [
+      pkgs.haskellPackages.hedgehog
+      pkgs.haskellPackages.nonempty-containers
+      pkgs.haskellPackages.deriving-compat
+      pkgs.haskellPackages.data-fix
+      pkgs.haskellPackages.bytestring
+      pkgs.haskellPackages.attoparsec
+      pkgs.haskellPackages.pa-prelude
+      pkgs.haskellPackages.pa-label
+      pkgs.haskellPackages.pa-error-tree
     ];
-  } ''
+
+    isLibrary = true;
+    license = lib.licenses.mit;
+
+
+  };
+
+  gen = import ./gen.nix { inherit lib; };
+
+  pretty-rs = depot.nix.writers.rustSimpleLib
+    {
+      name = "netencode-pretty";
+      dependencies = [
+        netencode-rs
+      ];
+    }
+    (builtins.readFile ./pretty.rs);
+
+  pretty = depot.nix.writers.rustSimple
+    {
+      name = "netencode-pretty";
+      dependencies = [
+        netencode-rs
+        pretty-rs
+        depot.users.Profpatsch.execline.exec-helpers
+      ];
+    } ''
     extern crate netencode;
     extern crate netencode_pretty;
     extern crate exec_helpers;
 
     fn main() {
       let (_, prog) = exec_helpers::args_for_exec("netencode-pretty", 0);
-      let mut buf = vec![];
-      let u = netencode::u_from_stdin_or_die_user_error("netencode-pretty", &mut buf);
-      match netencode_pretty::Pretty::from_u(u).print_multiline(&mut std::io::stdout()) {
+      let t = netencode::t_from_stdin_or_die_user_error("netencode-pretty");
+      match netencode_pretty::Pretty::from_u(t.to_u()).print_multiline(&mut std::io::stdout()) {
         Ok(()) => {},
         Err(err) => exec_helpers::die_temporary("netencode-pretty", format!("could not write to stdout: {}", err))
       }
     }
   '';
 
-  netencode-mustache = depot.nix.writers.rustSimple {
-    name = "netencode_mustache";
-    dependencies = [
-      depot.users.Profpatsch.arglib.netencode.rust
-      netencode-rs
-      depot.third_party.rust-crates.mustache
-    ];
-  } (builtins.readFile ./netencode-mustache.rs);
+  netencode-mustache = depot.nix.writers.rustSimple
+    {
+      name = "netencode_mustache";
+      dependencies = [
+        depot.users.Profpatsch.arglib.netencode.rust
+        netencode-rs
+        depot.third_party.rust-crates.mustache
+      ];
+    }
+    (builtins.readFile ./netencode-mustache.rs);
 
 
-  record-get = depot.nix.writers.rustSimple {
-    name = "record-get";
-    dependencies = [
-      netencode-rs
-      depot.users.Profpatsch.execline.exec-helpers
-      depot.users.Profpatsch.arglib.netencode.rust
-    ];
-  } ''
+  record-get = depot.nix.writers.rustSimple
+    {
+      name = "record-get";
+      dependencies = [
+        netencode-rs
+        depot.users.Profpatsch.execline.exec-helpers
+      ];
+    } ''
     extern crate netencode;
-    extern crate arglib_netencode;
     extern crate exec_helpers;
     use netencode::{encode, dec};
     use netencode::dec::{Decoder, DecodeError};
 
     fn main() {
-        let mut buf = vec![];
         let args = exec_helpers::args("record-get", 1);
         let field = match std::str::from_utf8(&args[0]) {
             Ok(f) => f,
             Err(_e) => exec_helpers::die_user_error("record-get", format!("The field name needs to be valid unicode"))
         };
-        let u = netencode::u_from_stdin_or_die_user_error("record-get", &mut buf);
-        match (dec::RecordDot {field, inner: dec::AnyU }).dec(u) {
+        let t = netencode::t_from_stdin_or_die_user_error("record-get");
+        match (dec::RecordDot {field, inner: dec::AnyU }).dec(t.to_u()) {
             Ok(u) => encode(&mut std::io::stdout(), &u).expect("encoding to stdout failed"),
             Err(DecodeError(err)) => exec_helpers::die_user_error("record-get", err)
         }
     }
   '';
 
-  record-splice-env = depot.nix.writers.rustSimple {
-    name = "record-splice-env";
-    dependencies = [
-      netencode-rs
-      depot.users.Profpatsch.execline.exec-helpers
-    ];
-  } ''
+  record-splice-env = depot.nix.writers.rustSimple
+    {
+      name = "record-splice-env";
+      dependencies = [
+        netencode-rs
+        depot.users.Profpatsch.execline.exec-helpers
+      ];
+    } ''
     extern crate netencode;
     extern crate exec_helpers;
     use netencode::dec::{Record, Try, ScalarAsBytes, Decoder, DecodeError};
 
     fn main() {
-        let mut buf = vec![];
-        let u = netencode::u_from_stdin_or_die_user_error("record-splice-env", &mut buf);
+        let t = netencode::t_from_stdin_or_die_user_error("record-splice-env");
         let (_, prog) = exec_helpers::args_for_exec("record-splice-env", 0);
-        match Record(Try(ScalarAsBytes)).dec(u) {
+        match Record(Try(ScalarAsBytes)).dec(t.to_u()) {
             Ok(map) => {
                 exec_helpers::exec_into_args(
                     "record-splice-env",
@@ -109,13 +141,14 @@ let
     }
   '';
 
-  env-splice-record = depot.nix.writers.rustSimple {
-    name = "env-splice-record";
-    dependencies = [
-      netencode-rs
-      depot.users.Profpatsch.execline.exec-helpers
-    ];
-  } ''
+  env-splice-record = depot.nix.writers.rustSimple
+    {
+      name = "env-splice-record";
+      dependencies = [
+        netencode-rs
+        depot.users.Profpatsch.execline.exec-helpers
+      ];
+    } ''
     extern crate netencode;
     extern crate exec_helpers;
     use netencode::{T};
@@ -135,9 +168,11 @@ let
     }
   '';
 
-in depot.nix.utils.drvTargets {
+in
+depot.nix.readTree.drvTargets {
   inherit
     netencode-rs
+    netencode-hs
     pretty-rs
     pretty
     netencode-mustache
diff --git a/users/Profpatsch/netencode/gen.nix b/users/Profpatsch/netencode/gen.nix
index 305ff7b08d..efc9629ca0 100644
--- a/users/Profpatsch/netencode/gen.nix
+++ b/users/Profpatsch/netencode/gen.nix
@@ -27,29 +27,33 @@ let
   concatStrings = builtins.concatStringsSep "";
 
   record = lokv: netstring "{" "}"
-    (concatStrings (map ({key, val}: tag key val) lokv));
+    (concatStrings (map ({ key, val }: tag key val) lokv));
 
   list = l: netstring "[" "]" (concatStrings l);
 
   dwim = val:
-    let match = {
-      "bool" = n1;
-      "int" = i6;
-      "string" = text;
-      "set" = attrs:
-        # it could be a derivation, then just return the path
-        if attrs.type or "" == "derivation" then text "${attrs}"
-        else
-          record (lib.mapAttrsToList
-          (k: v: {
-            key = k;
-            val = dwim v;
-          }) attrs);
-      "list" = l: list (map dwim l);
-    };
-    in match.${builtins.typeOf val} val;
+    let
+      match = {
+        "bool" = n1;
+        "int" = i6;
+        "string" = text;
+        "set" = attrs:
+          # it could be a derivation, then just return the path
+          if attrs.type or "" == "derivation" then text "${attrs}"
+          else
+            record (lib.mapAttrsToList
+              (k: v: {
+                key = k;
+                val = dwim v;
+              })
+              attrs);
+        "list" = l: list (map dwim l);
+      };
+    in
+    match.${builtins.typeOf val} val;
 
-in {
+in
+{
   inherit
     unit
     n1
diff --git a/users/Profpatsch/netencode/netencode-mustache.rs b/users/Profpatsch/netencode/netencode-mustache.rs
index ee7bafed22..73ed5be1de 100644
--- a/users/Profpatsch/netencode/netencode-mustache.rs
+++ b/users/Profpatsch/netencode/netencode-mustache.rs
@@ -1,12 +1,12 @@
-extern crate netencode;
-extern crate mustache;
 extern crate arglib_netencode;
+extern crate mustache;
+extern crate netencode;
 
-use mustache::{Data};
-use netencode::{T};
+use mustache::Data;
+use netencode::T;
 use std::collections::HashMap;
-use std::os::unix::ffi::{OsStrExt};
-use std::io::{Read};
+use std::io::Read;
+use std::os::unix::ffi::OsStrExt;
 
 fn netencode_to_mustache_data_dwim(t: T) -> Data {
     match t {
@@ -25,27 +25,26 @@ fn netencode_to_mustache_data_dwim(t: T) -> Data {
         T::Record(xs) => Data::Map(
             xs.into_iter()
                 .map(|(key, val)| (key, netencode_to_mustache_data_dwim(val)))
-                .collect::<HashMap<_,_>>()
+                .collect::<HashMap<_, _>>(),
         ),
         T::List(xs) => Data::Vec(
             xs.into_iter()
                 .map(|x| netencode_to_mustache_data_dwim(x))
-                .collect::<Vec<_>>()
+                .collect::<Vec<_>>(),
         ),
     }
 }
 
 pub fn from_stdin() -> () {
-    let data = netencode_to_mustache_data_dwim(
-        arglib_netencode::arglib_netencode("netencode-mustache", Some(std::ffi::OsStr::new("TEMPLATE_DATA")))
-    );
+    let data = netencode_to_mustache_data_dwim(arglib_netencode::arglib_netencode(
+        "netencode-mustache",
+        Some(std::ffi::OsStr::new("TEMPLATE_DATA")),
+    ));
     let mut stdin = String::new();
     std::io::stdin().read_to_string(&mut stdin).unwrap();
     mustache::compile_str(&stdin)
-        .and_then(|templ| templ.render_data(
-            &mut std::io::stdout(),
-            &data
-        )).unwrap()
+        .and_then(|templ| templ.render_data(&mut std::io::stdout(), &data))
+        .unwrap()
 }
 
 pub fn main() {
diff --git a/users/Profpatsch/netencode/netencode.cabal b/users/Profpatsch/netencode/netencode.cabal
new file mode 100644
index 0000000000..7bff4487bb
--- /dev/null
+++ b/users/Profpatsch/netencode/netencode.cabal
@@ -0,0 +1,74 @@
+cabal-version:      3.0
+name:               netencode
+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
+
+
+library
+    import: common-options
+    exposed-modules:
+        Netencode,
+        Netencode.Parse
+
+    build-depends:
+        base >=4.15 && <5,
+        pa-prelude,
+        pa-label,
+        pa-error-tree,
+        hedgehog,
+        nonempty-containers,
+        deriving-compat,
+        data-fix,
+        bytestring,
+        attoparsec,
+        text,
+        semigroupoids,
+        selective
diff --git a/users/Profpatsch/netencode/netencode.rs b/users/Profpatsch/netencode/netencode.rs
index fcf642ca02..34a8fcef09 100644
--- a/users/Profpatsch/netencode/netencode.rs
+++ b/users/Profpatsch/netencode/netencode.rs
@@ -1,9 +1,9 @@
-extern crate nom;
 extern crate exec_helpers;
+extern crate nom;
 
 use std::collections::HashMap;
-use std::io::{Write, Read};
-use std::fmt::{Display, Debug};
+use std::fmt::{Debug, Display};
+use std::io::{Read, Write};
 
 #[derive(Debug, PartialEq, Eq, Clone)]
 pub enum T {
@@ -46,22 +46,19 @@ impl T {
             T::I7(i) => U::I7(*i),
             T::Text(t) => U::Text(t.as_str()),
             T::Binary(v) => U::Binary(v),
-            T::Sum(Tag { tag, val }) => U::Sum(
-                Tag { tag: tag.as_str(), val: Box::new(val.to_u()) }
-            ),
-            T::Record(map) => U::Record(
-                map.iter().map(|(k, v)| (k.as_str(), v.to_u())).collect()
-            ),
-            T::List(l) => U::List(
-                l.iter().map(|v| v.to_u()).collect::<Vec<U<'a>>>()
-            ),
+            T::Sum(Tag { tag, val }) => U::Sum(Tag {
+                tag: tag.as_str(),
+                val: Box::new(val.to_u()),
+            }),
+            T::Record(map) => U::Record(map.iter().map(|(k, v)| (k.as_str(), v.to_u())).collect()),
+            T::List(l) => U::List(l.iter().map(|v| v.to_u()).collect::<Vec<U<'a>>>()),
         }
     }
 
     pub fn encode<'a>(&'a self) -> Vec<u8> {
         match self {
             // TODO: don’t go via U, inefficient
-            o => o.to_u().encode()
+            o => o.to_u().encode(),
         }
     }
 }
@@ -110,15 +107,16 @@ impl<'a> U<'a> {
             U::I7(i) => T::I7(*i),
             U::Text(t) => T::Text((*t).to_owned()),
             U::Binary(v) => T::Binary((*v).to_owned()),
-            U::Sum(Tag { tag, val }) => T::Sum(
-                Tag { tag: (*tag).to_owned(), val: Box::new(val.to_t()) }
-            ),
+            U::Sum(Tag { tag, val }) => T::Sum(Tag {
+                tag: (*tag).to_owned(),
+                val: Box::new(val.to_t()),
+            }),
             U::Record(map) => T::Record(
-                map.iter().map(|(k, v)| ((*k).to_owned(), v.to_t())).collect::<HashMap<String, T>>()
-            ),
-            U::List(l) => T::List(
-                l.iter().map(|v| v.to_t()).collect::<Vec<T>>()
+                map.iter()
+                    .map(|(k, v)| ((*k).to_owned(), v.to_t()))
+                    .collect::<HashMap<String, T>>(),
             ),
+            U::List(l) => T::List(l.iter().map(|v| v.to_t()).collect::<Vec<T>>()),
         }
     }
 }
@@ -127,16 +125,18 @@ impl<'a> U<'a> {
 pub struct Tag<S, A> {
     // TODO: make into &str
     pub tag: S,
-    pub val: Box<A>
+    pub val: Box<A>,
 }
 
 impl<S, A> Tag<S, A> {
     fn map<F, B>(self, f: F) -> Tag<S, B>
-        where F: Fn(A) -> B {
-          Tag {
-              tag: self.tag,
-              val: Box::new(f(*self.val))
-          }
+    where
+        F: Fn(A) -> B,
+    {
+        Tag {
+            tag: self.tag,
+            val: Box::new(f(*self.val)),
+        }
     }
 }
 
@@ -147,77 +147,170 @@ fn encode_tag<W: Write>(w: &mut W, tag: &str, val: &U) -> std::io::Result<()> {
 }
 
 pub fn encode<W: Write>(w: &mut W, u: &U) -> std::io::Result<()> {
-  match u {
-      U::Unit => write!(w, "u,"),
-      U::N1(b) => if *b { write!(w, "n1:1,") } else { write!(w, "n1:0,") },
-      U::N3(n) => write!(w, "n3:{},", n),
-      U::N6(n) => write!(w, "n6:{},", n),
-      U::N7(n) => write!(w, "n7:{},", n),
-      U::I3(i) => write!(w, "i3:{},", i),
-      U::I6(i) => write!(w, "i6:{},", i),
-      U::I7(i) => write!(w, "i7:{},", i),
-      U::Text(s) => {
-          write!(w, "t{}:", s.len());
-          w.write_all(s.as_bytes());
-          write!(w, ",")
-      }
-      U::Binary(s) => {
-          write!(w, "b{}:", s.len());
-          w.write_all(&s);
-          write!(w, ",")
-      },
-      U::Sum(Tag{tag, val}) => encode_tag(w, tag, val),
-      U::Record(m) => {
-          let mut c = std::io::Cursor::new(vec![]);
-          for (k, v) in m {
-              encode_tag(&mut c, k, v)?;
-          }
-          write!(w, "{{{}:", c.get_ref().len())?;
-          w.write_all(c.get_ref())?;
-          write!(w, "}}")
-      },
-      U::List(l) => {
-          let mut c = std::io::Cursor::new(vec![]);
-          for u in l {
-              encode(&mut c, u)?;
-          }
-          write!(w, "[{}:", c.get_ref().len())?;
-          w.write_all(c.get_ref())?;
-          write!(w, "]")
-      }
-  }
+    match u {
+        U::Unit => write!(w, "u,"),
+        U::N1(b) => {
+            if *b {
+                write!(w, "n1:1,")
+            } else {
+                write!(w, "n1:0,")
+            }
+        }
+        U::N3(n) => write!(w, "n3:{},", n),
+        U::N6(n) => write!(w, "n6:{},", n),
+        U::N7(n) => write!(w, "n7:{},", n),
+        U::I3(i) => write!(w, "i3:{},", i),
+        U::I6(i) => write!(w, "i6:{},", i),
+        U::I7(i) => write!(w, "i7:{},", i),
+        U::Text(s) => {
+            write!(w, "t{}:", s.len());
+            w.write_all(s.as_bytes());
+            write!(w, ",")
+        }
+        U::Binary(s) => {
+            write!(w, "b{}:", s.len());
+            w.write_all(&s);
+            write!(w, ",")
+        }
+        U::Sum(Tag { tag, val }) => encode_tag(w, tag, val),
+        U::Record(m) => {
+            let mut c = std::io::Cursor::new(vec![]);
+            for (k, v) in m {
+                encode_tag(&mut c, k, v)?;
+            }
+            write!(w, "{{{}:", c.get_ref().len())?;
+            w.write_all(c.get_ref())?;
+            write!(w, "}}")
+        }
+        U::List(l) => {
+            let mut c = std::io::Cursor::new(vec![]);
+            for u in l {
+                encode(&mut c, u)?;
+            }
+            write!(w, "[{}:", c.get_ref().len())?;
+            w.write_all(c.get_ref())?;
+            write!(w, "]")
+        }
+    }
 }
 
 pub fn text(s: String) -> T {
     T::Text(s)
 }
 
-pub fn u_from_stdin_or_die_user_error<'a>(prog_name: &'_ str, stdin_buf: &'a mut Vec<u8>) -> U<'a> {
-    std::io::stdin().lock().read_to_end(stdin_buf);
-    let u = match parse::u_u(stdin_buf) {
-        Ok((rest, u)) => match rest {
-            b"" => u,
-            _ => exec_helpers::die_user_error(prog_name, format!("stdin contained some soup after netencode value: {:?}", String::from_utf8_lossy(rest)))
-        },
-        Err(err) => exec_helpers::die_user_error(prog_name, format!("unable to parse netencode from stdin: {:?}", err))
-    };
-    u
+pub fn t_from_stdin_or_die_user_error<'a>(prog_name: &'_ str) -> T {
+    match t_from_stdin_or_die_user_error_with_rest(prog_name, &vec![]) {
+        None => exec_helpers::die_user_error(prog_name, "stdin was empty"),
+        Some((rest, t)) => {
+            if rest.is_empty() {
+                t
+            } else {
+                exec_helpers::die_user_error(
+                    prog_name,
+                    format!(
+                        "stdin contained some soup after netencode value: {:?}",
+                        String::from_utf8_lossy(&rest)
+                    ),
+                )
+            }
+        }
+    }
+}
+
+/// Read a netencode value from stdin incrementally, return bytes that could not be read.
+/// Nothing if there was nothing to read from stdin & no initial_bytes were provided.
+/// These can be passed back as `initial_bytes` if more values should be read.
+pub fn t_from_stdin_or_die_user_error_with_rest<'a>(
+    prog_name: &'_ str,
+    initial_bytes: &[u8],
+) -> Option<(Vec<u8>, T)> {
+    let mut chonker = Chunkyboi::new(std::io::stdin().lock(), 4096);
+    // The vec to pass to the parser on each step
+    let mut parser_vec: Vec<u8> = initial_bytes.to_vec();
+    // whether stdin was already empty
+    let mut was_empty: bool = false;
+    loop {
+        match chonker.next() {
+            None => {
+                if parser_vec.is_empty() {
+                    return None;
+                } else {
+                    was_empty = true
+                }
+            }
+            Some(Err(err)) => exec_helpers::die_temporary(
+                prog_name,
+                &format!("could not read from stdin: {:?}", err),
+            ),
+            Some(Ok(mut new_bytes)) => parser_vec.append(&mut new_bytes),
+        }
+
+        match parse::t_t(&parser_vec) {
+            Ok((rest, t)) => return Some((rest.to_owned(), t)),
+            Err(nom::Err::Incomplete(Needed)) => {
+                if was_empty {
+                    exec_helpers::die_user_error(
+                        prog_name,
+                        &format!(
+                            "unable to parse netencode from stdin, input incomplete: {:?}",
+                            parser_vec
+                        ),
+                    );
+                }
+                // read more from stdin and try parsing again
+                continue;
+            }
+            Err(err) => exec_helpers::die_user_error(
+                prog_name,
+                &format!("unable to parse netencode from stdin: {:?}", err),
+            ),
+        }
+    }
+}
+
+// iter helper
+// TODO: put into its own module
+struct Chunkyboi<T> {
+    inner: T,
+    buf: Vec<u8>,
+}
+
+impl<R: Read> Chunkyboi<R> {
+    fn new(inner: R, chunksize: usize) -> Self {
+        let buf = vec![0; chunksize];
+        Chunkyboi { inner, buf }
+    }
+}
+
+impl<R: Read> Iterator for Chunkyboi<R> {
+    type Item = std::io::Result<Vec<u8>>;
+
+    fn next(&mut self) -> Option<std::io::Result<Vec<u8>>> {
+        match self.inner.read(&mut self.buf) {
+            Ok(0) => None,
+            Ok(read) => {
+                // clone a new buffer so we can reuse the internal one
+                Some(Ok(self.buf[..read].to_owned()))
+            }
+            Err(err) => Some(Err(err)),
+        }
+    }
 }
 
 pub mod parse {
-    use super::{T, Tag, U};
+    use super::{Tag, T, U};
 
-    use std::str::FromStr;
-    use std::ops::Neg;
     use std::collections::HashMap;
+    use std::ops::Neg;
+    use std::str::FromStr;
 
-    use nom::{IResult};
-    use nom::branch::{alt};
+    use nom::branch::alt;
     use nom::bytes::streaming::{tag, take};
-    use nom::character::streaming::{digit1, char};
-    use nom::sequence::{tuple};
-    use nom::combinator::{map, map_res, flat_map, map_parser, opt};
+    use nom::character::streaming::{char, digit1};
+    use nom::combinator::{flat_map, map, map_parser, map_res, opt};
     use nom::error::{context, ErrorKind, ParseError};
+    use nom::sequence::tuple;
+    use nom::IResult;
 
     fn unit_t(s: &[u8]) -> IResult<&[u8], ()> {
         let (s, _) = context("unit", tag("u,"))(s)?;
@@ -227,9 +320,9 @@ pub mod parse {
     fn usize_t(s: &[u8]) -> IResult<&[u8], usize> {
         context(
             "usize",
-            map_res(
-                map_res(digit1, |n| std::str::from_utf8(n)),
-                |s| s.parse::<usize>())
+            map_res(map_res(digit1, |n| std::str::from_utf8(n)), |s| {
+                s.parse::<usize>()
+            }),
         )(s)
     }
 
@@ -238,87 +331,77 @@ pub mod parse {
             // This is the point where we check the descriminator;
             // if the beginning char does not match, we can immediately return.
             let (s, _) = char(begin)(s)?;
-            let (s, (len, _)) = tuple((
-                usize_t,
-                char(':')
-            ))(s)?;
-            let (s, (res, _)) = tuple((
-                take(len),
-                char(end)
-            ))(s)?;
+            let (s, (len, _)) = tuple((usize_t, char(':')))(s)?;
+            let (s, (res, _)) = tuple((take(len), char(end)))(s)?;
             Ok((s, res))
         }
     }
 
-
     fn uint_t<'a, I: FromStr + 'a>(t: &'static str) -> impl Fn(&'a [u8]) -> IResult<&'a [u8], I> {
         move |s: &'a [u8]| {
             let (s, (_, _, int, _)) = tuple((
                 tag(t.as_bytes()),
                 char(':'),
-                map_res(
-                    map_res(digit1, |n: &[u8]| std::str::from_utf8(n)),
-                    |s| s.parse::<I>()
-                ),
-                char(',')
+                map_res(map_res(digit1, |n: &[u8]| std::str::from_utf8(n)), |s| {
+                    s.parse::<I>()
+                }),
+                char(','),
             ))(s)?;
             Ok((s, int))
         }
     }
 
     fn bool_t<'a>() -> impl Fn(&'a [u8]) -> IResult<&'a [u8], bool> {
-        context("bool", alt((
-            map(tag("n1:0,"), |_| false),
-            map(tag("n1:1,"), |_| true),
-        )))
-    }
-
-    fn int_t<'a, I: FromStr + Neg<Output=I>>(t: &'static str) -> impl Fn(&'a [u8]) -> IResult<&[u8], I> {
         context(
-            t,
-            move |s: &'a [u8]| {
-                let (s, (_, _, neg, int, _)) = tuple((
-                    tag(t.as_bytes()),
-                    char(':'),
-                    opt(char('-')),
-                    map_res(
-                        map_res(digit1, |n: &[u8]| std::str::from_utf8(n)),
-                        |s| s.parse::<I>()
-                    ),
-                    char(',')
-                ))(s)?;
-                let res = match neg {
-                    Some(_) => -int,
-                    None => int,
-                };
-                Ok((s, res))
-            }
+            "bool",
+            alt((map(tag("n1:0,"), |_| false), map(tag("n1:1,"), |_| true))),
         )
     }
 
+    fn int_t<'a, I: FromStr + Neg<Output = I>>(
+        t: &'static str,
+    ) -> impl Fn(&'a [u8]) -> IResult<&[u8], I> {
+        context(t, move |s: &'a [u8]| {
+            let (s, (_, _, neg, int, _)) = tuple((
+                tag(t.as_bytes()),
+                char(':'),
+                opt(char('-')),
+                map_res(map_res(digit1, |n: &[u8]| std::str::from_utf8(n)), |s| {
+                    s.parse::<I>()
+                }),
+                char(','),
+            ))(s)?;
+            let res = match neg {
+                Some(_) => -int,
+                None => int,
+            };
+            Ok((s, res))
+        })
+    }
+
     fn tag_t(s: &[u8]) -> IResult<&[u8], Tag<String, T>> {
         // recurses into the main parser
-        map(tag_g(t_t),
-            |Tag {tag, val}|
-            Tag {
-                tag: tag.to_string(),
-                val
-            })(s)
+        map(tag_g(t_t), |Tag { tag, val }| Tag {
+            tag: tag.to_string(),
+            val,
+        })(s)
     }
 
     fn tag_g<'a, P, O>(inner: P) -> impl Fn(&'a [u8]) -> IResult<&'a [u8], Tag<&'a str, O>>
     where
-        P: Fn(&'a [u8]) -> IResult<&'a [u8], O>
+        P: Fn(&'a [u8]) -> IResult<&'a [u8], O>,
     {
         move |s: &[u8]| {
             let (s, tag) = sized('<', '|')(s)?;
             let (s, val) = inner(s)?;
-            Ok((s, Tag {
-                tag: std::str::from_utf8(tag)
-                    .map_err(|_| nom::Err::Failure((s, ErrorKind::Char)))?,
-                val: Box::new(val)
-            }))
-
+            Ok((
+                s,
+                Tag {
+                    tag: std::str::from_utf8(tag)
+                        .map_err(|_| nom::Err::Failure((s, ErrorKind::Char)))?,
+                    val: Box::new(val),
+                },
+            ))
         }
     }
 
@@ -330,9 +413,9 @@ pub mod parse {
 
     fn text_g(s: &[u8]) -> IResult<&[u8], &str> {
         let (s, res) = sized('t', ',')(s)?;
-        Ok((s,
-            std::str::from_utf8(res)
-                .map_err(|_| nom::Err::Failure((s, ErrorKind::Char)))?,
+        Ok((
+            s,
+            std::str::from_utf8(res).map_err(|_| nom::Err::Failure((s, ErrorKind::Char)))?,
         ))
     }
 
@@ -374,22 +457,24 @@ pub mod parse {
     {
         map_parser(
             sized('[', ']'),
-            nom::multi::many0(inner_no_empty_string(inner))
+            nom::multi::many0(inner_no_empty_string(inner)),
         )
     }
 
     fn record_t<'a>(s: &'a [u8]) -> IResult<&'a [u8], HashMap<String, T>> {
         let (s, r) = record_g(t_t)(s)?;
-        Ok((s,
+        Ok((
+            s,
             r.into_iter()
-            .map(|(k, v)| (k.to_string(), v))
-            .collect::<HashMap<_,_>>()))
+                .map(|(k, v)| (k.to_string(), v))
+                .collect::<HashMap<_, _>>(),
+        ))
     }
 
     fn record_g<'a, P, O>(inner: P) -> impl Fn(&'a [u8]) -> IResult<&'a [u8], HashMap<&'a str, O>>
     where
         O: Clone,
-        P: Fn(&'a [u8]) -> IResult<&'a [u8], O>
+        P: Fn(&'a [u8]) -> IResult<&'a [u8], O>,
     {
         move |s: &'a [u8]| {
             let (s, map) = map_parser(
@@ -397,19 +482,17 @@ pub mod parse {
                 nom::multi::fold_many0(
                     inner_no_empty_string(tag_g(&inner)),
                     HashMap::new(),
-                    |mut acc: HashMap<_,_>, Tag { tag, mut val }| {
-                        // ignore duplicated tag names that appear later
+                    |mut acc: HashMap<_, _>, Tag { tag, mut val }| {
+                        // ignore earlier tags with the same name
                         // according to netencode spec
-                        if ! acc.contains_key(tag) {
-                            acc.insert(tag, *val);
-                        }
+                        let _ = acc.insert(tag, *val);
                         acc
-                    }
-                )
+                    },
+                ),
             )(s)?;
             if map.is_empty() {
                 // records must not be empty, according to the spec
-                Err(nom::Err::Failure((s,nom::error::ErrorKind::Many1)))
+                Err(nom::Err::Failure((s, nom::error::ErrorKind::Many1)))
             } else {
                 Ok((s, map))
             }
@@ -424,7 +507,6 @@ pub mod parse {
             map(tag_g(u_u), |t| U::Sum(t)),
             map(list_g(u_u), U::List),
             map(record_g(u_u), U::Record),
-
             map(bool_t(), |u| U::N1(u)),
             map(uint_t("n3"), |u| U::N3(u)),
             map(uint_t("n6"), |u| U::N6(u)),
@@ -432,7 +514,6 @@ pub mod parse {
             map(int_t("i3"), |u| U::I3(u)),
             map(int_t("i6"), |u| U::I6(u)),
             map(int_t("i7"), |u| U::I7(u)),
-
             // less common
             map(uint_t("n2"), |u| U::N3(u)),
             map(uint_t("n4"), |u| U::N6(u)),
@@ -445,7 +526,7 @@ pub mod parse {
         ))(s)
     }
 
-    pub fn t_t(s: &[u8]) -> IResult<&[u8], T>  {
+    pub fn t_t(s: &[u8]) -> IResult<&[u8], T> {
         alt((
             text,
             binary(),
@@ -453,7 +534,6 @@ pub mod parse {
             map(tag_t, |t| T::Sum(t)),
             map(list_t, |l| T::List(l)),
             map(record_t, |p| T::Record(p)),
-
             map(bool_t(), |u| T::N1(u)),
             // 8, 64 and 128 bit
             map(uint_t("n3"), |u| T::N3(u)),
@@ -462,7 +542,6 @@ pub mod parse {
             map(int_t("i3"), |u| T::I3(u)),
             map(int_t("i6"), |u| T::I6(u)),
             map(int_t("i7"), |u| T::I7(u)),
-
             // less common
             map(uint_t("n2"), |u| T::N3(u)),
             map(uint_t("n4"), |u| T::N6(u)),
@@ -481,30 +560,18 @@ pub mod parse {
 
         #[test]
         fn test_parse_unit_t() {
-            assert_eq!(
-                unit_t("u,".as_bytes()),
-                Ok(("".as_bytes(), ()))
-            );
+            assert_eq!(unit_t("u,".as_bytes()), Ok(("".as_bytes(), ())));
         }
 
         #[test]
         fn test_parse_bool_t() {
-            assert_eq!(
-                bool_t()("n1:0,".as_bytes()),
-                Ok(("".as_bytes(), false))
-            );
-            assert_eq!(
-                bool_t()("n1:1,".as_bytes()),
-                Ok(("".as_bytes(), true))
-            );
+            assert_eq!(bool_t()("n1:0,".as_bytes()), Ok(("".as_bytes(), false)));
+            assert_eq!(bool_t()("n1:1,".as_bytes()), Ok(("".as_bytes(), true)));
         }
 
         #[test]
         fn test_parse_usize_t() {
-            assert_eq!(
-                usize_t("32foo".as_bytes()),
-                Ok(("foo".as_bytes(), 32))
-            );
+            assert_eq!(usize_t("32foo".as_bytes()), Ok(("foo".as_bytes(), 32)));
         }
 
         #[test]
@@ -515,7 +582,10 @@ pub mod parse {
             );
             assert_eq!(
                 uint_t::<u8>("n3")("n3:1024,abc".as_bytes()),
-                Err(nom::Err::Error(("1024,abc".as_bytes(), nom::error::ErrorKind::MapRes)))
+                Err(nom::Err::Error((
+                    "1024,abc".as_bytes(),
+                    nom::error::ErrorKind::MapRes
+                )))
             );
             assert_eq!(
                 int_t::<i64>("i6")("i6:-23,abc".as_bytes()),
@@ -544,18 +614,21 @@ pub mod parse {
             assert_eq!(
                 text("t5:hello,".as_bytes()),
                 Ok(("".as_bytes(), T::Text("hello".to_owned()))),
-                "{}", r"t5:hello,"
+                "{}",
+                r"t5:hello,"
             );
             assert_eq!(
                 text("t4:fo".as_bytes()),
                 // The content of the text should be 4 long
                 Err(nom::Err::Incomplete(nom::Needed::Size(4))),
-                "{}", r"t4:fo,"
+                "{}",
+                r"t4:fo,"
             );
             assert_eq!(
                 text("t9:今日は,".as_bytes()),
                 Ok(("".as_bytes(), T::Text("今日は".to_owned()))),
-                "{}", r"t9:今日は,"
+                "{}",
+                r"t9:今日は,"
             );
         }
 
@@ -564,24 +637,28 @@ pub mod parse {
             assert_eq!(
                 binary()("b5:hello,".as_bytes()),
                 Ok(("".as_bytes(), T::Binary(Vec::from("hello".to_owned())))),
-                "{}", r"b5:hello,"
+                "{}",
+                r"b5:hello,"
             );
             assert_eq!(
                 binary()("b4:fo".as_bytes()),
                 // The content of the byte should be 4 long
                 Err(nom::Err::Incomplete(nom::Needed::Size(4))),
-                "{}", r"b4:fo,"
+                "{}",
+                r"b4:fo,"
             );
             assert_eq!(
                 binary()("b4:foob".as_bytes()),
                 // The content is 4 bytes now, but the finishing , is missing
                 Err(nom::Err::Incomplete(nom::Needed::Size(1))),
-                    "{}", r"b4:fo,"
-                );
+                "{}",
+                r"b4:fo,"
+            );
             assert_eq!(
                 binary()("b9:今日は,".as_bytes()),
                 Ok(("".as_bytes(), T::Binary(Vec::from("今日は".as_bytes())))),
-                "{}", r"b9:今日は,"
+                "{}",
+                r"b9:今日は,"
             );
         }
 
@@ -590,25 +667,23 @@ pub mod parse {
             assert_eq!(
                 list_t("[0:]".as_bytes()),
                 Ok(("".as_bytes(), vec![])),
-                "{}", r"[0:]"
+                "{}",
+                r"[0:]"
             );
             assert_eq!(
                 list_t("[6:u,u,u,]".as_bytes()),
-                Ok(("".as_bytes(), vec![
-                    T::Unit,
-                    T::Unit,
-                    T::Unit,
-                ])),
-                "{}", r"[6:u,u,u,]"
+                Ok(("".as_bytes(), vec![T::Unit, T::Unit, T::Unit,])),
+                "{}",
+                r"[6:u,u,u,]"
             );
             assert_eq!(
                 list_t("[15:u,[7:t3:foo,]u,]".as_bytes()),
-                Ok(("".as_bytes(), vec![
-                    T::Unit,
-                    T::List(vec![T::Text("foo".to_owned())]),
-                    T::Unit,
-                ])),
-                "{}", r"[15:u,[7:t3:foo,]u,]"
+                Ok((
+                    "".as_bytes(),
+                    vec![T::Unit, T::List(vec![T::Text("foo".to_owned())]), T::Unit,]
+                )),
+                "{}",
+                r"[15:u,[7:t3:foo,]u,]"
             );
         }
 
@@ -616,27 +691,40 @@ pub mod parse {
         fn test_record() {
             assert_eq!(
                 record_t("{21:<1:a|u,<1:b|u,<1:c|u,}".as_bytes()),
-                Ok(("".as_bytes(), vec![
-                    ("a".to_owned(), T::Unit),
-                    ("b".to_owned(), T::Unit),
-                    ("c".to_owned(), T::Unit),
-                ].into_iter().collect::<HashMap<String, T>>())),
-                "{}", r"{21:<1:a|u,<1:b|u,<1:c|u,}"
+                Ok((
+                    "".as_bytes(),
+                    vec![
+                        ("a".to_owned(), T::Unit),
+                        ("b".to_owned(), T::Unit),
+                        ("c".to_owned(), T::Unit),
+                    ]
+                    .into_iter()
+                    .collect::<HashMap<String, T>>()
+                )),
+                "{}",
+                r"{21:<1:a|u,<1:b|u,<1:c|u,}"
             );
             // duplicated keys are ignored (first is taken)
             assert_eq!(
                 record_t("{25:<1:a|u,<1:b|u,<1:a|i1:-1,}".as_bytes()),
-                Ok(("".as_bytes(), vec![
-                    ("a".to_owned(), T::Unit),
-                    ("b".to_owned(), T::Unit),
-                ].into_iter().collect::<HashMap<_,_>>())),
-                "{}", r"{25:<1:a|u,<1:b|u,<1:a|i1:-1,}"
+                Ok((
+                    "".as_bytes(),
+                    vec![("a".to_owned(), T::I3(-1)), ("b".to_owned(), T::Unit),]
+                        .into_iter()
+                        .collect::<HashMap<_, _>>()
+                )),
+                "{}",
+                r"{25:<1:a|u,<1:b|u,<1:a|i1:-1,}"
             );
             // empty records are not allowed
             assert_eq!(
                 record_t("{0:}".as_bytes()),
-                Err(nom::Err::Failure(("".as_bytes(), nom::error::ErrorKind::Many1))),
-                "{}", r"{0:}"
+                Err(nom::Err::Failure((
+                    "".as_bytes(),
+                    nom::error::ErrorKind::Many1
+                ))),
+                "{}",
+                r"{0:}"
             );
         }
 
@@ -645,37 +733,62 @@ pub mod parse {
             assert_eq!(
                 t_t("n3:255,".as_bytes()),
                 Ok(("".as_bytes(), T::N3(255))),
-                "{}", r"n3:255,"
+                "{}",
+                r"n3:255,"
             );
             assert_eq!(
                 t_t("t6:halloo,".as_bytes()),
                 Ok(("".as_bytes(), T::Text("halloo".to_owned()))),
-                "{}", r"t6:halloo,"
+                "{}",
+                r"t6:halloo,"
             );
             assert_eq!(
                 t_t("<3:foo|t6:halloo,".as_bytes()),
-                Ok(("".as_bytes(), T::Sum (Tag {
-                    tag: "foo".to_owned(),
-                    val: Box::new(T::Text("halloo".to_owned()))
-                }))),
-                "{}", r"<3:foo|t6:halloo,"
+                Ok((
+                    "".as_bytes(),
+                    T::Sum(Tag {
+                        tag: "foo".to_owned(),
+                        val: Box::new(T::Text("halloo".to_owned()))
+                    })
+                )),
+                "{}",
+                r"<3:foo|t6:halloo,"
             );
             // { a: Unit
             // , foo: List <A: Unit | B: List i3> }
             assert_eq!(
                 t_t("{52:<1:a|u,<3:foo|[33:<1:A|u,<1:A|n1:1,<1:B|[7:i3:127,]]}".as_bytes()),
-                Ok(("".as_bytes(), T::Record(vec![
-                    ("a".to_owned(), T::Unit),
-                    ("foo".to_owned(), T::List(vec![
-                        T::Sum(Tag { tag: "A".to_owned(), val: Box::new(T::Unit) }),
-                        T::Sum(Tag { tag: "A".to_owned(), val: Box::new(T::N1(true)) }),
-                        T::Sum(Tag { tag: "B".to_owned(), val: Box::new(T::List(vec![T::I3(127)])) }),
-                    ]))
-                ].into_iter().collect::<HashMap<String, T>>()))),
-                "{}", r"{52:<1:a|u,<3:foo|[33:<1:A|u,<1:A|n1:1,<1:B|[7:i3:127,]]}"
+                Ok((
+                    "".as_bytes(),
+                    T::Record(
+                        vec![
+                            ("a".to_owned(), T::Unit),
+                            (
+                                "foo".to_owned(),
+                                T::List(vec![
+                                    T::Sum(Tag {
+                                        tag: "A".to_owned(),
+                                        val: Box::new(T::Unit)
+                                    }),
+                                    T::Sum(Tag {
+                                        tag: "A".to_owned(),
+                                        val: Box::new(T::N1(true))
+                                    }),
+                                    T::Sum(Tag {
+                                        tag: "B".to_owned(),
+                                        val: Box::new(T::List(vec![T::I3(127)]))
+                                    }),
+                                ])
+                            )
+                        ]
+                        .into_iter()
+                        .collect::<HashMap<String, T>>()
+                    )
+                )),
+                "{}",
+                r"{52:<1:a|u,<3:foo|[33:<1:A|u,<1:A|n1:1,<1:B|[7:i3:127,]]}"
             );
         }
-
     }
 }
 
@@ -690,8 +803,10 @@ pub mod dec {
         fn dec(&self, u: U<'a>) -> Result<Self::A, DecodeError>;
     }
 
+    /// Any netencode, as `T`.
     #[derive(Clone, Copy)]
     pub struct AnyT;
+    /// Any netencode, as `U`.
     #[derive(Clone, Copy)]
     pub struct AnyU;
 
@@ -709,8 +824,11 @@ pub mod dec {
         }
     }
 
+    /// A text
     #[derive(Clone, Copy)]
     pub struct Text;
+
+    /// A bytestring
     // TODO: rename to Bytes
     #[derive(Clone, Copy)]
     pub struct Binary;
@@ -730,11 +848,15 @@ pub mod dec {
         fn dec(&self, u: U<'a>) -> Result<Self::A, DecodeError> {
             match u {
                 U::Binary(b) => Ok(b),
-                other => Err(DecodeError(format!("Cannot decode {:?} into Binary", other))),
+                other => Err(DecodeError(format!(
+                    "Cannot decode {:?} into Binary",
+                    other
+                ))),
             }
         }
     }
 
+    /// Any scalar, converted to bytes.
     #[derive(Clone, Copy)]
     pub struct ScalarAsBytes;
 
@@ -755,80 +877,93 @@ pub mod dec {
         }
     }
 
+    /// A map of Ts (TODO: rename to map)
     #[derive(Clone, Copy)]
     pub struct Record<T>(pub T);
 
     impl<'a, Inner> Decoder<'a> for Record<Inner>
-        where Inner: Decoder<'a>
+    where
+        Inner: Decoder<'a>,
     {
         type A = HashMap<&'a str, Inner::A>;
         fn dec(&self, u: U<'a>) -> Result<Self::A, DecodeError> {
             match u {
-                U::Record(map) =>
-                    map.into_iter()
+                U::Record(map) => map
+                    .into_iter()
                     .map(|(k, v)| self.0.dec(v).map(|v2| (k, v2)))
                     .collect::<Result<Self::A, _>>(),
-                o => Err(DecodeError(format!("Cannot decode {:?} into record", o)))
+                o => Err(DecodeError(format!("Cannot decode {:?} into record", o))),
             }
         }
     }
 
+    /// Assume a record and project out the field with the given name and type.
     #[derive(Clone, Copy)]
     pub struct RecordDot<'a, T> {
         pub field: &'a str,
-        pub inner: T
+        pub inner: T,
     }
 
-    impl <'a, Inner> Decoder<'a> for RecordDot<'_, Inner>
-        where Inner: Decoder<'a> + Clone
+    impl<'a, Inner> Decoder<'a> for RecordDot<'_, Inner>
+    where
+        Inner: Decoder<'a> + Clone,
     {
         type A = Inner::A;
         fn dec(&self, u: U<'a>) -> Result<Self::A, DecodeError> {
             match Record(self.inner.clone()).dec(u) {
                 Ok(mut map) => match map.remove(self.field) {
                     Some(inner) => Ok(inner),
-                    None => Err(DecodeError(format!("Cannot find `{}` in record map", self.field))),
+                    None => Err(DecodeError(format!(
+                        "Cannot find `{}` in record map",
+                        self.field
+                    ))),
                 },
                 Err(err) => Err(err),
             }
         }
     }
 
+    /// Equals one of the listed `A`s exactly, after decoding.
     #[derive(Clone)]
-    pub struct OneOf<T, A>{
+    pub struct OneOf<T, A> {
         pub inner: T,
         pub list: Vec<A>,
     }
 
-    impl <'a, Inner> Decoder<'a> for OneOf<Inner, Inner::A>
-        where Inner: Decoder<'a>,
-              Inner::A: Display + Debug + PartialEq
+    impl<'a, Inner> Decoder<'a> for OneOf<Inner, Inner::A>
+    where
+        Inner: Decoder<'a>,
+        Inner::A: Display + Debug + PartialEq,
     {
         type A = Inner::A;
         fn dec(&self, u: U<'a>) -> Result<Self::A, DecodeError> {
             match self.inner.dec(u) {
                 Ok(inner) => match self.list.iter().any(|x| x.eq(&inner)) {
                     true => Ok(inner),
-                    false => Err(DecodeError(format!("{} is not one of {:?}", inner, self.list)))
+                    false => Err(DecodeError(format!(
+                        "{} is not one of {:?}",
+                        inner, self.list
+                    ))),
                 },
-                Err(err) => Err(err)
+                Err(err) => Err(err),
             }
         }
     }
 
+    /// Try decoding as `T`.
     #[derive(Clone)]
     pub struct Try<T>(pub T);
 
-    impl <'a, Inner> Decoder<'a> for Try<Inner>
-        where Inner: Decoder<'a>
+    impl<'a, Inner> Decoder<'a> for Try<Inner>
+    where
+        Inner: Decoder<'a>,
     {
         type A = Option<Inner::A>;
         fn dec(&self, u: U<'a>) -> Result<Self::A, DecodeError> {
             match self.0.dec(u) {
                 Ok(inner) => Ok(Some(inner)),
-                Err(err) => Ok(None)
+                Err(err) => Ok(None),
             }
         }
     }
-
 }
diff --git a/users/Profpatsch/netencode/pretty.rs b/users/Profpatsch/netencode/pretty.rs
index 8fec24a60e..935c3d4a8a 100644
--- a/users/Profpatsch/netencode/pretty.rs
+++ b/users/Profpatsch/netencode/pretty.rs
@@ -1,6 +1,6 @@
 extern crate netencode;
 
-use netencode::{U, T, Tag};
+use netencode::{Tag, T, U};
 
 pub enum Pretty {
     Single {
@@ -20,7 +20,7 @@ pub enum Pretty {
         r#type: char,
         length: String,
         vals: Vec<Pretty>,
-        trailer: char
+        trailer: char,
     },
 }
 
@@ -39,7 +39,7 @@ impl Pretty {
                 r#type: 't',
                 length: format!("{}:", s.len()),
                 val: s.to_string(),
-                trailer: ','
+                trailer: ',',
             },
             U::Binary(s) => Pretty::Single {
                 r#type: 'b',
@@ -47,15 +47,18 @@ impl Pretty {
                 // For pretty printing we want the string to be visible obviously.
                 // Instead of not supporting binary, let’s use lossy conversion.
                 val: String::from_utf8_lossy(s).into_owned(),
-                trailer: ','
+                trailer: ',',
             },
-            U::Sum(Tag{tag, val}) => Self::pretty_tag(tag, Self::from_u(*val)),
+            U::Sum(Tag { tag, val }) => Self::pretty_tag(tag, Self::from_u(*val)),
             U::Record(m) => Pretty::Multi {
                 r#type: '{',
                 // TODO: we are losing the size here, should we recompute it? Keep it?
                 length: String::from(""),
-                vals: m.into_iter().map(|(k, v)| Self::pretty_tag(k, Self::from_u(v))).collect(),
-                trailer: '}'
+                vals: m
+                    .into_iter()
+                    .map(|(k, v)| Self::pretty_tag(k, Self::from_u(v)))
+                    .collect(),
+                trailer: '}',
             },
             U::List(l) => Pretty::Multi {
                 r#type: '[',
@@ -68,13 +71,14 @@ impl Pretty {
     }
 
     fn scalar<D>(r#type: char, length: &str, d: D) -> Pretty
-    where D: std::fmt::Display
+    where
+        D: std::fmt::Display,
     {
         Pretty::Single {
             r#type,
             length: length.to_string(),
             val: format!("{}", d),
-            trailer: ','
+            trailer: ',',
         }
     }
 
@@ -89,43 +93,62 @@ impl Pretty {
     }
 
     pub fn print_multiline<W>(&self, mut w: &mut W) -> std::io::Result<()>
-        where W: std::io::Write
+    where
+        W: std::io::Write,
     {
         Self::go(&mut w, self, 0, true);
         write!(w, "\n")
     }
 
     fn go<W>(mut w: &mut W, p: &Pretty, depth: usize, is_newline: bool) -> std::io::Result<()>
-        where W: std::io::Write
+    where
+        W: std::io::Write,
     {
-        const full : usize = 4;
-        const half : usize = 2;
-        let i = &vec![b' '; depth*full];
-        let iandhalf = &vec![b' '; depth*full + half];
-        let (i, iandhalf) = unsafe {(
-            std::str::from_utf8_unchecked(i),
-            std::str::from_utf8_unchecked(iandhalf),
-        )};
+        const full: usize = 4;
+        const half: usize = 2;
+        let i = &vec![b' '; depth * full];
+        let iandhalf = &vec![b' '; depth * full + half];
+        let (i, iandhalf) = unsafe {
+            (
+                std::str::from_utf8_unchecked(i),
+                std::str::from_utf8_unchecked(iandhalf),
+            )
+        };
         if is_newline {
             write!(&mut w, "{}", i);
         }
         match p {
-            Pretty::Single {r#type, length, val, trailer} =>
-                write!(&mut w, "{} {}{}", r#type, val, trailer),
-            Pretty::Tag { r#type, length, key, inner, val } => {
+            Pretty::Single {
+                r#type,
+                length,
+                val,
+                trailer,
+            } => write!(&mut w, "{} {}{}", r#type, val, trailer),
+            Pretty::Tag {
+                r#type,
+                length,
+                key,
+                inner,
+                val,
+            } => {
                 write!(&mut w, "{} {} {}", r#type, key, inner)?;
                 Self::go::<W>(&mut w, val, depth, false)
-            },
+            }
             // if the length is 0 or 1, we print on one line,
             // only if there’s more than one element we split the resulting value.
             // we never break lines on arbitrary column sizes, since that is just silly.
-            Pretty::Multi {r#type, length, vals, trailer} => match vals.len() {
+            Pretty::Multi {
+                r#type,
+                length,
+                vals,
+                trailer,
+            } => match vals.len() {
                 0 => write!(&mut w, "{} {}", r#type, trailer),
                 1 => {
                     write!(&mut w, "{} ", r#type);
                     Self::go::<W>(&mut w, &vals[0], depth, false)?;
                     write!(&mut w, "{}", trailer)
-                },
+                }
                 more => {
                     write!(&mut w, "\n{}{} \n", iandhalf, r#type)?;
                     for v in vals {
diff --git a/users/Profpatsch/netstring/default.nix b/users/Profpatsch/netstring/default.nix
index 2b21cde388..047fe6bae1 100644
--- a/users/Profpatsch/netstring/default.nix
+++ b/users/Profpatsch/netstring/default.nix
@@ -1,8 +1,16 @@
 { lib, pkgs, depot, ... }:
 let
-  python-netstring = depot.users.Profpatsch.writers.python3Lib {
-    name = "netstring";
-  } ''
+  toNetstring = depot.nix.netstring.fromString;
+
+  toNetstringList = xs:
+    lib.concatStrings (map toNetstring xs);
+
+  toNetstringKeyVal = depot.nix.netstring.attrsToKeyValList;
+
+  python-netstring = depot.users.Profpatsch.writers.python3Lib
+    {
+      name = "netstring";
+    } ''
     def read_netstring(bytes):
         (int_length, rest) = bytes.split(sep=b':', maxsplit=1)
         val = rest[:int(int_length)]
@@ -27,9 +35,10 @@ let
         return res
   '';
 
-  rust-netstring = depot.nix.writers.rustSimpleLib {
-    name = "netstring";
-  } ''
+  rust-netstring = depot.nix.writers.rustSimpleLib
+    {
+      name = "netstring";
+    } ''
     pub fn to_netstring(s: &[u8]) -> Vec<u8> {
         let len = s.len();
         // length of the integer as ascii
@@ -43,9 +52,13 @@ let
     }
   '';
 
-in depot.nix.utils.drvTargets {
+in
+depot.nix.readTree.drvTargets {
   inherit
+    toNetstring
+    toNetstringList
+    toNetstringKeyVal
     python-netstring
     rust-netstring
-      ;
+    ;
 }
diff --git a/users/Profpatsch/netstring/tests/default.nix b/users/Profpatsch/netstring/tests/default.nix
index f64beb9e92..6a1062988f 100644
--- a/users/Profpatsch/netstring/tests/default.nix
+++ b/users/Profpatsch/netstring/tests/default.nix
@@ -2,12 +2,13 @@
 
 let
 
-  python-netstring-test = depot.users.Profpatsch.writers.python3 {
-    name = "python-netstring-test";
-    libraries = p: [
-      depot.users.Profpatsch.netstring.python-netstring
-    ];
-  } ''
+  python-netstring-test = depot.users.Profpatsch.writers.python3
+    {
+      name = "python-netstring-test";
+      libraries = p: [
+        depot.users.Profpatsch.netstring.python-netstring
+      ];
+    } ''
     import netstring
 
     def assEq(left, right):
@@ -33,12 +34,13 @@ let
     )
   '';
 
-  rust-netstring-test = depot.nix.writers.rustSimple {
-    name = "rust-netstring-test";
-    dependencies = [
-      depot.users.Profpatsch.netstring.rust-netstring
-    ];
-  } ''
+  rust-netstring-test = depot.nix.writers.rustSimple
+    {
+      name = "rust-netstring-test";
+      dependencies = [
+        depot.users.Profpatsch.netstring.rust-netstring
+      ];
+    } ''
     extern crate netstring;
 
     fn main() {
@@ -53,7 +55,8 @@ let
     }
   '';
 
-in depot.nix.utils.drvTargets {
+in
+depot.nix.readTree.drvTargets {
   inherit
     python-netstring-test
     rust-netstring-test
diff --git a/users/Profpatsch/nix-home/README.md b/users/Profpatsch/nix-home/README.md
new file mode 100644
index 0000000000..222978bc8c
--- /dev/null
+++ b/users/Profpatsch/nix-home/README.md
@@ -0,0 +1,7 @@
+# nix-home
+
+My very much simplified version of [home-manager](https://github.com/nix-community/home-manager/).
+
+Only takes care about installing symlinks into `$HOME`, and uses [`GNU stow`](https://www.gnu.org/software/stow/) for doing the actual mutating.
+
+No support for services (yet).
diff --git a/users/Profpatsch/nix-home/default.nix b/users/Profpatsch/nix-home/default.nix
new file mode 100644
index 0000000000..ee154c549a
--- /dev/null
+++ b/users/Profpatsch/nix-home/default.nix
@@ -0,0 +1,212 @@
+{ depot, pkgs, lib, ... }:
+
+let
+  bins = depot.nix.getBins pkgs.stow [ "stow" ]
+    // depot.nix.getBins pkgs.coreutils [ "mkdir" "ln" "printenv" "rm" ]
+    // depot.nix.getBins pkgs.xe [ "xe" ]
+    // depot.nix.getBins pkgs.lr [ "lr" ]
+    // depot.nix.getBins pkgs.nix [ "nix-store" ]
+  ;
+
+  # run stow to populate the target directory with the given stow package, read from stowDir.
+  # Bear in mind that `stowDirOriginPath` should always be semantically bound to the given `stowDir`, otherwise stow might become rather confused.
+  runStow =
+    {
+      # “stow package” to stow (see manpage)
+      # TODO: allow this function to un-stow multiple packages!
+      stowPackage
+    , # “target directory” to stow in (see manpage)
+      targetDir
+    , # The “stow directory” (see manpage), containing “stow packages” (see manpage)
+      stowDir
+    , # representative directory for the stowDir in the file system, against which stow will create relative links.
+      # ATTN: this is always overwritten with the contents of `stowDir`! You shouldn’t re-use the same `stowDirOriginPath` for different `stowDir`s, otherwise there might be surprises.
+      stowDirOriginPath
+    ,
+    }: depot.nix.writeExecline "stow-${stowPackage}" { } [
+      # first, create a temporary stow directory to use as source
+      # (stow will use it to determine the origin of files)
+      "if"
+      [ bins.mkdir "-p" stowDirOriginPath ]
+      # remove old symlinks
+      "if"
+      [
+        "pipeline"
+        [
+          bins.lr
+          "-0"
+          "-t"
+          "depth == 1 && type == l"
+          stowDirOriginPath
+        ]
+        bins.xe
+        "-0"
+        bins.rm
+      ]
+      # create an indirect gc root so our config is not cleaned under our asses by a garbage collect
+      "if"
+      [
+        bins.nix-store
+        "--realise"
+        "--indirect"
+        "--add-root"
+        "${stowDirOriginPath}/.nix-stowdir-gc-root"
+        stowDir
+      ]
+      # populate with new stow targets
+      "if"
+      [
+        "elglob"
+        "-w0"
+        "stowPackages"
+        "${stowDir}/*"
+        bins.ln
+        "--force"
+        "-st"
+        stowDirOriginPath
+        "$stowPackages"
+      ]
+      # stow always looks for $HOME/.stowrc to read more arguments
+      "export"
+      "HOME"
+      "/homeless-shelter"
+      bins.stow
+      # always run restow for now; this does more stat but will remove stale links
+      "--restow"
+      "--dir"
+      stowDirOriginPath
+      "--target"
+      targetDir
+      stowPackage
+    ];
+
+  # create a stow dir from a list of drv paths and a stow package name.
+  makeStowDir =
+    (with depot.nix.yants;
+    defun
+      [
+        (list (struct {
+          originalDir = drv;
+          stowPackage = string;
+        }))
+        drv
+      ])
+      (dirs:
+        depot.nix.runExecline "make-stow-dir"
+          {
+            stdin = lib.pipe dirs [
+              (map depot.users.Profpatsch.netencode.gen.dwim)
+              depot.users.Profpatsch.netstring.toNetstringList
+            ];
+          } [
+          "importas"
+          "out"
+          "out"
+          "if"
+          [ bins.mkdir "-p" "$out" ]
+          "forstdin"
+          "-d"
+          ""
+          "-o"
+          "0"
+          "line"
+          "pipeline"
+          [
+            depot.users.Profpatsch.execline.print-one-env
+            "line"
+          ]
+          depot.users.Profpatsch.netencode.record-splice-env
+          "importas"
+          "-ui"
+          "originalDir"
+          "originalDir"
+          "importas"
+          "-ui"
+          "stowPackage"
+          "stowPackage"
+          bins.ln
+          "-sT"
+          "$originalDir"
+          "\${out}/\${stowPackage}"
+        ]);
+
+  # this is a dumb way of generating a pure list of packages from a depot namespace.
+  readTreeNamespaceDrvs = namespace:
+    lib.pipe namespace [
+      (lib.filterAttrs (_: v: lib.isDerivation v))
+      (lib.mapAttrsToList (k: v: {
+        name = k;
+        drv = v;
+      }))
+    ];
+
+  scriptsStow =
+    lib.pipe { } [
+      (_: makeStowDir [{
+        stowPackage = "scripts";
+        originalDir = pkgs.linkFarm "scripts-farm"
+          ([
+            {
+              name = "scripts/ytextr";
+              path = depot.users.Profpatsch.ytextr;
+            }
+            {
+              name = "scripts/lorri-wait-for-eval";
+              path = depot.users.Profpatsch.lorri-wait-for-eval;
+            }
+            {
+              name = "scripts/lw";
+              path = depot.users.Profpatsch.lorri-wait-for-eval;
+            }
+
+          ]
+          ++
+          (lib.pipe depot.users.Profpatsch.aliases [
+            readTreeNamespaceDrvs
+            (map ({ name, drv }: {
+              name = "scripts/${name}";
+              path = drv;
+            }))
+          ]));
+      }])
+      (d: runStow {
+        stowDir = d;
+        stowPackage = "scripts";
+        targetDir = "/home/philip";
+        stowDirOriginPath = "/home/philip/.local/share/nix-home/stow-origin";
+      })
+    ];
+
+
+
+  terminalEmulatorStow =
+    lib.pipe { } [
+      (_: makeStowDir [{
+        stowPackage = "terminal-emulator";
+        originalDir = pkgs.linkFarm "terminal-emulator-farm"
+          ([
+            {
+              name = "bin/terminal-emulator";
+              path = depot.users.Profpatsch.alacritty;
+            }
+          ]);
+
+      }])
+      (d: runStow {
+        stowDir = d;
+        stowPackage = "terminal-emulator";
+        targetDir = "/home/philip";
+        # TODO: this should only be done once, in a single runStow instead of multiple
+        stowDirOriginPath = "/home/philip/.local/share/nix-home/stow-origin-terminal-emulator";
+      })
+    ];
+
+in
+
+# TODO: run multiple stows with runStow?
+  # TODO: temp setup
+depot.nix.writeExecline "nix-home" { } [
+  "if"
+  [ scriptsStow ]
+  terminalEmulatorStow
+]
diff --git a/users/Profpatsch/nix-tools.nix b/users/Profpatsch/nix-tools.nix
new file mode 100644
index 0000000000..4f29274573
--- /dev/null
+++ b/users/Profpatsch/nix-tools.nix
@@ -0,0 +1,159 @@
+{ depot, pkgs, ... }:
+
+let
+  bins = depot.nix.getBins pkgs.nix [ "nix-build" "nix-instantiate" ];
+
+  # TODO: both of these don’t prevent `result` from being created. good? bad?
+
+  # Usage (execline syntax):
+  #    nix-run { -A foo <more_nix_options> } args...
+  #
+  # Takes an execline block of `nix-build` arguments, which should produce an executable store path.
+  # Then runs the store path with `prog...`.
+  nix-run = depot.nix.writeExecline "nix-run" { argMode = "env"; } [
+    "backtick"
+    "-iE"
+    "storepath"
+    [
+      runblock
+      "1"
+      bins.nix-build
+    ]
+    runblock
+    "-r"
+    "2"
+    "$storepath"
+  ];
+
+  # Usage (execline syntax):
+  #    nix-run-bin { -A foo <more_nix_options> } <foo_bin_name> args...
+  #
+  # Takes an execline block of `nix-build` arguments, which should produce a store path with a bin/ directory in it.
+  # Then runs the given command line with the given arguments. All executables in the built storepath’s bin directory are prepended to `PATH`.
+  nix-run-bin = depot.nix.writeExecline "nix-run-bin" { argMode = "env"; } [
+    "backtick"
+    "-iE"
+    "storepath"
+    [
+      runblock
+      "1"
+      bins.nix-build
+    ]
+    "importas"
+    "-ui"
+    "PATH"
+    "PATH"
+    "export"
+    "PATH"
+    "\${storepath}/bin:\${PATH}"
+    runblock
+    "-r"
+    "2"
+  ];
+
+  nix-eval = depot.nix.writeExecline "nix-eval" { } [
+    bins.nix-instantiate
+    "--read-write-mode"
+    "--eval"
+    "--strict"
+    "$@"
+  ];
+
+  # This is a rewrite of execline’s runblock.
+  # It adds the feature that instead of just
+  # executing the block it reads, it can also
+  # pass it as argv to given commands.
+  #
+  # This is going to be added to a future version
+  # of execline by skarnet, but for now it’s easier
+  # to just dirtily reimplement it in Python.
+  #
+  # TODO: this was added to recent execline versions,
+  # but it doesn’t seem to be a drop-in replacement,
+  # if I use execline’s runblock in nix-run-bin above,
+  # I get errors like
+  # > export: fatal: unable to exec runblock: Success
+  runblock = pkgs.writers.writePython3 "runblock"
+    {
+      flakeIgnore = [ "E501" "E226" ];
+    } ''
+    import sys
+    import os
+    from pathlib import Path
+
+    skip = False
+    one = sys.argv[1]
+    if one == "-r":
+        skip = True
+        block_number = int(sys.argv[2])
+        block_start = 3
+    elif one.startswith("-"):
+        print("runblock-python: only -r supported", file=sys.stderr)
+        sys.exit(100)
+    else:
+        block_number = int(one)
+        block_start = 2
+
+    execline_argv_no = int(os.getenvb(b"#"))
+    runblock_argv = [os.getenv(str(no)) for no in range(1, execline_argv_no + 1)]
+
+
+    def parse_block(args):
+        new_args = []
+        if args == []:
+            print(
+                "runblock-python: empty block",
+                file=sys.stderr
+            )
+            sys.exit(100)
+        for arg in args:
+            if arg == "":
+                break
+            elif arg.startswith(" "):
+                new_args.append(arg[1:])
+            else:
+                print(
+                    "runblock-python: unterminated block: {}".format(args),
+                    file=sys.stderr
+                )
+                sys.exit(100)
+        args_rest = args[len(new_args)+1:]
+        return (new_args, args_rest)
+
+
+    if skip:
+        rest = runblock_argv
+        for _ in range(0, block_number-1):
+            (_, rest) = parse_block(rest)
+        new_argv = rest
+    else:
+        new_argv = []
+        rest = runblock_argv
+        for _ in range(0, block_number):
+            (new_argv, rest) = parse_block(rest)
+
+    given_argv = sys.argv[block_start:]
+    run = given_argv + new_argv
+    if os.path.isabs(run[0]):
+        # TODO: ideally I’d check if it’s an executable here, but it was too hard to figure out and I couldn’t be bothered tbh
+        if not Path(run[0]).is_file():
+            print(
+                "runblock-python: Executable {} does not exist or is not a file.".format(run[0]),
+                file=sys.stderr
+            )
+            sys.exit(100)
+    os.execvp(
+        file=run[0],
+        args=run
+    )
+  '';
+
+
+in
+{
+  inherit
+    nix-run
+    nix-run-bin
+    nix-eval
+    ;
+}
diff --git a/users/Profpatsch/nixpkgs-rewriter/MetaStdenvLib.hs b/users/Profpatsch/nixpkgs-rewriter/MetaStdenvLib.hs
deleted file mode 100644
index 3ed96a7b6e..0000000000
--- a/users/Profpatsch/nixpkgs-rewriter/MetaStdenvLib.hs
+++ /dev/null
@@ -1,80 +0,0 @@
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NamedFieldPuns #-}
-import Nix.Parser
-import Nix.Expr.Types
-import Nix.Expr.Types.Annotated
-import System.Environment (getArgs)
-import System.Exit (die)
-import Data.Fix (Fix(..))
-import qualified Data.Text as Text
-import qualified Data.ByteString.Lazy.Char8 as BL
-import qualified Data.Aeson as A
-import qualified Data.Aeson.Encoding as A
-import Data.Function ((&))
-import qualified System.IO as IO
-import qualified Text.Megaparsec.Pos as MP
-
-main = do
-  (nixFile:_) <- getArgs
-  (parseNixFileLoc nixFile :: IO _) >>= \case
-    Failure err -> do
-      ePutStrLn $ show err
-      die "oh no"
-    Success expr -> do
-      case snd $ match expr of
-        NoArguments -> do
-          ePutStrLn $ "NoArguments in " <> nixFile
-          printPairs mempty
-        YesLib vars -> do
-          ePutStrLn $ "lib in " <> show vars <> " in " <> nixFile
-          printPairs mempty
-        NoLib vars srcSpan -> do
-          ePutStrLn $ nixFile <> " needs lib added"
-          printPairs
-            $ "fileName" A..= nixFile
-            <> "fromLine" A..= (srcSpan & spanBegin & sourceLine)
-            <> "fromColumn" A..= (srcSpan & spanBegin & sourceColumn)
-            <> "toLine" A..= (srcSpan & spanEnd & sourceLine)
-            <> "toColumn" A..= (srcSpan & spanEnd & sourceColumn)
-
-printPairs pairs = BL.putStrLn $ A.encodingToLazyByteString $ A.pairs pairs
-
-ePutStrLn = IO.hPutStrLn IO.stderr
-
-data Descend = YesDesc | NoDesc
-  deriving Show
-data Matched =  NoArguments | NoLib [VarName] SrcSpan | YesLib [VarName]
-  deriving Show
-
-match :: Fix (Compose (Ann SrcSpan) NExprF) -> (Descend, Matched)
-match = \case
-  (AnnE outerSpan (NAbs (ParamSet params _ _) (AnnE innerSpan _))) -> (NoDesc,
-    let vars = map fst params in
-    case (any (== "lib") vars) of
-      True -> YesLib vars
-      False ->
-          -- The span of the arglist is from the beginning of the match
-          -- to the beginning of the inner expression
-          let varSpan = SrcSpan
-                { spanBegin = outerSpan & spanBegin
-                -- -1 to prevent the spans from overlapping
-                , spanEnd = sourcePosMinus1 (innerSpan & spanBegin) }
-          in NoLib vars varSpan)
-  _ -> (NoDesc, NoArguments)
-
--- | Remove one from a source positon.
---
--- That means if the current position is at the very beginning of a line,
--- jump to the previous line.
-sourcePosMinus1 :: SourcePos -> SourcePos
-sourcePosMinus1 src@(SourcePos { sourceLine, sourceColumn }) =
-  let
-    col = MP.mkPos $ max (MP.unPos sourceColumn - 1) 1
-    line = MP.mkPos $ case MP.unPos sourceColumn of
-      1 -> max (MP.unPos sourceLine - 1) 1
-      _ -> MP.unPos sourceLine
-  in src
-    { sourceLine = line
-    , sourceColumn = col }
diff --git a/users/Profpatsch/nixpkgs-rewriter/default.nix b/users/Profpatsch/nixpkgs-rewriter/default.nix
deleted file mode 100644
index 9dac018441..0000000000
--- a/users/Profpatsch/nixpkgs-rewriter/default.nix
+++ /dev/null
@@ -1,112 +0,0 @@
-{ depot, pkgs, ... }:
-let
-  inherit (depot.nix)
-    writeExecline
-    ;
-  inherit (depot.users.Profpatsch.lib)
-    debugExec
-    ;
-
-  bins = depot.nix.getBins pkgs.coreutils [ "head" "shuf" ]
-      // depot.nix.getBins pkgs.jq [ "jq" ]
-      // depot.nix.getBins pkgs.findutils [ "xargs" ]
-      // depot.nix.getBins pkgs.gnused [ "sed" ]
-      ;
-
-  export-json-object = pkgs.writers.writePython3 "export-json-object" {} ''
-    import json
-    import sys
-    import os
-
-    d = json.load(sys.stdin)
-
-    if d == {}:
-        sys.exit(0)
-
-    for k, v in d.items():
-        os.environ[k] = str(v)
-
-    os.execvp(sys.argv[1], sys.argv[1:])
-  '';
-
-  meta-stdenv-lib = pkgs.writers.writeHaskell "meta-stdenv-lib" {
-    libraries = [
-      pkgs.haskellPackages.hnix
-      pkgs.haskellPackages.aeson
-    ];
-  } ./MetaStdenvLib.hs;
-
-  replace-between-lines = writeExecline "replace-between-lines" { readNArgs = 1; } [
-    "importas" "-ui" "file" "fileName"
-    "importas" "-ui" "from" "fromLine"
-    "importas" "-ui" "to" "toLine"
-    "if" [ depot.tools.eprintf "%s-%s\n" "$from" "$to" ]
-    (debugExec "adding lib")
-    bins.sed
-      "-e" "\${from},\${to} \${1}"
-      "-i" "$file"
-  ];
-
-  add-lib-if-necessary = writeExecline "add-lib-if-necessary" { readNArgs = 1; } [
-    "pipeline" [ meta-stdenv-lib "$1" ]
-     export-json-object
-     # first replace any stdenv.lib mentions in the arg header
-     # if this is not done, the replace below kills these.
-     # Since we want it anyway ultimately, let’s do it here.
-     "if" [ replace-between-lines "s/stdenv\.lib/lib/" ]
-     # then add the lib argument
-     # (has to be before stdenv, otherwise default arguments might be in the way)
-     replace-between-lines "s/stdenv/lib, stdenv/"
-  ];
-
-  metaString = ''meta = with stdenv.lib; {'';
-
-  replace-stdenv-lib = pkgs.writers.writeBash "replace-stdenv-lib" ''
-    set -euo pipefail
-    sourceDir="$1"
-    for file in $(
-      ${pkgs.ripgrep}/bin/rg \
-        --files-with-matches \
-        --fixed-strings \
-        -e '${metaString}' \
-        "$sourceDir"
-    )
-    do
-      echo "replacing stdenv.lib meta in $file" >&2
-      ${bins.sed} -e '/${metaString}/ s/stdenv.lib/lib/' \
-          -i "$file"
-      ${add-lib-if-necessary} "$file"
-    done
-  '';
-
-  instantiate-nixpkgs-randomly = writeExecline "instantiate-nixpkgs-randomly" { readNArgs = 1; } [
-    "export" "NIXPKGS_ALLOW_BROKEN" "1"
-    "export" "NIXPKGS_ALLOW_UNFREE" "1"
-    "export" "NIXPKGS_ALLOW_INSECURE" "1"
-    "export" "NIXPKGS_ALLOW_UNSUPPORTED_SYSTEM" "1"
-    "pipeline" [
-      "nix"
-        "eval"
-        "--raw"
-        ''(
-          let pkgs = import ''${1} {};
-          in builtins.toJSON (builtins.attrNames pkgs)
-        )''
-    ]
-    "pipeline" [ bins.jq "-r" ".[]" ]
-    "pipeline" [ bins.shuf ]
-    "pipeline" [ bins.head "-n" "1000" ]
-    bins.xargs "-I" "{}" "-n1"
-    "if" [ depot.tools.eprintf "instantiating %s\n" "{}" ]
-    "nix-instantiate" "$1" "-A" "{}"
-  ];
-
-in depot.nix.utils.drvTargets {
-  inherit
-   instantiate-nixpkgs-randomly
-  # requires hnix, which we don’t want in tvl for now
-  # uncomment manually if you want to use it.
-  #   meta-stdenv-lib
-  #   replace-stdenv-lib
-    ;
-}
diff --git a/users/Profpatsch/openlab-tools/Main.hs b/users/Profpatsch/openlab-tools/Main.hs
new file mode 100644
index 0000000000..d5f958a38a
--- /dev/null
+++ b/users/Profpatsch/openlab-tools/Main.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import OpenlabTools qualified
+
+main :: IO ()
+main = OpenlabTools.main
diff --git a/users/Profpatsch/openlab-tools/default.nix b/users/Profpatsch/openlab-tools/default.nix
new file mode 100644
index 0000000000..82641989f7
--- /dev/null
+++ b/users/Profpatsch/openlab-tools/default.nix
@@ -0,0 +1,69 @@
+{ depot, pkgs, lib, ... }:
+
+let
+  #   bins = depot.nix.getBins pkgs.sqlite ["sqlite3"];
+
+  openlab-tools = pkgs.haskellPackages.mkDerivation {
+    pname = "openlab-tools";
+    version = "0.1.0";
+
+    src = depot.users.Profpatsch.exactSource ./. [
+      ./openlab-tools.cabal
+      ./Main.hs
+      ./src/OpenlabTools.hs
+    ];
+
+    libraryHaskellDepends = [
+      depot.users.Profpatsch.my-prelude
+      depot.users.Profpatsch.my-webstuff
+      pkgs.haskellPackages.pa-prelude
+      pkgs.haskellPackages.pa-label
+      pkgs.haskellPackages.pa-json
+      pkgs.haskellPackages.pa-error-tree
+      pkgs.haskellPackages.pa-field-parser
+      pkgs.haskellPackages.pa-run-command
+      pkgs.haskellPackages.aeson-better-errors
+      pkgs.haskellPackages.blaze-html
+      pkgs.haskellPackages.deepseq
+      pkgs.haskellPackages.case-insensitive
+      pkgs.haskellPackages.hs-opentelemetry-sdk
+      pkgs.haskellPackages.http-conduit
+      pkgs.haskellPackages.http-types
+      pkgs.haskellPackages.ihp-hsx
+      pkgs.haskellPackages.monad-logger
+      pkgs.haskellPackages.selective
+      pkgs.haskellPackages.unliftio
+      pkgs.haskellPackages.wai-extra
+      pkgs.haskellPackages.warp
+      pkgs.haskellPackages.tagsoup
+      pkgs.haskellPackages.time
+    ];
+
+    isExecutable = true;
+    isLibrary = false;
+    license = lib.licenses.mit;
+  };
+
+  bins = depot.nix.getBins openlab-tools [ "openlab-tools" ];
+
+in
+
+depot.nix.writeExecline "openlab-tools-wrapped" { } [
+  "importas"
+  "-i"
+  "PATH"
+  "PATH"
+  "export"
+  "PATH"
+  "${pkgs.postgresql}/bin:$${PATH}"
+  "export"
+  "OPENLAB_TOOLS_TOOLS"
+  (pkgs.linkFarm "openlab-tools-tools" [
+    {
+      name = "pg_format";
+      path = "${pkgs.pgformatter}/bin/pg_format";
+    }
+  ])
+  bins.openlab-tools
+]
+
diff --git a/users/Profpatsch/openlab-tools/openlab-tools.cabal b/users/Profpatsch/openlab-tools/openlab-tools.cabal
new file mode 100644
index 0000000000..b7d217e051
--- /dev/null
+++ b/users/Profpatsch/openlab-tools/openlab-tools.cabal
@@ -0,0 +1,111 @@
+cabal-version:      3.0
+name:               openlab-tools
+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
+
+
+library
+    import: common-options
+
+    hs-source-dirs: src
+
+    exposed-modules:
+       OpenlabTools
+
+    build-depends:
+        base >=4.15 && <5,
+        text,
+        my-prelude,
+        my-webstuff,
+        pa-prelude,
+        pa-error-tree,
+        pa-label,
+        pa-json,
+        pa-field-parser,
+        pa-run-command,
+        aeson-better-errors,
+        aeson,
+        blaze-html,
+        bytestring,
+        containers,
+        deepseq,
+        unordered-containers,
+        exceptions,
+        filepath,
+        hs-opentelemetry-sdk,
+        hs-opentelemetry-api,
+        http-conduit,
+        http-types,
+        ihp-hsx,
+        monad-logger,
+        mtl,
+        network-uri,
+        scientific,
+        selective,
+        unliftio,
+        wai-extra,
+        wai,
+        warp,
+        tagsoup,
+        time,
+        stm,
+        case-insensitive
+
+executable openlab-tools
+    import: common-options
+
+    main-is: Main.hs
+
+    ghc-options:
+      -threaded
+
+    build-depends:
+        base >=4.15 && <5,
+        openlab-tools
diff --git a/users/Profpatsch/openlab-tools/src/OpenlabTools.hs b/users/Profpatsch/openlab-tools/src/OpenlabTools.hs
new file mode 100644
index 0000000000..9fe51aba18
--- /dev/null
+++ b/users/Profpatsch/openlab-tools/src/OpenlabTools.hs
@@ -0,0 +1,551 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module OpenlabTools where
+
+import Control.Concurrent.STM hiding (atomically, readTVarIO)
+import Control.DeepSeq (NFData, deepseq)
+import Control.Monad.Logger qualified as Logger
+import Control.Monad.Logger.CallStack
+import Control.Monad.Reader
+import Data.Aeson.BetterErrors qualified as Json
+import Data.CaseInsensitive qualified as CaseInsensitive
+import Data.Error.Tree
+import Data.HashMap.Strict qualified as HashMap
+import Data.List qualified as List
+import Data.Maybe (listToMaybe)
+import Data.Text qualified as Text
+import Data.Time (NominalDiffTime, UTCTime (utctDayTime), diffUTCTime, getCurrentTime)
+import Data.Time qualified as Time
+import Data.Time.Clock (addUTCTime)
+import Data.Time.Format qualified as Time.Format
+import Debug.Trace
+import FieldParser (FieldParser' (..))
+import FieldParser qualified as Field
+import GHC.Records (HasField (..))
+import GHC.Stack qualified
+import IHP.HSX.QQ (hsx)
+import Json qualified
+import Label
+import Network.HTTP.Client.Conduit qualified as Http
+import Network.HTTP.Simple qualified as Http
+import Network.HTTP.Types
+import Network.HTTP.Types qualified as Http
+import Network.Wai qualified as Wai
+import Network.Wai.Handler.Warp qualified as Warp
+import Network.Wai.Parse qualified as Wai
+import OpenTelemetry.Trace qualified as Otel hiding (getTracer, inSpan, inSpan')
+import OpenTelemetry.Trace.Core qualified as Otel hiding (inSpan, inSpan')
+import OpenTelemetry.Trace.Monad qualified as Otel
+import Parse (Parse)
+import Parse qualified
+import PossehlAnalyticsPrelude
+import Pretty
+import System.Environment qualified as Env
+import System.IO qualified as IO
+import Text.Blaze.Html.Renderer.Pretty qualified as Html.Pretty
+import Text.Blaze.Html.Renderer.Utf8 qualified as Html
+import Text.Blaze.Html5 qualified as Html
+import Text.HTML.TagSoup qualified as Soup
+import UnliftIO hiding (Handler, newTVarIO)
+import Prelude hiding (span, until)
+
+mapallSpaceOla :: Text
+mapallSpaceOla = "https://mapall.space/heatmap/show.php?id=OpenLab+Augsburg"
+
+mainPage :: Html.Html
+mainPage =
+  Html.docTypeHtml
+    [hsx|
+          <head>
+            <title>Openlab Augsburg Tools</title>
+            <meta charset="utf-8">
+            <meta name="viewport" content="width=device-width, initial-scale=1">
+          </head>
+
+          <body>
+            <p>Welcome to the OpenLab Augsburg tools thingy. The idea is to provide some services that can be embedded into our other pages.</p>
+
+            <h2>What’s there</h2>
+            <ul>
+              <li>
+                A <a href="snips/table-opening-hours-last-week">table displaying the opening hours last week</a>, courtesy of <a href={mapallSpaceOla}>mapall.space</a>.
+              </li>
+            </ul>
+
+
+            <h2>Show me the code/how to contribute</h2>
+
+            <p>The source code can be found <a href="https://code.tvl.fyi/tree/users/Profpatsch/openlab-tools">in my user dir in the tvl repo</a>.</p>
+
+            <p>To build the server, clone the repository from <a href="https://code.tvl.fyi/depot.git">https://code.tvl.fyi/depot.git</a>.
+            Then <code>cd</code> into <code>users/Profpatsch</code>, run <code>nix-shell</code>.
+            </p>
+
+            <p>You can now run the server with <code>cabal repl openlab-tools/`</code> by executing the <code>main</code> function inside the GHC repl. It starts on port <code>9099</code>.
+            <br>
+            To try out changes to the code, stop the server with <kbd><kbd>Ctrl</kbd>+<kbd>z</kbd></kbd> and type <code>:reload</code>, then <code>main</code> again.
+            <br>
+            Finally, from within <code>users/Profpatsch</code> you can start a working development environment by installing <var>vscode</var> or <var>vscodium</var> and the <var>Haskell</var> extension. Then run <code>code .</code> from within the directory.
+            </p>
+
+            <p>Once you have a patch, <a href="https://matrix.to/#/@profpatsch:augsburg.one">contact me on Matrix</a> or DM me at <code>irc/libera</code>, nick <code>Profpatsch</code>.
+            </p>
+          </body>
+        |]
+
+debug :: Bool
+debug = False
+
+runApp :: IO ()
+runApp = withTracer $ \tracer -> do
+  let renderHtml =
+        if debug
+          then Html.Pretty.renderHtml >>> stringToText >>> textToBytesUtf8 >>> toLazyBytes
+          else Html.renderHtml
+
+  let runApplication ::
+        (MonadUnliftIO m, MonadLogger m) =>
+        ( Wai.Request ->
+          (Wai.Response -> m Wai.ResponseReceived) ->
+          m Wai.ResponseReceived
+        ) ->
+        m ()
+      runApplication app = do
+        withRunInIO $ \runInIO -> Warp.run 9099 $ \req respond -> do
+          let catchAppException act =
+                try act >>= \case
+                  Right a -> pure a
+                  Left (AppException err) -> do
+                    runInIO (logError err)
+                    respond (Wai.responseLBS Http.status500 [] "")
+          liftIO $ catchAppException (runInIO $ app req (\resp -> liftIO $ respond resp))
+
+  let appT :: AppT IO () = do
+        let h extra res = Wai.responseLBS Http.ok200 (("Content-Type", "text/html") : extra) res
+        runHandlers
+          runApplication
+          [ Handler
+              { path = "",
+                body =
+                  Body
+                    (pure ())
+                    (\((), _) -> pure $ h [] (renderHtml mainPage))
+              },
+            Handler
+              { path = "snips/table-opening-hours-last-week",
+                body =
+                  Body
+                    ((label @"ifModifiedSince" <$> parseIfModifiedSince))
+                    ( \(req', cache) -> do
+                        now <- liftIO getCurrentTime <&> mkSecondTime
+                        new <- updateCacheIfNewer now cache heatmap
+                        let cacheToHeaders =
+                              [ ("Last-Modified", new.lastModified & formatHeaderTime),
+                                ("Expires", new.until & formatHeaderTime),
+                                ( "Cache-Control",
+                                  let maxAge = new.until `diffSecondTime` now
+                                   in [fmt|max-age={maxAge & floor @NominalDiffTime @Int  & show}, immutable|]
+                                )
+                              ]
+                        if
+                            -- If the last cache update is newer or equal to the requested version, we can tell the browser it’s fine
+                            | Just modifiedSince <- req'.ifModifiedSince,
+                              modifiedSince >= new.lastModified ->
+                                pure $ Wai.responseLBS Http.status304 cacheToHeaders ""
+                            | otherwise ->
+                                pure $ h cacheToHeaders (new.result & toLazyBytes)
+                    )
+              }
+          ]
+
+  runReaderT (appT :: AppT IO ()).unAppT Context {..}
+  where
+    -- "https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Last-Modified#syntax"
+    headerFormat = "%a, %d %b %0Y %T GMT"
+    formatHeaderTime (SecondTime t) =
+      t
+        & Time.Format.formatTime
+          @UTCTime
+          Time.Format.defaultTimeLocale
+          headerFormat
+        & stringToText
+        & textToBytesUtf8
+    parseHeaderTime =
+      Field.utf8
+        >>> ( FieldParser $ \t ->
+                t
+                  & textToString
+                  & Time.Format.parseTimeM
+                    @Maybe
+                    @UTCTime
+                    {-no leading whitespace -} False
+                    Time.Format.defaultTimeLocale
+                    headerFormat
+                  & annotate [fmt|Cannot parse header timestamp "{t}"|]
+            )
+    parseIfModifiedSince :: Parse Wai.Request (Maybe SecondTime)
+    parseIfModifiedSince =
+      lmap
+        ( (.requestHeaders)
+            >>> findMaybe
+              ( \(h, v) ->
+                  if "If-Modified-Since" == CaseInsensitive.mk h then Just v else Nothing
+              )
+        )
+        (Parse.maybe $ Parse.fieldParser parseHeaderTime)
+        & rmap (fmap mkSecondTime)
+
+parseRequest :: (MonadThrow f, MonadIO f) => Otel.Span -> Parse from a -> from -> f a
+parseRequest span parser req =
+  Parse.runParse "Unable to parse the HTTP request" parser req
+    & assertM span id
+
+heatmap :: AppT IO ByteString
+heatmap = do
+  Http.httpBS [fmt|GET {mapallSpaceOla}|]
+    <&> (.responseBody)
+    <&> Soup.parseTags
+    <&> Soup.canonicalizeTags
+    <&> findHeatmap
+    <&> fromMaybe (htmlToTags [hsx|<p>Uh oh! could not fetch the table from <a href={mapallSpaceOla}>{mapallSpaceOla}</a></p>|])
+    <&> Soup.renderTags
+  where
+    firstSection f t = t & Soup.sections f & listToMaybe
+    match :: Soup.Tag ByteString -> Soup.Tag ByteString -> Bool
+    match x (t :: Soup.Tag ByteString) = (Soup.~==) @ByteString t x
+    findHeatmap t =
+      t
+        & firstSection (match (Soup.TagOpen ("") [("class", "heatmap")]))
+        >>= firstSection (match (Soup.TagOpen "table" []))
+        <&> getTable
+        <&> (<> htmlToTags [hsx|<figcaption>source: <a href={mapallSpaceOla} target="_blank">mapall.space</a></figcaption>|])
+        <&> wrapTagStream (T2 (label @"el" "figure") (label @"attrs" []))
+
+    -- get the table from opening tag to closing tag (allowing nested tables)
+    getTable = go 0
+      where
+        go _ [] = []
+        go d (el : els)
+          | match (Soup.TagOpen "table" []) el = el : go (d + 1) els
+          | match (Soup.TagClose "table") el = if d <= 1 then [el] else el : go (traceShowId $ d - 1) els
+          | otherwise = el : go d els
+
+    htmlToTags :: Html.Html -> [Soup.Tag ByteString]
+    htmlToTags h = h & Html.renderHtml & toStrictBytes & Soup.parseTags
+
+    -- TODO: this is dog-slow because of the whole list recreation!
+    wrapTagStream ::
+      T2 "el" ByteString "attrs" [Soup.Attribute ByteString] ->
+      [Soup.Tag ByteString] ->
+      [Soup.Tag ByteString]
+    wrapTagStream tag inner = (Soup.TagOpen (tag.el) tag.attrs : inner) <> [Soup.TagClose tag.el]
+
+main :: IO ()
+main =
+  runApp
+
+-- ( do
+--     -- todo: trace that to the init functions as well
+--     Otel.inSpan "whatcd-resolver main function" Otel.defaultSpanArguments $ do
+--       _ <- runTransaction migrate
+--       htmlUi
+-- )
+
+data Handler m = Handler
+  { path :: Text,
+    body :: Body m
+  }
+
+data Body m
+  = forall a.
+    Body
+      (Parse Wai.Request a)
+      ((a, TVar (Cache ByteString)) -> m Wai.Response)
+
+runHandlers ::
+  (Otel.MonadTracer m, MonadUnliftIO m, MonadThrow m) =>
+  -- ( (Wai.Request -> (Wai.Response -> m Wai.ResponseReceived) -> m Wai.ResponseReceived) ->
+  --   m ()
+  -- ) ->
+  ( (Wai.Request -> (Wai.Response -> m a) -> m a) ->
+    m ()
+  ) ->
+  [Handler m] ->
+  m ()
+runHandlers runApplication handlers = do
+  withCaches ::
+    [ T2
+        "handler"
+        (Handler m)
+        "cache"
+        (TVar (Cache ByteString))
+    ] <-
+    handlers
+      & traverse
+        ( \h -> do
+            cache <- liftIO $ newCache h.path "nothing yet"
+            pure $ T2 (label @"handler" h) (label @"cache" cache)
+        )
+  runApplication $ \req respond -> do
+    let mHandler =
+          withCaches
+            & List.find
+              ( \h ->
+                  (h.handler.path)
+                    == (req & Wai.pathInfo & Text.intercalate "/")
+              )
+    case mHandler of
+      Nothing -> respond $ Wai.responseLBS Http.status404 [] "nothing here (yet)"
+      Just handler -> do
+        inSpan' "TODO" $ \span -> do
+          case handler.handler.body of
+            Body parse runHandler -> do
+              req' <- req & parseRequest span parse
+              resp <- runHandler (req', handler.cache)
+              respond resp
+
+inSpan :: (MonadUnliftIO m, Otel.MonadTracer m) => Text -> m a -> m a
+inSpan name = Otel.inSpan name Otel.defaultSpanArguments
+
+inSpan' :: (MonadUnliftIO m, Otel.MonadTracer m) => Text -> (Otel.Span -> m a) -> m a
+-- inSpan' name =  Otel.inSpan' name Otel.defaultSpanArguments
+inSpan' _name act = act (error "todo telemetry disabled")
+
+zipT2 ::
+  forall l1 l2 t1 t2.
+  ( HasField l1 (T2 l1 [t1] l2 [t2]) [t1],
+    HasField l2 (T2 l1 [t1] l2 [t2]) [t2]
+  ) =>
+  T2 l1 [t1] l2 [t2] ->
+  [T2 l1 t1 l2 t2]
+zipT2 xs =
+  zipWith
+    (\t1 t2 -> T2 (label @l1 t1) (label @l2 t2))
+    (getField @l1 xs)
+    (getField @l2 xs)
+
+unzipT2 :: forall l1 t1 l2 t2. [T2 l1 t1 l2 t2] -> T2 l1 [t1] l2 [t2]
+unzipT2 xs = xs <&> toTup & unzip & fromTup
+  where
+    toTup :: forall a b. T2 a t1 b t2 -> (t1, t2)
+    toTup (T2 a b) = (getField @a a, getField @b b)
+    fromTup :: (a, b) -> T2 l1 a l2 b
+    fromTup (t1, t2) = T2 (label @l1 t1) (label @l2 t2)
+
+unzipT3 :: forall l1 t1 l2 t2 l3 t3. [T3 l1 t1 l2 t2 l3 t3] -> T3 l1 [t1] l2 [t2] l3 [t3]
+unzipT3 xs = xs <&> toTup & unzip3 & fromTup
+  where
+    toTup :: forall a b c. T3 a t1 b t2 c t3 -> (t1, t2, t3)
+    toTup (T3 a b c) = (getField @a a, getField @b b, getField @c c)
+    fromTup :: (a, b, c) -> T3 l1 a l2 b l3 c
+    fromTup (t1, t2, t3) = T3 (label @l1 t1) (label @l2 t2) (label @l3 t3)
+
+newtype Optional a = OptionalInternal (Maybe a)
+
+mkOptional :: a -> Optional a
+mkOptional defaultValue = OptionalInternal $ Just defaultValue
+
+defaults :: Optional a
+defaults = OptionalInternal Nothing
+
+instance HasField "withDefault" (Optional a) (a -> a) where
+  getField (OptionalInternal m) defaultValue = case m of
+    Nothing -> defaultValue
+    Just a -> a
+
+httpJson ::
+  ( MonadIO m,
+    MonadThrow m
+  ) =>
+  (Optional (Label "contentType" ByteString)) ->
+  Otel.Span ->
+  Json.Parse ErrorTree b ->
+  Http.Request ->
+  m b
+httpJson opts span parser req = do
+  let opts' = opts.withDefault (label @"contentType" "application/json")
+  Http.httpBS req
+    >>= assertM
+      span
+      ( \resp -> do
+          let statusCode = resp & Http.responseStatus & (.statusCode)
+              contentType =
+                resp
+                  & Http.responseHeaders
+                  & List.lookup "content-type"
+                  <&> Wai.parseContentType
+                  <&> (\(ct, _mimeAttributes) -> ct)
+          if
+              | statusCode == 200,
+                Just ct <- contentType,
+                ct == opts'.contentType ->
+                  Right $ (resp & Http.responseBody)
+              | statusCode == 200,
+                Just otherType <- contentType ->
+                  Left [fmt|Server returned a non-json body, with content-type "{otherType}"|]
+              | statusCode == 200,
+                Nothing <- contentType ->
+                  Left [fmt|Server returned a body with unspecified content type|]
+              | code <- statusCode -> Left [fmt|Server returned an non-200 error code, code {code}: {resp & showPretty}|]
+      )
+    >>= assertM
+      span
+      ( \body ->
+          Json.parseStrict parser body
+            & first (Json.parseErrorTree "could not parse redacted response")
+      )
+
+assertM :: (MonadThrow f, MonadIO f) => Otel.Span -> (t -> Either ErrorTree a) -> t -> f a
+assertM span f v = case f v of
+  Right a -> pure a
+  Left err -> appThrowTree span err
+
+-- | UTC time that is only specific to the second
+newtype SecondTime = SecondTime {unSecondTime :: UTCTime}
+  deriving newtype (Show, Eq, Ord)
+
+mkSecondTime :: UTCTime -> SecondTime
+mkSecondTime utcTime = SecondTime utcTime {utctDayTime = Time.secondsToDiffTime $ floor utcTime.utctDayTime}
+
+diffSecondTime :: SecondTime -> SecondTime -> NominalDiffTime
+diffSecondTime (SecondTime a) (SecondTime b) = diffUTCTime a b
+
+data Cache a = Cache
+  { name :: !Text,
+    until :: !SecondTime,
+    lastModified :: !SecondTime,
+    result :: !a
+  }
+  deriving (Show)
+
+newCache :: Text -> a -> IO (TVar (Cache a))
+newCache name result = do
+  let until = mkSecondTime $ Time.UTCTime {utctDay = Time.ModifiedJulianDay 1, utctDayTime = 1}
+  let lastModified = until
+  newTVarIO $ Cache {..}
+
+updateCache :: (NFData a, Eq a) => SecondTime -> TVar (Cache a) -> a -> STM (Cache a)
+updateCache now cache result' = do
+  -- make sure we don’t hold onto the world by deepseq-ing and evaluating to WHNF
+  let !result = deepseq result' result'
+  let until = mkSecondTime $ (5 * 60) `addUTCTime` now.unSecondTime
+  !toWrite <- do
+    old <- readTVar cache
+    let name = old.name
+    -- only update the lastModified time iff the content changed (this is helpful for HTTP caching with If-Modified-Since)
+    if old.result == result
+      then do
+        let lastModified = old.lastModified
+        pure $ Cache {..}
+      else do
+        let lastModified = now
+        pure $ Cache {..}
+  _ <- writeTVar cache $! toWrite
+  pure toWrite
+
+-- | Run the given action iff the cache is stale, otherwise just return the item from the cache.
+updateCacheIfNewer :: (MonadUnliftIO m, NFData b, Eq b) => SecondTime -> TVar (Cache b) -> m b -> m (Cache b)
+updateCacheIfNewer now cache act = withRunInIO $ \runInIO -> do
+  old <- readTVarIO cache
+  if old.until < now
+    then do
+      res <- runInIO act
+      atomically $ updateCache now cache res
+    else pure old
+
+-- pgFormat <- readTools (label @"toolsEnvVar" "OPENLAB_TOOLS_TOOLS") (readTool "pg_format")
+-- let config = label @"logDatabaseQueries" LogDatabaseQueries
+-- pgConnPool <-
+--   Pool.newPool $
+--     Pool.defaultPoolConfig
+--       {- resource init action -} (Postgres.connectPostgreSQL (db & TmpPg.toConnectionString))
+--       {- resource destruction -} Postgres.close
+--       {- unusedResourceOpenTime -} 10
+--       {- max resources across all stripes -} 20
+-- transmissionSessionId <- newEmptyMVar
+-- let newAppT = do
+--       logInfo [fmt|Running with config: {showPretty config}|]
+--       logInfo [fmt|Connected to database at {db & TmpPg.toDataDirectory} on socket {db & TmpPg.toConnectionString}|]
+--       appT
+-- runReaderT newAppT.unAppT Context {..}
+
+withTracer :: (Otel.Tracer -> IO c) -> IO c
+withTracer f = do
+  setDefaultEnv "OTEL_SERVICE_NAME" "whatcd-resolver"
+  bracket
+    -- Install the SDK, pulling configuration from the environment
+    Otel.initializeGlobalTracerProvider
+    -- Ensure that any spans that haven't been exported yet are flushed
+    Otel.shutdownTracerProvider
+    -- Get a tracer so you can create spans
+    (\tracerProvider -> f $ Otel.makeTracer tracerProvider "whatcd-resolver" Otel.tracerOptions)
+
+setDefaultEnv :: String -> String -> IO ()
+setDefaultEnv envName defaultValue = do
+  Env.lookupEnv envName >>= \case
+    Just _env -> pure ()
+    Nothing -> Env.setEnv envName defaultValue
+
+data Context = Context
+  { tracer :: Otel.Tracer
+  }
+
+newtype AppT m a = AppT {unAppT :: ReaderT Context m a}
+  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadUnliftIO, MonadThrow)
+
+data AppException = AppException Text
+  deriving stock (Show)
+  deriving anyclass (Exception)
+
+-- | A specialized variant of @addEvent@ that records attributes conforming to
+-- the OpenTelemetry specification's
+-- <https://github.com/open-telemetry/opentelemetry-specification/blob/49c2f56f3c0468ceb2b69518bcadadd96e0a5a8b/specification/trace/semantic_conventions/exceptions.md semantic conventions>
+--
+-- @since 0.0.1.0
+recordException ::
+  ( MonadIO m,
+    HasField "message" r Text,
+    HasField "type_" r Text
+  ) =>
+  Otel.Span ->
+  r ->
+  m ()
+recordException span dat = liftIO $ do
+  callStack <- GHC.Stack.whoCreated dat.message
+  newEventTimestamp <- Just <$> Otel.getTimestamp
+  Otel.addEvent span $
+    Otel.NewEvent
+      { newEventName = "exception",
+        newEventAttributes =
+          HashMap.fromList
+            [ ("exception.type", Otel.toAttribute @Text dat.type_),
+              ("exception.message", Otel.toAttribute @Text dat.message),
+              ("exception.stacktrace", Otel.toAttribute @Text $ Text.unlines $ map stringToText callStack)
+            ],
+        ..
+      }
+
+appThrowTree :: (MonadThrow m, MonadIO m) => Otel.Span -> ErrorTree -> m a
+appThrowTree span exc = do
+  let msg = prettyErrorTree exc
+  -- recordException
+  --   span
+  --   ( T2
+  --       (label @"type_" "AppException")
+  --       (label @"message" msg)
+  --   )
+  throwM $ AppException msg
+
+orAppThrowTree :: (MonadThrow m, MonadIO m) => Otel.Span -> Either ErrorTree a -> m a
+orAppThrowTree span = \case
+  Left err -> appThrowTree span err
+  Right a -> pure a
+
+instance (MonadIO m) => MonadLogger (AppT m) where
+  monadLoggerLog loc src lvl msg = liftIO $ Logger.defaultOutput IO.stderr loc src lvl (Logger.toLogStr msg)
+
+instance (Monad m) => Otel.MonadTracer (AppT m) where
+  getTracer = AppT $ asks (.tracer)
diff --git a/users/Profpatsch/read-http.nix b/users/Profpatsch/read-http.nix
index 854a11b7d0..d9ad6fc30d 100644
--- a/users/Profpatsch/read-http.nix
+++ b/users/Profpatsch/read-http.nix
@@ -2,15 +2,18 @@
 
 let
 
-  read-http = depot.nix.writers.rustSimple {
-    name = "read-http";
-    dependencies = [
-      depot.third_party.rust-crates.ascii
-      depot.third_party.rust-crates.httparse
-      depot.users.Profpatsch.netencode.netencode-rs
-      depot.users.Profpatsch.arglib.netencode.rust
-      depot.users.Profpatsch.execline.exec-helpers
-    ];
-  } (builtins.readFile ./read-http.rs);
+  read-http = depot.nix.writers.rustSimple
+    {
+      name = "read-http";
+      dependencies = [
+        depot.third_party.rust-crates.ascii
+        depot.third_party.rust-crates.httparse
+        depot.users.Profpatsch.netencode.netencode-rs
+        depot.users.Profpatsch.arglib.netencode.rust
+        depot.users.Profpatsch.execline.exec-helpers
+      ];
+    }
+    (builtins.readFile ./read-http.rs);
 
-in read-http
+in
+read-http
diff --git a/users/Profpatsch/read-http.rs b/users/Profpatsch/read-http.rs
index 50ff663b99..2b24e6beb1 100644
--- a/users/Profpatsch/read-http.rs
+++ b/users/Profpatsch/read-http.rs
@@ -1,37 +1,35 @@
-extern crate httparse;
-extern crate netencode;
 extern crate arglib_netencode;
 extern crate ascii;
 extern crate exec_helpers;
+extern crate httparse;
+extern crate netencode;
 
-use std::os::unix::io::FromRawFd;
-use std::io::Read;
-use std::io::Write;
+use exec_helpers::{die_expected_error, die_temporary, die_user_error};
 use std::collections::HashMap;
-use exec_helpers::{die_user_error, die_expected_error, die_temporary};
+use std::io::{Read, Write};
+use std::os::unix::io::FromRawFd;
 
-use netencode::{U, T, dec};
 use netencode::dec::Decoder;
+use netencode::{dec, T, U};
 
 enum What {
     Request,
-    Response
+    Response,
 }
 
 // reads a http request (stdin), and writes all headers to stdout, as netencoded record.
 // The keys are text, but can be lists of text iff headers appear multiple times, so beware.
 fn main() -> std::io::Result<()> {
-
     exec_helpers::no_args("read-http");
 
     let args = dec::RecordDot {
         field: "what",
         inner: dec::OneOf {
             list: vec!["request", "response"],
-            inner: dec::Text
-        }
+            inner: dec::Text,
+        },
     };
-    let what : What = match args.dec(arglib_netencode::arglib_netencode("read-http", None).to_u()) {
+    let what: What = match args.dec(arglib_netencode::arglib_netencode("read-http", None).to_u()) {
         Ok("request") => What::Request,
         Ok("response") => What::Response,
         Ok(v) => panic!("shouldn’t happen!, value was: {}", v),
@@ -39,7 +37,8 @@ fn main() -> std::io::Result<()> {
     };
 
     fn read_stdin_to_complete<F>(mut parse: F) -> ()
-        where F: FnMut(&[u8]) -> httparse::Result<usize>
+    where
+        F: FnMut(&[u8]) -> httparse::Result<usize>,
     {
         let mut res = httparse::Status::Partial;
         loop {
@@ -48,16 +47,22 @@ fn main() -> std::io::Result<()> {
             }
             let mut buf = [0; 2048];
             match std::io::stdin().read(&mut buf[..]) {
-                Ok(size) => if size == 0 {
-                    break;
-                },
-                Err(err) => die_temporary("read-http", format!("could not read from stdin, {:?}", err))
+                Ok(size) => {
+                    if size == 0 {
+                        break;
+                    }
+                }
+                Err(err) => {
+                    die_temporary("read-http", format!("could not read from stdin, {:?}", err))
+                }
             }
             match parse(&buf) {
                 Ok(status) => {
                     res = status;
                 }
-                Err(err) => die_temporary("read-http", format!("httparse parsing failed: {:#?}", err))
+                Err(err) => {
+                    die_temporary("read-http", format!("httparse parsing failed: {:#?}", err))
+                }
             }
         }
     }
@@ -66,7 +71,10 @@ fn main() -> std::io::Result<()> {
         let mut res = HashMap::new();
         for httparse::Header { name, value } in headers {
             let val = ascii::AsciiStr::from_ascii(*value)
-                .expect(&format!("read-http: we require header values to be ASCII, but the header {} was {:?}", name, value))
+                .expect(&format!(
+                    "read-http: we require header values to be ASCII, but the header {} was {:?}",
+                    name, value
+                ))
                 .as_str();
             // lowercase the header names, since the standard doesn’t care
             // and we want unique strings to match against
@@ -77,13 +85,13 @@ fn main() -> std::io::Result<()> {
                     let name_lower = name.to_lowercase();
                     let _ = res.insert(name_lower, U::List(vec![U::Text(t), U::Text(val)]));
                     ()
-                },
+                }
                 Some(U::List(mut l)) => {
                     let name_lower = name.to_lowercase();
                     l.push(U::Text(val));
                     let _ = res.insert(name_lower, U::List(l));
                     ()
-                },
+                }
                 Some(o) => panic!("read-http: header not text nor list: {:?}", o),
             }
         }
@@ -98,12 +106,14 @@ fn main() -> std::io::Result<()> {
             match chonker.next() {
                 Some(Ok(chunk)) => {
                     buf.extend_from_slice(&chunk);
-                    if chunk.windows(4).any(|c| c == b"\r\n\r\n" ) {
+                    if chunk.windows(4).any(|c| c == b"\r\n\r\n") {
                         return Some(());
                     }
-                },
-                Some(Err(err)) => die_temporary("read-http", format!("error reading from stdin: {:?}", err)),
-                None => return None
+                }
+                Some(Err(err)) => {
+                    die_temporary("read-http", format!("error reading from stdin: {:?}", err))
+                }
+                None => return None,
             }
         }
     }
@@ -118,68 +128,99 @@ fn main() -> std::io::Result<()> {
             let mut buf: Vec<u8> = vec![];
             match read_till_end_of_header(&mut buf, stdin.lock()) {
                 Some(()) => match req.parse(&buf) {
-                    Ok(httparse::Status::Complete(_body_start)) => {},
-                    Ok(httparse::Status::Partial) => die_expected_error("read-http", "httparse should have gotten a full header"),
-                    Err(err) => die_expected_error("read-http", format!("httparse response parsing failed: {:#?}", err))
+                    Ok(httparse::Status::Complete(_body_start)) => {}
+                    Ok(httparse::Status::Partial) => {
+                        die_expected_error("read-http", "httparse should have gotten a full header")
+                    }
+                    Err(err) => die_expected_error(
+                        "read-http",
+                        format!("httparse response parsing failed: {:#?}", err),
+                    ),
                 },
-                None => die_expected_error("read-http", format!("httparse end of stdin reached before able to parse request headers"))
+                None => die_expected_error(
+                    "read-http",
+                    format!("httparse end of stdin reached before able to parse request headers"),
+                ),
             }
             let method = req.method.expect("method must be filled on complete parse");
             let path = req.path.expect("path must be filled on complete parse");
             write_dict_req(method, path, &normalize_headers(req.headers))
-        },
+        }
         Response => {
             let mut resp = httparse::Response::new(&mut headers);
             let mut buf: Vec<u8> = vec![];
             match read_till_end_of_header(&mut buf, stdin.lock()) {
                 Some(()) => match resp.parse(&buf) {
-                    Ok(httparse::Status::Complete(_body_start)) => {},
-                    Ok(httparse::Status::Partial) => die_expected_error("read-http", "httparse should have gotten a full header"),
-                    Err(err) => die_expected_error("read-http", format!("httparse response parsing failed: {:#?}", err))
+                    Ok(httparse::Status::Complete(_body_start)) => {}
+                    Ok(httparse::Status::Partial) => {
+                        die_expected_error("read-http", "httparse should have gotten a full header")
+                    }
+                    Err(err) => die_expected_error(
+                        "read-http",
+                        format!("httparse response parsing failed: {:#?}", err),
+                    ),
                 },
-                None => die_expected_error("read-http", format!("httparse end of stdin reached before able to parse response headers"))
+                None => die_expected_error(
+                    "read-http",
+                    format!("httparse end of stdin reached before able to parse response headers"),
+                ),
             }
             let code = resp.code.expect("code must be filled on complete parse");
-            let reason = resp.reason.expect("reason must be filled on complete parse");
+            let reason = resp
+                .reason
+                .expect("reason must be filled on complete parse");
             write_dict_resp(code, reason, &normalize_headers(resp.headers))
         }
     }
 }
 
-fn write_dict_req<'a, 'buf>(method: &'buf str, path: &'buf str, headers: &'a HashMap<String, U<'a>>) -> std::io::Result<()> {
-    let mut http = vec![
-        ("method", U::Text(method)),
-        ("path", U::Text(path)),
-    ].into_iter().collect();
+fn write_dict_req<'a, 'buf>(
+    method: &'buf str,
+    path: &'buf str,
+    headers: &'a HashMap<String, U<'a>>,
+) -> std::io::Result<()> {
+    let mut http = vec![("method", U::Text(method)), ("path", U::Text(path))]
+        .into_iter()
+        .collect();
     write_dict(http, headers)
 }
 
-fn write_dict_resp<'a, 'buf>(code: u16, reason: &'buf str, headers: &'a HashMap<String, U<'a>>) -> std::io::Result<()> {
+fn write_dict_resp<'a, 'buf>(
+    code: u16,
+    reason: &'buf str,
+    headers: &'a HashMap<String, U<'a>>,
+) -> std::io::Result<()> {
     let mut http = vec![
         ("status", U::N6(code as u64)),
         ("status-text", U::Text(reason)),
-    ].into_iter().collect();
+    ]
+    .into_iter()
+    .collect();
     write_dict(http, headers)
 }
 
-
-fn write_dict<'buf, 'a>(mut http: HashMap<&str, U<'a>>, headers: &'a HashMap<String, U<'a>>) -> std::io::Result<()> {
-    match http.insert("headers", U::Record(
-        headers.iter().map(|(k,v)| (k.as_str(), v.clone())).collect()
-    )) {
+fn write_dict<'buf, 'a>(
+    mut http: HashMap<&str, U<'a>>,
+    headers: &'a HashMap<String, U<'a>>,
+) -> std::io::Result<()> {
+    match http.insert(
+        "headers",
+        U::Record(
+            headers
+                .iter()
+                .map(|(k, v)| (k.as_str(), v.clone()))
+                .collect(),
+        ),
+    ) {
         None => (),
         Some(_) => panic!("read-http: headers already in dict"),
     };
-    netencode::encode(
-        &mut std::io::stdout(),
-        &U::Record(http)
-    )?;
+    netencode::encode(&mut std::io::stdout(), &U::Record(http))?;
     Ok(())
 }
 
-
 // iter helper
-
+// TODO: put into its own module
 struct Chunkyboi<T> {
     inner: T,
     buf: Vec<u8>,
@@ -188,10 +229,7 @@ struct Chunkyboi<T> {
 impl<R: Read> Chunkyboi<R> {
     fn new(inner: R, chunksize: usize) -> Self {
         let buf = vec![0; chunksize];
-        Chunkyboi {
-            inner,
-            buf
-        }
+        Chunkyboi { inner, buf }
     }
 }
 
@@ -205,7 +243,7 @@ impl<R: Read> Iterator for Chunkyboi<R> {
                 // clone a new buffer so we can reuse the internal one
                 Some(Ok(self.buf[..read].to_owned()))
             }
-            Err(err) => Some(Err(err))
+            Err(err) => Some(Err(err)),
         }
     }
 }
diff --git a/users/Profpatsch/reverse-haskell-deps.nix b/users/Profpatsch/reverse-haskell-deps.nix
deleted file mode 100644
index b47347ea9f..0000000000
--- a/users/Profpatsch/reverse-haskell-deps.nix
+++ /dev/null
@@ -1,26 +0,0 @@
-{ depot, pkgs, ... }:
-
-# Parses https://packdeps.haskellers.com/reverse
-# and outputs the amount of reverse dependencies of each hackage package.
-
-let
-
-  rev = depot.nix.writeExecline "reverse-haskell-deps" {} [
-    "pipeline" [
-      "${pkgs.curl}/bin/curl" "-L" "https://packdeps.haskellers.com/reverse"
-    ]
-    rev-hs
-
-  ];
-
-  rev-hs = pkgs.writers.writeHaskell "revers-haskell-deps-hs" {
-    libraries =  [
-      pkgs.haskellPackages.nicify-lib
-      pkgs.haskellPackages.tagsoup
-    ];
-
-  }
-    ./reverse-haskell-deps.hs;
-
-
-in rev
diff --git a/users/Profpatsch/reverse-haskell-deps/README.md b/users/Profpatsch/reverse-haskell-deps/README.md
new file mode 100644
index 0000000000..efc288cae4
--- /dev/null
+++ b/users/Profpatsch/reverse-haskell-deps/README.md
@@ -0,0 +1,3 @@
+# reverse-haskell-deps
+
+Parse the HTML at `https://packdeps.haskellers.com/reverse` to get the data about Haskell package reverse dependencies in a structured way (they should just expose that as a json tbh).
diff --git a/users/Profpatsch/reverse-haskell-deps.hs b/users/Profpatsch/reverse-haskell-deps/ReverseHaskellDeps.hs
index 6b644df9ec..0e18ce8a6b 100644
--- a/users/Profpatsch/reverse-haskell-deps.hs
+++ b/users/Profpatsch/reverse-haskell-deps/ReverseHaskellDeps.hs
@@ -1,72 +1,76 @@
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-import qualified Text.HTML.TagSoup as Tag
-import qualified Data.Text as Text
-import Data.Text (Text)
-import qualified Data.List as List
+
+module Main where
+
+import Data.ByteString qualified as ByteString
+import Data.Either
+import Data.List qualified as List
 import Data.Maybe
-import Text.Nicify
-import qualified Text.Read as Read
+import Data.Text (Text)
+import Data.Text qualified as Text
+import Data.Text.Encoding qualified
+import MyPrelude
 import Numeric.Natural
-import Data.Either
-import qualified Data.ByteString as ByteString
-import qualified Data.Text.Encoding
+import Text.HTML.TagSoup qualified as Tag
+import Text.Nicify
+import Text.Read qualified as Read
 
-parseNat :: Text.Text -> Maybe Natural
-parseNat = Read.readMaybe . Text.unpack
+parseNat :: Text -> Maybe Natural
+parseNat = Read.readMaybe . textToString
 
 printNice :: Show a => a -> IO ()
 printNice = putStrLn . nicify . show
 
-type Tag = Tag.Tag Text.Text
+type Tag = Tag.Tag Text
 
 main = do
   reverseHtml <- readStdinUtf8
   printNice $ List.sortOn snd $ packagesAndReverseDeps reverseHtml
-
   where
-    readStdinUtf8 = Data.Text.Encoding.decodeUtf8 <$> ByteString.getContents
+    readStdinUtf8 = bytesToTextUtf8Lenient <$> ByteString.getContents
 
 -- | reads the table provided by https://packdeps.haskellers.com/reverse
 -- figuring out all sections (starting with the link to the package name),
 -- then figuring out the name of the package and the first column,
 -- which is the number of reverse dependencies of the package
+packagesAndReverseDeps :: Text -> [(Text, Natural)]
 packagesAndReverseDeps reverseHtml = do
   let tags = Tag.parseTags reverseHtml
-  let sections =  Tag.partitions (isJust . reverseLink) tags
-  let sectionNames = map (fromJust . reverseLink . head) sections
+  let sections = Tag.partitions (isJust . reverseLink) tags
+  let sectionName [] = "<unknown section>"
+      sectionName (sect : _) = sect & reverseLink & fromMaybe "<unknown section>"
+  let sectionNames = map sectionName sections
   mapMaybe
-    (\(name :: Text.Text, sect) -> do
+    ( \(name :: Text, sect) -> do
         reverseDeps <- firstNaturalNumber sect
-        pure (sectionPackageName name sect, reverseDeps) :: Maybe (Text.Text, Natural))
+        pure (sectionPackageName name sect, reverseDeps) :: Maybe (Text, Natural)
+    )
     $ zip sectionNames sections
-
-
   where
     reverseLink = \case
-      Tag.TagOpen "a" attrs -> mapFind attrReverseLink attrs
+      Tag.TagOpen "a" attrs -> findMaybe attrReverseLink attrs
       _ -> Nothing
 
     attrReverseLink = \case
-      ("href", lnk) -> if
-          | "packdeps.haskellers.com/reverse/" `Text.isInfixOf` lnk -> Just lnk
-          | otherwise -> Nothing
+      ("href", lnk) ->
+        if
+            | "packdeps.haskellers.com/reverse/" `Text.isInfixOf` lnk -> Just lnk
+            | otherwise -> Nothing
       _ -> Nothing
 
     sectionPackageName :: Text -> [Tag] -> Text
     sectionPackageName sectionName = \case
-      (_: Tag.TagText name : _) -> name
-      (_: el : _) -> sectionName
+      (_ : Tag.TagText name : _) -> name
+      (_ : el : _) -> sectionName
       xs -> sectionName
 
-
     firstNaturalNumber :: [Tag] -> Maybe Natural
     firstNaturalNumber =
-      mapFind (\case
-        Tag.TagText t -> parseNat t
-        _ -> Nothing)
-
-    mapFind :: (a -> Maybe b) -> [a] -> Maybe b
-    mapFind f xs = fromJust . f <$> List.find (isJust . f) xs
+      findMaybe
+        ( \case
+            Tag.TagText t -> parseNat t
+            _ -> Nothing
+        )
diff --git a/users/Profpatsch/reverse-haskell-deps/default.nix b/users/Profpatsch/reverse-haskell-deps/default.nix
new file mode 100644
index 0000000000..b0a44420d7
--- /dev/null
+++ b/users/Profpatsch/reverse-haskell-deps/default.nix
@@ -0,0 +1,32 @@
+{ depot, pkgs, ... }:
+
+# Parses https://packdeps.haskellers.com/reverse
+# and outputs the amount of reverse dependencies of each hackage package.
+
+let
+
+  rev = depot.nix.writeExecline "reverse-haskell-deps" { } [
+    "pipeline"
+    [
+      "${pkgs.curl}/bin/curl"
+      "-L"
+      "https://packdeps.haskellers.com/reverse"
+    ]
+    rev-hs
+
+  ];
+
+  rev-hs = pkgs.writers.writeHaskell "revers-haskell-deps-hs"
+    {
+      libraries = [
+        depot.users.Profpatsch.my-prelude
+        pkgs.haskellPackages.nicify-lib
+        pkgs.haskellPackages.tagsoup
+      ];
+      ghcArgs = [ "-threaded" ];
+    }
+    ./ReverseHaskellDeps.hs;
+
+
+in
+rev
diff --git a/users/Profpatsch/reverse-haskell-deps/reverse-haskell-deps.cabal b/users/Profpatsch/reverse-haskell-deps/reverse-haskell-deps.cabal
new file mode 100644
index 0000000000..4792f52adf
--- /dev/null
+++ b/users/Profpatsch/reverse-haskell-deps/reverse-haskell-deps.cabal
@@ -0,0 +1,16 @@
+cabal-version:      3.0
+name:               reverse-haskell-deps
+version:            0.1.0.0
+author:             Profpatsch
+maintainer:         mail@profpatsch.de
+
+library
+    exposed-modules:          ReverseHaskellDeps.hs
+
+    build-depends:
+        base >=4.15 && <5,
+        my-prelude,
+        tagsoup,
+        nicify-lib
+
+    default-language: Haskell2010
diff --git a/users/Profpatsch/shell.nix b/users/Profpatsch/shell.nix
new file mode 100644
index 0000000000..b5095d476f
--- /dev/null
+++ b/users/Profpatsch/shell.nix
@@ -0,0 +1,110 @@
+# generic shell.nix that can be used for most of my projects here,
+# until I figure out a way to have composable shells.
+let root = (import ../../. { }); in
+{ pkgs ? root.third_party.nixpkgs, depot ? root, ... }:
+
+pkgs.mkShell {
+
+  buildInputs = [
+    pkgs.sqlite-interactive
+    pkgs.sqlite-utils
+    pkgs.haskell-language-server
+    pkgs.cabal-install
+    (pkgs.haskellPackages.ghcWithHoogle (h: [
+      h.async
+      h.aeson-better-errors
+      h.blaze-html
+      h.conduit-extra
+      h.error
+      h.monad-logger
+      h.pa-field-parser
+      h.pa-label
+      h.pa-json
+      h.pa-pretty
+      h.pa-run-command
+      h.ihp-hsx
+      h.PyF
+      h.foldl
+      h.unliftio
+      h.xml-conduit
+      h.wai
+      h.wai-extra
+      h.warp
+      h.profunctors
+      h.semigroupoids
+      h.validation-selective
+      h.free
+      h.cryptonite-conduit
+      h.sqlite-simple
+      h.hedgehog
+      h.http-conduit
+      h.http-conduit
+      h.wai-conduit
+      h.nonempty-containers
+      h.deriving-compat
+      h.unix
+      h.tagsoup
+      h.attoparsec
+      h.iCalendar
+      h.case-insensitive
+      h.hscolour
+      h.nicify-lib
+      h.hspec
+      h.hspec-expectations-pretty-diff
+      h.tmp-postgres
+      h.postgresql-simple
+      h.resource-pool
+      h.xmonad-contrib
+      h.hs-opentelemetry-sdk
+      h.punycode
+    ]))
+
+    pkgs.rustup
+    pkgs.pkg-config
+    pkgs.fuse
+    pkgs.postgresql_14
+    pkgs.nodejs
+    pkgs.ninja
+    pkgs.s6
+    pkgs.caddy
+
+    (depot.nix.binify {
+      name = "nix-run";
+      exe = depot.users.Profpatsch.nix-tools.nix-run;
+    })
+  ];
+
+  DEPOT_ROOT = toString ./../..;
+  PROFPATSCH_ROOT = toString ./.;
+
+  WHATCD_RESOLVER_TOOLS = pkgs.linkFarm "whatcd-resolver-tools" [
+    {
+      name = "pg_format";
+      path = "${pkgs.pgformatter}/bin/pg_format";
+    }
+  ];
+
+  # DECLIB_MASTODON_ACCESS_TOKEN read from `pass` in .envrc.
+
+  RUSTC_WRAPPER =
+    let
+      wrapperArgFile = libs: pkgs.writeText "rustc-wrapper-args"
+        (pkgs.lib.concatStringsSep
+          "\n"
+          (pkgs.lib.concatLists
+            (map
+              (lib: [
+                "-L"
+                "${pkgs.lib.getLib lib}/lib"
+              ])
+              libs)));
+    in
+    depot.nix.writeExecline "rustc-wrapper" { readNArgs = 1; } [
+      "$1"
+      "$@"
+      "@${wrapperArgFile [
+      depot.third_party.rust-crates.nom
+    ]}"
+    ];
+
+}
diff --git a/users/Profpatsch/shortcuttable/default.nix b/users/Profpatsch/shortcuttable/default.nix
new file mode 100644
index 0000000000..13ba220400
--- /dev/null
+++ b/users/Profpatsch/shortcuttable/default.nix
@@ -0,0 +1,172 @@
+{ depot, lib, pkgs, ... }:
+
+let
+  # run prog... and restart whenever SIGHUP is received
+  #
+  # this is useful for binding to a shortcut.
+  #
+  # Unfortunately, this requires a bunch of workarounds around the semantics of `trap`,
+  # but the general idea of bundling subprocesses with `setsid` is somewhat sound.
+  runShortcuttable =
+    depot.nix.writeExecline "run-shortcuttable" { } [
+      "importas"
+      "-i"
+      "run"
+      "XDG_RUNTIME_DIR"
+      "if"
+      [ "mkdir" "-p" "\${run}/shortcuttable/test" ]
+      "getpid"
+      "-E"
+      "controlpid"
+      savePid
+      "\${run}/shortcuttable/test/control"
+      "$controlpid"
+
+      # start the program
+      "background"
+      [
+        startSaveSID
+        "\${run}/shortcuttable/test/running-sid"
+        "$@"
+      ]
+
+      "trap"
+      [
+        "SIGHUP"
+        [
+          "if"
+          [ "echo" "got hup" ]
+          "if"
+          [
+            "if"
+            [ "echo" "killing our child processes" ]
+            "envfile"
+            "\${run}/shortcuttable/test/running-sid"
+            "importas"
+            "-ui"
+            "child_sid"
+            "pid"
+            "foreground"
+            [ "ps" "-f" "--sid" "$child_sid" ]
+            ctrlCCtrlDSid
+            "$child_sid"
+          ]
+          "if"
+          [ "echo" "restarting into" "$@" ]
+          "background"
+          [
+            startSaveSID
+            "\${run}/shortcuttable/test/running-sid"
+            "$@"
+          ]
+        ]
+        "SIGTERM"
+        [
+          (killShortcuttable { signal = "TERM"; })
+          "\${run}/shortcuttable/test/running-sid"
+          "\${run}/shortcuttable/test/exit"
+        ]
+        "SIGINT"
+        [
+          (killShortcuttable { signal = "INT"; })
+          "\${run}/shortcuttable/test/running-sid"
+          "\${run}/shortcuttable/test/exit"
+        ]
+      ]
+      depot.users.Profpatsch.execline.setsid
+      "child_sid"
+      "getpid"
+      "-E"
+      "exitpid"
+      savePid
+      "\${run}/shortcuttable/test/exit"
+      "$exitpid"
+      "sleep"
+      "infinity"
+    ];
+
+  killShortcuttable = { signal }: depot.nix.writeExecline "kill-shortcuttable" { readNArgs = 2; } [
+    "if"
+    [ "echo" "got SIG${signal}, quitting" ]
+    "if"
+    [
+      "envfile"
+      "$1"
+      "importas"
+      "-ui"
+      "child_sid"
+      "pid"
+      "foreground"
+      [ "ps" "-f" "--sid" "$child_sid" ]
+      ctrlCCtrlDSid
+      "$child_sid"
+    ]
+    "if"
+    [ "echo" "killing shortcuttable loop" ]
+    "envfile"
+    "$2"
+    "importas"
+    "-ui"
+    "trap_pid"
+    "pid"
+    "foreground"
+    [ "ps" "-fp" "$trap_pid" ]
+    "kill"
+    "--signal"
+    signal
+    "$trap_pid"
+  ];
+
+  savePid = depot.nix.writeExecline "save-pid" { readNArgs = 2; } [
+    "if"
+    [ "echo" "saving process:" ]
+    "if"
+    [ "ps" "-fp" "$2" ]
+    "if"
+    [
+      "redirfd"
+      "-w"
+      "1"
+      "$1"
+      "printf"
+      "pid = %s\n"
+      "$2"
+    ]
+    "$@"
+  ];
+
+  # try to kill process, first with SIGTERM then SIGQUIT (in case it’s a repl)
+  ctrlCCtrlDSid = depot.nix.writeExecline "ctrl-c-ctrl-d" { readNArgs = 1; } [
+    "ifelse"
+    "-n"
+    [ "kill" "--signal" "TERM" "--" "-\${1}" ]
+    [
+      "if"
+      [ "echo" "could not kill via SIGTERM, trying SIGQUIT …" ]
+      "ifelse"
+      "-n"
+      [ "kill" "--signal" "QUIT" "--" "-\${1}" ]
+      [ "echo" "SIGQUIT failed as well, keeping it running" ]
+      "$@"
+    ]
+    "$@"
+  ];
+
+  startSaveSID = depot.nix.writeExecline "start-save-sid" { readNArgs = 1; } [
+    depot.users.Profpatsch.execline.setsid
+    "child_sid"
+    "importas"
+    "-ui"
+    "child_sid"
+    "child_sid"
+    "if"
+    [ "echo" "children sid:" "$child_sid" ]
+    savePid
+    "$1"
+    "$child_sid"
+    "$@"
+  ];
+
+
+in
+runShortcuttable
diff --git a/users/Profpatsch/struct-edit/default.nix b/users/Profpatsch/struct-edit/default.nix
deleted file mode 100644
index 970cdd4d02..0000000000
--- a/users/Profpatsch/struct-edit/default.nix
+++ /dev/null
@@ -1,13 +0,0 @@
-{ depot, ... }:
-depot.nix.buildGo.program {
-    name = "struct-edit";
-    srcs = [
-      ./main.go
-    ];
-    deps = [
-      depot.third_party.gopkgs."github.com".charmbracelet.bubbletea
-      depot.third_party.gopkgs."github.com".charmbracelet.lipgloss
-      depot.third_party.gopkgs."github.com".muesli.termenv
-      depot.third_party.gopkgs."github.com".mattn.go-isatty
-    ];
-}
diff --git a/users/Profpatsch/struct-edit/main.go b/users/Profpatsch/struct-edit/main.go
deleted file mode 100644
index 7e43074266..0000000000
--- a/users/Profpatsch/struct-edit/main.go
+++ /dev/null
@@ -1,431 +0,0 @@
-package main
-
-import (
-	json "encoding/json"
-	"fmt"
-	"log"
-	"os"
-	"strings"
-	"sort"
-
-	tea "github.com/charmbracelet/bubbletea"
-	lipgloss "github.com/charmbracelet/lipgloss"
-	// termenv "github.com/muesli/termenv"
-	// isatty "github.com/mattn/go-isatty"
-)
-
-// Keeps the full data structure and a path that indexes our current position into it.
-type model struct {
-	path          []index
-	data          val
-}
-
-// an index into a value, uint for lists and string for maps.
-// nil for any scalar value.
-// TODO: use an actual interface for these
-type index interface{}
-
-/// recursive value that we can represent.
-type val struct {
-	// the “type” of value; see tag const belove
-	tag tag
-	// last known position of our cursor
-	last_index index
-	// documentation (TODO)
-	doc string
-	// the actual value;
-	// the actual structure is behind a pointer so we can replace the struct.
-	// determined by the tag
-	// tagString -> *string
-	// tagFloat -> *float64
-	// tagList -> *[]val
-	// tagMap -> *map[string]val
-	val interface{}
-}
-
-type tag string
-
-const (
-	tagString tag = "string"
-	tagFloat  tag = "float"
-	tagList   tag = "list"
-	tagMap    tag = "map"
-)
-
-// print a value, flat
-func (v val) Render() string {
-	s := ""
-	switch v.tag {
-	case tagString:
-		s += *v.val.(*string)
-	case tagFloat:
-		s += fmt.Sprint(*v.val.(*float64))
-	case tagList:
-		s += "[ "
-		vs := []string{}
-		for _, enum := range v.enumerate() {
-			vs = append(vs, enum.v.Render())
-		}
-		s += strings.Join(vs, ", ")
-		s += " ]"
-	case tagMap:
-		s += "{ "
-		vs := []string{}
-		for _, enum := range v.enumerate() {
-			vs = append(vs, fmt.Sprintf("%s: %s", enum.i.(string), enum.v.Render()))
-		}
-		s += strings.Join(vs, ", ")
-		s += " }"
-	default:
-		s += fmt.Sprintf("<unknown: %v>", v)
-	}
-	return s
-}
-
-// render an index, depending on the type
-func renderIndex(i index) (s string) {
-	switch i := i.(type) {
-	case nil:
-		s = ""
-	// list index
-	case uint:
-		s = "*"
-	// map index
-	case string:
-		s = i + ":"
-	}
-	return
-}
-
-// take an arbitrary (within restrictions) go value and construct a val from it
-func makeVal(i interface{}) val {
-	var v val
-	switch i := i.(type) {
-	case string:
-		v = val{
-			tag: tagString,
-			last_index: index(nil),
-			doc: "",
-			val: &i,
-		}
-	case float64:
-		v = val{
-			tag: tagFloat,
-			last_index: index(nil),
-			doc: "",
-			val: &i,
-		}
-	case []interface{}:
-		ls := []val{}
-		for _, i := range i {
-			ls = append(ls, makeVal(i))
-		}
-		v = val{
-			tag: tagList,
-			last_index: pos1Inner(tagList, &ls),
-			doc: "",
-			val: &ls,
-		}
-	case map[string]interface{}:
-		ls := map[string]val{}
-		for k, i := range i {
-			ls[k] = makeVal(i)
-		}
-		v = val{
-			tag: tagMap,
-			last_index: pos1Inner(tagMap, &ls),
-			doc: "",
-			val: &ls,
-		}
-	default:
-		log.Fatalf("makeVal: cannot read json of type %T", i)
-	}
-	return v
-}
-
-// return an index that points at the first entry in val
-func (v val) pos1() index {
-	return v.enumerate()[0].i
-}
-
-func pos1Inner(tag tag, v interface{}) index {
-	return enumerateInner(tag, v)[0].i
-}
-
-type enumerate struct {
-	i index
-	v val
-}
-
-// enumerate gives us a stable ordering of elements in this val.
-// for scalars it’s just a nil index & the val itself.
-// Guaranteed to always return at least one element.
-func (v val) enumerate() (e []enumerate) {
-	e = enumerateInner(v.tag, v.val)
-	if e == nil {
-		e = append(e, enumerate{
-			i: nil,
-			v: v,
-		})
-	}
-	return
-}
-
-// like enumerate, but returns an empty slice for scalars without inner vals.
-func enumerateInner(tag tag, v interface{}) (e []enumerate) {
-	switch tag {
-	case tagString:
-		fallthrough
-	case tagFloat:
-		e = nil
-	case tagList:
-		for i, v := range *v.(*[]val) {
-			e = append(e, enumerate{i: index(uint(i)), v: v})
-		}
-	case tagMap:
-		// map sorting order is not stable (actually randomized thank jabber)
-		// so let’s sort them
-		keys := []string{}
-		m := *v.(*map[string]val)
-		for k, _ := range m {
-			keys = append(keys, k)
-		}
-		sort.Strings(keys)
-		for _, k := range keys {
-			e = append(e, enumerate{i: index(k), v: m[k]})
-		}
-	default:
-		log.Fatalf("unknown val tag %s, %v", tag, v)
-	}
-	return
-}
-
-func (m model) PathString() string {
-	s := "/ "
-	var is []string
-	for _, v := range m.path {
-		is = append(is, fmt.Sprintf("%v", v))
-	}
-	s += strings.Join(is, " / ")
-	return s
-}
-
-// walk the given path down in data, to get the value at that point.
-// Assumes that all path indexes are valid indexes into data.
-// Returns a pointer to the value at point, in order to be able to change it.
-func walk(data *val, path []index) (*val, bool, error) {
-	res := data
-	atPath := func(index int) string {
-		return fmt.Sprintf("at path %v", path[:index+1])
-	}
-	errf := func(ty string, val interface{}, index int) error {
-		return fmt.Errorf("walk: can’t walk into %s %v %s", ty, val, atPath(index))
-	}
-	for i, p := range path {
-		switch res.tag {
-		case tagString:
-			return nil, true, nil
-		case tagFloat:
-			return nil, true, nil
-		case tagList:
-			switch p := p.(type) {
-			case uint:
-				list := *res.val.(*[]val)
-				if int(p) >= len(list) || p < 0 {
-					return nil, false, fmt.Errorf("index out of bounds %s", atPath(i))
-				}
-				res = &list[p]
-			default:
-				return nil, false, fmt.Errorf("not a list index %s", atPath(i))
-			}
-		case tagMap:
-			switch p := p.(type) {
-			case string:
-				m := *res.val.(*map[string]val)
-				if a, ok := m[p]; ok {
-					res = &a
-				} else {
-				  return nil, false, fmt.Errorf("index %s not in map %s", p, atPath(i))
-				}
-			default:
-				return nil, false, fmt.Errorf("not a map index %v %s", p, atPath(i))
-			}
-
-		default:
-			return nil, false, errf(string(res.tag), res.val, i)
-		}
-	}
-	return res, false, nil
-}
-
-// descend into the selected index. Assumes that the index is valid.
-// Will not descend into scalars.
-func (m model) descend() (model, error) {
-	// TODO: two walks?!
-	this, _, err := walk(&m.data, m.path)
-	if err != nil {
-		return m, err
-	}
-	newPath := append(m.path, this.last_index)
-	_, bounce, err := walk(&m.data, newPath)
-	if err != nil {
-		return m, err
-	}
-	// only descend if we *can*
-	if !bounce {
-		m.path = newPath
-	}
-	return m, nil
-}
-
-// ascend to one level up. stops at the root.
-func (m model) ascend() (model, error) {
-	if len(m.path) > 0 {
-		m.path = m.path[:len(m.path)-1]
-		_, _, err := walk(&m.data, m.path)
-		return m, err
-	}
-	return m, nil
-}
-
-/// go to the next item, or wraparound
-func (min model) next() (m model, err error) {
-	m = min
-	this, _, err := walk(&m.data, m.path)
-	if err != nil {
-		return
-	}
-	enumL := this.enumerate()
-	setNext := false
-	for _, enum := range enumL {
-		if setNext {
-			this.last_index = enum.i
-			setNext = false
-			break
-		}
-		if enum.i == this.last_index {
-			setNext = true
-		}
-	}
-	// wraparound
-	if setNext {
-		this.last_index = enumL[0].i
-	}
-	return
-}
-
-/// go to the previous item, or wraparound
-func (min model) prev() (m model, err error) {
-	m = min
-	this, _, err := walk(&m.data, m.path)
-	if err != nil {
-		return
-	}
-	enumL := this.enumerate()
-	// last element, wraparound
-	prevIndex := enumL[len(enumL)-1].i
-	for _, enum := range enumL {
-		if enum.i == this.last_index {
-			this.last_index = prevIndex
-			break
-		}
-		prevIndex = enum.i
-	}
-	return
-}
-
-/// bubbletea implementations
-
-func (m model) Init() tea.Cmd {
-	return nil
-}
-
-func initialModel(v interface{}) model {
-	val := makeVal(v)
-	return model{
-		path:          []index{},
-		data:          val,
-	}
-}
-
-func (m model) Update(msg tea.Msg) (tea.Model, tea.Cmd) {
-	var err error
-	switch msg := msg.(type) {
-	case tea.KeyMsg:
-		switch msg.String() {
-		case "ctrl+c", "q":
-			return m, tea.Quit
-
-		case "up":
-			m, err = m.prev()
-
-		case "down":
-			m, err = m.next()
-
-		case "right":
-			m, err = m.descend()
-
-		case "left":
-			m, err = m.ascend()
-
-			// 	case "enter":
-			// 		_, ok := m.selected[m.cursor]
-			// 		if ok {
-			// 			delete(m.selected, m.cursor)
-			// 		} else {
-			// 			m.selected[m.cursor] = struct{}{}
-			// 		}
-		}
-
-	}
-	if err != nil {
-		log.Fatal(err)
-	}
-	return m, nil
-}
-
-var pathColor = lipgloss.NewStyle().
-	// light blue
-	Foreground(lipgloss.Color("12"))
-
-var selectedColor = lipgloss.NewStyle().
-	Bold(true)
-
-func (m model) View() string {
-	s := pathColor.Render(m.PathString())
-	cur, _, err := walk(&m.data, m.path)
-	if err != nil {
-		log.Fatal(err)
-	}
-	s += cur.doc + "\n"
-	s += "\n"
-	for _, enum := range cur.enumerate() {
-		is := renderIndex(enum.i)
-		if is != "" {
-			s += is + " "
-		}
-		if enum.i == cur.last_index {
-			s += selectedColor.Render(enum.v.Render())
-		} else {
-			s += enum.v.Render()
-		}
-		s += "\n"
-	}
-
-	// s += fmt.Sprintf("%v\n", m)
-	// s += fmt.Sprintf("%v\n", cur)
-
-	return s
-}
-
-func main() {
-	var input interface{}
-	err := json.NewDecoder(os.Stdin).Decode(&input)
-	if err != nil {
-		log.Fatal("json from stdin: ", err)
-	}
-	p := tea.NewProgram(initialModel(input))
-	if err := p.Start(); err != nil {
-		log.Fatal("bubbletea TUI error: ", err)
-	}
-}
diff --git a/users/Profpatsch/sync-abfall-ics-aichach-friedberg/README.md b/users/Profpatsch/sync-abfall-ics-aichach-friedberg/README.md
new file mode 100644
index 0000000000..e0a6aa2fb8
--- /dev/null
+++ b/users/Profpatsch/sync-abfall-ics-aichach-friedberg/README.md
@@ -0,0 +1,3 @@
+# sync-abfall-ics-aichach-friedberg
+
+A small tool to sync the ICS files for the local trash collection times at https://abfallwirtschaft.lra-aic-fdb.de/
diff --git a/users/Profpatsch/sync-abfall-ics-aichach-friedberg/default.nix b/users/Profpatsch/sync-abfall-ics-aichach-friedberg/default.nix
new file mode 100644
index 0000000000..739274cb6f
--- /dev/null
+++ b/users/Profpatsch/sync-abfall-ics-aichach-friedberg/default.nix
@@ -0,0 +1,31 @@
+{ depot, pkgs, ... }:
+
+let
+  sync-to-dir = depot.users.Profpatsch.writers.python3
+    {
+      name = "sync-ics-to-dir";
+      libraries = (py: [
+        py.httpx
+        py.icalendar
+      ]);
+    } ./sync-ics-to-dir.py;
+
+  config =
+    depot.users.Profpatsch.importDhall.importDhall
+      {
+        root = ./..;
+        files = [
+          "sync-abfall-ics-aichach-friedberg/ics-to-caldav.dhall"
+          "dhall/lib.dhall"
+          "ini/ini.dhall"
+        ];
+        main = "sync-abfall-ics-aichach-friedberg/ics-to-caldav.dhall";
+        deps = [
+        ];
+      }
+      depot.users.Profpatsch.ini.externs;
+
+
+
+in
+{ inherit config; }
diff --git a/users/Profpatsch/sync-abfall-ics-aichach-friedberg/ics-to-caldav.dhall b/users/Profpatsch/sync-abfall-ics-aichach-friedberg/ics-to-caldav.dhall
new file mode 100644
index 0000000000..2a7ac84979
--- /dev/null
+++ b/users/Profpatsch/sync-abfall-ics-aichach-friedberg/ics-to-caldav.dhall
@@ -0,0 +1,139 @@
+let Ini = ../ini/ini.dhall
+
+let Lib = ../dhall/lib.dhall
+
+in  \(Ini/externs : Ini.Externs) ->
+      let Vdirsyncer =
+            let StorageType =
+                  < FileSystem : { path : Text, fileext : < ICS > }
+                  | Http : { url : Text }
+                  >
+
+            let Collection = < FromA | FromB | Collection : Text >
+
+            let Collections =
+                  < Unspecified | TheseCollections : List Collection >
+
+            let Storage = { storageName : Text, storage : StorageType }
+
+            in  { Storage
+                , StorageType
+                , Collection
+                , Collections
+                , Pair =
+                    { pairName : Text
+                    , a : Storage
+                    , b : Storage
+                    , collections : Collections
+                    }
+                }
+
+      let toIniSections
+          : Vdirsyncer.Pair -> Ini.Sections
+          = \(pair : Vdirsyncer.Pair) ->
+              let
+                  -- we assume the names are [a-zA-Z_]
+                  renderList =
+                    \(l : List Text) ->
+                          "["
+                      ++  Lib.Text/concatMapSep
+                            ", "
+                            Text
+                            (\(t : Text) -> "\"${t}\"")
+                            l
+                      ++  "]"
+
+              in  let nv = \(name : Text) -> \(value : Text) -> { name, value }
+
+                  let mkStorage =
+                        \(storage : Vdirsyncer.Storage) ->
+                          { name = "storage ${storage.storageName}"
+                          , value =
+                              merge
+                                { FileSystem =
+                                    \ ( fs
+                                      : { path : Text, fileext : < ICS > }
+                                      ) ->
+                                      [ nv "type" "filesystem"
+                                      , nv
+                                          "fileext"
+                                          (merge { ICS = ".ics" } fs.fileext)
+                                      , nv "path" fs.path
+                                      ]
+                                , Http =
+                                    \(http : { url : Text }) ->
+                                      [ nv "type" "http", nv "url" http.url ]
+                                }
+                                storage.storage
+                          }
+
+                  in  [ { name = "pair ${pair.pairName}"
+                        , value =
+                          [ nv "a" pair.a.storageName
+                          , nv "b" pair.b.storageName
+                          , nv
+                              "collections"
+                              ( merge
+                                  { Unspecified = "none"
+                                  , TheseCollections =
+                                      \(colls : List Vdirsyncer.Collection) ->
+                                        renderList
+                                          ( Lib.List/map
+                                              Vdirsyncer.Collection
+                                              Text
+                                              ( \ ( coll
+                                                  : Vdirsyncer.Collection
+                                                  ) ->
+                                                  merge
+                                                    { FromA = "from a"
+                                                    , FromB = "from b"
+                                                    , Collection =
+                                                        \(t : Text) -> t
+                                                    }
+                                                    coll
+                                              )
+                                              colls
+                                          )
+                                  }
+                                  pair.collections
+                              )
+                          ]
+                        }
+                      , mkStorage pair.a
+                      , mkStorage pair.b
+                      ]
+
+      in  { example =
+              Ini/externs.renderIni
+                ( Ini.appendInis
+                    ( Lib.List/map
+                        Vdirsyncer.Pair
+                        Ini.Ini
+                        ( \(pair : Vdirsyncer.Pair) ->
+                            { globalSection = [] : Ini.Section
+                            , sections = toIniSections pair
+                            }
+                        )
+                        (   [ { pairName = "testPair"
+                              , a =
+                                { storageName = "mystor"
+                                , storage =
+                                    Vdirsyncer.StorageType.FileSystem
+                                      { path = "./test-ics"
+                                      , fileext = < ICS >.ICS
+                                      }
+                                }
+                              , b =
+                                { storageName = "mystor"
+                                , storage =
+                                    Vdirsyncer.StorageType.Http
+                                      { url = "https://profpatsch.de" }
+                                }
+                              , collections = Vdirsyncer.Collections.Unspecified
+                              }
+                            ]
+                          : List Vdirsyncer.Pair
+                        )
+                    )
+                )
+          }
diff --git a/users/Profpatsch/sync-abfall-ics-aichach-friedberg/sync-ics-to-dir.py b/users/Profpatsch/sync-abfall-ics-aichach-friedberg/sync-ics-to-dir.py
new file mode 100644
index 0000000000..4af3b9fb85
--- /dev/null
+++ b/users/Profpatsch/sync-abfall-ics-aichach-friedberg/sync-ics-to-dir.py
@@ -0,0 +1,133 @@
+# horrible little module that fetches ICS files for the local trash public service.
+#
+# It tries its best to not overwrite existing ICS files in case the upstream goes down
+# or returns empty ICS files.
+import sys
+import httpx
+import asyncio
+import icalendar
+from datetime import datetime
+import syslog
+import os.path
+
+# Internal id for the street (extracted from the ics download url)
+ortsteil_id = "e9c32ab3-df25-4660-b88e-abda91897d7a"
+
+# They are using a numeric encoding to refer to different kinds of trash
+fraktionen = {
+    "restmüll": "1",
+    "bio": "5",
+    "papier": "7",
+    "gelbe_tonne": "13",
+    "problemmüllsammlung": "20"
+}
+
+def ics_url(year):
+  frakt = ','.join(fraktionen.values())
+  return f'https://awido.cubefour.de/Customer/aic-fdb/KalenderICS.aspx?oid={ortsteil_id}&jahr={year}&fraktionen={frakt}&reminder=1.12:00'
+
+def fetchers_for_years(start_year, no_of_years_in_future):
+    """given a starting year, and a number of years in the future,
+    return the years for which to fetch ics files"""
+    current_year = datetime.now().year
+    max_year = current_year + no_of_years_in_future
+    return {
+        "passed_years": range(start_year, current_year),
+        "this_and_future_years": range(current_year, 1 + max_year)
+    }
+
+async def fetch_ics(c, url):
+    """fetch an ICS file from an URL"""
+    try:
+        resp = await c.get(url)
+    except Exception as e:
+        return { "ics_does_not_exist_exc": e }
+
+    if resp.is_error:
+        return { "ics_does_not_exist": resp }
+    else:
+        try:
+            ics = icalendar.Calendar.from_ical(resp.content)
+            return { "ics": { "ics_parsed": ics, "ics_bytes": resp.content } }
+        except ValueError as e:
+            return { "ics_cannot_be_parsed": e }
+
+def ics_has_events(ics):
+    """Determine if there is any event in the ICS, otherwise we can assume it’s an empty file"""
+    for item in ics.walk():
+      if isinstance(item, icalendar.Event):
+        return True
+    return False
+
+async def write_nonempty_ics(directory, year, ics):
+    # only overwrite if the new ics has any events
+    if ics_has_events(ics['ics_parsed']):
+        path = os.path.join(directory, f"{year}.ics")
+        with open(path, "wb") as f:
+            f.write(ics['ics_bytes'])
+            info(f"wrote ics for year {year} to file {path}")
+    else:
+        info(f"ics for year {year} was empty, skipping")
+
+
+def main():
+    ics_directory = os.getenv("ICS_DIRECTORY", None)
+    if not ics_directory:
+        critical("please set ICS_DIRECTORY")
+    start_year = int(os.getenv("ICS_START_YEAR", 2022))
+    future_years = int(os.getenv("ICS_FUTURE_YEARS", 2))
+
+    years = fetchers_for_years(start_year, no_of_years_in_future=future_years)
+
+
+    async def go():
+        async with httpx.AsyncClient(follow_redirects=True) as c:
+            info(f"fetching ics for passed years: {years['passed_years']}")
+            for year in years["passed_years"]:
+                match await fetch_ics(c, ics_url(year)):
+                    case { "ics_does_not_exist_exc": error }:
+                       warn(f"The ics for the year {year} is gone, error when requesting: {error} for url {ics_url(year)}")
+                    case { "ics_does_not_exist": resp }:
+                       warn(f"The ics for the year {year} is gone, server returned status {resp.status} for url {ics_url(year)}")
+                    case { "ics_cannot_be_parsed": error }:
+                       warn(f"The returned ICS could not be parsed: {error} for url {ics_url(year)}")
+                    case { "ics": ics }:
+                       info(f"fetched ics from {ics_url(year)}")
+                       await write_nonempty_ics(ics_directory, year, ics)
+                    case _:
+                       critical("unknown case for ics result")
+
+
+            info(f"fetching ics for current and upcoming years: {years['this_and_future_years']}")
+            for year in years["this_and_future_years"]:
+                match await fetch_ics(c, ics_url(year)):
+                    case { "ics_does_not_exist_exc": error }:
+                       critical(f"The ics for the year {year} is not available, error when requesting: {error} for url {ics_url(year)}")
+                    case { "ics_does_not_exist": resp }:
+                       critical(f"The ics for the year {year} is not available, server returned status {resp.status} for url {ics_url(year)}")
+                    case { "ics_cannot_be_parsed": error }:
+                       critical(f"The returned ICS could not be parsed: {error} for url {ics_url(year)}")
+                    case { "ics": ics }:
+                       info(f"fetched ics from {ics_url(year)}")
+                       await write_nonempty_ics(ics_directory, year, ics)
+                    case _:
+                       critical("unknown case for ics result")
+
+    asyncio.run(go())
+
+def info(msg):
+    syslog.syslog(syslog.LOG_INFO, msg)
+
+def critical(msg):
+    syslog.syslog(syslog.LOG_CRIT, msg)
+    sys.exit(1)
+
+def warn(msg):
+    syslog.syslog(syslog.LOG_WARNING, msg)
+
+def debug(msg):
+    syslog.syslog(syslog.LOG_DEBUG, msg)
+
+
+if __name__ == "__main__":
+    main()
diff --git a/users/Profpatsch/tagtime/README.md b/users/Profpatsch/tagtime/README.md
new file mode 100644
index 0000000000..ab2c7d14e5
--- /dev/null
+++ b/users/Profpatsch/tagtime/README.md
@@ -0,0 +1,18 @@
+# tagtime reimplementation
+
+What’s great about original perl tagtime?
+
+* timestamps are deterministic from the beginning (keep)
+* the tagging system should just work (tm)
+
+What’s the problem with the original perl tagtime?
+
+* it uses a bad, arbitrary file format -> sqlite3
+* the query window does not time out, so it’s easy to miss that it’s open (often hidden behind another window), and then the following pings might never appear)
+* There’s a bug with tags containing a `.` -> sqlite3
+
+What would be cool to have?
+
+* multi-entry mode (ping on phone and laptop and merge the replies eventually since they will apply to single timestamps)
+* simplifying reporting based on fuzzy matching & history
+* auto-generate nice time reports with hours for work items
diff --git a/users/Profpatsch/toINI.nix b/users/Profpatsch/toINI.nix
new file mode 100644
index 0000000000..537505d30b
--- /dev/null
+++ b/users/Profpatsch/toINI.nix
@@ -0,0 +1,79 @@
+{ lib, ... }:
+let
+  /* Generate an INI-style config file from an attrset
+   * specifying the global section (no header), and a
+   * list of sections which contain name/value pairs.
+   *
+   * generators.toINI {} {
+   *   globalSection = [
+   *     { name = "someGlobalKey"; value = "hi"; }
+   *   ];
+   *   sections = [
+   *     { name = "foo"; value = [
+   *         { name = "hi"; value = "${pkgs.hello}"; }
+   *         { name = "ciao"; value = "bar"; }
+   *       ];
+   *     }
+   *     { name = "baz";
+   *       value = [ { name = "also, integers"; value = 42; } ];
+   *     }
+   *   ];
+   * }
+   *
+   *> someGlobalKey=hi
+   *>
+   *> [foo]
+   *> hi=/nix/store/y93qql1p5ggfnaqjjqhxcw0vqw95rlz0-hello-2.10
+   *> ciao=bar
+   *>
+   *> [baz]
+   *> also, integers=42
+   *>
+   *
+   * The mk* configuration attributes can generically change
+   * the way sections and key-value strings are generated.
+   *
+   * Order of the sections and of keys is preserved,
+   * duplicate keys are allowed.
+   */
+  toINI =
+    {
+      # apply transformations (e.g. escapes) to section names
+      mkSectionName ? (name: lib.strings.escape [ "[" "]" ] name)
+    , # format a setting line from key and value
+      mkKeyValue ? lib.generators.mkKeyValueDefault { } "="
+    ,
+    }: { globalSection, sections }:
+    let
+      mkSection = sectName: sectValues: ''
+        [${mkSectionName sectName}]
+      '' + toKeyValue { inherit mkKeyValue; } sectValues;
+      # map input to ini sections
+      mkSections = lib.strings.concatMapStringsSep "\n"
+        ({ name, value }: mkSection name value)
+        sections;
+      mkGlobalSection =
+        if globalSection == [ ]
+        then ""
+        else toKeyValue { inherit mkKeyValue; } globalSection
+          + "\n";
+    in
+    mkGlobalSection
+    + mkSections;
+
+  /* Generate a name-value-style config file from a list.
+   *
+   * mkKeyValue is the same as in toINI.
+   */
+  toKeyValue =
+    { mkKeyValue ? lib.generators.mkKeyValueDefault { } "="
+    ,
+    }:
+    let
+      mkLine = k: v: mkKeyValue k v + "\n";
+      mkLines = k: v: [ (mkLine k v) ];
+    in
+    nameValues: lib.strings.concatStrings (lib.concatLists (map ({ name, value }: mkLines name value) nameValues));
+
+in
+toINI
diff --git a/users/Profpatsch/tree-sitter.nix b/users/Profpatsch/tree-sitter.nix
index 1e3f378019..2224da2a3b 100644
--- a/users/Profpatsch/tree-sitter.nix
+++ b/users/Profpatsch/tree-sitter.nix
@@ -2,17 +2,18 @@
 
 let
   bins = depot.nix.getBins pkgs.coreutils [ "head" "printf" "cat" ]
-      // depot.nix.getBins pkgs.ncurses [ "tput" ]
-      // depot.nix.getBins pkgs.bc [ "bc" ]
-      // depot.nix.getBins pkgs.ocamlPackages.sexp [ "sexp" ];
-
-  print-ast = depot.nix.writers.rustSimple {
-    name = "print-ast";
-    dependencies = with depot.third_party.rust-crates; [
-      libloading
-      tree-sitter
-    ];
-  } ''
+    // depot.nix.getBins pkgs.ncurses [ "tput" ]
+    // depot.nix.getBins pkgs.bc [ "bc" ]
+    // depot.nix.getBins pkgs.ocamlPackages.sexp [ "sexp" ];
+
+  print-ast = depot.nix.writers.rustSimple
+    {
+      name = "print-ast";
+      dependencies = with depot.third_party.rust-crates; [
+        libloading
+        tree-sitter
+      ];
+    } ''
     extern crate libloading;
     extern crate tree_sitter;
     use std::mem;
@@ -58,13 +59,14 @@ let
     };
   };
 
-  watch-file-modified = depot.nix.writers.rustSimple {
-    name = "watch-file-modified";
-    dependencies = [
-      depot.third_party.rust-crates.inotify
-      depot.users.Profpatsch.netstring.rust-netstring
-    ];
-  } ''
+  watch-file-modified = depot.nix.writers.rustSimple
+    {
+      name = "watch-file-modified";
+      dependencies = [
+        depot.third_party.rust-crates.inotify
+        depot.users.Profpatsch.netstring.rust-netstring
+      ];
+    } ''
     extern crate inotify;
     extern crate netstring;
     use inotify::{EventMask, WatchMask, Inotify};
@@ -101,75 +103,103 @@ let
   '';
 
   # clear screen and set LINES and COLUMNS to terminal height & width
-  clear-screen = depot.nix.writeExecline "clear-screen" {} [
-    "if" [ bins.tput "clear" ]
-    "backtick" "-in" "LINES" [ bins.tput "lines" ]
-    "backtick" "-in" "COLUMNS" [ bins.tput "cols" ]
+  clear-screen = depot.nix.writeExecline "clear-screen" { } [
+    "if"
+    [ bins.tput "clear" ]
+    "backtick"
+    "-in"
+    "LINES"
+    [ bins.tput "lines" ]
+    "backtick"
+    "-in"
+    "COLUMNS"
+    [ bins.tput "cols" ]
     "$@"
   ];
 
   print-nix-file = depot.nix.writeExecline "print-nix-file" { readNArgs = 1; } [
-    "pipeline" [ print-ast "${tree-sitter-nix}/parser" "tree_sitter_nix" "$1" ]
-    "pipeline" [ bins.sexp "print" ]
+    "pipeline"
+    [ print-ast "${tree-sitter-nix}/parser" "tree_sitter_nix" "$1" ]
+    "pipeline"
+    [ bins.sexp "print" ]
     clear-screen
-    "importas" "-ui" "lines" "LINES"
-    "backtick" "-in" "ls" [
+    "importas"
+    "-ui"
+    "lines"
+    "LINES"
+    "backtick"
+    "-in"
+    "ls"
+    [
       "pipeline"
-        # when you pull out bc to decrement an integer it’s time to switch to python lol
-        [ bins.printf "x=%s; --x\n" "$lines" ]
-        bins.bc
+      # when you pull out bc to decrement an integer it’s time to switch to python lol
+      [ bins.printf "x=%s; --x\n" "$lines" ]
+      bins.bc
     ]
-    "importas" "-ui" "l" "ls"
-    bins.head "-n\${l}"
+    "importas"
+    "-ui"
+    "l"
+    "ls"
+    bins.head
+    "-n\${l}"
   ];
 
   print-nix-file-on-update = depot.nix.writeExecline "print-nix-file-on-update" { readNArgs = 1; } [
-    "if" [ print-nix-file "$1" ]
-    "pipeline" [ watch-file-modified "$1" ]
-    "forstdin" "-d" "" "file"
-    "importas" "file" "file"
-    print-nix-file "$file"
+    "if"
+    [ print-nix-file "$1" ]
+    "pipeline"
+    [ watch-file-modified "$1" ]
+    "forstdin"
+    "-d"
+    ""
+    "file"
+    "importas"
+    "file"
+    "file"
+    print-nix-file
+    "$file"
   ];
 
   # copied from nixpkgs
   buildTreeSitterGrammar =
-      {
-        # language name
-        language
-        # source for the language grammar
-      , source
-      }:
-
-      pkgs.stdenv.mkDerivation {
-
-        pname = "${language}-grammar";
-        inherit (pkgs.tree-sitter) version;
-
-        src = source;
-
-        buildInputs = [ pkgs.tree-sitter ];
-
-        dontUnpack = true;
-        configurePhase= ":";
-        buildPhase = ''
-          runHook preBuild
-          scanner_cc="$src/src/scanner.cc"
-          if [ ! -f "$scanner_cc" ]; then
-            scanner_cc=""
-          fi
-          $CXX -I$src/src/ -c $scanner_cc
-          $CC -I$src/src/ -shared -o parser -Os  scanner.o $src/src/parser.c -lstdc++
-          runHook postBuild
-        '';
-        installPhase = ''
-          runHook preInstall
-          mkdir $out
-          mv parser $out/
-          runHook postInstall
-        '';
-      };
-
-in depot.nix.utils.drvTargets {
+    {
+      # language name
+      language
+      # source for the language grammar
+    , source
+    }:
+
+    pkgs.stdenv.mkDerivation {
+
+      pname = "${language}-grammar";
+      inherit (pkgs.tree-sitter) version;
+
+      src = source;
+
+      buildInputs = [ pkgs.tree-sitter ];
+
+      dontUnpack = true;
+      configurePhase = ":";
+      buildPhase = ''
+        runHook preBuild
+        scanner_cc="$src/src/scanner.cc"
+        if [ ! -f "$scanner_cc" ]; then
+          scanner_cc=""
+        fi
+        $CXX -I$src/src/ -c $scanner_cc
+        $CC -I$src/src/ -shared -o parser -Os  scanner.o $src/src/parser.c -lstdc++
+        runHook postBuild
+      '';
+      installPhase = ''
+        runHook preInstall
+        mkdir $out
+        mv parser $out/
+        runHook postInstall
+      '';
+    };
+
+in
+depot.nix.readTree.drvTargets {
   inherit
     print-ast
     tree-sitter-nix
diff --git a/users/Profpatsch/whatcd-resolver/Main.hs b/users/Profpatsch/whatcd-resolver/Main.hs
new file mode 100644
index 0000000000..21cd80cbf0
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/Main.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import WhatcdResolver qualified
+
+main :: IO ()
+main = WhatcdResolver.main
diff --git a/users/Profpatsch/whatcd-resolver/README.md b/users/Profpatsch/whatcd-resolver/README.md
new file mode 100644
index 0000000000..d1902e546a
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/README.md
@@ -0,0 +1,21 @@
+# whatcd-resolver
+
+To run:
+
+```
+ninja run-services
+```
+
+in one terminal (starts the background tasks)
+
+```
+ninja run
+```
+
+to start the server. It runs on `9092`.
+
+You need to be in the `nix-shell` in `./..`.
+
+You need to set the `pass` key `internet/redacted/api-keys/whatcd-resolver` to an API key for RED.
+
+You need to have a transmission-rpc-daemon listening on port `9091` (no auth, try ssh port forwarding lol).
diff --git a/users/Profpatsch/whatcd-resolver/build.ninja b/users/Profpatsch/whatcd-resolver/build.ninja
new file mode 100644
index 0000000000..ff6ba8df04
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/build.ninja
@@ -0,0 +1,20 @@
+
+builddir = .ninja
+
+outdir = ./output
+
+rule run-services
+  command = s6-svscan ./services
+
+rule run
+  command = execlineb -c '$
+    importas -i DEPOT_ROOT DEPOT_ROOT $
+    importas -i PROFPATSCH_ROOT PROFPATSCH_ROOT cd $$PROFPATSCH_ROOT $
+    nix-run { $$DEPOT_ROOT -A users.Profpatsch.shortcuttable } cabal repl whatcd-resolver/ --repl-options "-e main" $
+    '
+
+build run-services: run-services
+  pool = console
+
+build run: run
+  pool = console
diff --git a/users/Profpatsch/whatcd-resolver/default.nix b/users/Profpatsch/whatcd-resolver/default.nix
new file mode 100644
index 0000000000..27468507ac
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/default.nix
@@ -0,0 +1,76 @@
+{ depot, pkgs, lib, ... }:
+
+let
+  #   bins = depot.nix.getBins pkgs.sqlite ["sqlite3"];
+
+  whatcd-resolver = pkgs.haskellPackages.mkDerivation {
+    pname = "whatcd-resolver";
+    version = "0.1.0";
+
+    src = depot.users.Profpatsch.exactSource ./. [
+      ./whatcd-resolver.cabal
+      ./Main.hs
+      ./src/WhatcdResolver.hs
+      ./src/AppT.hs
+      ./src/JsonLd.hs
+      ./src/Optional.hs
+      ./src/Html.hs
+      ./src/Http.hs
+      ./src/Transmission.hs
+      ./src/Redacted.hs
+    ];
+
+    libraryHaskellDepends = [
+      depot.users.Profpatsch.my-prelude
+      depot.users.Profpatsch.my-webstuff
+      pkgs.haskellPackages.pa-prelude
+      pkgs.haskellPackages.pa-label
+      pkgs.haskellPackages.pa-json
+      pkgs.haskellPackages.pa-error-tree
+      pkgs.haskellPackages.pa-field-parser
+      pkgs.haskellPackages.pa-run-command
+      pkgs.haskellPackages.aeson-better-errors
+      pkgs.haskellPackages.blaze-html
+      pkgs.haskellPackages.hs-opentelemetry-sdk
+      pkgs.haskellPackages.http-conduit
+      pkgs.haskellPackages.http-types
+      pkgs.haskellPackages.ihp-hsx
+      pkgs.haskellPackages.monad-logger
+      pkgs.haskellPackages.resource-pool
+      pkgs.haskellPackages.postgresql-simple
+      pkgs.haskellPackages.tmp-postgres
+      pkgs.haskellPackages.unliftio
+      pkgs.haskellPackages.wai-extra
+      pkgs.haskellPackages.warp
+      pkgs.haskellPackages.punycode
+    ];
+
+    isExecutable = true;
+    isLibrary = false;
+    license = lib.licenses.mit;
+  };
+
+  bins = depot.nix.getBins whatcd-resolver [ "whatcd-resolver" ];
+
+in
+
+depot.nix.writeExecline "whatcd-resolver-wrapped" { } [
+  "importas"
+  "-i"
+  "PATH"
+  "PATH"
+  "export"
+  "PATH"
+  # TODO: figure out how to automatically migrate to a new postgres version with tmp_postgres (dump?)
+  "${pkgs.postgresql_14}/bin:$${PATH}"
+  "export"
+  "WHATCD_RESOLVER_TOOLS"
+  (pkgs.linkFarm "whatcd-resolver-tools" [
+    {
+      name = "pg_format";
+      path = "${pkgs.pgformatter}/bin/pg_format";
+    }
+  ])
+  bins.whatcd-resolver
+]
+
diff --git a/users/Profpatsch/whatcd-resolver/notes.org b/users/Profpatsch/whatcd-resolver/notes.org
new file mode 100644
index 0000000000..24662c0f32
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/notes.org
@@ -0,0 +1,48 @@
+* The Glorious what.cd¹ Resolver
+
+  ¹: At the time of writing, what.cd didn’t even exist anymore
+
+** Idea
+   
+   Stream your music (or media) from a private tracker transparently.
+   “Spotify for torrents”
+
+** Technical
+
+   You need to have a seedbox, which runs a server program.
+   The server manages queries, downloads torrents and requested files, and
+   provides http streams to the downloaded files (while caching them for
+   seeding).
+
+   Clients then use the API to search for music (e.g. query for artists or
+   tracks) and get back the promise of a stream to the resolved file (a bit how
+   resolvers in the Tomahawk Player work)
+
+*** The Server
+
+**** Resolving queries
+
+     ~resolve :: Query -> IO Identifiers~
+
+     A query is a search input for content (could be an artist or a movie name
+     or something)
+
+     There have to be multiple providers, depending on the site used
+     (e.g. one for Gazelle trackers, one for Piratebay) and some intermediate
+     structure (e.g. for going through Musicbrainz first).
+
+     Output is a unique identifier for a fetchable resource; this could be a
+     link to a torrent combined with a file/directory in said torrent.
+
+**** Fetching Identifiers
+
+     ~fetch :: Identifier -> IO (Promise Stream)~
+
+     Takes an Identifier (which should provide all information on how to grab
+     the media file and returns a stream to the media file once it’s ready.
+     
+     For torrents, this probably consists of telling the torrent
+     library/application to fetch a certain torrent and start downloading the
+     required files in it. The torrent fetcher would also need to do seeding and
+     space management, since one usually has to keep a ratio and hard drive
+     space is not unlimited.
diff --git a/users/Profpatsch/whatcd-resolver/server-notes.org b/users/Profpatsch/whatcd-resolver/server-notes.org
new file mode 100644
index 0000000000..cb990aba3d
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/server-notes.org
@@ -0,0 +1,2 @@
+* whatcd-resolver-server
+
diff --git a/users/Profpatsch/whatcd-resolver/services/.gitignore b/users/Profpatsch/whatcd-resolver/services/.gitignore
new file mode 100644
index 0000000000..5cdb254e8c
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/services/.gitignore
@@ -0,0 +1,3 @@
+/.s6-svscan/
+/**/event/
+/**/supervise/
diff --git a/users/Profpatsch/whatcd-resolver/services/jaeger/run b/users/Profpatsch/whatcd-resolver/services/jaeger/run
new file mode 100755
index 0000000000..41332f8bb6
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/services/jaeger/run
@@ -0,0 +1,3 @@
+#!/usr/bin/env execlineb
+importas -i DEPOT_ROOT DEPOT_ROOT
+nix-run { $DEPOT_ROOT -A users.Profpatsch.jaeger -kK --builders '' }
diff --git a/users/Profpatsch/whatcd-resolver/services/reverse-proxy/run b/users/Profpatsch/whatcd-resolver/services/reverse-proxy/run
new file mode 100755
index 0000000000..7081b35f5a
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/services/reverse-proxy/run
@@ -0,0 +1,2 @@
+#!/usr/bin/env execlineb
+caddy reverse-proxy --from :9092 --to :9093
diff --git a/users/Profpatsch/whatcd-resolver/src/AppT.hs b/users/Profpatsch/whatcd-resolver/src/AppT.hs
new file mode 100644
index 0000000000..7afd430745
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/src/AppT.hs
@@ -0,0 +1,151 @@
+{-# LANGUAGE DeriveAnyClass #-}
+
+module AppT where
+
+import Control.Monad.Logger qualified as Logger
+import Control.Monad.Logger.CallStack
+import Control.Monad.Reader
+import Data.Error.Tree
+import Data.HashMap.Strict (HashMap)
+import Data.HashMap.Strict qualified as HashMap
+import Data.Pool (Pool)
+import Data.Text qualified as Text
+import Database.PostgreSQL.Simple qualified as Postgres
+import GHC.Stack qualified
+import Label
+import OpenTelemetry.Trace qualified as Otel hiding (getTracer, inSpan, inSpan')
+import OpenTelemetry.Trace.Core qualified as Otel hiding (inSpan, inSpan')
+import OpenTelemetry.Trace.Monad qualified as Otel
+import PossehlAnalyticsPrelude
+import Postgres.MonadPostgres
+import System.IO qualified as IO
+import Tool (Tool)
+import UnliftIO
+import Prelude hiding (span)
+
+data Context = Context
+  { config :: Label "logDatabaseQueries" DebugLogDatabaseQueries,
+    tracer :: Otel.Tracer,
+    pgFormat :: Tool,
+    pgConnPool :: Pool Postgres.Connection,
+    transmissionSessionId :: MVar ByteString
+  }
+
+newtype AppT m a = AppT {unAppT :: ReaderT Context m a}
+  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadUnliftIO, MonadThrow)
+
+data AppException = AppException Text
+  deriving stock (Show)
+  deriving anyclass (Exception)
+
+-- *  Logging & Opentelemetry
+
+instance (MonadIO m) => MonadLogger (AppT m) where
+  monadLoggerLog loc src lvl msg = liftIO $ Logger.defaultOutput IO.stderr loc src lvl (Logger.toLogStr msg)
+
+instance (Monad m) => Otel.MonadTracer (AppT m) where
+  getTracer = AppT $ asks (.tracer)
+
+class (MonadUnliftIO m, Otel.MonadTracer m) => MonadOtel m
+
+instance (MonadUnliftIO m) => MonadOtel (AppT m)
+
+instance (MonadOtel m) => MonadOtel (Transaction m)
+
+inSpan :: (MonadOtel m) => Text -> m a -> m a
+inSpan name = Otel.inSpan name Otel.defaultSpanArguments
+
+inSpan' :: (MonadOtel m) => Text -> (Otel.Span -> m a) -> m a
+inSpan' name = Otel.inSpan' name Otel.defaultSpanArguments
+
+-- | Add the attribute to the span, prefixing it with the `_` namespace (to easier distinguish our application’s tags from standard tags)
+addAttribute :: (MonadIO m, Otel.ToAttribute a) => Otel.Span -> Text -> a -> m ()
+addAttribute span key a = Otel.addAttribute span ("_." <> key) a
+
+-- | Add the attributes to the span, prefixing each key with the `_` namespace (to easier distinguish our application’s tags from standard tags)
+addAttributes :: (MonadIO m) => Otel.Span -> HashMap Text Otel.Attribute -> m ()
+addAttributes span attrs = Otel.addAttributes span $ attrs & HashMap.mapKeys ("_." <>)
+
+appThrowTreeNewSpan :: (MonadThrow m, MonadOtel m) => Text -> ErrorTree -> m a
+appThrowTreeNewSpan spanName exc = inSpan' spanName $ \span -> do
+  let msg = prettyErrorTree exc
+  recordException
+    span
+    ( T2
+        (label @"type_" "AppException")
+        (label @"message" msg)
+    )
+  throwM $ AppException msg
+
+appThrowTree :: (MonadThrow m, MonadIO m) => Otel.Span -> ErrorTree -> m a
+appThrowTree span exc = do
+  let msg = prettyErrorTree exc
+  recordException
+    span
+    ( T2
+        (label @"type_" "AppException")
+        (label @"message" msg)
+    )
+  throwM $ AppException msg
+
+orAppThrowTree :: (MonadThrow m, MonadIO m) => Otel.Span -> Either ErrorTree a -> m a
+orAppThrowTree span = \case
+  Left err -> appThrowTree span err
+  Right a -> pure a
+
+assertM :: (MonadThrow f, MonadIO f) => Otel.Span -> (t -> Either ErrorTree a) -> t -> f a
+assertM span f v = case f v of
+  Right a -> pure a
+  Left err -> appThrowTree span err
+
+assertMNewSpan :: (MonadThrow f, MonadOtel f) => Text -> (t -> Either ErrorTree a) -> t -> f a
+assertMNewSpan spanName f v = case f v of
+  Right a -> pure a
+  Left err -> appThrowTreeNewSpan spanName err
+
+-- | A specialized variant of @addEvent@ that records attributes conforming to
+-- the OpenTelemetry specification's
+-- <https://github.com/open-telemetry/opentelemetry-specification/blob/49c2f56f3c0468ceb2b69518bcadadd96e0a5a8b/specification/trace/semantic_conventions/exceptions.md semantic conventions>
+--
+-- @since 0.0.1.0
+recordException ::
+  ( MonadIO m,
+    HasField "message" r Text,
+    HasField "type_" r Text
+  ) =>
+  Otel.Span ->
+  r ->
+  m ()
+recordException span dat = liftIO $ do
+  callStack <- GHC.Stack.whoCreated dat.message
+  newEventTimestamp <- Just <$> Otel.getTimestamp
+  Otel.addEvent span $
+    Otel.NewEvent
+      { newEventName = "exception",
+        newEventAttributes =
+          HashMap.fromList
+            [ ("exception.type", Otel.toAttribute @Text dat.type_),
+              ("exception.message", Otel.toAttribute @Text dat.message),
+              ("exception.stacktrace", Otel.toAttribute @Text $ Text.unlines $ map stringToText callStack)
+            ],
+        ..
+      }
+
+-- * Postgres
+
+instance (MonadThrow m, MonadUnliftIO m) => MonadPostgres (AppT m) where
+  execute = executeImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries))
+  executeMany = executeManyImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries))
+  executeManyReturningWith = executeManyReturningWithImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries))
+  queryWith = queryWithImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries))
+  queryWith_ = queryWithImpl_ (AppT ask)
+
+  foldRowsWithAcc = foldRowsWithAccImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries))
+  runTransaction = runPGTransaction
+
+runPGTransaction :: (MonadUnliftIO m) => Transaction (AppT m) a -> AppT m a
+runPGTransaction (Transaction transaction) = do
+  pool <- AppT ask <&> (.pgConnPool)
+  withRunInIO $ \unliftIO ->
+    withPGTransaction pool $ \conn -> do
+      unliftIO $ runReaderT transaction conn
diff --git a/users/Profpatsch/whatcd-resolver/src/Html.hs b/users/Profpatsch/whatcd-resolver/src/Html.hs
new file mode 100644
index 0000000000..49b87b23dc
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/src/Html.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Html where
+
+import Data.Aeson qualified as Json
+import Data.Aeson.KeyMap qualified as KeyMap
+import Data.List.NonEmpty qualified as NonEmpty
+import Data.Map.Strict qualified as Map
+import IHP.HSX.QQ (hsx)
+import PossehlAnalyticsPrelude
+import Text.Blaze.Html (Html)
+import Text.Blaze.Html5 qualified as Html
+import Prelude hiding (span)
+
+-- | Render an arbitrary json value to HTML in a more-or-less reasonable fashion.
+mkVal :: Json.Value -> Html
+mkVal = \case
+  Json.Number n -> Html.toHtml @Text $ showToText n
+  Json.String s -> Html.toHtml @Text s
+  Json.Bool True -> [hsx|<em>true</em>|]
+  Json.Bool False -> [hsx|<em>false</em>|]
+  Json.Null -> [hsx|<em>null</em>|]
+  Json.Array arr -> toOrderedList mkVal arr
+  Json.Object obj ->
+    obj
+      & KeyMap.toMapText
+      & toDefinitionList (Html.toHtml @Text) mkVal
+
+toOrderedList :: (Foldable t1) => (t2 -> Html) -> t1 t2 -> Html
+toOrderedList mkValFn arr =
+  arr
+    & foldMap (\el -> Html.li $ mkValFn el)
+    & Html.ol
+
+toUnorderedList :: (Foldable t1) => (t2 -> Html) -> t1 t2 -> Html
+toUnorderedList mkValFn arr =
+  arr
+    & foldMap (\el -> Html.li $ mkValFn el)
+    & Html.ul
+
+-- | Render a definition list from a Map
+toDefinitionList :: (Text -> Html) -> (t -> Html) -> Map Text t -> Html
+toDefinitionList mkKeyFn mkValFn obj =
+  obj
+    & Map.toList
+    & foldMap (\(k, v) -> Html.dt (mkKeyFn k) <> Html.dd (mkValFn v))
+    & Html.dl
+
+-- | Render a table-like structure of json values as an HTML table.
+toTable :: [[(Text, Json.Value)]] -> Html
+toTable xs =
+  case xs & nonEmpty of
+    Nothing ->
+      [hsx|<p>No results.</p>|]
+    Just xs' -> do
+      let headers = xs' & NonEmpty.head <&> fst <&> (\h -> [hsx|<th>{h}</th>|]) & mconcat
+      let vals = xs' & foldMap (Html.tr . foldMap (Html.td . mkVal . snd))
+      [hsx|
+              <table class="table">
+                <thead>
+                  <tr>
+                  {headers}
+                  </tr>
+                </thead>
+                <tbody>
+                  {vals}
+                </tbody>
+              </table>
+          |]
diff --git a/users/Profpatsch/whatcd-resolver/src/Http.hs b/users/Profpatsch/whatcd-resolver/src/Http.hs
new file mode 100644
index 0000000000..4fdbb306ad
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/src/Http.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Http
+  ( doRequestJson,
+    RequestOptions (..),
+    mkRequestOptions,
+    setRequestMethod,
+    setRequestBodyLBS,
+    setRequestHeader,
+    getResponseStatus,
+    getResponseHeader,
+    getResponseBody,
+  )
+where
+
+import AppT
+import Data.CaseInsensitive (CI (original))
+import Data.Char qualified as Char
+import Data.Int (Int64)
+import Data.List qualified as List
+import Data.Text qualified as Text
+import Data.Text.Lazy qualified as Lazy.Text
+import Data.Text.Punycode qualified as Punycode
+import Json.Enc qualified as Enc
+import MyPrelude
+import Network.HTTP.Client
+import Network.HTTP.Simple
+import OpenTelemetry.Attributes qualified as Otel
+import Optional
+import Prelude hiding (span)
+
+data RequestOptions = RequestOptions
+  { method :: ByteString,
+    host :: Text,
+    port :: Optional Int,
+    path :: Optional [Text],
+    headers :: Optional [Header],
+    usePlainHttp :: Optional Bool
+  }
+
+mkRequestOptions :: (HasField "method" r ByteString, HasField "host" r Text) => r -> RequestOptions
+mkRequestOptions opts =
+  RequestOptions
+    { method = opts.method,
+      port = defaults,
+      host = opts.host,
+      path = defaults,
+      headers = defaults,
+      usePlainHttp = defaults
+    }
+
+doRequestJson ::
+  (MonadOtel m) =>
+  RequestOptions ->
+  Enc.Enc ->
+  m (Response ByteString)
+doRequestJson opts val = inSpan' "HTTP Request (JSON)" $ \span -> do
+  let x = requestToXhCommandLine opts val
+  let attrs = [100, 200 .. fromIntegral @Int @Int64 (x & Text.length)]
+  for_ attrs $ \n -> do
+    addAttribute span [fmt|request.xh.{n}|] (Lazy.Text.repeat 'x' & Lazy.Text.take n & toStrict & Otel.TextAttribute)
+  addAttribute span "request.xh" (requestToXhCommandLine opts val)
+  defaultRequest {secure = not (opts & optsUsePlainHttp)}
+    & setRequestHost (opts & optsHost)
+    & setRequestPort (opts & optsPort)
+    -- TODO: is this automatically escaped by the library?
+    & setRequestPath (opts & optsPath)
+    & setRequestHeaders (opts & optsHeaders)
+    & setRequestMethod opts.method
+    & setRequestBodyLBS (Enc.encToBytesUtf8Lazy val)
+    & httpBS
+
+optsHost :: RequestOptions -> ByteString
+optsHost opts =
+  if opts.host & Text.isAscii
+    then opts.host & textToBytesUtf8
+    else opts.host & Punycode.encode
+
+optsUsePlainHttp :: RequestOptions -> Bool
+optsUsePlainHttp opts = opts.usePlainHttp.withDefault False
+
+optsPort :: RequestOptions -> Int
+optsPort opts = opts.port.withDefault (if opts & optsUsePlainHttp then 80 else 443)
+
+optsPath :: RequestOptions -> ByteString
+optsPath opts = opts.path.withDefault [] & Text.intercalate "/" & ("/" <>) & textToBytesUtf8
+
+optsHeaders :: RequestOptions -> [Header]
+optsHeaders opts = opts.headers.withDefault []
+
+-- | Create a string that can be pasted on the command line to invoke the same HTTP request via the `xh` tool (curl but nicer syntax)
+requestToXhCommandLine :: RequestOptions -> Enc.Enc -> Text
+requestToXhCommandLine opts val = do
+  let protocol = if opts & optsUsePlainHttp then "http" :: Text else "https"
+  let url = [fmt|{protocol}://{opts & optsHost}:{opts & optsPort}{opts & optsPath}|]
+  let headers = opts & optsHeaders <&> \(hdr, v) -> hdr.original <> ":" <> v
+
+  prettyArgsForBash $
+    mconcat
+      [ ["xh", url],
+        headers <&> bytesToTextUtf8Lenient,
+        ["--raw"],
+        [val & Enc.encToBytesUtf8 & bytesToTextUtf8Lenient]
+      ]
+
+-- | Pretty print a command line in a way that can be copied to bash.
+prettyArgsForBash :: [Text] -> Text
+prettyArgsForBash = Text.intercalate " " . map simpleBashEscape
+
+-- | Simple escaping for bash words. If they contain anything that’s not ascii chars
+-- and a bunch of often-used special characters, put the word in single quotes.
+simpleBashEscape :: Text -> Text
+simpleBashEscape t = do
+  case Text.find (not . isSimple) t of
+    Just _ -> escapeSingleQuote t
+    Nothing -> t
+  where
+    -- any word that is just ascii characters is simple (no spaces or control characters)
+    -- or contains a few often-used characters like - or .
+    isSimple c =
+      Char.isAsciiLower c
+        || Char.isAsciiUpper c
+        || Char.isDigit c
+        -- These are benign, bash will not interpret them as special characters.
+        || List.elem c ['-', '.', ':', '/']
+    -- Put the word in single quotes
+    -- If there is a single quote in the word,
+    -- close the single quoted word, add a single quote, open the word again
+    escapeSingleQuote t' = "'" <> Text.replace "'" "'\\''" t' <> "'"
diff --git a/users/Profpatsch/whatcd-resolver/src/JsonLd.hs b/users/Profpatsch/whatcd-resolver/src/JsonLd.hs
new file mode 100644
index 0000000000..16b1ab991b
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/src/JsonLd.hs
@@ -0,0 +1,138 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module JsonLd where
+
+import AppT
+import Control.Monad.Reader
+import Data.Aeson qualified as Json
+import Data.Aeson.BetterErrors qualified as Json
+import Data.ByteString.Builder qualified as Builder
+import Data.List qualified as List
+import Data.Map.Strict qualified as Map
+import Data.Set (Set)
+import Data.Set qualified as Set
+import Html qualified
+import IHP.HSX.QQ (hsx)
+import Json qualified
+import Label
+import MyPrelude
+import Network.HTTP.Client.Conduit qualified as Http
+import Network.HTTP.Simple qualified as Http
+import Network.HTTP.Types.URI qualified as Url
+import Network.URI (URI)
+import Optional
+import Redacted
+import Text.Blaze.Html (Html)
+import Prelude hiding (span)
+
+-- | A recursive `json+ld` structure.
+data Jsonld
+  = JsonldObject JsonldObject
+  | JsonldAnonymousObject JsonldAnonymousObject
+  | JsonldArray [Jsonld]
+  | JsonldField Json.Value
+  deriving stock (Show, Eq)
+
+-- | A json+ld object, that is something which can be further expanded by following the URL in its `id_` field.
+data JsonldObject = JsonldObject'
+  { -- | `@type` field; currently just the plain value without taking into account the json+ld context
+    type_ :: Set Text,
+    -- | `@id` field, usually a link to follow for expanding the object to its full glory
+    id_ :: Text,
+    -- | any fields of this object that remote deemed important enough to already pre-emptively include in the object; to get all fields resolve the URL in `id_`.
+    previewFields :: Map Text Jsonld
+  }
+  deriving stock (Show, Eq)
+
+-- | A json+ld object that cannot be inspected further by resolving its ID
+data JsonldAnonymousObject = JsonldAnonymousObject'
+  { -- | `@type` field; currently just the plain value without taking into account the json+ld context
+    type_ :: Set Text,
+    -- | fields of this anonymous object
+    fields :: Map Text Jsonld
+  }
+  deriving stock (Show, Eq)
+
+jsonldParser :: (Monad m) => Json.ParseT err m Jsonld
+jsonldParser =
+  Json.asValue >>= \cur -> do
+    if
+      | Json.Object _ <- cur -> do
+          type_ <-
+            Json.keyMay "@type" (Json.asArraySet Json.asText Json.<|> (Set.singleton <$> Json.asText))
+              <&> fromMaybe Set.empty
+          idMay <- Json.keyMay "@id" $ Json.asText
+          fields <-
+            Json.asObjectMap jsonldParser
+              <&> Map.delete "@type"
+              <&> Map.delete "@id"
+
+          if
+            | Just id_ <- idMay -> do
+                pure $ JsonldObject $ JsonldObject' {previewFields = fields, ..}
+            | otherwise -> pure $ JsonldAnonymousObject $ JsonldAnonymousObject' {..}
+      | Json.Array _ <- cur -> do
+          JsonldArray <$> Json.eachInArray jsonldParser
+      | otherwise -> pure $ JsonldField cur
+
+renderJsonld :: Jsonld -> Html
+renderJsonld = \case
+  JsonldObject obj -> renderObject obj (Just obj.id_) obj.previewFields
+  JsonldAnonymousObject obj -> renderObject obj Nothing obj.fields
+  JsonldArray arr ->
+    Html.toOrderedList renderJsonld arr
+  JsonldField f -> Html.mkVal f
+  where
+    renderObject obj mId_ fields = do
+      let id_ =
+            mId_ <&> \i ->
+              [hsx|
+                  <dt>Url</dt>
+                  <dd><a href={i}>{i}</a></dd>
+                  |]
+          getMoreButton =
+            mId_ <&> \i ->
+              [hsx|
+              <div>
+                <button
+                  hx-get={snippetHref i}
+                  hx-target="closest dl"
+                  hx-swap="outerHTML"
+                >more fields …</button>
+              </div>
+            |]
+      [hsx|
+      <dl>
+        <dt>Type</dt>
+        <dd>{obj.type_ & toList & schemaTypes}</dd>
+        {id_}
+        <dt>Fields</dt>
+        <dd>
+          {fields & Html.toDefinitionList schemaType renderJsonld}
+          {getMoreButton}
+        </dd>
+      </dl>
+    |]
+    snippetHref target =
+      Builder.toLazyByteString $
+        "/snips/jsonld/render"
+          <> Url.renderQueryBuilder True [("target", Just (textToBytesUtf8 target))]
+
+    schemaTypes xs =
+      xs
+        <&> schemaType
+        & List.intersperse ", "
+        & mconcat
+    schemaType t =
+      let href :: Text = [fmt|https://schema.org/{t}|] in [hsx|<a href={href} target="_blank">{t}</a>|]
+
+httpGetJsonLd :: (MonadThrow m, MonadOtel m) => (URI, Http.Request) -> m Jsonld
+httpGetJsonLd (uri, req) = inSpan' "Fetch json+ld" $ \span -> do
+  addAttribute span "json+ld.targetUrl" (uri & showToText)
+  httpJson
+    (mkOptional (label @"contentType" "application/ld+json"))
+    jsonldParser
+    ( req
+        & Http.setRequestMethod "GET"
+        & Http.setRequestHeader "Accept" ["application/ld+json"]
+    )
diff --git a/users/Profpatsch/whatcd-resolver/src/Optional.hs b/users/Profpatsch/whatcd-resolver/src/Optional.hs
new file mode 100644
index 0000000000..9791c84970
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/src/Optional.hs
@@ -0,0 +1,18 @@
+module Optional where
+
+import GHC.Records (getField)
+import MyPrelude
+
+newtype Optional a = OptionalInternal (Maybe a)
+  deriving newtype (Functor)
+
+mkOptional :: a -> Optional a
+mkOptional defaultValue = OptionalInternal $ Just defaultValue
+
+defaults :: Optional a
+defaults = OptionalInternal Nothing
+
+instance HasField "withDefault" (Optional a) (a -> a) where
+  getField (OptionalInternal m) defaultValue = case m of
+    Nothing -> defaultValue
+    Just a -> a
diff --git a/users/Profpatsch/whatcd-resolver/src/Redacted.hs b/users/Profpatsch/whatcd-resolver/src/Redacted.hs
new file mode 100644
index 0000000000..4369c18408
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/src/Redacted.hs
@@ -0,0 +1,537 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Redacted where
+
+import AppT
+import Control.Monad.Logger.CallStack
+import Control.Monad.Reader
+import Data.Aeson qualified as Json
+import Data.Aeson.BetterErrors qualified as Json
+import Data.Aeson.KeyMap qualified as KeyMap
+import Data.Error.Tree
+import Data.List qualified as List
+import Database.PostgreSQL.Simple (Binary (Binary), Only (..))
+import Database.PostgreSQL.Simple.SqlQQ (sql)
+import Database.PostgreSQL.Simple.Types (PGArray (PGArray))
+import FieldParser qualified as Field
+import Json qualified
+import Label
+import MyPrelude
+import Network.HTTP.Client.Conduit qualified as Http
+import Network.HTTP.Simple qualified as Http
+import Network.HTTP.Types
+import Network.Wai.Parse qualified as Wai
+import OpenTelemetry.Trace qualified as Otel hiding (getTracer, inSpan, inSpan')
+import Optional
+import Postgres.Decoder qualified as Dec
+import Postgres.MonadPostgres
+import Pretty
+import RunCommand (runCommandExpect0)
+import Prelude hiding (span)
+
+redactedSearch ::
+  (MonadLogger m, MonadThrow m, MonadOtel m) =>
+  [(ByteString, ByteString)] ->
+  Json.Parse ErrorTree a ->
+  m a
+redactedSearch advanced parser =
+  inSpan "Redacted API Search" $
+    redactedApiRequestJson
+      ( T2
+          (label @"action" "browse")
+          (label @"actionArgs" ((advanced <&> second Just)))
+      )
+      parser
+
+redactedGetTorrentFile ::
+  ( MonadLogger m,
+    MonadThrow m,
+    HasField "torrentId" dat Int,
+    MonadOtel m
+  ) =>
+  dat ->
+  m ByteString
+redactedGetTorrentFile dat = inSpan' "Redacted Get Torrent File" $ \span -> do
+  req <-
+    mkRedactedApiRequest
+      ( T2
+          (label @"action" "download")
+          ( label @"actionArgs"
+              [ ("id", Just (dat.torrentId & showToText @Int & textToBytesUtf8))
+              -- try using tokens as long as we have them (TODO: what if there’s no tokens left?
+              -- ANSWER: it breaks:
+              -- responseBody = "{\"status\":\"failure\",\"error\":\"You do not have any freeleech tokens left. Please use the regular DL link.\"}",
+              -- ("usetoken", Just "1")
+              ]
+          )
+      )
+  httpTorrent span req
+
+-- fix
+--   ( \io -> do
+--       logInfo "delay"
+--       liftIO $ threadDelay 10_000_000
+--       io
+--   )
+
+exampleSearch :: (MonadThrow m, MonadLogger m, MonadPostgres m, MonadOtel m) => m (Transaction m ())
+exampleSearch = do
+  t1 <-
+    redactedSearchAndInsert
+      [ ("searchstr", "cherish"),
+        ("artistname", "kirinji"),
+        -- ("year", "1982"),
+        -- ("format", "MP3"),
+        -- ("releasetype", "album"),
+        ("order_by", "year")
+      ]
+  t3 <-
+    redactedSearchAndInsert
+      [ ("searchstr", "mouss et hakim"),
+        ("artistname", "mouss et hakim"),
+        -- ("year", "1982"),
+        -- ("format", "MP3"),
+        -- ("releasetype", "album"),
+        ("order_by", "year")
+      ]
+  t2 <-
+    redactedSearchAndInsert
+      [ ("searchstr", "thriller"),
+        ("artistname", "michael jackson"),
+        -- ("year", "1982"),
+        -- ("format", "MP3"),
+        -- ("releasetype", "album"),
+        ("order_by", "year")
+      ]
+  pure (t1 >> t2 >> t3)
+
+-- | Do the search, return a transaction that inserts all results from all pages of the search.
+redactedSearchAndInsert ::
+  forall m.
+  ( MonadLogger m,
+    MonadPostgres m,
+    MonadThrow m,
+    MonadOtel m
+  ) =>
+  [(ByteString, ByteString)] ->
+  m (Transaction m ())
+redactedSearchAndInsert extraArguments = do
+  logInfo [fmt|Doing redacted search with arguments: {showPretty extraArguments}|]
+  -- The first search returns the amount of pages, so we use that to query all results piece by piece.
+  firstPage <- go Nothing
+  let remainingPages = firstPage.pages - 1
+  logInfo [fmt|Got the first page, found {remainingPages} more pages|]
+  let otherPagesNum = [(2 :: Natural) .. remainingPages]
+  otherPages <- traverse go (Just <$> otherPagesNum)
+  pure $
+    (firstPage : otherPages)
+      & concatMap (.tourGroups)
+      & \case
+        IsNonEmpty tgs -> tgs & insertTourGroupsAndTorrents
+        IsEmpty -> pure ()
+  where
+    go mpage =
+      redactedSearch
+        ( extraArguments
+            -- pass the page (for every search but the first one)
+            <> (mpage & ifExists (\page -> ("page", (page :: Natural) & showToText & textToBytesUtf8)))
+        )
+        ( do
+            status <- Json.key "status" Json.asText
+            when (status /= "success") $ do
+              Json.throwCustomError [fmt|Status was not "success", but {status}|]
+            Json.key "response" $ do
+              pages <-
+                Json.keyMay "pages" (Field.toJsonParser (Field.mapError singleError $ Field.jsonNumber >>> Field.boundedScientificIntegral @Int "not an Integer" >>> Field.integralToNatural))
+                  -- in case the field is missing, let’s assume there is only one page
+                  <&> fromMaybe 1
+              Json.key "results" $ do
+                tourGroups <-
+                  label @"tourGroups"
+                    <$> ( Json.eachInArray $ do
+                            groupId <- Json.keyLabel @"groupId" "groupId" (Json.asIntegral @_ @Int)
+                            groupName <- Json.keyLabel @"groupName" "groupName" Json.asText
+                            fullJsonResult <-
+                              label @"fullJsonResult"
+                                <$> ( Json.asObject
+                                        -- remove torrents cause they are inserted separately below
+                                        <&> KeyMap.filterWithKey (\k _ -> k /= "torrents")
+                                        <&> Json.Object
+                                    )
+                            let tourGroup = T3 groupId groupName fullJsonResult
+                            torrents <- Json.keyLabel @"torrents" "torrents" $
+                              Json.eachInArray $ do
+                                torrentId <- Json.keyLabel @"torrentId" "torrentId" (Json.asIntegral @_ @Int)
+                                fullJsonResultT <- label @"fullJsonResult" <$> Json.asValue
+                                pure $ T2 torrentId fullJsonResultT
+                            pure (T2 (label @"tourGroup" tourGroup) torrents)
+                        )
+                pure
+                  ( T2
+                      (label @"pages" pages)
+                      tourGroups
+                  )
+        )
+    insertTourGroupsAndTorrents ::
+      NonEmpty
+        ( T2
+            "tourGroup"
+            (T3 "groupId" Int "groupName" Text "fullJsonResult" Json.Value)
+            "torrents"
+            [T2 "torrentId" Int "fullJsonResult" Json.Value]
+        ) ->
+      Transaction m ()
+    insertTourGroupsAndTorrents dat = do
+      let tourGroups = dat <&> (.tourGroup)
+      let torrents = dat <&> (.torrents)
+      insertTourGroups tourGroups
+        >>= ( \res ->
+                insertTorrents $
+                  zipT2 $
+                    T2
+                      (label @"torrentGroupIdPg" $ res <&> (.tourGroupIdPg))
+                      (label @"torrents" (torrents & toList))
+            )
+    insertTourGroups ::
+      NonEmpty
+        ( T3
+            "groupId"
+            Int
+            "groupName"
+            Text
+            "fullJsonResult"
+            Json.Value
+        ) ->
+      Transaction m [Label "tourGroupIdPg" Int]
+    insertTourGroups dats = do
+      let groupNames =
+            dats <&> \dat -> [fmt|{dat.groupId}: {dat.groupName}|]
+      logInfo [fmt|Inserting tour groups for {showPretty groupNames}|]
+      _ <-
+        execute
+          [fmt|
+                  DELETE FROM redacted.torrent_groups
+                  WHERE group_id = ANY (?::integer[])
+              |]
+          (Only $ (dats <&> (.groupId) & toList & PGArray :: PGArray Int))
+      executeManyReturningWith
+        [fmt|
+              INSERT INTO redacted.torrent_groups (
+                group_id, group_name, full_json_result
+              ) VALUES
+              ( ?, ? , ? )
+              ON CONFLICT (group_id) DO UPDATE SET
+                group_id = excluded.group_id,
+                group_name = excluded.group_name,
+                full_json_result = excluded.full_json_result
+              RETURNING (id)
+            |]
+        ( dats <&> \dat ->
+            ( dat.groupId,
+              dat.groupName,
+              dat.fullJsonResult
+            )
+        )
+        (label @"tourGroupIdPg" <$> Dec.fromField @Int)
+
+    insertTorrents ::
+      [ T2
+          "torrentGroupIdPg"
+          Int
+          "torrents"
+          [T2 "torrentId" Int "fullJsonResult" Json.Value]
+      ] ->
+      Transaction m ()
+    insertTorrents dats = do
+      _ <-
+        execute
+          [sql|
+            DELETE FROM redacted.torrents_json
+            WHERE torrent_id = ANY (?::integer[])
+          |]
+          ( Only $
+              PGArray
+                [ torrent.torrentId
+                  | dat <- dats,
+                    torrent <- dat.torrents
+                ]
+          )
+
+      execute
+        [sql|
+          INSERT INTO redacted.torrents_json
+            ( torrent_group
+            , torrent_id
+            , full_json_result)
+          SELECT *
+          FROM UNNEST(
+              ?::integer[]
+            , ?::integer[]
+            , ?::jsonb[]
+          ) AS inputs(
+              torrent_group
+            , torrent_id
+            , full_json_result)
+          |]
+        ( [ ( dat.torrentGroupIdPg :: Int,
+              group.torrentId :: Int,
+              group.fullJsonResult :: Json.Value
+            )
+            | dat <- dats,
+              group <- dat.torrents
+          ]
+            & unzip3PGArray
+        )
+      pure ()
+
+unzip3PGArray :: [(a1, a2, a3)] -> (PGArray a1, PGArray a2, PGArray a3)
+unzip3PGArray xs = xs & unzip3 & \(a, b, c) -> (PGArray a, PGArray b, PGArray c)
+
+redactedGetTorrentFileAndInsert ::
+  ( HasField "torrentId" r Int,
+    MonadPostgres m,
+    MonadThrow m,
+    MonadLogger m,
+    MonadOtel m
+  ) =>
+  r ->
+  Transaction m (Label "torrentFile" ByteString)
+redactedGetTorrentFileAndInsert dat = inSpan' "Redacted Get Torrent File and Insert" $ \span -> do
+  bytes <- redactedGetTorrentFile dat
+  execute
+    [sql|
+    UPDATE redacted.torrents_json
+    SET torrent_file = ?::bytea
+    WHERE torrent_id = ?::integer
+  |]
+    ( (Binary bytes :: Binary ByteString),
+      dat.torrentId
+    )
+    >>= assertOneUpdated span "redactedGetTorrentFileAndInsert"
+    >>= \() -> pure (label @"torrentFile" bytes)
+
+getTorrentFileById ::
+  ( MonadPostgres m,
+    HasField "torrentId" r Int,
+    MonadThrow m
+  ) =>
+  r ->
+  Transaction m (Maybe (Label "torrentFile" ByteString))
+getTorrentFileById dat = do
+  queryWith
+    [sql|
+    SELECT torrent_file
+    FROM redacted.torrents
+    WHERE torrent_id = ?::integer
+  |]
+    (Only $ (dat.torrentId :: Int))
+    (fmap @Maybe (label @"torrentFile") <$> Dec.byteaMay)
+    >>= ensureSingleRow
+
+updateTransmissionTorrentHashById ::
+  ( MonadPostgres m,
+    HasField "torrentId" r Int,
+    HasField "torrentHash" r Text
+  ) =>
+  r ->
+  Transaction m (Label "numberOfRowsAffected" Natural)
+updateTransmissionTorrentHashById dat = do
+  execute
+    [sql|
+    UPDATE redacted.torrents_json
+    SET transmission_torrent_hash = ?::text
+    WHERE torrent_id = ?::integer
+    |]
+    ( dat.torrentHash :: Text,
+      dat.torrentId :: Int
+    )
+
+assertOneUpdated ::
+  (HasField "numberOfRowsAffected" r Natural, MonadThrow m, MonadIO m) =>
+  Otel.Span ->
+  Text ->
+  r ->
+  m ()
+assertOneUpdated span name x = case x.numberOfRowsAffected of
+  1 -> pure ()
+  n -> appThrowTree span ([fmt|{name :: Text}: Expected to update exactly one row, but updated {n :: Natural} row(s)|])
+
+data TorrentData transmissionInfo = TorrentData
+  { groupId :: Int,
+    torrentId :: Int,
+    seedingWeight :: Int,
+    torrentJson :: Json.Value,
+    torrentGroupJson :: T3 "artist" Text "groupName" Text "groupYear" Int,
+    torrentStatus :: TorrentStatus transmissionInfo
+  }
+
+data TorrentStatus transmissionInfo
+  = NoTorrentFileYet
+  | NotInTransmissionYet
+  | InTransmission (T2 "torrentHash" Text "transmissionInfo" transmissionInfo)
+
+getTorrentById :: (MonadPostgres m, HasField "torrentId" r Int, MonadThrow m) => r -> Transaction m Json.Value
+getTorrentById dat = do
+  queryWith
+    [sql|
+    SELECT full_json_result FROM redacted.torrents
+    WHERE torrent_id = ?::integer
+  |]
+    (getLabel @"torrentId" dat)
+    (Dec.json Json.asValue)
+    >>= ensureSingleRow
+
+-- | Find the best torrent for each torrent group (based on the seeding_weight)
+getBestTorrents :: (MonadPostgres m) => Transaction m [TorrentData ()]
+getBestTorrents = do
+  queryWith
+    [sql|
+      SELECT * FROM (
+        SELECT DISTINCT ON (group_id)
+          tg.group_id,
+          t.torrent_id,
+          seeding_weight,
+          t.full_json_result AS torrent_json,
+          tg.full_json_result AS torrent_group_json,
+          t.torrent_file IS NOT NULL,
+          t.transmission_torrent_hash
+        FROM redacted.torrents t
+        JOIN redacted.torrent_groups tg ON tg.id = t.torrent_group
+        ORDER BY group_id, seeding_weight DESC
+      ) as _
+      ORDER BY seeding_weight DESC
+    |]
+    ()
+    ( do
+        groupId <- Dec.fromField @Int
+        torrentId <- Dec.fromField @Int
+        seedingWeight <- Dec.fromField @Int
+        torrentJson <- Dec.json Json.asValue
+        torrentGroupJson <-
+          ( Dec.json $ do
+              artist <- Json.keyLabel @"artist" "artist" Json.asText
+              groupName <- Json.keyLabel @"groupName" "groupName" Json.asText
+              groupYear <- Json.keyLabel @"groupYear" "groupYear" (Json.asIntegral @_ @Int)
+              pure $ T3 artist groupName groupYear
+            )
+        hasTorrentFile <- Dec.fromField @Bool
+        transmissionTorrentHash <-
+          Dec.fromField @(Maybe Text)
+        pure $
+          TorrentData
+            { torrentStatus =
+                if
+                  | not hasTorrentFile -> NoTorrentFileYet
+                  | Nothing <- transmissionTorrentHash -> NotInTransmissionYet
+                  | Just hash <- transmissionTorrentHash ->
+                      InTransmission $
+                        T2 (label @"torrentHash" hash) (label @"transmissionInfo" ()),
+              ..
+            }
+    )
+
+-- | Do a request to the redacted API. If you know what that is, you know how to find the API docs.
+mkRedactedApiRequest ::
+  ( MonadThrow m,
+    MonadIO m,
+    MonadLogger m,
+    HasField "action" p ByteString,
+    HasField "actionArgs" p [(ByteString, Maybe ByteString)]
+  ) =>
+  p ->
+  m Http.Request
+mkRedactedApiRequest dat = do
+  authKey <- runCommandExpect0 "pass" ["internet/redacted/api-keys/whatcd-resolver"]
+  pure $
+    [fmt|https://redacted.ch/ajax.php|]
+      & Http.setRequestMethod "GET"
+      & Http.setQueryString (("action", Just dat.action) : dat.actionArgs)
+      & Http.setRequestHeader "Authorization" [authKey]
+
+httpTorrent ::
+  ( MonadIO m,
+    MonadThrow m
+  ) =>
+  Otel.Span ->
+  Http.Request ->
+  m ByteString
+httpTorrent span req =
+  Http.httpBS req
+    >>= assertM
+      span
+      ( \resp -> do
+          let statusCode = resp & Http.responseStatus & (.statusCode)
+              contentType =
+                resp
+                  & Http.responseHeaders
+                  & List.lookup "content-type"
+                  <&> Wai.parseContentType
+                  <&> (\(ct, _mimeAttributes) -> ct)
+          if
+            | statusCode == 200,
+              Just "application/x-bittorrent" <- contentType ->
+                Right $ (resp & Http.responseBody)
+            | statusCode == 200,
+              Just otherType <- contentType ->
+                Left [fmt|Redacted returned a non-torrent body, with content-type "{otherType}"|]
+            | statusCode == 200,
+              Nothing <- contentType ->
+                Left [fmt|Redacted returned a body with unspecified content type|]
+            | code <- statusCode -> Left [fmt|Redacted returned an non-200 error code, code {code}: {resp & showPretty}|]
+      )
+
+httpJson ::
+  ( MonadThrow m,
+    MonadOtel m
+  ) =>
+  (Optional (Label "contentType" ByteString)) ->
+  Json.Parse ErrorTree b ->
+  Http.Request ->
+  m b
+httpJson opts parser req = inSpan' "HTTP Request (JSON)" $ \span -> do
+  let opts' = opts.withDefault (label @"contentType" "application/json")
+  Http.httpBS req
+    >>= assertM
+      span
+      ( \resp -> do
+          let statusCode = resp & Http.responseStatus & (.statusCode)
+              contentType =
+                resp
+                  & Http.responseHeaders
+                  & List.lookup "content-type"
+                  <&> Wai.parseContentType
+                  <&> (\(ct, _mimeAttributes) -> ct)
+          if
+            | statusCode == 200,
+              Just ct <- contentType,
+              ct == opts'.contentType ->
+                Right $ (resp & Http.responseBody)
+            | statusCode == 200,
+              Just otherType <- contentType ->
+                Left [fmt|Server returned a non-json body, with content-type "{otherType}"|]
+            | statusCode == 200,
+              Nothing <- contentType ->
+                Left [fmt|Server returned a body with unspecified content type|]
+            | code <- statusCode -> Left [fmt|Server returned an non-200 error code, code {code}: {resp & showPretty}|]
+      )
+    >>= assertM
+      span
+      ( \body ->
+          Json.parseStrict parser body
+            & first (Json.parseErrorTree "could not parse redacted response")
+      )
+
+redactedApiRequestJson ::
+  ( MonadThrow m,
+    MonadLogger m,
+    HasField "action" p ByteString,
+    HasField "actionArgs" p [(ByteString, Maybe ByteString)],
+    MonadOtel m
+  ) =>
+  p ->
+  Json.Parse ErrorTree a ->
+  m a
+redactedApiRequestJson dat parser =
+  do
+    mkRedactedApiRequest dat
+    >>= httpJson defaults parser
diff --git a/users/Profpatsch/whatcd-resolver/src/Transmission.hs b/users/Profpatsch/whatcd-resolver/src/Transmission.hs
new file mode 100644
index 0000000000..66dbeb9ce7
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/src/Transmission.hs
@@ -0,0 +1,306 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Transmission where
+
+import AppT
+import Control.Monad.Logger.CallStack
+import Control.Monad.Reader
+import Data.Aeson qualified as Json
+import Data.Aeson.BetterErrors qualified as Json
+import Data.Aeson.KeyMap qualified as KeyMap
+import Data.Error.Tree
+import Data.HashMap.Strict qualified as HashMap
+import Data.List qualified as List
+import Data.List.NonEmpty qualified as NonEmpty
+import Data.Map.Strict qualified as Map
+import Database.PostgreSQL.Simple (Only (..))
+import Database.PostgreSQL.Simple.Types (PGArray (PGArray))
+import FieldParser (FieldParser' (..))
+import FieldParser qualified as Field
+import Html qualified
+import Http qualified
+import Json qualified
+import Json.Enc (Enc)
+import Json.Enc qualified as Enc
+import Label
+import MyPrelude
+import Network.HTTP.Types
+import OpenTelemetry.Trace qualified as Otel hiding (getTracer, inSpan, inSpan')
+import Optional
+import Postgres.MonadPostgres
+import Pretty
+import Text.Blaze.Html (Html)
+import UnliftIO
+import Prelude hiding (span)
+
+-- | A value between (inclusive) 0% and (inclusive) 100%. Precise to 1% steps.
+newtype Percentage = Percentage {unPercentage :: Int}
+  deriving stock (Show)
+
+-- | Parse a scientific into a Percentage
+scientificPercentage :: FieldParser' Error Scientific Percentage
+scientificPercentage =
+  Field.boundedScientificRealFloat @Float
+    >>> ( FieldParser $ \f ->
+            if
+              | f < 0 -> Left "percentage cannot be negative"
+              | f > 1 -> Left "percentage cannot be over 100%"
+              | otherwise -> Right $ Percentage $ ceiling (f * 100)
+        )
+
+-- | Fetch the current status from transmission, and remove the tranmission hash from our database
+-- iff it does not exist in transmission anymore
+getAndUpdateTransmissionTorrentsStatus ::
+  ( MonadTransmission m,
+    MonadThrow m,
+    MonadLogger m,
+    MonadPostgres m,
+    MonadOtel m
+  ) =>
+  Map (Label "torrentHash" Text) () ->
+  (Transaction m (Map (Label "torrentHash" Text) (Label "percentDone" Percentage)))
+getAndUpdateTransmissionTorrentsStatus knownTorrents = do
+  let fields = ["hashString", "percentDone"]
+  actualTorrents <-
+    lift @Transaction $
+      doTransmissionRequest'
+        ( transmissionRequestListOnlyTorrents
+            ( T2
+                (label @"fields" fields)
+                (label @"ids" (Map.keys knownTorrents))
+            )
+            $ do
+              torrentHash <- Json.keyLabel @"torrentHash" "hashString" Json.asText
+              percentDone <- Json.keyLabel @"percentDone" "percentDone" (Field.toJsonParser $ Field.jsonNumber >>> scientificPercentage)
+              pure (torrentHash, percentDone)
+        )
+        <&> Map.fromList
+  let toDelete = Map.difference knownTorrents actualTorrents
+  execute
+    [fmt|
+    UPDATE redacted.torrents_json
+    SET transmission_torrent_hash = NULL
+    WHERE transmission_torrent_hash = ANY (?::text[])
+  |]
+    $ Only (toDelete & Map.keys <&> (.torrentHash) & PGArray :: PGArray Text)
+  pure actualTorrents
+
+getTransmissionTorrentsTable ::
+  (MonadTransmission m, MonadThrow m, MonadLogger m, MonadOtel m) => m Html
+getTransmissionTorrentsTable = do
+  let fields =
+        [ "hashString",
+          "name",
+          "percentDone",
+          "percentComplete",
+          "downloadDir",
+          "files"
+        ]
+  doTransmissionRequest'
+    ( transmissionRequestListAllTorrents fields $ do
+        Json.asObject <&> KeyMap.toMapText
+    )
+    <&> \resp ->
+      Html.toTable
+        ( resp
+            & List.sortOn (\m -> m & Map.lookup "percentDone" & fromMaybe (Json.Number 0))
+            <&> Map.toList
+            -- TODO
+            & List.take 100
+        )
+
+data TransmissionRequest = TransmissionRequest
+  { method :: Text,
+    arguments :: Map Text Enc,
+    tag :: Maybe Int
+  }
+  deriving stock (Show)
+
+transmissionConnectionConfig :: T3 "host" Text "port" Int "usePlainHttp" Bool
+transmissionConnectionConfig = (T3 (label @"host" "localhost") (label @"port" 9091) (label @"usePlainHttp" True))
+
+transmissionRequestListAllTorrents :: (Monad m) => [Text] -> Json.ParseT e m out -> (TransmissionRequest, Json.ParseT e m [out])
+transmissionRequestListAllTorrents fields parseTorrent =
+  ( TransmissionRequest
+      { method = "torrent-get",
+        arguments =
+          Map.fromList
+            [ ("fields", Enc.list Enc.text fields)
+            ],
+        tag = Nothing
+      },
+    Json.key "torrents" $ Json.eachInArray parseTorrent
+  )
+
+transmissionRequestListOnlyTorrents ::
+  ( HasField "ids" r1 [(Label "torrentHash" Text)],
+    HasField "fields" r1 [Text],
+    Monad m
+  ) =>
+  r1 ->
+  Json.ParseT e m out ->
+  (TransmissionRequest, Json.ParseT e m [out])
+transmissionRequestListOnlyTorrents dat parseTorrent =
+  ( TransmissionRequest
+      { method = "torrent-get",
+        arguments =
+          Map.fromList
+            [ ("ids", Enc.list (\i -> Enc.text i.torrentHash) dat.ids),
+              ("fields", Enc.list Enc.text dat.fields)
+            ],
+        tag = Nothing
+      },
+    Json.key "torrents" $ Json.eachInArray parseTorrent
+  )
+
+transmissionRequestAddTorrent ::
+  (HasField "torrentFile" r ByteString, Monad m) =>
+  r ->
+  ( TransmissionRequest,
+    Json.ParseT err m (T2 "torrentHash" Text "torrentName" Text)
+  )
+transmissionRequestAddTorrent dat =
+  ( TransmissionRequest
+      { method = "torrent-add",
+        arguments =
+          Map.fromList
+            [ ("metainfo", Enc.base64Bytes dat.torrentFile),
+              ("paused", Enc.bool False)
+            ],
+        tag = Nothing
+      },
+    do
+      let p method = Json.key method $ do
+            hash <- Json.keyLabel @"torrentHash" "hashString" Json.asText
+            name <- Json.keyLabel @"torrentName" "name" Json.asText
+            pure $ T2 hash name
+      p "torrent-duplicate" Json.<|> p "torrent-added"
+  )
+
+data TransmissionResponse output = TransmissionResponse
+  { result :: TransmissionResponseStatus,
+    arguments :: Maybe output,
+    tag :: Maybe Int
+  }
+  deriving stock (Show)
+
+data TransmissionResponseStatus
+  = TransmissionResponseSuccess
+  | TransmissionResponseFailure Text
+  deriving stock (Show)
+
+doTransmissionRequest' ::
+  ( MonadTransmission m,
+    MonadThrow m,
+    MonadLogger m,
+    MonadOtel m
+  ) =>
+  (TransmissionRequest, Json.Parse Error output) ->
+  m output
+doTransmissionRequest' req = inSpan' "Transmission Request" $ \span -> do
+  resp <-
+    doTransmissionRequest
+      span
+      transmissionConnectionConfig
+      req
+  case resp.result of
+    TransmissionResponseFailure err -> appThrowTree span (nestedError "Transmission RPC error" $ singleError $ newError err)
+    TransmissionResponseSuccess -> case resp.arguments of
+      Nothing -> appThrowTree span "Transmission RPC error: No `arguments` field in response"
+      Just out -> pure out
+
+-- | Contact the transmission RPC, and do the CSRF protection dance.
+--
+-- Spec: https://github.com/transmission/transmission/blob/main/docs/rpc-spec.md
+doTransmissionRequest ::
+  ( MonadTransmission m,
+    HasField "host" t1 Text,
+    HasField "port" t1 Int,
+    HasField "usePlainHttp" t1 Bool,
+    MonadThrow m,
+    MonadLogger m,
+    MonadOtel m
+  ) =>
+  Otel.Span ->
+  t1 ->
+  (TransmissionRequest, Json.Parse Error output) ->
+  m (TransmissionResponse output)
+doTransmissionRequest span dat (req, parser) = do
+  sessionId <- getTransmissionId
+  let textArg t = (Enc.text t, Otel.toAttribute @Text t)
+  let encArg enc = (enc, Otel.toAttribute @Text $ enc & Enc.encToTextPretty)
+  let intArg i = (Enc.int i, Otel.toAttribute @Int i)
+
+  let body :: [(Text, (Enc, Otel.Attribute))] =
+        ( [ ("method", req.method & textArg),
+            ("arguments", encArg $ Enc.map id req.arguments)
+          ]
+            <> (req.tag & foldMap (\t -> [("tag", t & intArg)]))
+        )
+  addAttributes
+    span
+    ( HashMap.fromList $
+        body
+          <&> bimap
+            (\k -> [fmt|transmission.{k}|])
+            (\(_, attr) -> attr)
+    )
+  resp <-
+    Http.doRequestJson
+      ( (Http.mkRequestOptions (T2 (label @"method" "POST") (label @"host" dat.host)))
+          { Http.path = mkOptional ["transmission", "rpc"],
+            Http.port = mkOptional dat.port,
+            Http.headers = mkOptional $ (sessionId & ifExists ("X-Transmission-Session-Id",)),
+            Http.usePlainHttp = mkOptional dat.usePlainHttp
+          }
+      )
+      (body <&> second fst & Enc.object)
+  -- Implement the CSRF protection thingy
+  case resp & Http.getResponseStatus & (.statusCode) of
+    409 -> do
+      tid <-
+        resp
+          & Http.getResponseHeader "X-Transmission-Session-Id"
+          & nonEmpty
+          & annotate [fmt|Missing "X-Transmission-Session-Id" header in 409 response: {showPretty resp}|]
+          & unwrapIOError
+          & liftIO
+          <&> NonEmpty.head
+      setTransmissionId tid
+      doTransmissionRequest span dat (req, parser)
+    200 ->
+      resp
+        & Http.getResponseBody
+        & Json.parseStrict
+          ( Json.mapError singleError $ do
+              result <-
+                Json.key "result" Json.asText <&> \case
+                  "success" -> TransmissionResponseSuccess
+                  err -> TransmissionResponseFailure err
+              arguments <-
+                Json.keyMay "arguments" parser
+              tag <-
+                Json.keyMay
+                  "tag"
+                  (Field.toJsonParser (Field.jsonNumber >>> Field.boundedScientificIntegral "tag too long"))
+              pure TransmissionResponse {..}
+          )
+        & first (Json.parseErrorTree "Cannot parse transmission RPC response")
+        & \case
+          Right a -> pure a
+          Left err -> do
+            case Json.eitherDecodeStrict' @Json.Value (resp & Http.getResponseBody) of
+              Left _err -> pure ()
+              Right val -> logInfo [fmt|failing transmission response: {showPrettyJson val}|]
+            appThrowTree span err
+    _ -> liftIO $ unwrapIOError $ Left [fmt|Non-200 response: {showPretty resp}|]
+
+class MonadTransmission m where
+  getTransmissionId :: m (Maybe ByteString)
+  setTransmissionId :: ByteString -> m ()
+
+instance (MonadIO m) => MonadTransmission (AppT m) where
+  getTransmissionId = AppT (asks (.transmissionSessionId)) >>= tryTakeMVar
+  setTransmissionId t = do
+    var <- AppT $ asks (.transmissionSessionId)
+    putMVar var t
diff --git a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
new file mode 100644
index 0000000000..f1902bac8c
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
@@ -0,0 +1,698 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module WhatcdResolver where
+
+import AppT
+import Control.Category qualified as Cat
+import Control.Monad.Catch.Pure (runCatch)
+import Control.Monad.Logger.CallStack
+import Control.Monad.Reader
+import Data.Aeson qualified as Json
+import Data.Aeson.BetterErrors qualified as Json
+import Data.Aeson.KeyMap qualified as KeyMap
+import Data.HashMap.Strict qualified as HashMap
+import Data.List qualified as List
+import Data.Map.Strict qualified as Map
+import Data.Pool qualified as Pool
+import Data.Text qualified as Text
+import Database.PostgreSQL.Simple qualified as Postgres
+import Database.PostgreSQL.Simple.SqlQQ (sql)
+import Database.PostgreSQL.Simple.Types (PGArray (PGArray))
+import Database.Postgres.Temp qualified as TmpPg
+import FieldParser (FieldParser, FieldParser' (..))
+import FieldParser qualified as Field
+import Html qualified
+import IHP.HSX.QQ (hsx)
+import Json qualified
+import Json.Enc (Enc)
+import Json.Enc qualified as Enc
+import JsonLd
+import Label
+import Multipart2 qualified as Multipart
+import MyPrelude
+import Network.HTTP.Client.Conduit qualified as Http
+import Network.HTTP.Simple qualified as Http
+import Network.HTTP.Types
+import Network.HTTP.Types qualified as Http
+import Network.URI (URI)
+import Network.URI qualified
+import Network.URI qualified as URI
+import Network.Wai (ResponseReceived)
+import Network.Wai qualified as Wai
+import Network.Wai.Handler.Warp qualified as Warp
+import Network.Wai.Parse qualified as Wai
+import OpenTelemetry.Attributes qualified as Otel
+import OpenTelemetry.Trace qualified as Otel hiding (getTracer, inSpan, inSpan')
+import OpenTelemetry.Trace.Monad qualified as Otel
+import Parse (Parse)
+import Parse qualified
+import Postgres.Decoder qualified as Dec
+import Postgres.MonadPostgres
+import Pretty
+import Redacted
+import System.Directory qualified as Dir
+import System.Directory qualified as Xdg
+import System.Environment qualified as Env
+import System.FilePath ((</>))
+import Text.Blaze.Html (Html)
+import Text.Blaze.Html.Renderer.Pretty qualified as Html.Pretty
+import Text.Blaze.Html.Renderer.Utf8 qualified as Html
+import Text.Blaze.Html5 qualified as Html
+import Tool (readTool, readTools)
+import Transmission
+import UnliftIO hiding (Handler)
+import Prelude hiding (span)
+
+main :: IO ()
+main =
+  runAppWith
+    ( do
+        -- todo: trace that to the init functions as well
+        Otel.inSpan "whatcd-resolver main function" Otel.defaultSpanArguments $ do
+          _ <- runTransaction migrate
+          htmlUi
+    )
+    <&> first showToError
+    >>= expectIOError "could not start whatcd-resolver"
+
+htmlUi :: AppT IO ()
+htmlUi = do
+  let debug = True
+  uniqueRunId <-
+    runTransaction $
+      querySingleRowWith
+        [sql|
+            SELECT gen_random_uuid()::text
+        |]
+        ()
+        (Dec.fromField @Text)
+
+  withRunInIO $ \runInIO -> Warp.run 9093 $ \req respond -> do
+    let catchAppException act =
+          try act >>= \case
+            Right a -> pure a
+            Left (AppException err) -> do
+              runInIO (logError err)
+              respond (Wai.responseLBS Http.status500 [] "")
+
+    catchAppException $ do
+      let mp span parser =
+            Multipart.parseMultipartOrThrow
+              (appThrowTree span)
+              parser
+              req
+
+      let torrentIdMp span =
+            mp
+              span
+              ( do
+                  label @"torrentId" <$> Multipart.field "torrent-id" ((Field.utf8 >>> Field.signedDecimal >>> Field.bounded @Int "int"))
+              )
+      let parseQueryArgs span parser =
+            Parse.runParse "Unable to find the right request query arguments" (lmap Wai.queryString parser) req
+              & assertM span id
+
+      let parseQueryArgsNewSpan spanName parser =
+            Parse.runParse "Unable to find the right request query arguments" (lmap Wai.queryString parser) req
+              & assertMNewSpan spanName id
+
+      let handlers :: Handlers (AppT IO)
+          handlers respond =
+            Map.fromList
+              [ ("", respond.h (mainHtml uniqueRunId)),
+                ( "snips/redacted/search",
+                  respond.h $
+                    \span -> do
+                      dat <-
+                        mp
+                          span
+                          ( do
+                              label @"searchstr" <$> Multipart.field "redacted-search" Cat.id
+                          )
+                      snipsRedactedSearch dat
+                ),
+                ( "snips/redacted/torrentDataJson",
+                  respond.h $ \span -> do
+                    dat <- torrentIdMp span
+                    Html.mkVal <$> (runTransaction $ getTorrentById dat)
+                ),
+                ( "snips/redacted/getTorrentFile",
+                  respond.h $ \span -> do
+                    dat <- torrentIdMp span
+                    runTransaction $ do
+                      inserted <- redactedGetTorrentFileAndInsert dat
+                      running <-
+                        lift @Transaction $
+                          doTransmissionRequest' (transmissionRequestAddTorrent inserted)
+                      updateTransmissionTorrentHashById
+                        ( T2
+                            (getLabel @"torrentHash" running)
+                            (getLabel @"torrentId" dat)
+                        )
+                      pure $
+                        everySecond
+                          "snips/transmission/getTorrentState"
+                          (Enc.object [("torrent-hash", Enc.text running.torrentHash)])
+                          "Starting"
+                ),
+                -- TODO: this is bad duplication??
+                ( "snips/redacted/startTorrentFile",
+                  respond.h $ \span -> do
+                    dat <- torrentIdMp span
+                    runTransaction $ do
+                      file <-
+                        getTorrentFileById dat
+                          <&> annotate [fmt|No torrent file for torrentId "{dat.torrentId}"|]
+                          >>= orAppThrowTree span
+
+                      running <-
+                        lift @Transaction $
+                          doTransmissionRequest' (transmissionRequestAddTorrent file)
+                      updateTransmissionTorrentHashById
+                        ( T2
+                            (getLabel @"torrentHash" running)
+                            (getLabel @"torrentId" dat)
+                        )
+                      pure $
+                        everySecond
+                          "snips/transmission/getTorrentState"
+                          (Enc.object [("torrent-hash", Enc.text running.torrentHash)])
+                          "Starting"
+                ),
+                ( "snips/transmission/getTorrentState",
+                  respond.h $ \span -> do
+                    dat <- mp span $ label @"torrentHash" <$> Multipart.field "torrent-hash" Field.utf8
+                    status <-
+                      doTransmissionRequest'
+                        ( transmissionRequestListOnlyTorrents
+                            ( T2
+                                (label @"ids" [label @"torrentHash" dat.torrentHash])
+                                (label @"fields" ["hashString"])
+                            )
+                            (Json.keyLabel @"torrentHash" "hashString" Json.asText)
+                        )
+                        <&> List.find (\torrent -> torrent.torrentHash == dat.torrentHash)
+
+                    pure $
+                      case status of
+                        Nothing -> [hsx|ERROR unknown|]
+                        Just _torrent -> [hsx|Running|]
+                ),
+                ( "snips/jsonld/render",
+                  respond.h $ \span -> do
+                    qry <-
+                      parseQueryArgs
+                        span
+                        ( label @"target"
+                            <$> ( (singleQueryArgument "target" Field.utf8 >>> textToURI)
+                                    & Parse.andParse uriToHttpClientRequest
+                                )
+                        )
+                    jsonld <- httpGetJsonLd (qry.target)
+                    pure $ renderJsonld jsonld
+                ),
+                ( "autorefresh",
+                  respond.plain $ do
+                    qry <-
+                      parseQueryArgsNewSpan
+                        "Autorefresh Query Parse"
+                        ( label @"hasItBeenRestarted"
+                            <$> singleQueryArgument "hasItBeenRestarted" Field.utf8
+                        )
+                    pure $
+                      Wai.responseLBS
+                        Http.ok200
+                        ( [("Content-Type", "text/html")]
+                            <> if uniqueRunId /= qry.hasItBeenRestarted
+                              then -- cause the client side to refresh
+                                [("HX-Refresh", "true")]
+                              else []
+                        )
+                        ""
+                )
+              ]
+      runInIO $
+        runHandlers
+          debug
+          (\respond -> respond.h $ (mainHtml uniqueRunId))
+          handlers
+          req
+          respond
+  where
+    everySecond :: Text -> Enc -> Html -> Html
+    everySecond call extraData innerHtml = [hsx|<div hx-trigger="every 1s" hx-swap="outerHTML" hx-post={call} hx-vals={Enc.encToBytesUtf8 extraData}>{innerHtml}</div>|]
+
+    mainHtml :: Text -> Otel.Span -> AppT IO Html
+    mainHtml uniqueRunId _span = runTransaction $ do
+      jsonld <-
+        httpGetJsonLd
+          ( URI.parseURI "https://musicbrainz.org/work/92000fd4-d304-406d-aeb4-6bdbeed318ec" & annotate "not an URI" & unwrapError,
+            "https://musicbrainz.org/work/92000fd4-d304-406d-aeb4-6bdbeed318ec"
+          )
+          <&> renderJsonld
+      bestTorrentsTable <- getBestTorrentsTable
+      -- transmissionTorrentsTable <- lift @Transaction getTransmissionTorrentsTable
+      pure $
+        Html.docTypeHtml
+          [hsx|
+      <head>
+        <title>whatcd-resolver</title>
+        <meta charset="utf-8">
+        <meta name="viewport" content="width=device-width, initial-scale=1">
+        <link href="https://cdn.jsdelivr.net/npm/bootstrap@5.3.0/dist/css/bootstrap.min.css" rel="stylesheet" integrity="sha384-9ndCyUaIbzAi2FUVXJi0CjmCapSmO7SnpJef0486qhLnuZ2cdeRhO02iuK6FUUVM" crossorigin="anonymous">
+        <script src="https://cdn.jsdelivr.net/npm/bootstrap@5.3.0/dist/js/bootstrap.bundle.min.js" integrity="sha384-geWF76RCwLtnZ8qwWowPQNguL3RmwHVBC9FhGdlKrxdiJJigb/j/68SIy3Te4Bkz" crossorigin="anonymous"></script>
+        <script src="https://unpkg.com/htmx.org@1.9.2" integrity="sha384-L6OqL9pRWyyFU3+/bjdSri+iIphTN/bvYyM37tICVyOJkWZLpP2vGn6VUEXgzg6h" crossorigin="anonymous"></script>
+        <style>
+          dl {
+            margin: 1em;
+            padding: 0.5em 1em;
+            border: thin solid;
+          }
+        </style>
+      </head>
+      <body>
+        {jsonld}
+        <form
+          hx-post="/snips/redacted/search"
+          hx-target="#redacted-search-results">
+          <label for="redacted-search">Redacted Search</label>
+          <input
+            id="redacted-search"
+            type="text"
+            name="redacted-search" />
+          <button type="submit" hx-disabled-elt="this">Search</button>
+          <div class="htmx-indicator">Search running!</div>
+        </form>
+        <div id="redacted-search-results">
+          {bestTorrentsTable}
+        </div>
+        <!-- refresh the page if the uniqueRunId is different -->
+        <input
+             hidden
+             type="text"
+             id="autorefresh"
+             name="hasItBeenRestarted"
+             value={uniqueRunId}
+             hx-get="/autorefresh"
+             hx-trigger="every 5s"
+             hx-swap="none"
+        />
+      </body>
+    |]
+
+type Handlers m = HandlerResponses m -> Map Text (m ResponseReceived)
+
+type HandlerResponses m = T2 "h" ((Otel.Span -> m Html) -> m ResponseReceived) "plain" (m Wai.Response -> m ResponseReceived)
+
+runHandlers ::
+  (MonadOtel m) =>
+  Bool ->
+  (HandlerResponses m -> m ResponseReceived) ->
+  (HandlerResponses m -> Map Text (m ResponseReceived)) ->
+  Wai.Request ->
+  (Wai.Response -> IO ResponseReceived) ->
+  m ResponseReceived
+runHandlers debug defaultHandler handlers req respond = withRunInIO $ \runInIO -> do
+  let renderHtml =
+        if debug
+          then Html.Pretty.renderHtml >>> stringToText >>> textToBytesUtf8 >>> toLazyBytes
+          else Html.renderHtml
+  let hh route act =
+        Otel.inSpan'
+          [fmt|Route {route }|]
+          ( Otel.defaultSpanArguments
+              { Otel.attributes =
+                  HashMap.fromList
+                    [ ("server.path", Otel.toAttribute @Text route)
+                    ]
+              }
+          )
+          ( \span -> do
+              res <- act span
+              liftIO $ respond . Wai.responseLBS Http.ok200 ([("Content-Type", "text/html")] <> res.extraHeaders) . renderHtml $ res.html
+          )
+  let h route act = hh route (\span -> act span <&> (\html -> T2 (label @"html" html) (label @"extraHeaders" [])))
+
+  let path = (req & Wai.pathInfo & Text.intercalate "/")
+  let handlerResponses =
+        ( T2
+            (label @"h" (h path))
+            (label @"plain" (\m -> liftIO $ runInIO m >>= respond))
+        )
+  let handler =
+        (handlers handlerResponses)
+          & Map.lookup path
+          & fromMaybe (defaultHandler handlerResponses)
+  runInIO handler
+
+singleQueryArgument :: Text -> FieldParser ByteString to -> Parse Http.Query to
+singleQueryArgument field inner =
+  Parse.mkParsePushContext
+    field
+    ( \(ctx, qry) -> case qry
+        & mapMaybe
+          ( \(k, v) ->
+              if k == (field & textToBytesUtf8)
+                then Just v
+                else Nothing
+          ) of
+        [] -> Left [fmt|No such query argument "{field}", at {ctx & Parse.showContext}|]
+        [Nothing] -> Left [fmt|Expected one query argument with a value, but "{field}" was a query flag|]
+        [Just one] -> Right one
+        more -> Left [fmt|More than one value for query argument "{field}": {show more}, at {ctx & Parse.showContext}|]
+    )
+    >>> Parse.fieldParser inner
+
+-- | Make sure we can parse the given Text into an URI.
+textToURI :: Parse Text URI
+textToURI =
+  Parse.fieldParser
+    ( FieldParser $ \text ->
+        text
+          & textToString
+          & Network.URI.parseURI
+          & annotate [fmt|Cannot parse this as a URL: "{text}"|]
+    )
+
+-- | Make sure we can parse the given URI into a Request.
+--
+-- This tries to work around the horrible, horrible interface in Http.Client.
+uriToHttpClientRequest :: Parse URI Http.Request
+uriToHttpClientRequest =
+  Parse.mkParseNoContext
+    ( \url ->
+        (url & Http.requestFromURI)
+          & runCatch
+          & first (checkException @Http.HttpException)
+          & \case
+            Left (Right (Http.InvalidUrlException urlText reason)) ->
+              Left [fmt|Unable to set the url "{urlText}" as request URL, reason: {reason}|]
+            Left (Right exc@(Http.HttpExceptionRequest _ _)) ->
+              Left [fmt|Weird! Should not get a HttpExceptionRequest when parsing an URL (bad library design), was {exc & displayException}|]
+            Left (Left someExc) ->
+              Left [fmt|Weird! Should not get anyhting but a HttpException when parsing an URL (bad library design), was {someExc & displayException}|]
+            Right req -> pure req
+    )
+
+checkException :: (Exception b) => SomeException -> Either SomeException b
+checkException some = case fromException some of
+  Nothing -> Left some
+  Just e -> Right e
+
+snipsRedactedSearch ::
+  ( MonadLogger m,
+    MonadPostgres m,
+    HasField "searchstr" r ByteString,
+    MonadThrow m,
+    MonadTransmission m,
+    MonadOtel m
+  ) =>
+  r ->
+  m Html
+snipsRedactedSearch dat = do
+  t <-
+    redactedSearchAndInsert
+      [ ("searchstr", dat.searchstr),
+        ("releasetype", "album")
+      ]
+  runTransaction $ do
+    t
+    getBestTorrentsTable
+
+getBestTorrentsTable ::
+  ( MonadTransmission m,
+    MonadThrow m,
+    MonadLogger m,
+    MonadPostgres m,
+    MonadOtel m
+  ) =>
+  Transaction m Html
+getBestTorrentsTable = do
+  bestStale :: [TorrentData ()] <- getBestTorrents
+  actual <-
+    getAndUpdateTransmissionTorrentsStatus
+      ( bestStale
+          & mapMaybe
+            ( \td -> case td.torrentStatus of
+                InTransmission h -> Just h
+                _ -> Nothing
+            )
+          <&> (\t -> (getLabel @"torrentHash" t, t.transmissionInfo))
+          & Map.fromList
+      )
+  let fresh =
+        bestStale
+          --  we have to update the status of every torrent that’s not in tranmission anymore
+          -- TODO I feel like it’s easier (& more correct?) to just do the database request again …
+          <&> ( \td -> case td.torrentStatus of
+                  InTransmission info ->
+                    case actual & Map.lookup (getLabel @"torrentHash" info) of
+                      -- TODO this is also pretty dumb, cause it assumes that we have the torrent file if it was in transmission before,
+                      -- which is an internal factum that is established in getBestTorrents (and might change later)
+                      Nothing -> td {torrentStatus = NotInTransmissionYet}
+                      Just transmissionInfo -> td {torrentStatus = InTransmission (T2 (getLabel @"torrentHash" info) (label @"transmissionInfo" transmissionInfo))}
+                  NotInTransmissionYet -> td {torrentStatus = NotInTransmissionYet}
+                  NoTorrentFileYet -> td {torrentStatus = NoTorrentFileYet}
+              )
+  let localTorrent b = case b.torrentStatus of
+        NoTorrentFileYet -> [hsx|<button hx-post="snips/redacted/getTorrentFile" hx-swap="outerHTML" hx-vals={Enc.encToBytesUtf8 $ Enc.object [("torrent-id", Enc.int b.torrentId)]}>Upload Torrent</button>|]
+        InTransmission info -> [hsx|{info.transmissionInfo.percentDone.unPercentage}% done|]
+        NotInTransmissionYet -> [hsx|<button hx-post="snips/redacted/startTorrentFile" hx-swap="outerHTML" hx-vals={Enc.encToBytesUtf8 $ Enc.object [("torrent-id", Enc.int b.torrentId)]}>Start Torrent</button>|]
+  let bestRows =
+        fresh
+          & foldMap
+            ( \b -> do
+                [hsx|
+                  <tr>
+                  <td>{localTorrent b}</td>
+                  <td>{Html.toHtml @Int b.groupId}</td>
+                  <td>{Html.toHtml @Text b.torrentGroupJson.artist}</td>
+                  <td>{Html.toHtml @Text b.torrentGroupJson.groupName}</td>
+                  <td>{Html.toHtml @Int b.seedingWeight}</td>
+                  <td><details hx-trigger="toggle once" hx-post="snips/redacted/torrentDataJson" hx-vals={Enc.encToBytesUtf8 $ Enc.object [("torrent-id", Enc.int b.torrentId)]}></details></td>
+                  </tr>
+                |]
+            )
+  pure $
+    [hsx|
+        <table class="table">
+          <thead>
+            <tr>
+              <th>Local</th>
+              <th>Group ID</th>
+              <th>Artist</th>
+              <th>Name</th>
+              <th>Weight</th>
+              <th>Torrent</th>
+              <th>Torrent Group</th>
+            </tr>
+          </thead>
+          <tbody>
+            {bestRows}
+          </tbody>
+        </table>
+      |]
+
+getTransmissionTorrentsTable ::
+  (MonadTransmission m, MonadThrow m, MonadLogger m, MonadOtel m) => m Html
+getTransmissionTorrentsTable = do
+  let fields =
+        [ "hashString",
+          "name",
+          "percentDone",
+          "percentComplete",
+          "downloadDir",
+          "files"
+        ]
+  doTransmissionRequest'
+    ( transmissionRequestListAllTorrents fields $ do
+        Json.asObject <&> KeyMap.toMapText
+    )
+    <&> \resp ->
+      Html.toTable
+        ( resp
+            & List.sortOn (\m -> m & Map.lookup "percentDone" & fromMaybe (Json.Number 0))
+            <&> Map.toList
+            -- TODO
+            & List.take 100
+        )
+
+unzip3PGArray :: [(a1, a2, a3)] -> (PGArray a1, PGArray a2, PGArray a3)
+unzip3PGArray xs = xs & unzip3 & \(a, b, c) -> (PGArray a, PGArray b, PGArray c)
+
+assertOneUpdated ::
+  (HasField "numberOfRowsAffected" r Natural, MonadThrow m, MonadIO m) =>
+  Otel.Span ->
+  Text ->
+  r ->
+  m ()
+assertOneUpdated span name x = case x.numberOfRowsAffected of
+  1 -> pure ()
+  n -> appThrowTree span ([fmt|{name :: Text}: Expected to update exactly one row, but updated {n :: Natural} row(s)|])
+
+migrate ::
+  ( MonadPostgres m,
+    MonadOtel m
+  ) =>
+  Transaction m (Label "numberOfRowsAffected" Natural)
+migrate = inSpan "Database Migration" $ do
+  execute
+    [sql|
+    CREATE SCHEMA IF NOT EXISTS redacted;
+
+    CREATE TABLE IF NOT EXISTS redacted.torrent_groups (
+      id SERIAL PRIMARY KEY,
+      group_id INTEGER,
+      group_name TEXT,
+      full_json_result JSONB,
+      UNIQUE(group_id)
+    );
+
+    CREATE TABLE IF NOT EXISTS redacted.torrents_json (
+      id SERIAL PRIMARY KEY,
+      torrent_id INTEGER,
+      torrent_group SERIAL NOT NULL REFERENCES redacted.torrent_groups(id) ON DELETE CASCADE,
+      full_json_result JSONB,
+      UNIQUE(torrent_id)
+    );
+
+    ALTER TABLE redacted.torrents_json
+    ADD COLUMN IF NOT EXISTS torrent_file bytea NULL;
+    ALTER TABLE redacted.torrents_json
+    ADD COLUMN IF NOT EXISTS transmission_torrent_hash text NULL;
+
+    -- inflect out values of the full json
+
+    CREATE OR REPLACE VIEW redacted.torrents AS
+    SELECT
+      t.id,
+      t.torrent_id,
+      t.torrent_group,
+      -- the seeding weight is used to find the best torrent in a group.
+      ( ((full_json_result->'seeders')::integer*3
+        + (full_json_result->'snatches')::integer
+        )
+      -- prefer remasters by multiplying them with 3
+      * (CASE
+          WHEN full_json_result->>'remasterTitle' ILIKE '%remaster%'
+          THEN 3
+          ELSE 1
+         END)
+      )
+      AS seeding_weight,
+      t.full_json_result,
+      t.torrent_file,
+      t.transmission_torrent_hash
+    FROM redacted.torrents_json t;
+
+    CREATE INDEX IF NOT EXISTS torrents_json_seeding ON redacted.torrents_json(((full_json_result->'seeding')::integer));
+    CREATE INDEX IF NOT EXISTS torrents_json_snatches ON redacted.torrents_json(((full_json_result->'snatches')::integer));
+  |]
+    ()
+
+httpTorrent ::
+  ( MonadIO m,
+    MonadThrow m
+  ) =>
+  Otel.Span ->
+  Http.Request ->
+  m ByteString
+httpTorrent span req =
+  Http.httpBS req
+    >>= assertM
+      span
+      ( \resp -> do
+          let statusCode = resp & Http.responseStatus & (.statusCode)
+              contentType =
+                resp
+                  & Http.responseHeaders
+                  & List.lookup "content-type"
+                  <&> Wai.parseContentType
+                  <&> (\(ct, _mimeAttributes) -> ct)
+          if
+            | statusCode == 200,
+              Just "application/x-bittorrent" <- contentType ->
+                Right $ (resp & Http.responseBody)
+            | statusCode == 200,
+              Just otherType <- contentType ->
+                Left [fmt|Redacted returned a non-torrent body, with content-type "{otherType}"|]
+            | statusCode == 200,
+              Nothing <- contentType ->
+                Left [fmt|Redacted returned a body with unspecified content type|]
+            | code <- statusCode -> Left [fmt|Redacted returned an non-200 error code, code {code}: {resp & showPretty}|]
+      )
+
+runAppWith :: AppT IO a -> IO (Either TmpPg.StartError a)
+runAppWith appT = withTracer $ \tracer -> withDb $ \db -> do
+  pgFormat <- readTools (label @"toolsEnvVar" "WHATCD_RESOLVER_TOOLS") (readTool "pg_format")
+  let config = label @"logDatabaseQueries" LogDatabaseQueries
+  pgConnPool <-
+    Pool.newPool $
+      Pool.defaultPoolConfig
+        {- resource init action -} (Postgres.connectPostgreSQL (db & TmpPg.toConnectionString))
+        {- resource destruction -} Postgres.close
+        {- unusedResourceOpenTime -} 10
+        {- max resources across all stripes -} 20
+  transmissionSessionId <- newEmptyMVar
+  let newAppT = do
+        logInfo [fmt|Running with config: {showPretty config}|]
+        logInfo [fmt|Connected to database at {db & TmpPg.toDataDirectory} on socket {db & TmpPg.toConnectionString}|]
+        appT
+  runReaderT newAppT.unAppT Context {..}
+
+withTracer :: (Otel.Tracer -> IO c) -> IO c
+withTracer f = do
+  setDefaultEnv "OTEL_SERVICE_NAME" "whatcd-resolver"
+  bracket
+    -- Install the SDK, pulling configuration from the environment
+    ( do
+        (processors, opts) <- Otel.getTracerProviderInitializationOptions
+        tp <-
+          Otel.createTracerProvider
+            processors
+            -- workaround the attribute length bug https://github.com/iand675/hs-opentelemetry/issues/113
+            ( opts
+                { Otel.tracerProviderOptionsAttributeLimits =
+                    opts.tracerProviderOptionsAttributeLimits
+                      { Otel.attributeCountLimit = Just 65_000
+                      }
+                }
+            )
+        Otel.setGlobalTracerProvider tp
+        pure tp
+    )
+    -- Ensure that any spans that haven't been exported yet are flushed
+    Otel.shutdownTracerProvider
+    -- Get a tracer so you can create spans
+    (\tracerProvider -> f $ Otel.makeTracer tracerProvider "whatcd-resolver" Otel.tracerOptions)
+
+setDefaultEnv :: String -> String -> IO ()
+setDefaultEnv envName defaultValue = do
+  Env.lookupEnv envName >>= \case
+    Just _env -> pure ()
+    Nothing -> Env.setEnv envName defaultValue
+
+withDb :: (TmpPg.DB -> IO a) -> IO (Either TmpPg.StartError a)
+withDb act = do
+  dataDir <- Xdg.getXdgDirectory Xdg.XdgData "whatcd-resolver"
+  let databaseDir = dataDir </> "database"
+  let socketDir = dataDir </> "database-socket"
+  Dir.createDirectoryIfMissing True socketDir
+  initDbConfig <-
+    Dir.doesDirectoryExist databaseDir >>= \case
+      True -> pure TmpPg.Zlich
+      False -> do
+        putStderrLn [fmt|Database does not exist yet, creating in "{databaseDir}"|]
+        Dir.createDirectoryIfMissing True databaseDir
+        pure TmpPg.DontCare
+  let cfg =
+        mempty
+          { TmpPg.dataDirectory = TmpPg.Permanent (databaseDir),
+            TmpPg.socketDirectory = TmpPg.Permanent socketDir,
+            TmpPg.port = pure $ Just 5431,
+            TmpPg.initDbConfig
+          }
+  TmpPg.withConfig cfg $ \db -> do
+    -- print [fmt|data dir: {db & TmpPg.toDataDirectory}|]
+    -- print [fmt|conn string: {db & TmpPg.toConnectionString}|]
+    act db
diff --git a/users/Profpatsch/whatcd-resolver/whatcd-resolver.cabal b/users/Profpatsch/whatcd-resolver/whatcd-resolver.cabal
new file mode 100644
index 0000000000..a9bd04827b
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/whatcd-resolver.cabal
@@ -0,0 +1,121 @@
+cabal-version:      3.0
+name:               whatcd-resolver
+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
+
+    -- Allow the same record field name to be declared twice per module.
+    -- This works, because we use `OverloadedRecordDot` everywhere (enforced by `NoFieldSelectors`).
+    DuplicateRecordFields
+
+    -- Record punning
+    RecordWildCards
+
+    -- Improved Deriving
+    DerivingStrategies
+    DerivingVia
+
+    -- Type-level strings
+    DataKinds
+
+    -- to enable the `type` keyword in import lists (ormolu uses this automatically)
+    ExplicitNamespaces
+
+    -- allows defining pattern synonyms, but also the `import Foo (pattern FooPattern)` import syntax
+    PatternSynonyms
+
+  default-language: GHC2021
+
+library
+    import: common-options
+
+    hs-source-dirs: src
+
+    exposed-modules:
+       WhatcdResolver
+       AppT
+       JsonLd
+       Optional
+       Http
+       Html
+       Transmission
+       Redacted
+
+    build-depends:
+        base >=4.15 && <5,
+        text,
+        my-prelude,
+        my-webstuff,
+        pa-prelude,
+        pa-error-tree,
+        pa-label,
+        pa-json,
+        pa-field-parser,
+        pa-run-command,
+        aeson-better-errors,
+        aeson,
+        blaze-html,
+        bytestring,
+        case-insensitive,
+        containers,
+        unordered-containers,
+        directory,
+        exceptions,
+        filepath,
+        hs-opentelemetry-sdk,
+        hs-opentelemetry-api,
+        http-conduit,
+        http-types,
+        http-client,
+        ihp-hsx,
+        monad-logger,
+        mtl,
+        network-uri,
+        resource-pool,
+        postgresql-simple,
+        punycode,
+        tmp-postgres,
+        unliftio,
+        wai-extra,
+        wai,
+        warp,
+
+executable whatcd-resolver
+    import: common-options
+
+    main-is: Main.hs
+
+    build-depends:
+        base >=4.15 && <5,
+        whatcd-resolver
diff --git a/users/Profpatsch/writers/default.nix b/users/Profpatsch/writers/default.nix
index 3151a9d3bd..9fb69231a1 100644
--- a/users/Profpatsch/writers/default.nix
+++ b/users/Profpatsch/writers/default.nix
@@ -1,7 +1,7 @@
 { depot, pkgs, lib, ... }:
 let
-  bins = depot.nix.getBins pkgs.s6-portable-utils ["s6-mkdir" "s6-cat" "s6-ln" "s6-ls" "s6-touch" ]
-      // depot.nix.getBins pkgs.coreutils ["printf" ];
+  bins = depot.nix.getBins pkgs.s6-portable-utils [ "s6-mkdir" "s6-cat" "s6-ln" "s6-ls" "s6-touch" ]
+    // depot.nix.getBins pkgs.coreutils [ "printf" ];
 
   inherit (depot.nix.yants) defun struct restrict attrs list string drv any;
 
@@ -11,66 +11,110 @@ let
     restrict
       "flake error"
       (s: lib.any (prefix: (builtins.substring 0 1 s) == prefix)
-          [ "E" "W" ])
+        [ "E" "W" ])
       string;
   Libraries = defun [ (attrs any) (list drv) ];
 
-  python3 = {
-    name,
-    libraries ? (_: []),
-    flakeIgnore ? []
-  }: pkgs.writers.writePython3 name {
-    libraries = Libraries libraries pkgs.python3Packages;
-    flakeIgnore =
-      let ignoreTheseErrors = [
-        # whitespace after {
-        "E201"
-        # whitespace before }
-        "E202"
-        # fuck 4-space indentation
-        "E121" "E111"
-        # who cares about blank lines …
-        # … at end of files
-        "W391"
-        # … between functions
-        "E302" "E305"
-      ];
-      in list FlakeError (ignoreTheseErrors ++ flakeIgnore);
-  };
+  pythonPackages = pkgs.python310Packages;
+  buildPythonPackages = pkgs.buildPackages.python310Packages;
+  python = pythonPackages.python;
+
+  python3 =
+    { name
+    , libraries ? (_: [ ])
+    , flakeIgnore ? [ ]
+    }:
+    let
+    in
+    pkgs.writers.makePythonWriter python pythonPackages buildPythonPackages name {
+      libraries = Libraries libraries pythonPackages;
+      flakeIgnore =
+        let
+          ignoreTheseErrors = [
+            # whitespace after {
+            "E201"
+            # whitespace before }
+            "E202"
+            # fuck 4-space indentation
+            "E121"
+            "E111"
+            # who cares about blank lines …
+            # … at end of files
+            "W391"
+            # … between functions
+            "E302"
+            "E305"
+            # … if there’s too many of them
+            "E303"
+            # or lines that are too long
+            "E501"
+          ];
+        in
+        list FlakeError (ignoreTheseErrors ++ flakeIgnore);
+    };
 
   # TODO: add the same flake check as the pyhon3 writer
-  python3Lib = { name, libraries ? (_: []) }: moduleString:
-    let srcTree = depot.nix.runExecline.local name { stdin = moduleString; } [
-      "importas" "out" "out"
-      "if" [ bins.s6-mkdir "-p" "\${out}/${name}" ]
-      "if" [
-        "redirfd" "-w" "1" "\${out}/setup.py"
-        bins.printf ''
-          from distutils.core import setup
+  python3Lib = { name, libraries ? (_: [ ]) }: moduleString:
+    let
+      srcTree = depot.nix.runExecline.local name { stdin = moduleString; } [
+        "importas"
+        "out"
+        "out"
+        "if"
+        [ bins.s6-mkdir "-p" "\${out}/${name}" ]
+        "if"
+        [
+          "redirfd"
+          "-w"
+          "1"
+          "\${out}/setup.py"
+          bins.printf
+          ''
+            from distutils.core import setup
 
-          setup(
-            name='%s',
-            packages=['%s']
-          )
-        '' name name
-      ]
-      "if" [
-        # redirect stdin to the init py
-        "redirfd" "-w" "1" "\${out}/${name}/__init__.py"
-        bins.s6-cat
-      ]
-    ];
-    in pkgs.python3Packages.buildPythonPackage {
+            setup(
+              name='%s',
+              packages=['%s']
+            )
+          ''
+          name
+          name
+        ]
+        "if"
+        [
+          # redirect stdin to the init py
+          "redirfd"
+          "-w"
+          "1"
+          "\${out}/${name}/__init__.py"
+          bins.s6-cat
+        ]
+      ];
+    in
+    pythonPackages.buildPythonPackage {
       inherit name;
       src = srcTree;
-      propagatedBuildInputs = libraries pkgs.python3Packages;
+      propagatedBuildInputs = libraries pythonPackages;
       doCheck = false;
     };
 
 
-in {
+  ghcBins = libraries: depot.nix.getBins (pkgs.ghc.withPackages (_: libraries)) [ "runghc" ];
+
+  writeHaskellInteractive = name: { libraries, ghcArgs ? [ ] }: path:
+    depot.nix.writeExecline name { } ([
+      (ghcBins libraries).runghc
+      "--"
+    ] ++ ghcArgs ++ [
+      "--"
+      path
+    ]);
+
+in
+{
   inherit
     python3
     python3Lib
+    writeHaskellInteractive
     ;
 }
diff --git a/users/Profpatsch/writers/tests/default.nix b/users/Profpatsch/writers/tests/default.nix
index c4769a28c6..879aae82f7 100644
--- a/users/Profpatsch/writers/tests/default.nix
+++ b/users/Profpatsch/writers/tests/default.nix
@@ -10,38 +10,46 @@ let
     coreutils
     ;
 
-  run = drv: depot.nix.runExecline.local "run-${drv.name}" {} [
-    "if" [ drv ]
-    "importas" "out" "out"
-    "${coreutils}/bin/touch" "$out"
+  run = drv: depot.nix.runExecline.local "run-${drv.name}" { } [
+    "if"
+    [ drv ]
+    "importas"
+    "out"
+    "out"
+    "${coreutils}/bin/touch"
+    "$out"
   ];
 
-  pythonTransitiveLib = python3Lib {
-    name = "transitive";
-  } ''
+  pythonTransitiveLib = python3Lib
+    {
+      name = "transitive";
+    } ''
     def transitive(s):
       return s + " 1 2 3"
   '';
 
-  pythonTestLib = python3Lib {
-    name = "test_lib";
-    libraries = _: [ pythonTransitiveLib ];
-  } ''
+  pythonTestLib = python3Lib
+    {
+      name = "test_lib";
+      libraries = _: [ pythonTransitiveLib ];
+    } ''
     import transitive
     def test():
       return transitive.transitive("test")
   '';
 
-  pythonWithLib = run (python3 {
-    name = "python-with-lib";
-    libraries = _: [ pythonTestLib ];
-  } ''
+  pythonWithLib = run (python3
+    {
+      name = "python-with-lib";
+      libraries = _: [ pythonTestLib ];
+    } ''
     import test_lib
 
-    assert(test_lib.test() == "test 1 2 3")
+    assert test_lib.test() == "test 1 2 3"
   '');
 
-in depot.nix.utils.drvTargets {
+in
+depot.nix.readTree.drvTargets {
   inherit
     pythonWithLib
     ;
diff --git a/users/Profpatsch/ytextr/README.md b/users/Profpatsch/ytextr/README.md
new file mode 100644
index 0000000000..f1e40d8e68
--- /dev/null
+++ b/users/Profpatsch/ytextr/README.md
@@ -0,0 +1,5 @@
+# ytextr
+
+Wrapper around `yt-dlp` for downloading videos in good default quality with good default settings.
+
+Will always download the most up-to-date `yt-dlp` first, because the software usually stops working after a few weeks and needs to be updated, so just using `<nixpkgs>` often fails.
diff --git a/users/Profpatsch/ytextr/create-symlink-farm.nix b/users/Profpatsch/ytextr/create-symlink-farm.nix
new file mode 100644
index 0000000000..7b3a45b916
--- /dev/null
+++ b/users/Profpatsch/ytextr/create-symlink-farm.nix
@@ -0,0 +1,19 @@
+{
+  # list of package attribute names to get at run time
+  packageNamesAtRuntimeJsonPath
+,
+}:
+let
+  pkgs = import <nixpkgs> { };
+
+  getPkg = pkgName: pkgs.${pkgName};
+
+  packageNamesAtRuntime = builtins.fromJSON (builtins.readFile packageNamesAtRuntimeJsonPath);
+
+  runtime = map getPkg packageNamesAtRuntime;
+
+in
+pkgs.symlinkJoin {
+  name = "symlink-farm";
+  paths = runtime;
+}
diff --git a/users/Profpatsch/ytextr/default.nix b/users/Profpatsch/ytextr/default.nix
new file mode 100644
index 0000000000..3f3f073113
--- /dev/null
+++ b/users/Profpatsch/ytextr/default.nix
@@ -0,0 +1,82 @@
+{ depot, pkgs, lib, ... }:
+
+# ytextr is a wrapper arount yt-dlp (previously youtube-dl)
+# that extracts a single video according to my preferred settings.
+#
+# It will be sandboxed to the current directory, since I don’t particularly
+# trust the massive codebase of that tool (with hundreds of contributors).
+#
+# Since the rules for downloading videos is usually against the wishes
+# of proprietary vendors, and a video is many megabytes anyway,
+# it will be fetched from the most recent nixpkgs unstable channel before running.
+
+let
+  bins = depot.nix.getBins pkgs.nix [ "nix-build" ]
+    // depot.nix.getBins pkgs.bubblewrap [ "bwrap" ];
+
+  # Run a command, with the given packages in scope, and `packageNamesAtRuntime` being fetched at the start in the given nix `channel`.
+  nix-run-with-channel =
+    {
+      # The channel to get `packageNamesAtRuntime` from
+      channel
+    , # executable to run with `packageNamesAtRuntime` in PATH
+      # and the argv
+      executable
+    , # A list of nixpkgs package attribute names that should be put into PATH when running `command`.
+      packageNamesAtRuntime
+    ,
+    }: depot.nix.writeExecline "nix-run-with-channel-${channel}" { } [
+      # TODO: prevent race condition by writing a temporary gc root
+      "backtick"
+      "-iE"
+      "storepath"
+      [
+        bins.nix-build
+        "-I"
+        "nixpkgs=channel:${channel}"
+        "--arg"
+        "packageNamesAtRuntimeJsonPath"
+        (pkgs.writeText "packageNamesAtRuntime.json" (builtins.toJSON packageNamesAtRuntime))
+        ./create-symlink-farm.nix
+      ]
+      "importas"
+      "-ui"
+      "PATH"
+      "PATH"
+      "export"
+      "PATH"
+      "\${storepath}/bin:\${PATH}"
+      executable
+      "$@"
+    ];
+
+in
+nix-run-with-channel {
+  channel = "nixos-unstable";
+  packageNamesAtRuntime = [ "yt-dlp" ];
+  executable = depot.nix.writeExecline "ytextr" { } [
+    "getcwd"
+    "-E"
+    "cwd"
+    bins.bwrap
+    "--ro-bind"
+    "/nix/store"
+    "/nix/store"
+    "--ro-bind"
+    "/etc"
+    "/etc"
+    "--bind"
+    "$cwd"
+    "$cwd"
+    "yt-dlp"
+    "--no-playlist"
+    "--write-sub"
+    "--all-subs"
+    "--embed-subs"
+    "--merge-output-format"
+    "mkv"
+    "-f"
+    "bestvideo[height<=?1080]+bestaudio/best"
+    "$@"
+  ];
+}