{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}
-- | Provides example usage for "Snap.Snaplet.ReCaptcha".
module Snap.Snaplet.ReCaptcha.Example
( -- * Main
main
, initSample
-- * Necessities
, sampleTemplate
-- * Implementation
, initBlog
) where
import qualified Blaze.ByteString.Builder as Blaze
import Heist
import Heist.Compiled
import Snap
import Snap.Snaplet.Heist.Compiled
import Snap.Snaplet.ReCaptcha
import Control.Applicative
import Control.Lens
import Control.Monad.Trans
import qualified Data.ByteString.Char8 as BS
import Data.Monoid
import Data.Text (Text)
-- | Simple sample snaplet, built using 'ReCaptcha' in order to demonstrate how
-- one might use it in the scenario of adding comments to a blog.
data Sample = Sample
{ _recaptcha :: !(Snaplet ReCaptcha)
, _heist :: !(Snaplet (Heist Sample))
, _blog :: !(Snaplet Blog)
}
-- | Not actually a blog
data Blog = Blog
{ _currentPost :: !(Maybe BS.ByteString)
}
makeLenses ''Sample
makeLenses ''Blog
instance HasReCaptcha Sample where
captchaLens = subSnaplet recaptcha
instance HasHeist Sample where
heistLens = subSnaplet heist
-- | A "blog" snaplet which reads hypothetical "posts" by their id, and
-- displays a comment form there.
--
-- @GET@ on @posts/:id@ → a comment form
--
-- @POST@ on @posts/:id@ → the comment poster which verifies that the user
-- correctly responded to the captcha.
initBlog :: forall b. (HasReCaptcha b, HasHeist b) => Snaplet (Heist b)
-> SnapletInit b Blog
initBlog heist = makeSnaplet "blog" "simple blog" Nothing $ do
me <- getLens
addRoutes
-- Hypothetical comments are just sent as POST to the respective post they
-- are replying to
[("/posts/:id", method GET displayPost <|> method POST commentOnPost)]
addConfig heist $ mempty &~ do
-- Just 'blog-post' to be whatever is in 'post' at the time
-- (hopefully set by 'displayPost' after being routed to /posts/:id)
scCompiledSplices .=
("blog-post" ## pureSplice Blaze.fromByteString . lift $ do
post' <- withTop' me (use currentPost)
case post' of
Just post -> return post
Nothing -> fail "Couldn't find that.")
return (Blog Nothing)
where
displayPost :: Handler b Blog ()
displayPost = do
Just postId <- getParam "id"
currentPost .= Just ("there is no post #" <> postId <> ". only me.")
render "recaptcha-example" <|> fail "Couldn't load recaptcha-example.tpl"
commentOnPost :: Handler b Blog ()
commentOnPost = do
Just postId <- getParam "id"
checkCaptcha <|> fail "Bad captcha response."
-- if we reach here, the captcha was OK
Just name <- getPostParam "name"
Just email <- getPostParam "email"
Just content <- getPostParam "content"
writeBS $ BS.concat [postId, " < (", name,", ", email, ", ", content, ")"]
-- | Heist template, written to $PWD\/snaplets\/heist\/recaptcha-example.tpl
--
-- >sampleTemplate ≈
-- >
-- >
-- >
-- >
-- >
-- >
-- >
-- >
--
sampleTemplate :: Text
sampleTemplate =
"\
\ \
\ \
\ \
\ \
\ \
\ \
\"
-- | Requires 'snaplets/heist/templates/sample.tpl' - a suggested version of
-- which is available in this module as 'sampleTemplate'.
--
-- This reads the ReCaptcha configuration as an ordinary snaplet config on the
-- filesystem as per 'initReCaptcha' (@snaplets/recaptcha/devel.cfg@).
initSample :: SnapletInit Sample Sample
initSample = makeSnaplet "sample" "" Nothing $ do
h <- nestSnaplet "heist" heist (heistInit "templates")
c <- nestSnaplet "submit" recaptcha (initReCaptcha (Just h))
t <- nestSnaplet "blog" blog (initBlog h)
return (Sample c h t)
-- | @ 'main' = 'serveSnaplet' 'defaultConfig' 'initSample' @
--
-- You can load this into GHCi and run it, with full logging to stdout/stderr
--
-- >>> :main --verbose --access-log= --error-log=
main :: IO ()
main = serveSnaplet defaultConfig initSample