{ config, pkgs, ... }:

let
  haskellEnv = pkgs.haskellPackages.ghcWithPackages (pkgs: with pkgs; [ filepath directory cryptonite bytestring uuid ]);
  mlmmj-exposed = pkgs.stdenv.mkDerivation {
    name = "mlmmj-exposed";
    src = pkgs.writeText "mlmmj-exposed.hs" ''
      {-# LANGUAGE ViewPatterns #-}

      import System.IO
      import System.IO.Error
      import System.FilePath
      import System.Environment
      import System.Exit
      import System.Directory
      import System.Process
      import Text.Printf

      import Data.Char

      import Control.Monad

      import Crypto.Hash

      import qualified Data.ByteString.Lazy as LBS
      import qualified Data.ByteString.Char8 as CBS

      import qualified Data.UUID as UUID (toString)
      import qualified Data.UUID.V4 as UUID (nextRandom)

      main :: IO ()
      main = do
        progName <- takeFileName <$> getProgName
        case progName of
          "mlmmj-exposed" -> do
            args <- getArgs
            case args of
              [listDir, (map toLower -> extension)] -> do
                setCurrentDirectory listDir
                identities <- getIdentities
                subscribers <- getSubscribers
                let hashes = filter ((==) extension . snd) [((ident, sub), hash' (ident, sub)) | ident <- identities, sub <- subscribers]
                case hashes of
                  [((_, recipient), _)] -> do
                    uuid <- UUID.nextRandom
                    let fName = "queue" </> "exposed" <.> UUID.toString uuid
                    getContents >>= writeFile fName
                    hPrintf stdout "Forwarding mail to <%s>, subscribed to %s\n" recipient (takeBaseName listDir)
                    callProcess "${pkgs.mlmmj}/bin/mlmmj-send" ["-L", listDir, "-l", "6", "-m", fName, "-T", recipient]
                    removeFile fName
                  [] -> die "Unknown extension"
                  _ -> die "Ambiguous extension"
              _ -> hPutStrLn stderr ("Called without expected arguments (<listDirectory> <recipientExtension>)") >> exitWith (ExitFailure 2)
          "mlmmj-expose" -> do
            args <- getArgs
            case args of
              [listDir, (map toLower -> ident)] -> do
                setCurrentDirectory listDir
                identities <- getIdentities
                case ident `elem` identities of
                  True -> putStrLn "Identity is already known"
                  False -> writeFile "exposed.ids" . unlines $ ident : identities
              _ -> hPutStrLn stderr ("Called without expected arguments (<listDirectory> <senderIdentity>)") >> exitWith (ExitFailure 2)
          "mlmmj-get-exposed" -> do
            args <- getArgs
            case args of
              (dropTrailingPathSeparator -> listDir) : (map toLower -> ident) : (map (map toLower) -> recipients) -> do
                setCurrentDirectory listDir
                identities <- getIdentities
                unless (ident `elem` identities) . die $ "Unknown sender: ‘" ++ ident ++ "’"
                subscribers <- getSubscribers
                forM_ recipients (\recipient -> do {
                  unless (recipient `elem` subscribers) . die $ "Unknown recipient: ‘" ++ recipient ++ "’";
                  putStrLn $ takeFileName listDir ++ "+" ++ hash' (ident, recipient) ++ "@subs.lists.yggdrasil.li";
                })
              _ -> hPutStrLn stderr ("Called without expected arguments (<listDirectory> <senderIdentity> [<recipient> [...]])") >> exitWith (ExitFailure 2)
          _ -> hPutStrLn stderr ("Called under unsupported name ‘" ++ progName ++ "’") >> exitWith (ExitFailure 2)
      getIdentities :: IO [String]
      getIdentities = (filter (not . null) . lines <$> readFile "exposed.ids") `catchIOError` (\e -> if isDoesNotExistError e then return [] else ioError e)

      getSubscribers :: IO [String]
      getSubscribers = map (map toLower) . concat <$> mapM (flip catchIOError (\e -> if isDoesNotExistError e then return [] else ioError e) . readDir) ["subscribers.d", "digesters.d"]
        where
          readDir dir = concat <$> (mapM (fmap lines . readFile) . map (dir </>) . filter (not . (`elem` [".", ".."]))=<< (getDirectoryContents dir))

      hash' :: Show a => a -> String
      hash' = take len . map toLower . show . (hash :: CBS.ByteString -> Digest SHA256) . CBS.pack . map toLower . show

      len :: Int
      len = 32
    '';
    buildCommand = ''
      mkdir -p $out/bin
      #cp $src $out/bin/.mlmmj-exposed
      ${haskellEnv}/bin/ghc -o $out/bin/.mlmmj-exposed -odir . -hidir . $src
      for f in mlmmj-exposed mlmmj-expose mlmmj-get-exposed; do
        ln -s .mlmmj-exposed $out/bin/$f
      done
    '';
  };
in rec {
  nixpkgs.config.packageOverrides = pkgs: rec {
    inherit mlmmj-exposed;
  };
  environment.systemPackages = [ mlmmj-exposed ];
}