{ config, pkgs, ... }:

let
  haskellEnv = pkgs.haskellPackages.ghcWithPackages (pkgs: with pkgs; [ filepath directory SimpleAES bytestring hex ]);
  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 Data.Char

      import Control.Monad

      import Codec.Crypto.SimpleAES

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

      import Data.Hex

      main :: IO ()
      main = do
        progName <- takeFileName <$> getProgName
        case progName of
          "mlmmj-exposed" -> do
            args <- getArgs
            case args of
              [listDir, rawExtension] -> do
                extension <- CLBS.pack <$> unhex rawExtension
                setCurrentDirectory listDir
                key <- (BS.readFile "exposed.key") `catchIOError` (\e -> if isDoesNotExistError e then randomKey >>= (\k -> BS.writeFile "exposed.key" k >> return k) else ioError e)
                let ((map toLower -> ident), (map toLower -> recipient)) = read . CLBS.unpack $ decryptMsg CBC key extension
                identities <- getIdentities
                unless (ident `elem` identities) . die $ "Unknown sender: ‘" ++ ident ++ "’"
                subscribers <- getSubscribers
                unless (recipient `elem` subscribers) . die $ "Unknown recipient: ‘" ++ recipient ++ "’"
                getContents >>= writeFile "queue/exposed"
                callProcess "${pkgs.mlmmj}/bin/mlmmj-send" ["-L", listDir, "-l", "6", "-m", "queue/exposed", "-T", recipient]
              _ -> 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 <- (read <$> readFile "exposed.ids") `catchIOError` (\e -> if isDoesNotExistError e then return [] else ioError e)
                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
                key <- (BS.readFile "exposed.key") `catchIOError` (\e -> if isDoesNotExistError e then randomKey >>= (\k -> BS.writeFile "exposed.key" k >> return k) else ioError e)
                identities <- getIdentities
                unless (ident `elem` identities) . die $ "Unknown sender: ‘" ++ ident ++ "’"
                subscribers <- getSubscribers
                forM_ recipients (\recipient -> do {
                  unless (recipient `elem` subscribers) . die $ "Unknown recipient: ‘" ++ recipient ++ "’";
                  encryptMsg CBC key (CLBS.pack . show $ (ident, recipient)) >>= putStrLn . (\ext -> takeFileName listDir ++ "+" ++ ext ++ "@subs.lists.yggdrasil.li") . hex . CLBS.unpack;
                })
              _ -> 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))

      massage :: BS.ByteString -> BS.ByteString
      massage = CBS.pack . map massage' . CBS.unpack
        where
          massage' '+' = '-'
          massage' '/' = '_'
          massage' c = c

      unmassage :: BS.ByteString -> BS.ByteString
      unmassage = CBS.pack . map massage' . CBS.unpack
        where
          massage' '-' = '+'
          massage' '_' = '/'
          massage' c = c
    '';
    buildCommand = ''
      mkdir -p $out/bin
      #cp $src $out/bin/.mlmmj-exposed
      ${haskellEnv}/bin/ghc -o $out/bin/.mlmmj-exposed $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 ];
}