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 <mail@profpatsch.de>
Reviewed-by: Profpatsch <mail@profpatsch.de>
This commit is contained in:
Profpatsch 2023-01-15 21:20:40 +01:00
parent 1a18c25d81
commit f627ee84b3
5 changed files with 107 additions and 23 deletions

View file

@ -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)

View file

@ -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
|]
}

View file

@ -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 <-

View file

@ -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
];
ghcArgs = [ "-threaded" ];
})
(depot.users.Profpatsch.arglib.netencode.with-args {
BINS = depot.nix.getBins pkgs.dovecot_pigeonhole [ "sieve-test" ];
})
src = depot.users.Profpatsch.exactSource ./. [
./mailbox-org.cabal
./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.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" ];
})
]

View file

@ -27,7 +27,12 @@ executable mailbox-org
aeson,
aeson-better-errors,
bytestring,
PyF,
typed-process,
process,
containers,
default-language: Haskell2010
default-extensions:
GHC2021