{-  darcs-monitor - Darcs repository monitor
    Copyright © 2007 Antti-Juhani Kaijanaho
    Copyright © 2007 Benjamin Franksen

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License along
    with this program; if not, write to the Free Software Foundation, Inc.,
    51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-}
module EmailPatch (emailPatch,defaultSendmail) where

import Control.Monad.Trans
import System.Directory
import System.Exit
import System.IO
import System.Process

import Config
import Darcs
import PatchData

import Paths_darcs_monitor

defaultSendmail :: String
defaultSendmail = "/usr/sbin/sendmail"

sendMail :: (MonadConfig m, MonadIO m) =>
            String -> String -> m Bool
sendMail recipient text = do
  sendmail <- asks confSendmailPath
  liftIO $ do (inh, outh, errh, ph) <-
                  runInteractiveProcess sendmail [recipient] Nothing Nothing
              hClose outh
              hPutStr inh text
              hClose inh
              err <- hGetContents errh
              hPutStr stderr err
              ec <- waitForProcess ph
              return (ec == ExitSuccess)

emailPatch :: (MonadConfig m, MonadIO m) =>
              String -> PatchData -> m Bool
emailPatch rec pd = do
  diff <- invokeDarcs ["diff"
                      ,"--match=hash " ++ patchHash pd
                      ,"--repo=" ++ patchRepo pd
                      ,"-u"]
  changes <- invokeDarcs ["changes"
                      ,"--match=hash " ++ patchHash pd
                      ,"--repo=" ++ patchRepo pd
                      ,"-s"]
  menc <- asks confCharset
  met <- asks confEmailTemplate
  maxDiff <- asks confMaxDiff
  et <- liftIO $ case met of
          Just s  -> return s
          Nothing -> do let s = patchRepoDir pd ++ "email-template"
                        ex <- doesFileExist s
                        if ex
                          then return s
                          else getDataFileName "default-template"
  tmpl <- liftIO $ readFile et
  let f hdr ('%':'%':r) = let r' = dropWhile (/= '\n') r
                              r'' = case r' of ('\n':r''') -> r'''
                                               _           -> r'
                          in f hdr r''
      f hdr ('%':r) = let (k,('%':r')) = span (/= '%') r
                          he s = if hdr
                                 then headerEncode menc s 
                                 else nhe s
                          nhe = showString
                          repl = case k of
                                   "RECIPIENT" -> nhe rec
                                   "DIFF"      -> he
                                                  $ case maxDiff of
                                                    Just md
                                                      | length diff > md
                                                        -> take md diff ++
                                                           "[...incomplete...]"
                                                    _ -> diff
                                   "CHANGES"   -> he changes
                                   "REPO"      -> he (patchRepo pd)
                                   "SHORTREPO" -> he (shortRepo pd)
                                   "AUTHOR"    -> he (patchAuthor pd ++ " ") .
                                                  showChar '<' .
                                                  nhe (patchAuthorEmail pd) .
                                                  showChar '>'
                                   "DATE"      -> nhe (patchDate pd)
                                   "HASH"      -> nhe (patchHash pd)
                                   "TITLE"     -> he (patchTitle pd)
                                   "COMMENT"   -> he (patchComment pd)
                                   _           -> nhe ('%' : k ++ "%")
                      in repl . f hdr r'
      f True ('\n':'\n':r) = showString "\n\n" . f False r
      f hdr (c:r) = showChar c . f hdr r
      f _ [] = id
      text' = f True tmpl
  let text = case menc of
               Just enc -> showString "MIME-Version: 1.0\n\
                                      \Content-Transfer-Encoding: 8bit\n\
                                      \Content-Type: text/plain; charset=" .
                           showString enc .
                           showChar '\n' .
                           text'
               Nothing -> text'
  liftIO $ putStrLn $ "Sending mail to " ++ rec ++ " about " ++ patchTitle pd
  sendMail rec (text "")


headerEncode :: Maybe String -> String -> ShowS
headerEncode menc str =
  case menc of
    Nothing  -> showString str
    Just enc -> let ws = words str
                    ws' = map (\s ->
                               if areSafe s
                               then s
                               else "=?" ++
                                    enc ++
                                    "?Q?" ++
                                    qEnc s "" ++
                                    "?="
                              ) ws
                in showString (unwords ws')
        where qEnc [] = id
              qEnc (' ':r) = showChar '_' . qEnc r
              qEnc ('_':r) = showString "=5F" . qEnc r
              qEnc (c:r)
                  | c `elem` safe = showChar c . qEnc r
                  | otherwise            = showChar '=' .
                                           showChar c1 .
                                           showChar c2 .
                                           qEnc r
                  where a = fromEnum c
                        a1 = a `div` 16
                        a2 = a `mod` 16
                        c1 = hds !! a1
                        c2 = hds !! a2
                        hds = "0123456789ABCDEF"

safe :: String
safe = "<>@-+.abcdefghijklmnopqrstuvwxyABCDEFGHIJKLMNOPQRSTUVWXY0123456789\
       \!\"#$%&\'()*,:;[]\\^_`{}|~/"

areSafe :: String -> Bool
areSafe = all (`elem` safe)

shortRepo :: PatchData -> String
shortRepo he 
    | last repo == '/' = reverse $ takeWhile (/= '/') $ tail $ reverse repo
    | '/' `elem` repo  = reverse $ takeWhile (/= '/') $ reverse repo
    | otherwise        = repo
      where repo = patchRepo he