{ config, pkgs, ... }:

let
  haskellEnv = pkgs.haskellPackages.ghcWithPackages (pkgs: with pkgs; [ filepath directory simpleAES bytestring base64-bytestring ]);
  mlmmj-exposed = pkgs.stdenv.mkDerivation {
    name = "mlmmj-exposed";
    src = pkgs.writeScript "mlmmj-exposed" ''
      #! ${haskellEnv}/bin/runghc

      {-# 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.Base64 as Base64

      main :: IO ()
      main = do
        progName <- takeFileName <$> getProgName
        case progName of
          "mlmmj-exposed" -> do
            args <- getArgs
            case args of
              [listDir, (Base64.decodeLenient -> extension)] -> 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)
                let (((map toLower -> ident), (map toLower -> recipient)) :: (String, String)) = read . CLBS.unpack $ decryptMsg CBC key recipientExt
                identities <- (read <$> readFile "exposed.ids") `catchIOError` (\e -> if isDoesNotExistError e then return [] else ioError e)
                unless (ident `elem` identities) . die $ "Unknown sender: ‘" ++ ident ++ "’"
                subscribers <- getSubscribers
                unless (recipient `elem` subscribers) . dio $ "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 "exosed.ids" . show $ ident : identities
              _ -> hPutStrLn stderr ("Called without expected arguments (<listDirectory> <senderIdentity>)") >> exitWith (ExitFailure 2)
           "mlmmj-get-exposed" -> do
            args <- getArgs
            case args of
              [listDir, (map toLower -> ident), (map toLower -> recipient)] -> 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 <- (read <$> readFile "exposed.ids") `catchIOError` (\e -> if isDoesNotExistError e then return [] else ioError e)
                unless (ident `elem` identities) . die $ "Unknown sender: ‘" ++ ident ++ "’"
                subscribers <- getSubscribers
                unless (recipient `elem` subscribers) . dio $ "Unknown recipient: ‘" ++ recipient ++ "’"
                encryptMsg CBC key (CLBS.pack . show $ (ident, recipient)) >>= CLBS.putStrLn
              _ -> hPutStrLn stderr ("Called without expected arguments (<listDirectory> <senderIdentity> <recipient>)") >> exitWith (ExitFailure 2)
          _ -> hPutStrLn stderr ("Called under unsupported name ‘" ++ progName ++ "’") >> exitWith (ExitFailure 2)

      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) =<< (getDirectoryContents dir)
    '';
    buildCommand = ''
      mkdir -p $out/bin
      cp $src $out/bin/.mlmmj-exposed
      ln -s $out/bin/mlmmj-exposed .mlmmj-exposed
    '';
  };
in rec {
  environment.systemPackages = [ mlmmj-exposed ];
}