diff --git a/common/secret/default.nix b/common/secret/default.nix index 46af7b39..c173e418 100644 Binary files a/common/secret/default.nix and b/common/secret/default.nix differ diff --git a/home/modules/mail.nix b/home/modules/mail.nix index 200d53ad..6087fad8 100644 --- a/home/modules/mail.nix +++ b/home/modules/mail.nix @@ -1,9 +1,114 @@ { lib, config, pkgs, ... }: with lib; let + inherit (import ../../lib) writeHaskellScript; mail = config.m-0.mail; inherit (config.m-0.private) sendmail me; + inherit (config.m-0.private.mail_filters) sortLists stupidLists notifications; maildir = config.accounts.email.maildirBasePath; + # mhdr -h List-ID -d Maildir/hera/Archiv/unsortiert | sort | sed 's/^.*<\(.*\)>$/\1/' | uniq | xargs -I '{}' sh -c "notmuch count List:{} | sed 's/$/: {}/'" | sort + # To find candidates + archiveSuffix = "hera/Archiv"; + unsortedSuffix = "${archiveSuffix}/unsortiert"; + unsorted = "${maildir}/${unsortedSuffix}"; + archive = "${maildir}/${archiveSuffix}"; + filter = rec { + mailToFolder = name: + toFolder (lib.concatStringsSep "." (splitString "@" name)); + toFolder = name: + lib.concatStringsSep "/" (lib.reverseList (lib.splitString "." name)); + simple = filter: target: { inherit filter target; }; + notifications = notify: + simple "from:${notify}" "notifications/${mailToFolder notify}"; + stupidList = list: simple "to:${list}" "list/${mailToFolder list}"; + simpleSortList = listName: + simple "List:${listName}" "list/${toFolder listName}"; + }; + myFilters = builtins.map filter.simpleSortList sortLists + ++ builtins.map filter.stupidList stupidLists + ++ builtins.map filter.notifications notifications; + sortMail = writeHaskellScript { + name = "sort-mail-archive"; + bins = [ pkgs.notmuch pkgs.coreutils pkgs.mblaze pkgs.findutils ]; + libraries = [ pkgs.haskellPackages.megaparsec ]; + imports = [ + "Text.Megaparsec" + "Text.Megaparsec.Char" + "Text.Megaparsec.Char.Lexer" + "qualified Data.List.NonEmpty as NE" + "qualified Data.Text as T" + "System.Environment (setEnv)" + ]; + } '' + reScan = notmuch "new" + + findFilterMail :: (Text,Text) -> IO (Maybe (LByteString, Text, Text)) + findFilterMail (filter, target) = do + files <- notmuch "search" "--output" "files" (toString filter) "folder:${unsortedSuffix}" |> capture + pure $ if (LBS.length files > 0) then Just (files, filter, target) else Nothing + + executeFilterMail :: (LByteString, Text, Text) -> IO () + executeFilterMail (files, filter, target) = do + putTextLn [i|Sorting "#{filter}" into #{target}|] + writeOutput files |> mscan + mmkdir ([i|${archive}/#{target}|] :: String) + writeOutput files |> mrefile ([i|${archive}/#{target}|] :: String) + + myFilters :: [(Text,Text)] + myFilters = [${ + lib.concatStringsSep "," + (builtins.map ({ filter, target }: ''("${filter}","${target}")'') + myFilters) + }] + + filtersFromTo :: Text -> Maybe (Text,Text) + filtersFromTo = filtersFromField "to" [toToName] + toToName :: Text -> Maybe Text + toToName (T.splitOn "@" -> [name, "maralorn.de"]) + | not (T.isInfixOf "randy" name) = Just . ("to/" <>) . T.intercalate "_" . T.splitOn "." $ name + toToName _ = Nothing + filtersFromField :: Text -> [Text-> Maybe Text] -> Text -> Maybe (Text,Text) + filtersFromField field filters text = fmap ([i|#{field}:#{text}|],) . viaNonEmpty Relude.head . mapMaybe ($ text) $ filters + filtersFromListIDs :: Text -> Maybe (Text,Text) + filtersFromListIDs = filtersFromField "List" [githubNameFolderFromId, gitlabNameFolderFromId] + githubNameFolderFromId :: Text -> Maybe Text + githubNameFolderFromId (reverse . T.splitOn "." -> ("com":"github":org:name)) = Just [i|github/#{org}/#{T.intercalate "_" $ reverse name}|] + githubNameFolderFromId _ = Nothing + gitlabNameFolderFromId :: Text -> Maybe Text + gitlabNameFolderFromId (reverse . T.splitOn "." -> ("de":"ccc":"darmstadt":"git":org:name1:name)) = Just [i|cda-gitlab/#{org}/#{T.intercalate "_" . toList . Relude.tail $ NE.reverse (name1:|name)}|] + gitlabNameFolderFromId _ = Nothing + + type Parser = Parsec Text Text + listId :: Parser Text + listId = manyTill anySingle (char '<') *> (toText <$> manyTill anySingle (char '>')) + + mySearch :: [String] -> IO [Text] + mySearch param = lines . decodeUtf8 <$> (Main.find ("${archive}":param) |> captureTrim) + + main :: IO () + main = do + setEnv "MBLAZE_PAGER" "cat" + setEnv "NOTMUCH_CONFIG" "${config.home.sessionVariables.NOTMUCH_CONFIG}" + reScan + (listIDs,tos) <- concurrently (mhdr "-h" "List-ID" "-d" "${unsorted}" |> capture) (mhdr "-h" "To" "-d" "${unsorted}" "-A" |> capture) + let listFilters = mapMaybe filtersFromListIDs . sortNub . mapMaybe (parseMaybe listId) . lines . decodeUtf8 $ listIDs + toFilters = mapMaybe filtersFromTo . sortNub . fmap (\x -> maybe x Relude.id $ parseMaybe listId x) . lines . decodeUtf8 $ tos + applicableFilters <- catMaybes <$> forConcurrently (listFilters <> myFilters <> toFilters) findFilterMail + for_ applicableFilters executeFilterMail + reScan + syncStates <- mySearch ["-name", ".mbsyncstate"] + dbFiles <- mySearch ["-name", ".isyncuidmap.db"] + dirs <- mySearch ["-type", "d"] + maildirs <- sortNub <$> (lines . decodeUtf8 =<<) <$> forM dirs (\dir -> mdirs (toString dir) |> captureTrim) + emptyMaildirs <- filterM (\dir -> (== 0) . LBS.length <$> (mlist (toString dir) |> captureTrim)) maildirs + forM_ emptyMaildirs $ \dir -> rmdir ([[i|#{dir}/cur|],[i|#{dir}/new|],[i|#{dir}/tmp|]] :: [String]) + let nonMaildirs = filter (`notElem` maildirs) dirs + delSyncs = filter (`elem` syncStates) $ (\x -> [i|#{x}/.mbsyncstate|]) <$> nonMaildirs + delDbs = filter (`elem` dbFiles) $ (\x -> [i|#{x}/.isyncuidmap.db|]) <$> nonMaildirs + whenNotNull (delSyncs ++ delDbs) $ rm . fmap toString . toList + emptyDirs <- Main.find "${archive}" "-type" "d" "-empty" "!" "-name" "cur" "!" "-name" "tmp" "!" "-name" "new" "-print0" |> capture + when (LBS.length emptyDirs > 0) $ writeOutput emptyDirs |> xargs "-0" "rmdir" + ''; in { options.m-0.mail.enable = mkEnableOption "private-mail"; @@ -15,8 +120,7 @@ in { enable = true; frequency = "*:0/30"; verbose = false; - postExec = - "${pkgs.notmuch}/bin/notmuch --config=${config.home.sessionVariables.NOTMUCH_CONFIG} new"; + postExec = "${sortMail}/bin/sort-mail-archive"; }; accounts.email.accounts = config.m-0.mail.accounts; @@ -75,8 +179,9 @@ in { }; maildir.synchronizeFlags = true; }; + home = { - packages = with pkgs; [ neomutt ]; + packages = [ pkgs.neomutt sortMail ]; file = let mutt_alternates = "@maralorn.de " + (builtins.concatStringsSep " " me.alternates); @@ -166,9 +271,9 @@ in { source "${hide-sidebar}" macro index "source ${hide-sidebar}" macro index "source ${show-sidebar}" - set sidebar_folder_indent=yes - set sidebar_short_path=yes - set sidebar_width=40 + set sidebar_folder_indent=no + set sidebar_short_path=no + set sidebar_width=60 set sidebar_sort_method="alpha" set sidebar_indent_string=" " color sidebar_indicator black white diff --git a/lib/default.nix b/lib/default.nix index 0163834e..9f151479 100644 --- a/lib/default.nix +++ b/lib/default.nix @@ -45,13 +45,22 @@ rec { writeHaskellScript = { name ? "haskell-script", bins ? [ ], libraries ? [ ], imports ? [ ] }: code: - pkgs.writers.writeHaskellBin name { - libraries = libraries ++ [ - shh - pkgs.haskellPackages.string-interpolate - pkgs.haskellPackages.relude - ]; - } '' + pkgs.writers.makeBinWriter { + compileScript = '' + cp $contentPath ${name}.hs + ${ + pkgs.ghc.withPackages (_: + libraries ++ [ + shh + pkgs.haskellPackages.string-interpolate + pkgs.haskellPackages.relude + pkgs.haskellPackages.async + ]) + }/bin/ghc ${name}.hs -threaded + mv ${name} $out + ${pkgs.binutils-unwrapped}/bin/strip --strip-unneeded "$out" + ''; + } "/bin/${name}" '' {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} @@ -62,15 +71,18 @@ rec { {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude #-} + {-# LANGUAGE TupleSections #-} import Shh import Relude import qualified Relude.Unsafe as Unsafe + import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString as BS import qualified Data.Text as Text import System.Environment (getArgs) import Control.Exception (bracket, try) import Data.String.Interpolate (i) + import Control.Concurrent.Async ${builtins.concatStringsSep "\n" (map (x: "import ${x}") imports)} -- Load binaries from Nix packages. The dependencies will be captured