Cleaned up helpers + docs

This commit is contained in:
Michael Snoyman 2010-05-11 23:14:33 +03:00
parent e062033942
commit d385fc48d1
4 changed files with 57 additions and 53 deletions

View File

@ -13,6 +13,8 @@
--
---------------------------------------------------------
-- | Generation of Atom newsfeeds. See
-- <http://en.wikipedia.org/wiki/Atom_(standard)>.
module Yesod.Helpers.AtomFeed
( AtomFeed (..)
, AtomFeedEntry (..)

View File

@ -20,18 +20,19 @@
--
---------------------------------------------------------
module Yesod.Helpers.Auth
( redirectLogin
, Auth (..)
( -- * Subsite
Auth (..)
, AuthRoutes (..)
, siteAuth
-- * Settings
, YesodAuth (..)
, identKey
, displayNameKey
, Creds (..)
, maybeCreds
, requireCreds
, AuthType (..)
, AuthEmailSettings (..)
, inMemoryEmailSettings
-- * Functions
, maybeCreds
, requireCreds
) where
import qualified Web.Authenticate.Rpxnow as Rpxnow
@ -71,12 +72,16 @@ class Yesod master => YesodAuth master where
stdgen <- newStdGen
return $ take 10 $ randomRs ('A', 'Z') stdgen
-- | Each authentication subsystem (OpenId, Rpxnow, Email) has its own
-- settings. If those settings are not present, then relevant handlers will
-- simply return a 404.
data Auth = Auth
{ authIsOpenIdEnabled :: Bool
, authRpxnowApiKey :: Maybe String
, authEmailSettings :: Maybe AuthEmailSettings
}
-- | Which subsystem authenticated the user.
data AuthType = AuthOpenId | AuthRpxnow | AuthEmail
deriving (Show, Read, Eq)
@ -86,7 +91,12 @@ type VerUrl = String
type EmailId = Integer
type SaltedPass = String
type VerStatus = Bool
-- | Data stored in a database for each e-mail address.
data EmailCreds = EmailCreds EmailId (Maybe SaltedPass) VerStatus VerKey
-- | For a sample set of settings for a trivial in-memory database, see
-- 'inMemoryEmailSettings'.
data AuthEmailSettings = AuthEmailSettings
{ addUnverified :: Email -> VerKey -> IO EmailId
, sendVerifyEmail :: Email -> VerKey -> VerUrl -> IO ()
@ -116,6 +126,7 @@ setCreds creds extra = do
setSession credsKey $ show creds
onLogin creds extra
-- | Retrieves user credentials, if user is authenticated.
maybeCreds :: GHandler sub master (Maybe Creds)
maybeCreds = do
mcs <- lookupSession credsKey
@ -258,22 +269,17 @@ getLogout = do
clearSession credsKey
redirectUltDest RedirectTemporary $ defaultDest y
-- | Redirect the user to the 'defaultLoginPath', setting the DEST cookie
-- appropriately.
redirectLogin :: YesodAuth master => GHandler sub master a
redirectLogin = do
y <- getYesod
setUltDest'
redirect RedirectTemporary $ defaultLoginRoute y
-- | Retrieve user credentials. If user is not logged in, redirects to the
-- 'defaultLoginRoute'. Sets ultimate destination to current route, so user
-- should be sent back here after authenticating.
requireCreds :: YesodAuth master => GHandler sub master Creds
requireCreds = maybeCreds >>= maybe redirectLogin return
identKey :: String
identKey = "IDENTIFIER"
displayNameKey :: String
displayNameKey = "DISPLAY_NAME"
requireCreds =
maybeCreds >>= maybe redirectLogin return
where
redirectLogin = do
y <- getYesod
setUltDest'
redirect RedirectTemporary $ defaultLoginRoute y
getAuthEmailSettings :: GHandler Auth master AuthEmailSettings
getAuthEmailSettings = getYesodSub >>= maybe notFound return . authEmailSettings

View File

@ -13,6 +13,9 @@
--
---------------------------------------------------------
-- | Generates XML sitemap files.
--
-- See <http://www.sitemaps.org/>.
module Yesod.Helpers.Sitemap
( sitemap
, robots
@ -31,6 +34,7 @@ data SitemapChangeFreq = Always
| Monthly
| Yearly
| Never
showFreq :: SitemapChangeFreq -> String
showFreq Always = "always"
showFreq Hourly = "hourly"
@ -64,6 +68,7 @@ template urls = [$hamlet|
sitemap :: [SitemapUrl (Routes master)] -> GHandler sub master RepXml
sitemap = fmap RepXml . hamletToContent . template
-- | A basic robots file which just lists the "Sitemap: " line.
robots :: Routes sub -- ^ sitemap url
-> GHandler sub master RepPlain
robots smurl = do

View File

@ -11,20 +11,23 @@
-- Stability : Unstable
-- Portability : portable
--
-- Serve static files from a Yesod app.
-- | Serve static files from a Yesod app.
--
-- This is most useful for standalone testing. When running on a production
-- server (like Apache), just let the server do the static serving.
--
---------------------------------------------------------
-- In fact, in an ideal setup you'll serve your static files from a separate
-- domain name to save time on transmitting cookies. In that case, you may wish
-- to use 'urlRenderOverride' to redirect requests to this subsite to a
-- separate domain name.
module Yesod.Helpers.Static
( FileLookup
, fileLookupDir
( -- * Subsite
Static (..)
, StaticRoutes (..)
, siteStatic
, StaticRoutes
, toStaticRoute
, staticArgs
, Static
-- * Lookup files in filesystem
, fileLookupDir
) where
import System.Directory (doesFileExist)
@ -32,25 +35,21 @@ import Control.Monad
import Yesod
import Data.List (intercalate)
import Network.Wai
type FileLookup = FilePath -> IO (Maybe (Either FilePath Content))
data Static = Static FileLookup
staticArgs :: FileLookup -> Static
staticArgs = Static
-- | A function for looking up file contents. For serving from the file system,
-- see 'fileLookupDir'.
data Static = Static (FilePath -> IO (Maybe (Either FilePath Content)))
$(mkYesodSub "Static" [] [$parseRoutes|
/* StaticRoute GET
|])
-- | A 'FileLookup' for files in a directory. Note that this function does not
-- check if the requested path does unsafe things, eg expose hidden files. You
-- should provide this checking elsewhere.
-- | Lookup files in a specific directory.
--
-- If you are just using this in combination with serveStatic, serveStatic
-- provides this checking.
-- If you are just using this in combination with the static subsite (you
-- probably are), the handler itself checks that no unsafe paths are being
-- requested. In particular, no path segments may begin with a single period,
-- so hidden files and parent directories are safe.
fileLookupDir :: FilePath -> Static
fileLookupDir dir = Static $ \fp -> do
let fp' = dir ++ '/' : fp
@ -59,11 +58,11 @@ fileLookupDir dir = Static $ \fp -> do
then return $ Just $ Left fp'
else return Nothing
getStatic :: FileLookup -> [String] -> GHandler sub master [(ContentType, Content)]
getStatic fl fp' = do
getStaticRoute :: [String]
-> GHandler Static master [(ContentType, Content)]
getStaticRoute fp' = do
Static fl <- getYesodSub
when (any isUnsafe fp') notFound
wai <- waiRequest
when (requestMethod wai /= GET) badMethod
let fp = intercalate "/" fp'
content <- liftIO $ fl fp
case content of
@ -74,11 +73,3 @@ getStatic fl fp' = do
isUnsafe [] = True
isUnsafe ('.':_) = True
isUnsafe _ = False
getStaticRoute :: [String] -> GHandler Static master [(ContentType, Content)]
getStaticRoute fp = do
Static fl <- getYesodSub
getStatic fl fp
toStaticRoute :: [String] -> StaticRoutes
toStaticRoute = StaticRoute