module Snap.Snaplet.Postmark where
import Control.Applicative ((<$>))
import Control.Monad (when)
import Control.Monad.State (get)
import Control.Monad.Trans (MonadIO, liftIO)
import Control.Monad.Trans.Writer (WriterT (..), tell)
import qualified Data.Configurator as C
import Data.List (intercalate)
import Data.Maybe (fromMaybe, isNothing)
import qualified Data.Text as T
import Network.Api.Postmark (Email (..), PostmarkError,
PostmarkResponse, PostmarkSettings,
Sent, email, emails, postmarkHttps,
request)
import Snap.Snaplet (Handler, SnapletInit,
getSnapletUserConfig, makeSnaplet)
newtype Postmark = Postmark { unPostmark :: PostmarkSettings } deriving Show
class (MonadIO m, Functor m) => HasPostmark m where
getPostmark :: m Postmark
instance HasPostmark (Handler b Postmark) where
getPostmark = get
logErr :: MonadIO m => t -> IO (Maybe a) -> WriterT [t] m (Maybe a)
logErr err m = do
res <- liftIO m
when (isNothing res) (tell [err])
return res
initPostmark :: SnapletInit b Postmark
initPostmark = makeSnaplet "postmark" "Postmark email client" Nothing $ do
config <- getSnapletUserConfig
(mscfg, errs) <- runWriterT $ do
secretKey <- logErr "Must specify Strip secret key" $ C.lookup config "secret_key"
return $ Postmark <$> (postmarkHttps <$> (T.pack <$> secretKey))
return $ fromMaybe (error $ intercalate "\n" errs) mscfg
withPS :: HasPostmark m => (PostmarkSettings -> m a) -> m a
withPS f = unPostmark <$> getPostmark >>= f
sendEmail :: HasPostmark m => Email -> m (PostmarkResponse PostmarkError Sent)
sendEmail msg = withPS $ liftIO . flip request (email msg)
sendEmails :: HasPostmark m => [Email] -> m (PostmarkResponse PostmarkError [Sent])
sendEmails msgs = withPS $ liftIO . flip request (emails msgs)