From f627ee84b3a002e8f1fe38d7859860faf7d40be9 Mon Sep 17 00:00:00 2001 From: Profpatsch Date: Sun, 15 Jan 2023 21:20:40 +0100 Subject: feat(users/Profpatsch/mailbox-org): add simple request json example 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 Reviewed-by: Profpatsch --- users/Profpatsch/arglib/netencode.nix | 2 +- users/Profpatsch/mailbox-org/AesonQQ.hs | 23 +++++++++++ users/Profpatsch/mailbox-org/MailboxOrg.hs | 54 ++++++++++++++++++++++++-- users/Profpatsch/mailbox-org/default.nix | 44 ++++++++++++--------- users/Profpatsch/mailbox-org/mailbox-org.cabal | 5 +++ 5 files changed, 106 insertions(+), 22 deletions(-) create mode 100644 users/Profpatsch/mailbox-org/AesonQQ.hs (limited to 'users/Profpatsch') diff --git a/users/Profpatsch/arglib/netencode.nix b/users/Profpatsch/arglib/netencode.nix index 2b94bd51cf..88bad97a3a 100644 --- a/users/Profpatsch/arglib/netencode.nix +++ b/users/Profpatsch/arglib/netencode.nix @@ -5,7 +5,7 @@ let # Add the given nix arguments to the program as ARGLIB_NETENCODE envvar # # Calls `netencode.gen.dwim` on the provided nix args value. - with-args = args: prog: depot.nix.writeExecline "${prog.name}-with-args" { } [ + with-args = name: args: prog: depot.nix.writeExecline "${name}-with-args" { } [ "export" "ARGLIB_NETENCODE" (depot.users.Profpatsch.netencode.gen.dwim args) diff --git a/users/Profpatsch/mailbox-org/AesonQQ.hs b/users/Profpatsch/mailbox-org/AesonQQ.hs new file mode 100644 index 0000000000..02e1c2f3df --- /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 f17780c14e..5e06297954 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 99b9d45b7d..cd41904722 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 66e96608e4..fe65da409d 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 -- cgit 1.4.1