{-# LANGUAGE RankNTypes, RecordWildCards, ApplicativeDo, FlexibleContexts #-}

module Postdelay.Queue
  ( sendmail
  , StoredMailF(..)
  , StoredMail, StoredMail'
  , sendStored, sendStored'
  , StoreConfig, storeConfig
  , pushStore, popStore
  ) where

import Postdelay.Types

import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Catch (handle, MonadThrow(throwM))
import Control.Monad.Trans.Maybe
import Control.Monad.Reader
import Control.Monad.Trans.Class
import Control.Monad

import System.IO (hClose, stderr)
import System.IO.Error
import GHC.IO.Exception
import System.Process

import Data.ByteString.Lazy as Lazy (ByteString)
import qualified Data.ByteString.Lazy as Lazy.BS

import Foreign.C.Error (Errno(..), ePIPE)

import Data.Bool
import Data.Conduit
import Data.Time

import qualified Options.Applicative as Opt (Parser)
import Options.Applicative hiding (Parser)


data StoredMailF a = StoredMail
  { sendDelay :: Delay
  , sender :: String
  , recipients :: [String]
  , message :: a
  }

type StoredMail = StoredMailF Lazy.ByteString
type StoredMail' = StoredMailF (IO Lazy.ByteString)

data StoreConfig = StoreConfig
  { storeLocation :: FilePath
  }


storeConfig :: Opt.Parser StoreConfig
storeConfig = do
  storeLocation <- strOption $ mconcat
    [ long "spool"
    , short 's'
    , metavar "PATH"
    , help "Where to expect the mail spool"
    ]
  pure StoreConfig{..}


sendmail' :: MonadIO m
         => [String] -- ^ Arguments to sendmail
         -> Lazy.ByteString -- ^ Message
         -> m ()
sendmail' args mail = liftIO . withCreateProcess cp $ \(Just inh) _ _ pHandle -> do
  ignoreSigPipe $ do
    Lazy.BS.hPutStr inh mail
    hClose inh

  ret <- waitForProcess pHandle
  bool throwM (\_ -> return ()) (ret == ExitSuccess) $ ret
  where
    cp = (proc "sendmail" args)
      { std_in = CreatePipe
      }
    ignoreSigPipe = handle $ \e -> case e of
      IOError { ioe_type  = ResourceVanished
              , ioe_errno = Just ioe }
        | Errno ioe == ePIPE -> return ()
      _ -> throwM e

sendmail :: MonadIO m
         => String -- ^ Sender
         -> [String] -- ^ Recipients
         -> Lazy.ByteString -- ^ Message
         -> m ()
sendmail sender recipients = sendmail' $ ["-G", "-i", "-f", sender, "--"] ++ recipients

sendStored :: MonadIO m => StoredMail -> m ()
sendStored StoredMail{ sendDelay = Until{..}, ..} = void . runMaybeT $ do
  now <- liftIO getCurrentTime
  guard $ now >= releaseTime
  lift $ sendmail sender recipients message

sendStored' :: MonadIO m => StoredMail' -> m ()
sendStored' StoredMail{..} = do
  message' <- liftIO message
  sendStored StoredMail{ message = message', .. }
  
popStore :: (MonadIO m, MonadReader StoreConfig m) => Source m StoredMail'
popStore = undefined

pushStore :: (MonadIO m, MonadReader StoreConfig m) => Source m StoredMail -> m ()
pushStore = undefined