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:
parent
1a18c25d81
commit
f627ee84b3
5 changed files with 107 additions and 23 deletions
|
@ -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)
|
||||
|
|
23
users/Profpatsch/mailbox-org/AesonQQ.hs
Normal file
23
users/Profpatsch/mailbox-org/AesonQQ.hs
Normal 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
|
||||
|]
|
||||
}
|
|
@ -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 <-
|
||||
|
|
|
@ -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" ];
|
||||
})
|
||||
]
|
||||
|
|
|
@ -27,7 +27,12 @@ executable mailbox-org
|
|||
aeson,
|
||||
aeson-better-errors,
|
||||
bytestring,
|
||||
PyF,
|
||||
typed-process,
|
||||
process,
|
||||
containers,
|
||||
|
||||
default-language: Haskell2010
|
||||
|
||||
default-extensions:
|
||||
GHC2021
|
||||
|
|
Loading…
Reference in a new issue