{ config, pkgs, ... }:

let
  haskellEnv = pkgs.haskellPackages.ghcWithPackages (pkgs: with pkgs; [ filepath directory cryptonite bytestring ]);
  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 Crypto.Hash

      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, (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
                    putStrLn $ show ["-L", listDir, "-l", "6", "-m", "queue/exposed", "-T", recipient]
                    -- getContents >>= writeFile "queue/exposed"
                    -- callProcess "${pkgs.mlmmj}/bin/mlmmj-send" ["-L", listDir, "-l", "6", "-m", "queue/exposed", "-T", recipient]
                  [] -> 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 :: BS.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 $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 ];
}