Yesod.Core exports everything
This commit is contained in:
Michael Snoyman
parent
aa20916e94
commit
372bcf52d8
529
Yesod/Core.hs
529
Yesod/Core.hs
@ -1,9 +1,3 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
-- | The basic typeclass for a Yesod application.
|
||||
module Yesod.Core
|
||||
( -- * Type classes
|
||||
Yesod (..)
|
||||
@ -25,522 +19,17 @@ module Yesod.Core
|
||||
-- * Misc
|
||||
, yesodVersion
|
||||
, yesodRender
|
||||
-- * Re-exports
|
||||
, module Yesod.Content
|
||||
, module Yesod.Dispatch
|
||||
, module Yesod.Handler
|
||||
, module Yesod.Request
|
||||
, module Yesod.Widget
|
||||
) where
|
||||
|
||||
import Yesod.Internal.Core
|
||||
import Yesod.Content
|
||||
import Yesod.Dispatch
|
||||
import Yesod.Handler
|
||||
|
||||
import Control.Arrow ((***))
|
||||
import qualified Paths_yesod_core
|
||||
import Data.Version (showVersion)
|
||||
import Yesod.Widget
|
||||
import Yesod.Request
|
||||
import qualified Network.Wai as W
|
||||
import Yesod.Internal
|
||||
import Yesod.Internal.Session
|
||||
import Yesod.Internal.Request
|
||||
import Web.ClientSession (getKey, defaultKeyFile)
|
||||
import qualified Web.ClientSession as CS
|
||||
import qualified Data.ByteString.Char8 as S8
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import Data.Monoid
|
||||
import Control.Monad.Trans.RWS
|
||||
import Text.Hamlet
|
||||
import Text.Cassius
|
||||
import Text.Julius
|
||||
import Text.Blaze (preEscapedLazyText, (!), customAttribute, textTag, toValue)
|
||||
import qualified Text.Blaze.Html5 as TBH
|
||||
import Data.Text.Lazy.Builder (toLazyText)
|
||||
import Data.Text.Lazy.Encoding (encodeUtf8)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Web.Cookie (parseCookies)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Time
|
||||
import Network.HTTP.Types (encodePath)
|
||||
import qualified Data.Text as TS
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import qualified Data.Text.Encoding.Error as TEE
|
||||
import Blaze.ByteString.Builder (Builder, toByteString)
|
||||
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
|
||||
import Data.List (foldl')
|
||||
import qualified Network.HTTP.Types as H
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text.Lazy.IO
|
||||
import qualified System.IO
|
||||
import qualified Data.Text.Lazy.Builder as TB
|
||||
|
||||
#if GHC7
|
||||
#define HAMLET hamlet
|
||||
#else
|
||||
#define HAMLET $hamlet
|
||||
#endif
|
||||
|
||||
class Eq u => RenderRoute u where
|
||||
renderRoute :: u -> ([Text], [(Text, Text)])
|
||||
|
||||
-- | This class is automatically instantiated when you use the template haskell
|
||||
-- mkYesod function. You should never need to deal with it directly.
|
||||
class YesodDispatch a master where
|
||||
yesodDispatch
|
||||
:: Yesod master
|
||||
=> a
|
||||
-> Maybe CS.Key
|
||||
-> [Text]
|
||||
-> master
|
||||
-> (Route a -> Route master)
|
||||
-> Maybe W.Application
|
||||
|
||||
yesodRunner :: Yesod master
|
||||
=> a
|
||||
-> master
|
||||
-> (Route a -> Route master)
|
||||
-> Maybe CS.Key -> Maybe (Route a) -> GHandler a master ChooseRep -> W.Application
|
||||
yesodRunner = defaultYesodRunner
|
||||
|
||||
-- | Define settings for a Yesod applications. The only required setting is
|
||||
-- 'approot'; other than that, there are intelligent defaults.
|
||||
class RenderRoute (Route a) => Yesod a where
|
||||
-- | An absolute URL to the root of the application. Do not include
|
||||
-- trailing slash.
|
||||
--
|
||||
-- If you want to be lazy, you can supply an empty string under the
|
||||
-- following conditions:
|
||||
--
|
||||
-- * Your application is served from the root of the domain.
|
||||
--
|
||||
-- * You do not use any features that require absolute URLs, such as Atom
|
||||
-- feeds and XML sitemaps.
|
||||
approot :: a -> Text
|
||||
|
||||
-- | The encryption key to be used for encrypting client sessions.
|
||||
-- Returning 'Nothing' disables sessions.
|
||||
encryptKey :: a -> IO (Maybe CS.Key)
|
||||
encryptKey _ = fmap Just $ getKey defaultKeyFile
|
||||
|
||||
-- | Number of minutes before a client session times out. Defaults to
|
||||
-- 120 (2 hours).
|
||||
clientSessionDuration :: a -> Int
|
||||
clientSessionDuration = const 120
|
||||
|
||||
-- | Output error response pages.
|
||||
errorHandler :: ErrorResponse -> GHandler sub a ChooseRep
|
||||
errorHandler = defaultErrorHandler
|
||||
|
||||
-- | Applies some form of layout to the contents of a page.
|
||||
defaultLayout :: GWidget sub a () -> GHandler sub a RepHtml
|
||||
defaultLayout w = do
|
||||
p <- widgetToPageContent w
|
||||
mmsg <- getMessage
|
||||
hamletToRepHtml [HAMLET|
|
||||
!!!
|
||||
|
||||
<html>
|
||||
<head>
|
||||
<title>#{pageTitle p}
|
||||
^{pageHead p}
|
||||
<body>
|
||||
$maybe msg <- mmsg
|
||||
<p .message>#{msg}
|
||||
^{pageBody p}
|
||||
|]
|
||||
|
||||
-- | Override the rendering function for a particular URL. One use case for
|
||||
-- this is to offload static hosting to a different domain name to avoid
|
||||
-- sending cookies.
|
||||
urlRenderOverride :: a -> Route a -> Maybe Builder
|
||||
urlRenderOverride _ _ = Nothing
|
||||
|
||||
-- | Determine if a request is authorized or not.
|
||||
--
|
||||
-- Return 'Nothing' is the request is authorized, 'Just' a message if
|
||||
-- unauthorized. If authentication is required, you should use a redirect;
|
||||
-- the Auth helper provides this functionality automatically.
|
||||
isAuthorized :: Route a
|
||||
-> Bool -- ^ is this a write request?
|
||||
-> GHandler s a AuthResult
|
||||
isAuthorized _ _ = return Authorized
|
||||
|
||||
-- | Determines whether the current request is a write request. By default,
|
||||
-- this assumes you are following RESTful principles, and determines this
|
||||
-- from request method. In particular, all except the following request
|
||||
-- methods are considered write: GET HEAD OPTIONS TRACE.
|
||||
--
|
||||
-- This function is used to determine if a request is authorized; see
|
||||
-- 'isAuthorized'.
|
||||
isWriteRequest :: Route a -> GHandler s a Bool
|
||||
isWriteRequest _ = do
|
||||
wai <- waiRequest
|
||||
return $ not $ W.requestMethod wai `elem`
|
||||
["GET", "HEAD", "OPTIONS", "TRACE"]
|
||||
|
||||
-- | The default route for authentication.
|
||||
--
|
||||
-- Used in particular by 'isAuthorized', but library users can do whatever
|
||||
-- they want with it.
|
||||
authRoute :: a -> Maybe (Route a)
|
||||
authRoute _ = Nothing
|
||||
|
||||
-- | A function used to clean up path segments. It returns 'Right' with a
|
||||
-- clean path or 'Left' with a new set of pieces the user should be
|
||||
-- redirected to. The default implementation enforces:
|
||||
--
|
||||
-- * No double slashes
|
||||
--
|
||||
-- * There is no trailing slash.
|
||||
--
|
||||
-- Note that versions of Yesod prior to 0.7 used a different set of rules
|
||||
-- involing trailing slashes.
|
||||
cleanPath :: a -> [Text] -> Either [Text] [Text]
|
||||
cleanPath _ s =
|
||||
if corrected == s
|
||||
then Right s
|
||||
else Left corrected
|
||||
where
|
||||
corrected = filter (not . TS.null) s
|
||||
|
||||
-- | Join the pieces of a path together into an absolute URL. This should
|
||||
-- be the inverse of 'splitPath'.
|
||||
joinPath :: a
|
||||
-> Builder -- ^ application root
|
||||
-> [TS.Text] -- ^ path pieces
|
||||
-> [(TS.Text, TS.Text)] -- ^ query string
|
||||
-> Builder
|
||||
joinPath _ ar pieces qs' = ar `mappend` encodePath pieces qs
|
||||
where
|
||||
qs = map (TE.encodeUtf8 *** go) qs'
|
||||
go "" = Nothing
|
||||
go x = Just $ TE.encodeUtf8 x
|
||||
|
||||
-- | This function is used to store some static content to be served as an
|
||||
-- external file. The most common case of this is stashing CSS and
|
||||
-- JavaScript content in an external file; the "Yesod.Widget" module uses
|
||||
-- this feature.
|
||||
--
|
||||
-- The return value is 'Nothing' if no storing was performed; this is the
|
||||
-- default implementation. A 'Just' 'Left' gives the absolute URL of the
|
||||
-- file, whereas a 'Just' 'Right' gives the type-safe URL. The former is
|
||||
-- necessary when you are serving the content outside the context of a
|
||||
-- Yesod application, such as via memcached.
|
||||
addStaticContent :: Text -- ^ filename extension
|
||||
-> Text -- ^ mime-type
|
||||
-> L.ByteString -- ^ content
|
||||
-> GHandler sub a (Maybe (Either Text (Route a, [(Text, Text)])))
|
||||
addStaticContent _ _ _ = return Nothing
|
||||
|
||||
-- | Whether or not to tie a session to a specific IP address. Defaults to
|
||||
-- 'True'.
|
||||
sessionIpAddress :: a -> Bool
|
||||
sessionIpAddress _ = True
|
||||
|
||||
-- | The path value to set for cookies. By default, uses \"\/\", meaning
|
||||
-- cookies will be sent to every page on the current domain.
|
||||
cookiePath :: a -> S8.ByteString
|
||||
cookiePath _ = "/"
|
||||
|
||||
-- | Maximum allowed length of the request body, in bytes.
|
||||
maximumContentLength :: a -> Maybe (Route a) -> Int
|
||||
maximumContentLength _ _ = 2 * 1024 * 1024 -- 2 megabytes
|
||||
|
||||
-- | Send a message to the log. By default, prints to stderr.
|
||||
messageLogger :: a
|
||||
-> LogLevel
|
||||
-> Text -- ^ source
|
||||
-> Text -- ^ message
|
||||
-> IO ()
|
||||
messageLogger _ level src msg =
|
||||
formatLogMessage level src msg >>=
|
||||
Data.Text.Lazy.IO.hPutStrLn System.IO.stderr
|
||||
|
||||
data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text
|
||||
deriving (Eq, Show, Read, Ord)
|
||||
|
||||
formatLogMessage :: LogLevel
|
||||
-> Text -- ^ source
|
||||
-> Text -- ^ message
|
||||
-> IO TL.Text
|
||||
formatLogMessage level src msg = do
|
||||
now <- getCurrentTime
|
||||
return $ TB.toLazyText $
|
||||
TB.fromText (TS.pack $ show now)
|
||||
`mappend` TB.fromText ": "
|
||||
`mappend` TB.fromText (TS.pack $ show level)
|
||||
`mappend` TB.fromText "@("
|
||||
`mappend` TB.fromText src
|
||||
`mappend` TB.fromText ") "
|
||||
`mappend` TB.fromText msg
|
||||
|
||||
defaultYesodRunner :: Yesod master
|
||||
=> a
|
||||
-> master
|
||||
-> (Route a -> Route master)
|
||||
-> Maybe CS.Key
|
||||
-> Maybe (Route a)
|
||||
-> GHandler a master ChooseRep
|
||||
-> W.Application
|
||||
defaultYesodRunner _ m toMaster _ murl _ req
|
||||
| maximumContentLength m (fmap toMaster murl) < len =
|
||||
return $ W.responseLBS
|
||||
(H.Status 413 "Too Large")
|
||||
[("Content-Type", "text/plain")]
|
||||
"Request body too large to be processed."
|
||||
where
|
||||
len = fromMaybe 0 $ lookup "content-length" (W.requestHeaders req) >>= readMay
|
||||
readMay s =
|
||||
case reads $ S8.unpack s of
|
||||
[] -> Nothing
|
||||
(x, _):_ -> Just x
|
||||
defaultYesodRunner s master toMasterRoute mkey murl handler req = do
|
||||
now <- liftIO getCurrentTime
|
||||
let getExpires m = fromIntegral (m * 60) `addUTCTime` now
|
||||
let exp' = getExpires $ clientSessionDuration master
|
||||
let rh = takeWhile (/= ':') $ show $ W.remoteHost req
|
||||
let host = if sessionIpAddress master then S8.pack rh else ""
|
||||
let session' =
|
||||
case mkey of
|
||||
Nothing -> []
|
||||
Just key -> fromMaybe [] $ do
|
||||
raw <- lookup "Cookie" $ W.requestHeaders req
|
||||
val <- lookup sessionName $ parseCookies raw
|
||||
decodeSession key now host val
|
||||
rr <- liftIO $ parseWaiRequest req session' mkey
|
||||
let h = do
|
||||
case murl of
|
||||
Nothing -> handler
|
||||
Just url -> do
|
||||
isWrite <- isWriteRequest $ toMasterRoute url
|
||||
ar <- isAuthorized (toMasterRoute url) isWrite
|
||||
case ar of
|
||||
Authorized -> return ()
|
||||
AuthenticationRequired ->
|
||||
case authRoute master of
|
||||
Nothing ->
|
||||
permissionDenied "Authentication required"
|
||||
Just url' -> do
|
||||
setUltDest'
|
||||
redirect RedirectTemporary url'
|
||||
Unauthorized s' -> permissionDenied s'
|
||||
handler
|
||||
let sessionMap = Map.fromList
|
||||
$ filter (\(x, _) -> x /= nonceKey) session'
|
||||
yar <- handlerToYAR master s toMasterRoute (yesodRender master) errorHandler rr murl sessionMap h
|
||||
let mnonce = reqNonce rr
|
||||
return $ yarToResponse (hr mnonce getExpires host exp') yar
|
||||
where
|
||||
hr mnonce getExpires host exp' hs ct sm =
|
||||
hs'''
|
||||
where
|
||||
sessionVal =
|
||||
case (mkey, mnonce) of
|
||||
(Just key, Just nonce)
|
||||
-> encodeSession key exp' host
|
||||
$ Map.toList
|
||||
$ Map.insert nonceKey nonce sm
|
||||
_ -> mempty
|
||||
hs' =
|
||||
case mkey of
|
||||
Nothing -> hs
|
||||
Just _ -> AddCookie
|
||||
(clientSessionDuration master)
|
||||
sessionName
|
||||
sessionVal
|
||||
: hs
|
||||
hs'' = map (headerToPair (cookiePath master) getExpires) hs'
|
||||
hs''' = ("Content-Type", ct) : hs''
|
||||
|
||||
data AuthResult = Authorized | AuthenticationRequired | Unauthorized Text
|
||||
deriving (Eq, Show, Read)
|
||||
|
||||
-- | A type-safe, concise method of creating breadcrumbs for pages. For each
|
||||
-- resource, you declare the title of the page and the parent resource (if
|
||||
-- present).
|
||||
class YesodBreadcrumbs y where
|
||||
-- | Returns the title and the parent resource, if available. If you return
|
||||
-- a 'Nothing', then this is considered a top-level page.
|
||||
breadcrumb :: Route y -> GHandler sub y (String, Maybe (Route y))
|
||||
|
||||
-- | Gets the title of the current page and the hierarchy of parent pages,
|
||||
-- along with their respective titles.
|
||||
breadcrumbs :: YesodBreadcrumbs y => GHandler sub y (String, [(Route y, String)])
|
||||
breadcrumbs = do
|
||||
x' <- getCurrentRoute
|
||||
tm <- getRouteToMaster
|
||||
let x = fmap tm x'
|
||||
case x of
|
||||
Nothing -> return ("Not found", [])
|
||||
Just y -> do
|
||||
(title, next) <- breadcrumb y
|
||||
z <- go [] next
|
||||
return (title, z)
|
||||
where
|
||||
go back Nothing = return back
|
||||
go back (Just this) = do
|
||||
(title, next) <- breadcrumb this
|
||||
go ((this, title) : back) next
|
||||
|
||||
applyLayout' :: Yesod master
|
||||
=> Html -- ^ title
|
||||
-> Hamlet (Route master) -- ^ body
|
||||
-> GHandler sub master ChooseRep
|
||||
applyLayout' title body = fmap chooseRep $ defaultLayout $ do
|
||||
setTitle title
|
||||
addHamlet body
|
||||
|
||||
-- | The default error handler for 'errorHandler'.
|
||||
defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep
|
||||
defaultErrorHandler NotFound = do
|
||||
r <- waiRequest
|
||||
let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
|
||||
applyLayout' "Not Found"
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
<h1>Not Found
|
||||
<p>#{path'}
|
||||
|]
|
||||
defaultErrorHandler (PermissionDenied msg) =
|
||||
applyLayout' "Permission Denied"
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
<h1>Permission denied
|
||||
<p>#{msg}
|
||||
|]
|
||||
defaultErrorHandler (InvalidArgs ia) =
|
||||
applyLayout' "Invalid Arguments"
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
<h1>Invalid Arguments
|
||||
<ul>
|
||||
$forall msg <- ia
|
||||
<li>#{msg}
|
||||
|]
|
||||
defaultErrorHandler (InternalError e) =
|
||||
applyLayout' "Internal Server Error"
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
<h1>Internal Server Error
|
||||
<p>#{e}
|
||||
|]
|
||||
defaultErrorHandler (BadMethod m) =
|
||||
applyLayout' "Bad Method"
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
<h1>Method Not Supported
|
||||
<p>Method "#{S8.unpack m}" not supported
|
||||
|]
|
||||
|
||||
-- | Return the same URL if the user is authorized to see it.
|
||||
--
|
||||
-- Built on top of 'isAuthorized'. This is useful for building page that only
|
||||
-- contain links to pages the user is allowed to see.
|
||||
maybeAuthorized :: Yesod a
|
||||
=> Route a
|
||||
-> Bool -- ^ is this a write request?
|
||||
-> GHandler s a (Maybe (Route a))
|
||||
maybeAuthorized r isWrite = do
|
||||
x <- isAuthorized r isWrite
|
||||
return $ if x == Authorized then Just r else Nothing
|
||||
|
||||
-- | Convert a widget to a 'PageContent'.
|
||||
widgetToPageContent :: (Eq (Route master), Yesod master)
|
||||
=> GWidget sub master ()
|
||||
-> GHandler sub master (PageContent (Route master))
|
||||
widgetToPageContent (GWidget w) = do
|
||||
((), _, GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head')) <- runRWST w () 0
|
||||
let title = maybe mempty unTitle mTitle
|
||||
let scripts = runUniqueList scripts'
|
||||
let stylesheets = runUniqueList stylesheets'
|
||||
let cssToHtml = preEscapedLazyText . renderCss
|
||||
celper :: Cassius url -> Hamlet url
|
||||
celper = fmap cssToHtml
|
||||
jsToHtml (Javascript b) = preEscapedLazyText $ toLazyText b
|
||||
jelper :: Julius url -> Hamlet url
|
||||
jelper = fmap jsToHtml
|
||||
|
||||
render <- getUrlRenderParams
|
||||
let renderLoc x =
|
||||
case x of
|
||||
Nothing -> Nothing
|
||||
Just (Left s) -> Just s
|
||||
Just (Right (u, p)) -> Just $ render u p
|
||||
cssLoc <-
|
||||
case style of
|
||||
Nothing -> return Nothing
|
||||
Just s -> do
|
||||
x <- addStaticContent "css" "text/css; charset=utf-8"
|
||||
$ encodeUtf8 $ renderCassius render s
|
||||
return $ renderLoc x
|
||||
jsLoc <-
|
||||
case jscript of
|
||||
Nothing -> return Nothing
|
||||
Just s -> do
|
||||
x <- addStaticContent "js" "text/javascript; charset=utf-8"
|
||||
$ encodeUtf8 $ renderJulius render s
|
||||
return $ renderLoc x
|
||||
|
||||
let addAttr x (y, z) = x ! customAttribute (textTag y) (toValue z)
|
||||
let renderLoc' render' (Local url) = render' url []
|
||||
renderLoc' _ (Remote s) = s
|
||||
let mkScriptTag (Script loc attrs) render' =
|
||||
foldl' addAttr TBH.script (("src", renderLoc' render' loc) : attrs) $ return ()
|
||||
let mkLinkTag (Stylesheet loc attrs) render' =
|
||||
foldl' addAttr TBH.link
|
||||
( ("rel", "stylesheet")
|
||||
: ("href", renderLoc' render' loc)
|
||||
: attrs
|
||||
)
|
||||
let head'' =
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
$forall s <- scripts
|
||||
^{mkScriptTag s}
|
||||
$forall s <- stylesheets
|
||||
^{mkLinkTag s}
|
||||
$maybe s <- style
|
||||
$maybe s <- cssLoc
|
||||
<link rel=stylesheet href=#{s}
|
||||
$nothing
|
||||
<style>^{celper s}
|
||||
$maybe j <- jscript
|
||||
$maybe s <- jsLoc
|
||||
<script src="#{s}">
|
||||
$nothing
|
||||
<script>^{jelper j}
|
||||
\^{head'}
|
||||
|]
|
||||
return $ PageContent title head'' body
|
||||
|
||||
yesodVersion :: String
|
||||
yesodVersion = showVersion Paths_yesod_core.version
|
||||
|
||||
yesodRender :: Yesod y
|
||||
=> y
|
||||
-> Route y
|
||||
-> [(Text, Text)]
|
||||
-> Text
|
||||
yesodRender y u qs =
|
||||
TE.decodeUtf8 $ toByteString $
|
||||
fromMaybe
|
||||
(joinPath y (fromText $ approot y) ps
|
||||
$ qs ++ qs')
|
||||
(urlRenderOverride y u)
|
||||
where
|
||||
(ps, qs') = renderRoute u
|
||||
import Yesod.Widget
|
||||
|
||||
@ -22,7 +22,7 @@ module Yesod.Dispatch
|
||||
|
||||
import Data.Either (partitionEithers)
|
||||
import Prelude hiding (exp)
|
||||
import Yesod.Core
|
||||
import Yesod.Internal.Core
|
||||
import Yesod.Handler
|
||||
import Yesod.Internal.Dispatch
|
||||
|
||||
|
||||
546
Yesod/Internal/Core.hs
Normal file
546
Yesod/Internal/Core.hs
Normal file
@ -0,0 +1,546 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
-- | The basic typeclass for a Yesod application.
|
||||
module Yesod.Internal.Core
|
||||
( -- * Type classes
|
||||
Yesod (..)
|
||||
, YesodDispatch (..)
|
||||
, RenderRoute (..)
|
||||
-- ** Breadcrumbs
|
||||
, YesodBreadcrumbs (..)
|
||||
, breadcrumbs
|
||||
-- * Utitlities
|
||||
, maybeAuthorized
|
||||
, widgetToPageContent
|
||||
-- * Defaults
|
||||
, defaultErrorHandler
|
||||
-- * Data types
|
||||
, AuthResult (..)
|
||||
-- * Logging
|
||||
, LogLevel (..)
|
||||
, formatLogMessage
|
||||
-- * Misc
|
||||
, yesodVersion
|
||||
, yesodRender
|
||||
) where
|
||||
|
||||
import Yesod.Content
|
||||
import Yesod.Handler
|
||||
|
||||
import Control.Arrow ((***))
|
||||
import qualified Paths_yesod_core
|
||||
import Data.Version (showVersion)
|
||||
import Yesod.Widget
|
||||
import Yesod.Request
|
||||
import qualified Network.Wai as W
|
||||
import Yesod.Internal
|
||||
import Yesod.Internal.Session
|
||||
import Yesod.Internal.Request
|
||||
import Web.ClientSession (getKey, defaultKeyFile)
|
||||
import qualified Web.ClientSession as CS
|
||||
import qualified Data.ByteString.Char8 as S8
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import Data.Monoid
|
||||
import Control.Monad.Trans.RWS
|
||||
import Text.Hamlet
|
||||
import Text.Cassius
|
||||
import Text.Julius
|
||||
import Text.Blaze (preEscapedLazyText, (!), customAttribute, textTag, toValue)
|
||||
import qualified Text.Blaze.Html5 as TBH
|
||||
import Data.Text.Lazy.Builder (toLazyText)
|
||||
import Data.Text.Lazy.Encoding (encodeUtf8)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Web.Cookie (parseCookies)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Time
|
||||
import Network.HTTP.Types (encodePath)
|
||||
import qualified Data.Text as TS
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import qualified Data.Text.Encoding.Error as TEE
|
||||
import Blaze.ByteString.Builder (Builder, toByteString)
|
||||
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
|
||||
import Data.List (foldl')
|
||||
import qualified Network.HTTP.Types as H
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text.Lazy.IO
|
||||
import qualified System.IO
|
||||
import qualified Data.Text.Lazy.Builder as TB
|
||||
|
||||
#if GHC7
|
||||
#define HAMLET hamlet
|
||||
#else
|
||||
#define HAMLET $hamlet
|
||||
#endif
|
||||
|
||||
class Eq u => RenderRoute u where
|
||||
renderRoute :: u -> ([Text], [(Text, Text)])
|
||||
|
||||
-- | This class is automatically instantiated when you use the template haskell
|
||||
-- mkYesod function. You should never need to deal with it directly.
|
||||
class YesodDispatch a master where
|
||||
yesodDispatch
|
||||
:: Yesod master
|
||||
=> a
|
||||
-> Maybe CS.Key
|
||||
-> [Text]
|
||||
-> master
|
||||
-> (Route a -> Route master)
|
||||
-> Maybe W.Application
|
||||
|
||||
yesodRunner :: Yesod master
|
||||
=> a
|
||||
-> master
|
||||
-> (Route a -> Route master)
|
||||
-> Maybe CS.Key -> Maybe (Route a) -> GHandler a master ChooseRep -> W.Application
|
||||
yesodRunner = defaultYesodRunner
|
||||
|
||||
-- | Define settings for a Yesod applications. The only required setting is
|
||||
-- 'approot'; other than that, there are intelligent defaults.
|
||||
class RenderRoute (Route a) => Yesod a where
|
||||
-- | An absolute URL to the root of the application. Do not include
|
||||
-- trailing slash.
|
||||
--
|
||||
-- If you want to be lazy, you can supply an empty string under the
|
||||
-- following conditions:
|
||||
--
|
||||
-- * Your application is served from the root of the domain.
|
||||
--
|
||||
-- * You do not use any features that require absolute URLs, such as Atom
|
||||
-- feeds and XML sitemaps.
|
||||
approot :: a -> Text
|
||||
|
||||
-- | The encryption key to be used for encrypting client sessions.
|
||||
-- Returning 'Nothing' disables sessions.
|
||||
encryptKey :: a -> IO (Maybe CS.Key)
|
||||
encryptKey _ = fmap Just $ getKey defaultKeyFile
|
||||
|
||||
-- | Number of minutes before a client session times out. Defaults to
|
||||
-- 120 (2 hours).
|
||||
clientSessionDuration :: a -> Int
|
||||
clientSessionDuration = const 120
|
||||
|
||||
-- | Output error response pages.
|
||||
errorHandler :: ErrorResponse -> GHandler sub a ChooseRep
|
||||
errorHandler = defaultErrorHandler
|
||||
|
||||
-- | Applies some form of layout to the contents of a page.
|
||||
defaultLayout :: GWidget sub a () -> GHandler sub a RepHtml
|
||||
defaultLayout w = do
|
||||
p <- widgetToPageContent w
|
||||
mmsg <- getMessage
|
||||
hamletToRepHtml [HAMLET|
|
||||
!!!
|
||||
|
||||
<html>
|
||||
<head>
|
||||
<title>#{pageTitle p}
|
||||
^{pageHead p}
|
||||
<body>
|
||||
$maybe msg <- mmsg
|
||||
<p .message>#{msg}
|
||||
^{pageBody p}
|
||||
|]
|
||||
|
||||
-- | Override the rendering function for a particular URL. One use case for
|
||||
-- this is to offload static hosting to a different domain name to avoid
|
||||
-- sending cookies.
|
||||
urlRenderOverride :: a -> Route a -> Maybe Builder
|
||||
urlRenderOverride _ _ = Nothing
|
||||
|
||||
-- | Determine if a request is authorized or not.
|
||||
--
|
||||
-- Return 'Nothing' is the request is authorized, 'Just' a message if
|
||||
-- unauthorized. If authentication is required, you should use a redirect;
|
||||
-- the Auth helper provides this functionality automatically.
|
||||
isAuthorized :: Route a
|
||||
-> Bool -- ^ is this a write request?
|
||||
-> GHandler s a AuthResult
|
||||
isAuthorized _ _ = return Authorized
|
||||
|
||||
-- | Determines whether the current request is a write request. By default,
|
||||
-- this assumes you are following RESTful principles, and determines this
|
||||
-- from request method. In particular, all except the following request
|
||||
-- methods are considered write: GET HEAD OPTIONS TRACE.
|
||||
--
|
||||
-- This function is used to determine if a request is authorized; see
|
||||
-- 'isAuthorized'.
|
||||
isWriteRequest :: Route a -> GHandler s a Bool
|
||||
isWriteRequest _ = do
|
||||
wai <- waiRequest
|
||||
return $ not $ W.requestMethod wai `elem`
|
||||
["GET", "HEAD", "OPTIONS", "TRACE"]
|
||||
|
||||
-- | The default route for authentication.
|
||||
--
|
||||
-- Used in particular by 'isAuthorized', but library users can do whatever
|
||||
-- they want with it.
|
||||
authRoute :: a -> Maybe (Route a)
|
||||
authRoute _ = Nothing
|
||||
|
||||
-- | A function used to clean up path segments. It returns 'Right' with a
|
||||
-- clean path or 'Left' with a new set of pieces the user should be
|
||||
-- redirected to. The default implementation enforces:
|
||||
--
|
||||
-- * No double slashes
|
||||
--
|
||||
-- * There is no trailing slash.
|
||||
--
|
||||
-- Note that versions of Yesod prior to 0.7 used a different set of rules
|
||||
-- involing trailing slashes.
|
||||
cleanPath :: a -> [Text] -> Either [Text] [Text]
|
||||
cleanPath _ s =
|
||||
if corrected == s
|
||||
then Right s
|
||||
else Left corrected
|
||||
where
|
||||
corrected = filter (not . TS.null) s
|
||||
|
||||
-- | Join the pieces of a path together into an absolute URL. This should
|
||||
-- be the inverse of 'splitPath'.
|
||||
joinPath :: a
|
||||
-> Builder -- ^ application root
|
||||
-> [TS.Text] -- ^ path pieces
|
||||
-> [(TS.Text, TS.Text)] -- ^ query string
|
||||
-> Builder
|
||||
joinPath _ ar pieces qs' = ar `mappend` encodePath pieces qs
|
||||
where
|
||||
qs = map (TE.encodeUtf8 *** go) qs'
|
||||
go "" = Nothing
|
||||
go x = Just $ TE.encodeUtf8 x
|
||||
|
||||
-- | This function is used to store some static content to be served as an
|
||||
-- external file. The most common case of this is stashing CSS and
|
||||
-- JavaScript content in an external file; the "Yesod.Widget" module uses
|
||||
-- this feature.
|
||||
--
|
||||
-- The return value is 'Nothing' if no storing was performed; this is the
|
||||
-- default implementation. A 'Just' 'Left' gives the absolute URL of the
|
||||
-- file, whereas a 'Just' 'Right' gives the type-safe URL. The former is
|
||||
-- necessary when you are serving the content outside the context of a
|
||||
-- Yesod application, such as via memcached.
|
||||
addStaticContent :: Text -- ^ filename extension
|
||||
-> Text -- ^ mime-type
|
||||
-> L.ByteString -- ^ content
|
||||
-> GHandler sub a (Maybe (Either Text (Route a, [(Text, Text)])))
|
||||
addStaticContent _ _ _ = return Nothing
|
||||
|
||||
-- | Whether or not to tie a session to a specific IP address. Defaults to
|
||||
-- 'True'.
|
||||
sessionIpAddress :: a -> Bool
|
||||
sessionIpAddress _ = True
|
||||
|
||||
-- | The path value to set for cookies. By default, uses \"\/\", meaning
|
||||
-- cookies will be sent to every page on the current domain.
|
||||
cookiePath :: a -> S8.ByteString
|
||||
cookiePath _ = "/"
|
||||
|
||||
-- | Maximum allowed length of the request body, in bytes.
|
||||
maximumContentLength :: a -> Maybe (Route a) -> Int
|
||||
maximumContentLength _ _ = 2 * 1024 * 1024 -- 2 megabytes
|
||||
|
||||
-- | Send a message to the log. By default, prints to stderr.
|
||||
messageLogger :: a
|
||||
-> LogLevel
|
||||
-> Text -- ^ source
|
||||
-> Text -- ^ message
|
||||
-> IO ()
|
||||
messageLogger _ level src msg =
|
||||
formatLogMessage level src msg >>=
|
||||
Data.Text.Lazy.IO.hPutStrLn System.IO.stderr
|
||||
|
||||
data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text
|
||||
deriving (Eq, Show, Read, Ord)
|
||||
|
||||
formatLogMessage :: LogLevel
|
||||
-> Text -- ^ source
|
||||
-> Text -- ^ message
|
||||
-> IO TL.Text
|
||||
formatLogMessage level src msg = do
|
||||
now <- getCurrentTime
|
||||
return $ TB.toLazyText $
|
||||
TB.fromText (TS.pack $ show now)
|
||||
`mappend` TB.fromText ": "
|
||||
`mappend` TB.fromText (TS.pack $ show level)
|
||||
`mappend` TB.fromText "@("
|
||||
`mappend` TB.fromText src
|
||||
`mappend` TB.fromText ") "
|
||||
`mappend` TB.fromText msg
|
||||
|
||||
defaultYesodRunner :: Yesod master
|
||||
=> a
|
||||
-> master
|
||||
-> (Route a -> Route master)
|
||||
-> Maybe CS.Key
|
||||
-> Maybe (Route a)
|
||||
-> GHandler a master ChooseRep
|
||||
-> W.Application
|
||||
defaultYesodRunner _ m toMaster _ murl _ req
|
||||
| maximumContentLength m (fmap toMaster murl) < len =
|
||||
return $ W.responseLBS
|
||||
(H.Status 413 "Too Large")
|
||||
[("Content-Type", "text/plain")]
|
||||
"Request body too large to be processed."
|
||||
where
|
||||
len = fromMaybe 0 $ lookup "content-length" (W.requestHeaders req) >>= readMay
|
||||
readMay s =
|
||||
case reads $ S8.unpack s of
|
||||
[] -> Nothing
|
||||
(x, _):_ -> Just x
|
||||
defaultYesodRunner s master toMasterRoute mkey murl handler req = do
|
||||
now <- liftIO getCurrentTime
|
||||
let getExpires m = fromIntegral (m * 60) `addUTCTime` now
|
||||
let exp' = getExpires $ clientSessionDuration master
|
||||
let rh = takeWhile (/= ':') $ show $ W.remoteHost req
|
||||
let host = if sessionIpAddress master then S8.pack rh else ""
|
||||
let session' =
|
||||
case mkey of
|
||||
Nothing -> []
|
||||
Just key -> fromMaybe [] $ do
|
||||
raw <- lookup "Cookie" $ W.requestHeaders req
|
||||
val <- lookup sessionName $ parseCookies raw
|
||||
decodeSession key now host val
|
||||
rr <- liftIO $ parseWaiRequest req session' mkey
|
||||
let h = do
|
||||
case murl of
|
||||
Nothing -> handler
|
||||
Just url -> do
|
||||
isWrite <- isWriteRequest $ toMasterRoute url
|
||||
ar <- isAuthorized (toMasterRoute url) isWrite
|
||||
case ar of
|
||||
Authorized -> return ()
|
||||
AuthenticationRequired ->
|
||||
case authRoute master of
|
||||
Nothing ->
|
||||
permissionDenied "Authentication required"
|
||||
Just url' -> do
|
||||
setUltDest'
|
||||
redirect RedirectTemporary url'
|
||||
Unauthorized s' -> permissionDenied s'
|
||||
handler
|
||||
let sessionMap = Map.fromList
|
||||
$ filter (\(x, _) -> x /= nonceKey) session'
|
||||
yar <- handlerToYAR master s toMasterRoute (yesodRender master) errorHandler rr murl sessionMap h
|
||||
let mnonce = reqNonce rr
|
||||
return $ yarToResponse (hr mnonce getExpires host exp') yar
|
||||
where
|
||||
hr mnonce getExpires host exp' hs ct sm =
|
||||
hs'''
|
||||
where
|
||||
sessionVal =
|
||||
case (mkey, mnonce) of
|
||||
(Just key, Just nonce)
|
||||
-> encodeSession key exp' host
|
||||
$ Map.toList
|
||||
$ Map.insert nonceKey nonce sm
|
||||
_ -> mempty
|
||||
hs' =
|
||||
case mkey of
|
||||
Nothing -> hs
|
||||
Just _ -> AddCookie
|
||||
(clientSessionDuration master)
|
||||
sessionName
|
||||
sessionVal
|
||||
: hs
|
||||
hs'' = map (headerToPair (cookiePath master) getExpires) hs'
|
||||
hs''' = ("Content-Type", ct) : hs''
|
||||
|
||||
data AuthResult = Authorized | AuthenticationRequired | Unauthorized Text
|
||||
deriving (Eq, Show, Read)
|
||||
|
||||
-- | A type-safe, concise method of creating breadcrumbs for pages. For each
|
||||
-- resource, you declare the title of the page and the parent resource (if
|
||||
-- present).
|
||||
class YesodBreadcrumbs y where
|
||||
-- | Returns the title and the parent resource, if available. If you return
|
||||
-- a 'Nothing', then this is considered a top-level page.
|
||||
breadcrumb :: Route y -> GHandler sub y (String, Maybe (Route y))
|
||||
|
||||
-- | Gets the title of the current page and the hierarchy of parent pages,
|
||||
-- along with their respective titles.
|
||||
breadcrumbs :: YesodBreadcrumbs y => GHandler sub y (String, [(Route y, String)])
|
||||
breadcrumbs = do
|
||||
x' <- getCurrentRoute
|
||||
tm <- getRouteToMaster
|
||||
let x = fmap tm x'
|
||||
case x of
|
||||
Nothing -> return ("Not found", [])
|
||||
Just y -> do
|
||||
(title, next) <- breadcrumb y
|
||||
z <- go [] next
|
||||
return (title, z)
|
||||
where
|
||||
go back Nothing = return back
|
||||
go back (Just this) = do
|
||||
(title, next) <- breadcrumb this
|
||||
go ((this, title) : back) next
|
||||
|
||||
applyLayout' :: Yesod master
|
||||
=> Html -- ^ title
|
||||
-> Hamlet (Route master) -- ^ body
|
||||
-> GHandler sub master ChooseRep
|
||||
applyLayout' title body = fmap chooseRep $ defaultLayout $ do
|
||||
setTitle title
|
||||
addHamlet body
|
||||
|
||||
-- | The default error handler for 'errorHandler'.
|
||||
defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep
|
||||
defaultErrorHandler NotFound = do
|
||||
r <- waiRequest
|
||||
let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
|
||||
applyLayout' "Not Found"
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
<h1>Not Found
|
||||
<p>#{path'}
|
||||
|]
|
||||
defaultErrorHandler (PermissionDenied msg) =
|
||||
applyLayout' "Permission Denied"
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
<h1>Permission denied
|
||||
<p>#{msg}
|
||||
|]
|
||||
defaultErrorHandler (InvalidArgs ia) =
|
||||
applyLayout' "Invalid Arguments"
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
<h1>Invalid Arguments
|
||||
<ul>
|
||||
$forall msg <- ia
|
||||
<li>#{msg}
|
||||
|]
|
||||
defaultErrorHandler (InternalError e) =
|
||||
applyLayout' "Internal Server Error"
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
<h1>Internal Server Error
|
||||
<p>#{e}
|
||||
|]
|
||||
defaultErrorHandler (BadMethod m) =
|
||||
applyLayout' "Bad Method"
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
<h1>Method Not Supported
|
||||
<p>Method "#{S8.unpack m}" not supported
|
||||
|]
|
||||
|
||||
-- | Return the same URL if the user is authorized to see it.
|
||||
--
|
||||
-- Built on top of 'isAuthorized'. This is useful for building page that only
|
||||
-- contain links to pages the user is allowed to see.
|
||||
maybeAuthorized :: Yesod a
|
||||
=> Route a
|
||||
-> Bool -- ^ is this a write request?
|
||||
-> GHandler s a (Maybe (Route a))
|
||||
maybeAuthorized r isWrite = do
|
||||
x <- isAuthorized r isWrite
|
||||
return $ if x == Authorized then Just r else Nothing
|
||||
|
||||
-- | Convert a widget to a 'PageContent'.
|
||||
widgetToPageContent :: (Eq (Route master), Yesod master)
|
||||
=> GWidget sub master ()
|
||||
-> GHandler sub master (PageContent (Route master))
|
||||
widgetToPageContent (GWidget w) = do
|
||||
((), _, GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head')) <- runRWST w () 0
|
||||
let title = maybe mempty unTitle mTitle
|
||||
let scripts = runUniqueList scripts'
|
||||
let stylesheets = runUniqueList stylesheets'
|
||||
let cssToHtml = preEscapedLazyText . renderCss
|
||||
celper :: Cassius url -> Hamlet url
|
||||
celper = fmap cssToHtml
|
||||
jsToHtml (Javascript b) = preEscapedLazyText $ toLazyText b
|
||||
jelper :: Julius url -> Hamlet url
|
||||
jelper = fmap jsToHtml
|
||||
|
||||
render <- getUrlRenderParams
|
||||
let renderLoc x =
|
||||
case x of
|
||||
Nothing -> Nothing
|
||||
Just (Left s) -> Just s
|
||||
Just (Right (u, p)) -> Just $ render u p
|
||||
cssLoc <-
|
||||
case style of
|
||||
Nothing -> return Nothing
|
||||
Just s -> do
|
||||
x <- addStaticContent "css" "text/css; charset=utf-8"
|
||||
$ encodeUtf8 $ renderCassius render s
|
||||
return $ renderLoc x
|
||||
jsLoc <-
|
||||
case jscript of
|
||||
Nothing -> return Nothing
|
||||
Just s -> do
|
||||
x <- addStaticContent "js" "text/javascript; charset=utf-8"
|
||||
$ encodeUtf8 $ renderJulius render s
|
||||
return $ renderLoc x
|
||||
|
||||
let addAttr x (y, z) = x ! customAttribute (textTag y) (toValue z)
|
||||
let renderLoc' render' (Local url) = render' url []
|
||||
renderLoc' _ (Remote s) = s
|
||||
let mkScriptTag (Script loc attrs) render' =
|
||||
foldl' addAttr TBH.script (("src", renderLoc' render' loc) : attrs) $ return ()
|
||||
let mkLinkTag (Stylesheet loc attrs) render' =
|
||||
foldl' addAttr TBH.link
|
||||
( ("rel", "stylesheet")
|
||||
: ("href", renderLoc' render' loc)
|
||||
: attrs
|
||||
)
|
||||
let head'' =
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
$forall s <- scripts
|
||||
^{mkScriptTag s}
|
||||
$forall s <- stylesheets
|
||||
^{mkLinkTag s}
|
||||
$maybe s <- style
|
||||
$maybe s <- cssLoc
|
||||
<link rel=stylesheet href=#{s}
|
||||
$nothing
|
||||
<style>^{celper s}
|
||||
$maybe j <- jscript
|
||||
$maybe s <- jsLoc
|
||||
<script src="#{s}">
|
||||
$nothing
|
||||
<script>^{jelper j}
|
||||
\^{head'}
|
||||
|]
|
||||
return $ PageContent title head'' body
|
||||
|
||||
yesodVersion :: String
|
||||
yesodVersion = showVersion Paths_yesod_core.version
|
||||
|
||||
yesodRender :: Yesod y
|
||||
=> y
|
||||
-> Route y
|
||||
-> [(Text, Text)]
|
||||
-> Text
|
||||
yesodRender y u qs =
|
||||
TE.decodeUtf8 $ toByteString $
|
||||
fromMaybe
|
||||
(joinPath y (fromText $ approot y) ps
|
||||
$ qs ++ qs')
|
||||
(urlRenderOverride y u)
|
||||
where
|
||||
(ps, qs') = renderRoute u
|
||||
@ -14,11 +14,11 @@ import Control.Monad (foldM)
|
||||
import Yesod.Handler (badMethod)
|
||||
import Yesod.Content (chooseRep)
|
||||
import qualified Network.Wai as W
|
||||
import Yesod.Core (yesodRunner, yesodDispatch)
|
||||
import Yesod.Internal.Core (yesodRunner, yesodDispatch)
|
||||
import Data.List (foldl')
|
||||
import Data.Char (toLower)
|
||||
import qualified Data.ByteString as S
|
||||
import Yesod.Core (Yesod (joinPath, approot, cleanPath))
|
||||
import Yesod.Internal.Core (Yesod (joinPath, approot, cleanPath))
|
||||
import Network.HTTP.Types (status301)
|
||||
import Data.Text (Text)
|
||||
import Data.Monoid (mappend)
|
||||
|
||||
@ -8,7 +8,7 @@ synopsis: Creation of type-safe, RESTful web applications.
|
||||
description:
|
||||
Yesod is a framework designed to foster creation of RESTful web application that have strong compile-time guarantees of correctness. It also affords space efficient code and portability to many deployment backends, from CGI to stand-alone serving.
|
||||
.
|
||||
The Yesod documentation site <http://www.yesodweb.com/> has much more information, tutorials and information on some of the supporting packages, like Hamlet and web-routes-quasi.
|
||||
The Yesod documentation site <http://www.yesodweb.com/> has much more information, tutorials and information on some of the supporting packages, like Hamlet and Persistent.
|
||||
category: Web, Yesod
|
||||
stability: Stable
|
||||
cabal-version: >= 1.6
|
||||
@ -56,6 +56,7 @@ library
|
||||
Yesod.Request
|
||||
Yesod.Widget
|
||||
other-modules: Yesod.Internal
|
||||
Yesod.Internal.Core
|
||||
Yesod.Internal.Session
|
||||
Yesod.Internal.Request
|
||||
Yesod.Internal.Dispatch
|
||||
|
||||
Loading…
Reference in New Issue
Block a user