feat(users/Profpatsch/mailbox-org): add simple request json example r/5661

Adds a simple json quasiquoter thingy.

Json can be sent to the `/mailfilter?action=update` endpoint.

Change-Id: Iba80c2ab69178e431519933c4a01cd68aaa9f637
Reviewed-on: https://cl.tvl.fyi/c/depot/+/7839
Tested-by: BuildkiteCI
Autosubmit: Profpatsch <mail@profpatsch.de>
Reviewed-by: Profpatsch <mail@profpatsch.de>

4 files changed, 105 insertions, 21 deletions

diff --git a/users/Profpatsch/mailbox-org/AesonQQ.hs b/users/Profpatsch/mailbox-org/AesonQQ.hs
new file mode 100644
index 000000000000..02e1c2f3dff0
--- /dev/null
+++ b/users/Profpatsch/mailbox-org/AesonQQ.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE TemplateHaskellQuotes #-}
+
+module AesonQQ where
+
+import Data.Aeson qualified as Json
+import Data.Either qualified as Either
+import MyPrelude
+import PyF qualified
+import PyF.Internal.QQ qualified as PyFConf
+
+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/mailbox-org/MailboxOrg.hs b/users/Profpatsch/mailbox-org/MailboxOrg.hs
index f17780c14e28..5e062979543b 100644
--- a/users/Profpatsch/mailbox-org/MailboxOrg.hs
+++ b/users/Profpatsch/mailbox-org/MailboxOrg.hs
@@ -14,6 +14,7 @@
 module Main where
 
 import Aeson (parseErrorTree)
+import AesonQQ (aesonQQ)
 import ArglibNetencode
 import Control.Exception (try)
 import Control.Monad (replicateM)
@@ -21,6 +22,7 @@ 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 Data.Error.Tree
 import Data.Functor.Compose
@@ -63,8 +65,7 @@ log err = do
   putStderrLn (errorContext progName.unCurrentProgramName err & prettyError)
 
 data Tools = Tools
-  { sieveTest :: Tool,
-    pass :: Tool
+  { pass :: Tool
   }
   deriving stock (Show)
 
@@ -75,7 +76,6 @@ parseTools :: Applicative m => (Text -> m (Either Error Tool)) -> m (Either Erro
 parseTools getTool = do
   let parser =
         ( do
-            sieveTest <- get "sieve-test"
             pass <- get "pass"
             pure Tools {..}
         )
@@ -144,6 +144,54 @@ data MailfilterList = MailfilterList
   }
   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 <-
diff --git a/users/Profpatsch/mailbox-org/default.nix b/users/Profpatsch/mailbox-org/default.nix
index 99b9d45b7d6a..cd419047223f 100644
--- a/users/Profpatsch/mailbox-org/default.nix
+++ b/users/Profpatsch/mailbox-org/default.nix
@@ -1,27 +1,35 @@
 { depot, pkgs, lib, ... }:
 
 let
+  mailbox-org = pkgs.haskellPackages.mkDerivation {
+    pname = "mailbox-org";
+    version = "0.1.0";
 
-  cas-serve =
-    lib.pipe ./MailboxOrg.hs [
-      (depot.users.Profpatsch.writers.writeHaskellInteractive "mailbox-org"
-        {
-          libraries = [
-            depot.users.Profpatsch.my-prelude
-            depot.users.Profpatsch.execline.exec-helpers-hs
-            depot.users.Profpatsch.arglib.netencode.haskell
-            pkgs.haskellPackages.aeson
-            pkgs.haskellPackages.http-conduit
-            pkgs.haskellPackages.aeson-better-errors
+    src = depot.users.Profpatsch.exactSource ./. [
+      ./mailbox-org.cabal
+      ./AesonQQ.hs
+      ./MailboxOrg.hs
+    ];
 
-          ];
-          ghcArgs = [ "-threaded" ];
-        })
-      (depot.users.Profpatsch.arglib.netencode.with-args {
-        BINS = depot.nix.getBins pkgs.dovecot_pigeonhole [ "sieve-test" ];
-      })
+    libraryHaskellDepends = [
+      depot.users.Profpatsch.my-prelude
+      depot.users.Profpatsch.execline.exec-helpers-hs
+      depot.users.Profpatsch.arglib.netencode.haskell
+      pkgs.haskellPackages.aeson
+      pkgs.haskellPackages.http-conduit
+      pkgs.haskellPackages.aeson-better-errors
     ];
 
+    isLibrary = false;
+    isExecutable = true;
+    license = lib.licenses.mit;
+  };
+
 
 in
-cas-serve
+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
index 66e96608e40f..fe65da409df6 100644
--- a/users/Profpatsch/mailbox-org/mailbox-org.cabal
+++ b/users/Profpatsch/mailbox-org/mailbox-org.cabal
@@ -27,7 +27,12 @@ executable mailbox-org
         aeson,
         aeson-better-errors,
         bytestring,
+        PyF,
+        typed-process,
         process,
         containers,
 
     default-language: Haskell2010
+
+    default-extensions:
+        GHC2021