From d385fc48d154c312f92c3d011b9ad9865577b6ff Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 11 May 2010 23:14:33 +0300 Subject: [PATCH] Cleaned up helpers + docs --- Yesod/Helpers/AtomFeed.hs | 2 ++ Yesod/Helpers/Auth.hs | 48 +++++++++++++++++++--------------- Yesod/Helpers/Sitemap.hs | 5 ++++ Yesod/Helpers/Static.hs | 55 ++++++++++++++++----------------------- 4 files changed, 57 insertions(+), 53 deletions(-) diff --git a/Yesod/Helpers/AtomFeed.hs b/Yesod/Helpers/AtomFeed.hs index 4bcd6b0f..bb5a7574 100644 --- a/Yesod/Helpers/AtomFeed.hs +++ b/Yesod/Helpers/AtomFeed.hs @@ -13,6 +13,8 @@ -- --------------------------------------------------------- +-- | Generation of Atom newsfeeds. See +-- . module Yesod.Helpers.AtomFeed ( AtomFeed (..) , AtomFeedEntry (..) diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs index 326038fb..1f8a4271 100644 --- a/Yesod/Helpers/Auth.hs +++ b/Yesod/Helpers/Auth.hs @@ -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 diff --git a/Yesod/Helpers/Sitemap.hs b/Yesod/Helpers/Sitemap.hs index 3c150abc..9543c733 100644 --- a/Yesod/Helpers/Sitemap.hs +++ b/Yesod/Helpers/Sitemap.hs @@ -13,6 +13,9 @@ -- --------------------------------------------------------- +-- | Generates XML sitemap files. +-- +-- See . 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 diff --git a/Yesod/Helpers/Static.hs b/Yesod/Helpers/Static.hs index 1e133f5f..117dc9e6 100644 --- a/Yesod/Helpers/Static.hs +++ b/Yesod/Helpers/Static.hs @@ -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