ses-html-snaplet (empty) → 0.1.0.0
raw patch · 4 files changed
+232/−0 lines, 4 filesdep +basedep +blaze-htmldep +bytestringsetup-changed
Dependencies added: base, blaze-html, bytestring, configurator, ses-html, snap, text, transformers
Files
- LICENSE +30/−0
- Setup.lhs +3/−0
- ses-html-snaplet.cabal +29/−0
- src/Snap/Snaplet/SES.hs +170/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2014, David Johnson++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Michael Snoyman nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ ses-html-snaplet.cabal view
@@ -0,0 +1,29 @@+name: ses-html-snaplet+version: 0.1.0.0+synopsis: Snaplet for the ses-html package+description: Send HTML formatted emails using Amazon's SES REST API with blaze+license: BSD3+license-file: LICENSE+author: David Johnson+maintainer: djohnson.m@gmail.com+copyright: David Johnson+category: Web, AWS, Email, Snap, Network+build-type: Simple+cabal-version: >=1.10++library+ exposed-modules: Snap.Snaplet.SES+ hs-source-dirs: src+ build-depends: base >=4.7 && <4.8+ , blaze-html >= 0.7.0.2+ , bytestring >= 0.10.4.0+ , configurator >= 0.3.0.0+ , ses-html >= 0.2.0.1+ , snap+ , text+ , transformers+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/dmjio/ses-html-snaplet
+ src/Snap/Snaplet/SES.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+module Snap.Snaplet.SES+ ( -- * Initialization+ initAWSKeys+ , sendEmail+ , sendEmailBlaze+ , withKeys+ -- * Types+ , AWSKeys (..)+ , HasAWSKeys (..)+ -- * Module Re-export+ , module Network.SES+ ) where++import Control.Monad.Trans.Reader (ReaderT, asks, ask)+import qualified Data.ByteString.Lazy.Char8 as BL8+import qualified Data.Configurator as C+import Data.Maybe (fromMaybe)+import Data.Monoid (mempty)+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import Network.SES hiding (sendEmail, sendEmailBlaze)+import qualified Network.SES as SES+import Snap+import qualified Text.Blaze.Html5 as H++------------------------------------------------------------------------------+-- | Type to hold AWS Config Information+data AWSKeys = AWSKeys+ { publicKey :: PublicKey -- ^ AWS Public Key+ , secretKey :: SecretKey -- ^ AWS Secret Key+ , region :: Region -- ^ AWS Region Key+ , sender :: Text -- ^ AWS Verified Sender Email+ } deriving Show++------------------------------------------------------------------------------+-- | Class to allow extraction of `AWSKeys` from arbitrary Monads constrained by MonadIO+class MonadIO m => HasAWSKeys m where+ getKeys :: m AWSKeys++instance HasAWSKeys (Handler b AWSKeys) where+ getKeys = get++instance MonadIO m => HasAWSKeys (ReaderT (Snaplet AWSKeys) m) where+ getKeys = asks (^# snapletValue)++instance MonadIO m => HasAWSKeys (ReaderT AWSKeys m) where+ getKeys = ask++------------------------------------------------------------------------------+-- | Helper function for operating on `AWSKeys` inside of `HasAWSKeys` constrained Monads+withKeys+ :: HasAWSKeys m + => (AWSKeys -> IO a) -- ^ Function operating on Keys+ -> m a +withKeys f = getKeys >>= liftIO . f ++------------------------------------------------------------------------------+-- | Send Blaze email from a snap handler+sendEmailBlaze+ :: HasAWSKeys m+ => To -- ^ Who the email is intended for+ -> Subject -- ^ Email `Subject`+ -> H.Html -- ^ Email Body+ -> m SESResult+sendEmailBlaze+ to+ subject+ body = withKeys $ \(AWSKeys secret public region sender) ->+ SES.sendEmailBlaze+ secret+ public+ region+ (BL8.fromStrict $ encodeUtf8 sender)+ to+ subject+ body++------------------------------------------------------------------------------+-- | Send a ByteString of HTML from a Snap Handler+sendEmail+ :: HasAWSKeys m+ => To -- ^ Who the email is intended for+ -> Subject -- ^ email `Subject`+ -> BL8.ByteString -- ^ email Body+ -> m SESResult+sendEmail+ to+ subject+ body = withKeys $ \(AWSKeys secret public region sender) ->+ SES.sendEmail+ secret+ public+ region+ (BL8.fromStrict $ encodeUtf8 sender)+ to+ subject+ body++------------------------------------------------------------------------------+-- | Initialize snaplet+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > {-# LANGUAGE RecordWildCards #-}+-- > {-# LANGUAGE TemplateHaskell #-}+-- > module Main ( main ) where+-- > +-- > import Control.Lens+-- > import qualified Data.ByteString.Char8 as B8+-- > import qualified Data.ByteString.Lazy.Char8 as BL8+-- > import Snap+-- > import Snap.Snaplet.SES+-- > +-- > data App = App {+-- > _awsKeys :: Snaplet AWSKeys+-- > }+-- > +-- > makeLenses ''App+-- > +-- > initApp :: SnapletInit App App+-- > initApp = makeSnaplet "name" "description" Nothing $ do+-- > _awsKeys <- nestSnaplet "ses-html" awsKeys initAWSKeys+-- > addRoutes [("/", handleKeys)]+-- > return App {..}+-- > where+-- > handleKeys = method GET $ do+-- > with awsKeys $ withKeys $ liftIO . print+-- > result <- with awsKeys $ sendEmail ["david@solidtranslate.com"] "cookie-crisp" "<h1>TEST</h1>"+-- > liftIO $ print result+-- > writeBS "done"+-- > +-- > main :: IO ()+-- > main = do (_, app, _) <- runSnaplet Nothing initApp+-- > httpServe config app+-- > where+-- > config = setAccessLog ConfigNoLog $+-- > setErrorLog ConfigNoLog $+-- > defaultConfig+--+-- .\/snaplets\/ses-html\/devel.cfg+--+-- > public = "publickey"+-- > secret = "secretkey"+-- > region = "us-east-1"+-- > sender = "sender@verifiedaddress.com"+--+initAWSKeys :: SnapletInit a AWSKeys+initAWSKeys = makeSnaplet "ses-html" "Get your aws keys" Nothing $ do+ config <- getSnapletUserConfig+ liftIO $ AWSKeys <$> ((PublicKey . encodeUtf8) <$> getPublic config)+ <*> ((SecretKey . encodeUtf8) <$> getSecret config)+ <*> getRegion config+ <*> getSender config+ where+ getRegion config = do+ let f :: Text -> Region+ f "us-east-1" = USEast1+ f "us-west-2" = USWest2+ f "eu-west-1" = EUWest1+ f _ = USEast1+ fromMaybe USEast1 <$> fmap f <$> C.lookup config "region"++ getPublic : getSecret : getSender : _+ = map getConfig [ "public"+ , "secret"+ , "sender"+ ]+ getConfig name config = fromMaybe mempty <$> C.lookup config name+