{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE 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.Lens
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