chore(users/Profpatsch): park mailbox-org r/8777

I should probably remove the default.nix files in these as well so
they don’t get built on CI.

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

5 files changed, 0 insertions, 687 deletions

diff --git a/users/Profpatsch/mailbox-org/MailboxOrg.hs b/users/Profpatsch/mailbox-org/MailboxOrg.hs
deleted file mode 100644
index 6c5820080c76..000000000000
--- a/users/Profpatsch/mailbox-org/MailboxOrg.hs
+++ /dev/null
@@ -1,523 +0,0 @@
-{-# 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
deleted file mode 100644
index b84e7b59c130..000000000000
--- a/users/Profpatsch/mailbox-org/README.md
+++ /dev/null
@@ -1,7 +0,0 @@
-# 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
deleted file mode 100644
index 73bd28292dcc..000000000000
--- a/users/Profpatsch/mailbox-org/default.nix
+++ /dev/null
@@ -1,38 +0,0 @@
-{ 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
deleted file mode 100644
index a1b041447bbb..000000000000
--- a/users/Profpatsch/mailbox-org/mailbox-org.cabal
+++ /dev/null
@@ -1,95 +0,0 @@
-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
deleted file mode 100644
index 2ac3d533aeaa..000000000000
--- a/users/Profpatsch/mailbox-org/src/AesonQQ.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-{-# 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
-            |]
-      }