haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' into yesod-1.4

Browse Source 
Conflicts:
	yesod-core/test/YesodCoreTest/CleanPath.hs
	yesod-persistent/yesod-persistent.cabal
This commit is contained in:
Michael Snoyman 2014-06-09 11:22:30 +03:00
commit b93a5d1993
32 changed files with 309 additions and 126 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
yesod-bin/Devel.hs
View File

@ -161,7 +161,11 @@ reverseProxy opts iappPort = do
#endif #endif
$ ProxyDest "127.0.0.1" appPort) $ ProxyDest "127.0.0.1" appPort)
def def
#if MIN_VERSION_wai(3, 0, 0)
{ wpsOnExc = \e req f -> onExc e req >>= f
#else
{ wpsOnExc = onExc { wpsOnExc = onExc
#endif
, wpsTimeout = , wpsTimeout =
if proxyTimeout opts == 0 if proxyTimeout opts == 0
then Nothing then Nothing

10
yesod-bin/hsfiles/mongo.hsfiles
View File

@ -122,7 +122,6 @@ import Yesod
import Yesod.Static import Yesod.Static
import Yesod.Auth import Yesod.Auth
import Yesod.Auth.BrowserId import Yesod.Auth.BrowserId
import Yesod.Auth.GoogleEmail
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Default.Util (addStaticContentExternal) import Yesod.Default.Util (addStaticContentExternal)
import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
@ -251,7 +250,7 @@ instance YesodAuth App where
} }
-- You can add other plugins like BrowserID, email or OAuth here -- You can add other plugins like BrowserID, email or OAuth here
authPlugins _ = [authBrowserId def, authGoogleEmail] authPlugins _ = [authBrowserId def]
authHttpManager = httpManager authHttpManager = httpManager
@ -346,7 +345,6 @@ infixr 5 <>
{-# START_FILE Model.hs #-} {-# START_FILE Model.hs #-}
module Model where module Model where
import Prelude
import Yesod import Yesod
import Data.Text (Text) import Data.Text (Text)
import Database.Persist.Quasi import Database.Persist.Quasi
@ -362,7 +360,7 @@ let mongoSettings = (mkPersistSettings (ConT ''MongoBackend))
{ mpsGeneric = False { mpsGeneric = False
} }
in share [mkPersist mongoSettings] in share [mkPersist mongoSettings]
$(persistFileWith lowerCaseSettings "config/models") $(persistFileWith upperCaseSettings "config/models")
{-# START_FILE PROJECTNAME.cabal #-} {-# START_FILE PROJECTNAME.cabal #-}
name: PROJECTNAME name: PROJECTNAME
@ -423,11 +421,11 @@ library
, shakespeare >= 2.0 && < 2.1 , shakespeare >= 2.0 && < 2.1
, hjsmin >= 0.1 && < 0.2 , hjsmin >= 0.1 && < 0.2
, monad-control >= 0.3 && < 0.4 , monad-control >= 0.3 && < 0.4
, wai-extra >= 2.1 && < 2.2 , wai-extra >= 3.0 && < 3.1
, yaml >= 0.8 && < 0.9 , yaml >= 0.8 && < 0.9
, http-conduit >= 2.1 && < 2.2 , http-conduit >= 2.1 && < 2.2
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 2.1 && < 2.2 , warp >= 3.0 && < 3.1
, data-default , data-default
, aeson >= 0.6 && < 0.8 , aeson >= 0.6 && < 0.8
, conduit >= 1.0 && < 2.0 , conduit >= 1.0 && < 2.0

8
yesod-bin/hsfiles/mysql.hsfiles
View File

@ -129,7 +129,6 @@ import Yesod
import Yesod.Static import Yesod.Static
import Yesod.Auth import Yesod.Auth
import Yesod.Auth.BrowserId import Yesod.Auth.BrowserId
import Yesod.Auth.GoogleEmail
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Default.Util (addStaticContentExternal) import Yesod.Default.Util (addStaticContentExternal)
import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
@ -260,7 +259,7 @@ instance YesodAuth App where
} }
-- You can add other plugins like BrowserID, email or OAuth here -- You can add other plugins like BrowserID, email or OAuth here
authPlugins _ = [authBrowserId def, authGoogleEmail] authPlugins _ = [authBrowserId def]
authHttpManager = httpManager authHttpManager = httpManager
@ -355,7 +354,6 @@ infixr 5 <>
{-# START_FILE Model.hs #-} {-# START_FILE Model.hs #-}
module Model where module Model where
import Prelude
import Yesod import Yesod
import Data.Text (Text) import Data.Text (Text)
import Database.Persist.Quasi import Database.Persist.Quasi
@ -427,11 +425,11 @@ library
, shakespeare >= 2.0 && < 2.1 , shakespeare >= 2.0 && < 2.1
, hjsmin >= 0.1 && < 0.2 , hjsmin >= 0.1 && < 0.2
, monad-control >= 0.3 && < 0.4 , monad-control >= 0.3 && < 0.4
, wai-extra >= 2.1 && < 2.2 , wai-extra >= 3.0 && < 3.1
, yaml >= 0.8 && < 0.9 , yaml >= 0.8 && < 0.9
, http-conduit >= 2.1 && < 2.2 , http-conduit >= 2.1 && < 2.2
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 2.1 && < 2.2 , warp >= 3.0 && < 3.1
, data-default , data-default
, aeson >= 0.6 && < 0.8 , aeson >= 0.6 && < 0.8
, conduit >= 1.0 && < 2.0 , conduit >= 1.0 && < 2.0

8
yesod-bin/hsfiles/postgres-fay.hsfiles
View File

@ -132,7 +132,6 @@ import Yesod
import Yesod.Static import Yesod.Static
import Yesod.Auth import Yesod.Auth
import Yesod.Auth.BrowserId import Yesod.Auth.BrowserId
import Yesod.Auth.GoogleEmail
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Default.Util (addStaticContentExternal) import Yesod.Default.Util (addStaticContentExternal)
import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
@ -273,7 +272,7 @@ instance YesodAuth App where
} }
-- You can add other plugins like BrowserID, email or OAuth here -- You can add other plugins like BrowserID, email or OAuth here
authPlugins _ = [authBrowserId def, authGoogleEmail] authPlugins _ = [authBrowserId def]
authHttpManager = httpManager authHttpManager = httpManager
@ -387,7 +386,6 @@ infixr 5 <>
{-# START_FILE Model.hs #-} {-# START_FILE Model.hs #-}
module Model where module Model where
import Prelude
import Yesod import Yesod
import Data.Text (Text) import Data.Text (Text)
import Database.Persist.Quasi import Database.Persist.Quasi
@ -464,11 +462,11 @@ library
, template-haskell , template-haskell
, shakespeare >= 2.0 && < 2.1 , shakespeare >= 2.0 && < 2.1
, monad-control >= 0.3 && < 0.4 , monad-control >= 0.3 && < 0.4
, wai-extra >= 2.1 && < 2.2 , wai-extra >= 3.0 && < 3.1
, yaml >= 0.8 && < 0.9 , yaml >= 0.8 && < 0.9
, http-conduit >= 2.1 && < 2.2 , http-conduit >= 2.1 && < 2.2
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 2.1 && < 2.2 , warp >= 3.0 && < 3.1
, data-default , data-default
, aeson >= 0.6 && < 0.8 , aeson >= 0.6 && < 0.8
, conduit >= 1.0 && < 2.0 , conduit >= 1.0 && < 2.0

8
yesod-bin/hsfiles/postgres.hsfiles
View File

@ -129,7 +129,6 @@ import Yesod
import Yesod.Static import Yesod.Static
import Yesod.Auth import Yesod.Auth
import Yesod.Auth.BrowserId import Yesod.Auth.BrowserId
import Yesod.Auth.GoogleEmail
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Default.Util (addStaticContentExternal) import Yesod.Default.Util (addStaticContentExternal)
import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
@ -260,7 +259,7 @@ instance YesodAuth App where
} }
-- You can add other plugins like BrowserID, email or OAuth here -- You can add other plugins like BrowserID, email or OAuth here
authPlugins _ = [authBrowserId def, authGoogleEmail] authPlugins _ = [authBrowserId def]
authHttpManager = httpManager authHttpManager = httpManager
@ -355,7 +354,6 @@ infixr 5 <>
{-# START_FILE Model.hs #-} {-# START_FILE Model.hs #-}
module Model where module Model where
import Prelude
import Yesod import Yesod
import Data.Text (Text) import Data.Text (Text)
import Database.Persist.Quasi import Database.Persist.Quasi
@ -427,11 +425,11 @@ library
, shakespeare >= 2.0 && < 2.1 , shakespeare >= 2.0 && < 2.1
, hjsmin >= 0.1 && < 0.2 , hjsmin >= 0.1 && < 0.2
, monad-control >= 0.3 && < 0.4 , monad-control >= 0.3 && < 0.4
, wai-extra >= 2.1 && < 2.2 , wai-extra >= 3.0 && < 3.1
, yaml >= 0.8 && < 0.9 , yaml >= 0.8 && < 0.9
, http-conduit >= 2.1 && < 2.2 , http-conduit >= 2.1 && < 2.2
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 2.1 && < 2.2 , warp >= 3.0 && < 3.1
, data-default , data-default
, aeson >= 0.6 && < 0.8 , aeson >= 0.6 && < 0.8
, conduit >= 1.0 && < 2.0 , conduit >= 1.0 && < 2.0

6
yesod-bin/hsfiles/simple.hsfiles
View File

@ -113,6 +113,8 @@ module Foundation where
import Prelude import Prelude
import Yesod import Yesod
import Yesod.Static import Yesod.Static
import Yesod.Auth
import Yesod.Auth.BrowserId
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Default.Util (addStaticContentExternal) import Yesod.Default.Util (addStaticContentExternal)
import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
@ -351,11 +353,11 @@ library
, shakespeare >= 2.0 && < 2.1 , shakespeare >= 2.0 && < 2.1
, hjsmin >= 0.1 && < 0.2 , hjsmin >= 0.1 && < 0.2
, monad-control >= 0.3 && < 0.4 , monad-control >= 0.3 && < 0.4
, wai-extra >= 2.1 && < 2.2 , wai-extra >= 3.0 && < 3.1
, yaml >= 0.8 && < 0.9 , yaml >= 0.8 && < 0.9
, http-conduit >= 2.1 && < 2.2 , http-conduit >= 2.1 && < 2.2
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 2.1 && < 2.2 , warp >= 3.0 && < 3.1
, data-default , data-default
, aeson >= 0.6 && < 0.8 , aeson >= 0.6 && < 0.8
, conduit >= 1.0 && < 2.0 , conduit >= 1.0 && < 2.0

8
yesod-bin/hsfiles/sqlite.hsfiles
View File

@ -129,7 +129,6 @@ import Yesod
import Yesod.Static import Yesod.Static
import Yesod.Auth import Yesod.Auth
import Yesod.Auth.BrowserId import Yesod.Auth.BrowserId
import Yesod.Auth.GoogleEmail
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Default.Util (addStaticContentExternal) import Yesod.Default.Util (addStaticContentExternal)
import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
@ -260,7 +259,7 @@ instance YesodAuth App where
} }
-- You can add other plugins like BrowserID, email or OAuth here -- You can add other plugins like BrowserID, email or OAuth here
authPlugins _ = [authBrowserId def, authGoogleEmail] authPlugins _ = [authBrowserId def]
authHttpManager = httpManager authHttpManager = httpManager
@ -355,7 +354,6 @@ infixr 5 <>
{-# START_FILE Model.hs #-} {-# START_FILE Model.hs #-}
module Model where module Model where
import Prelude
import Yesod import Yesod
import Data.Text (Text) import Data.Text (Text)
import Database.Persist.Quasi import Database.Persist.Quasi
@ -427,11 +425,11 @@ library
, shakespeare >= 2.0 && < 2.1 , shakespeare >= 2.0 && < 2.1
, hjsmin >= 0.1 && < 0.2 , hjsmin >= 0.1 && < 0.2
, monad-control >= 0.3 && < 0.4 , monad-control >= 0.3 && < 0.4
, wai-extra >= 2.1 && < 2.2 , wai-extra >= 3.0 && < 3.1
, yaml >= 0.8 && < 0.9 , yaml >= 0.8 && < 0.9
, http-conduit >= 2.1 && < 2.2 , http-conduit >= 2.1 && < 2.2
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 2.1 && < 2.2 , warp >= 3.0 && < 3.1
, data-default , data-default
, aeson >= 0.6 && < 0.8 , aeson >= 0.6 && < 0.8
, conduit >= 1.0 && < 2.0 , conduit >= 1.0 && < 2.0

2
yesod-bin/yesod-bin.cabal
View File

@ -1,5 +1,5 @@
name: yesod-bin name: yesod-bin
version: 1.2.9.4 version: 1.2.10.1
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>

5
yesod-core/Yesod/Core/Dispatch.hs
View File

@ -92,8 +92,13 @@ toWaiAppYre yre req =
where where
site = yreSite yre site = yreSite yre
sendRedirect :: Yesod master => master -> [Text] -> W.Application sendRedirect :: Yesod master => master -> [Text] -> W.Application
#if MIN_VERSION_wai(3, 0, 0)
sendRedirect y segments' env sendResponse =
sendResponse $ W.responseLBS status301
#else
sendRedirect y segments' env = sendRedirect y segments' env =
return $ W.responseLBS status301 return $ W.responseLBS status301
#endif
[ ("Content-Type", "text/plain") [ ("Content-Type", "text/plain")
, ("Location", Blaze.ByteString.Builder.toByteString dest') , ("Location", Blaze.ByteString.Builder.toByteString dest')
] "Redirecting" ] "Redirecting"

50
yesod-core/Yesod/Core/Handler.hs
View File

@ -93,6 +93,9 @@ module Yesod.Core.Handler
, sendWaiResponse , sendWaiResponse
#if MIN_VERSION_wai(2, 1, 0) #if MIN_VERSION_wai(2, 1, 0)
, sendRawResponse , sendRawResponse
#endif
#if MIN_VERSION_wai(3, 0, 0)
, sendRawResponseNoConduit
#endif #endif
-- * Different representations -- * Different representations
-- $representations -- $representations
@ -198,6 +201,8 @@ import Control.Exception (throwIO)
import Blaze.ByteString.Builder (Builder) import Blaze.ByteString.Builder (Builder)
import Safe (headMay) import Safe (headMay)
import Data.CaseInsensitive (CI) import Data.CaseInsensitive (CI)
import qualified Data.Conduit.List as CL
import Control.Monad (unless)
import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO
#if MIN_VERSION_wai(2, 0, 0) #if MIN_VERSION_wai(2, 0, 0)
#else #else
@ -368,7 +373,11 @@ handlerToIO =
where where
oldReq = handlerRequest oldHandlerData oldReq = handlerRequest oldHandlerData
oldWaiReq = reqWaiRequest oldReq oldWaiReq = reqWaiRequest oldReq
#if MIN_VERSION_wai(3, 0, 0)
newWaiReq = oldWaiReq { W.requestBody = return mempty
#else
newWaiReq = oldWaiReq { W.requestBody = mempty newWaiReq = oldWaiReq { W.requestBody = mempty
#endif
, W.requestBodyLength = W.KnownLength 0 , W.requestBodyLength = W.KnownLength 0
} }
oldEnv = handlerEnv oldHandlerData oldEnv = handlerEnv oldHandlerData
@ -576,6 +585,24 @@ sendResponseCreated url = do
sendWaiResponse :: MonadHandler m => W.Response -> m b sendWaiResponse :: MonadHandler m => W.Response -> m b
sendWaiResponse = handlerError . HCWai sendWaiResponse = handlerError . HCWai
#if MIN_VERSION_wai(3, 0, 0)
-- | Send a raw response without conduit. This is used for cases such as
-- WebSockets. Requires WAI 3.0 or later, and a web server which supports raw
-- responses (e.g., Warp).
--
-- Since 1.2.16
sendRawResponseNoConduit
:: (MonadHandler m, MonadBaseControl IO m)
=> (IO S8.ByteString -> (S8.ByteString -> IO ()) -> m ())
-> m a
sendRawResponseNoConduit raw = control $ \runInIO ->
runInIO $ sendWaiResponse $ flip W.responseRaw fallback
$ \src sink -> runInIO (raw src sink) >> return ()
where
fallback = W.responseLBS H.status500 [("Content-Type", "text/plain")]
"sendRawResponse: backend does not support raw responses"
#endif
#if MIN_VERSION_wai(2, 1, 0) #if MIN_VERSION_wai(2, 1, 0)
-- | Send a raw response. This is used for cases such as WebSockets. Requires -- | Send a raw response. This is used for cases such as WebSockets. Requires
-- WAI 2.1 or later, and a web server which supports raw responses (e.g., -- WAI 2.1 or later, and a web server which supports raw responses (e.g.,
@ -585,6 +612,19 @@ sendWaiResponse = handlerError . HCWai
sendRawResponse :: (MonadHandler m, MonadBaseControl IO m) sendRawResponse :: (MonadHandler m, MonadBaseControl IO m)
=> (Source IO S8.ByteString -> Sink S8.ByteString IO () -> m ()) => (Source IO S8.ByteString -> Sink S8.ByteString IO () -> m ())
-> m a -> m a
#if MIN_VERSION_wai(3, 0, 0)
sendRawResponse raw = control $ \runInIO ->
runInIO $ sendWaiResponse $ flip W.responseRaw fallback
$ \src sink -> runInIO (raw (src' src) (CL.mapM_ sink)) >> return ()
where
fallback = W.responseLBS H.status500 [("Content-Type", "text/plain")]
"sendRawResponse: backend does not support raw responses"
src' src = do
bs <- liftIO src
unless (S.null bs) $ do
yield bs
src' src
#else
sendRawResponse raw = control $ \runInIO -> sendRawResponse raw = control $ \runInIO ->
runInIO $ sendWaiResponse $ flip W.responseRaw fallback runInIO $ sendWaiResponse $ flip W.responseRaw fallback
$ \src sink -> runInIO (raw src sink) >> return () $ \src sink -> runInIO (raw src sink) >> return ()
@ -592,6 +632,7 @@ sendRawResponse raw = control $ \runInIO ->
fallback = W.responseLBS H.status500 [("Content-Type", "text/plain")] fallback = W.responseLBS H.status500 [("Content-Type", "text/plain")]
"sendRawResponse: backend does not support raw responses" "sendRawResponse: backend does not support raw responses"
#endif #endif
#endif
-- | Return a 404 not found page. Also denotes no handler available. -- | Return a 404 not found page. Also denotes no handler available.
notFound :: MonadHandler m => m a notFound :: MonadHandler m => m a
@ -1068,6 +1109,14 @@ provideRepType ct handler =
rawRequestBody :: MonadHandler m => Source m S.ByteString rawRequestBody :: MonadHandler m => Source m S.ByteString
rawRequestBody = do rawRequestBody = do
req <- lift waiRequest req <- lift waiRequest
#if MIN_VERSION_wai(3, 0, 0)
let loop = do
bs <- liftIO $ W.requestBody req
unless (S.null bs) $ do
yield bs
loop
loop
#else
transPipe transPipe
#if MIN_VERSION_wai(2, 0, 0) #if MIN_VERSION_wai(2, 0, 0)
liftIO liftIO
@ -1075,6 +1124,7 @@ rawRequestBody = do
liftResourceT liftResourceT
#endif #endif
(W.requestBody req) (W.requestBody req)
#endif
-- | Stream the data from the file. Since Yesod 1.2, this has been generalized -- | Stream the data from the file. Since Yesod 1.2, this has been generalized
-- to work in any @MonadResource@. -- to work in any @MonadResource@.

48
yesod-core/Yesod/Core/Internal/Request.hs
View File

@ -44,11 +44,28 @@ import Control.Monad.Trans.Resource (runResourceT, ResourceT)
import Control.Exception (throwIO) import Control.Exception (throwIO)
import Yesod.Core.Types import Yesod.Core.Types
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.IORef
-- | Impose a limit on the size of the request body. -- | Impose a limit on the size of the request body.
limitRequestBody :: Word64 -> W.Request -> W.Request limitRequestBody :: Word64 -> W.Request -> IO W.Request
#if MIN_VERSION_wai(3, 0, 0)
limitRequestBody maxLen req = do
ref <- newIORef maxLen
return req
{ W.requestBody = do
bs <- W.requestBody req
remaining <- readIORef ref
let len = fromIntegral $ S8.length bs
remaining' = remaining - len
if remaining < len
then throwIO $ HCWai tooLargeResponse
else do
writeIORef ref remaining'
return bs
}
#else
limitRequestBody maxLen req = limitRequestBody maxLen req =
req { W.requestBody = W.requestBody req $= limit maxLen } return req { W.requestBody = W.requestBody req $= limit maxLen }
where where
tooLarge = liftIO $ throwIO $ HCWai tooLargeResponse tooLarge = liftIO $ throwIO $ HCWai tooLargeResponse
@ -63,6 +80,7 @@ limitRequestBody maxLen req =
else do else do
yield bs yield bs
limit $ remaining - len limit $ remaining - len
#endif
tooLargeResponse :: W.Response tooLargeResponse :: W.Response
tooLargeResponse = W.responseLBS tooLargeResponse = W.responseLBS
@ -75,7 +93,7 @@ parseWaiRequest :: RandomGen g
-> SessionMap -> SessionMap
-> Bool -> Bool
-> Maybe Word64 -- ^ max body size -> Maybe Word64 -- ^ max body size
-> (Either YesodRequest (g -> YesodRequest)) -> (Either (IO YesodRequest) (g -> IO YesodRequest))
parseWaiRequest env session useToken mmaxBodySize = parseWaiRequest env session useToken mmaxBodySize =
-- In most cases, we won't need to generate any random values. Therefore, -- In most cases, we won't need to generate any random values. Therefore,
-- we split our results: if we need a random generator, return a Right -- we split our results: if we need a random generator, return a Right
@ -85,17 +103,19 @@ parseWaiRequest env session useToken mmaxBodySize =
Left token -> Left $ mkRequest token Left token -> Left $ mkRequest token
Right mkToken -> Right $ mkRequest . mkToken Right mkToken -> Right $ mkRequest . mkToken
where where
mkRequest token' = YesodRequest mkRequest token' = do
{ reqGetParams = gets envLimited <- maybe return limitRequestBody mmaxBodySize env
, reqCookies = cookies return YesodRequest
, reqWaiRequest = maybe id limitRequestBody mmaxBodySize env { reqGetParams = gets
, reqLangs = langs'' , reqCookies = cookies
, reqToken = token' , reqWaiRequest = envLimited
, reqSession = if useToken , reqLangs = langs''
then Map.delete tokenKey session , reqToken = token'
else session , reqSession = if useToken
, reqAccept = httpAccept env then Map.delete tokenKey session
} else session
, reqAccept = httpAccept env
}
gets = textQueryString env gets = textQueryString env
reqCookie = lookup "Cookie" $ W.requestHeaders env reqCookie = lookup "Cookie" $ W.requestHeaders env
cookies = maybe [] parseCookiesText reqCookie cookies = maybe [] parseCookiesText reqCookie

43
yesod-core/Yesod/Core/Internal/Response.hs
View File

@ -33,7 +33,49 @@ import qualified Data.ByteString.Lazy as L
import qualified Data.Map as Map import qualified Data.Map as Map
import Yesod.Core.Internal.Request (tokenKey) import Yesod.Core.Internal.Request (tokenKey)
import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (encodeUtf8)
import Data.Conduit (Flush (..), ($$))
import qualified Data.Conduit.List as CL
#if MIN_VERSION_wai(3, 0, 0)
yarToResponse :: YesodResponse
-> (SessionMap -> IO [Header]) -- ^ save session
-> YesodRequest
-> Request
-> InternalState
-> IO Response
yarToResponse (YRWai a) _ _ _ _ = return a
yarToResponse (YRPlain s' hs ct c newSess) saveSession yreq req is = do
extraHeaders <- do
let nsToken = maybe
newSess
(\n -> Map.insert tokenKey (encodeUtf8 n) newSess)
(reqToken yreq)
sessionHeaders <- saveSession nsToken
return $ ("Content-Type", ct) : map headerToPair sessionHeaders
let finalHeaders = extraHeaders ++ map headerToPair hs
finalHeaders' len = ("Content-Length", S8.pack $ show len)
: finalHeaders
let go (ContentBuilder b mlen) = do
let hs' = maybe finalHeaders finalHeaders' mlen
return $ ResponseBuilder s hs' b
go (ContentFile fp p) = do
return $ ResponseFile s finalHeaders fp p
go (ContentSource body) = return $ responseStream s finalHeaders
$ \sendChunk flush -> do
transPipe (flip runInternalState is) body
$$ CL.mapM_ (\mchunk ->
case mchunk of
Flush -> flush
Chunk builder -> sendChunk builder)
go (ContentDontEvaluate c') = go c'
go c
where
s
| s' == defaultStatus = H.status200
| otherwise = s'
#else
yarToResponse :: YesodResponse yarToResponse :: YesodResponse
-> (SessionMap -> IO [Header]) -- ^ save session -> (SessionMap -> IO [Header]) -- ^ save session
-> YesodRequest -> YesodRequest
@ -106,6 +148,7 @@ yarToResponse (YRPlain s' hs ct c newSess) saveSession yreq req
s s
| s' == defaultStatus = H.status200 | s' == defaultStatus = H.status200
| otherwise = s' | otherwise = s'
#endif
-- | Indicates that the user provided no specific status code to be used, and -- | Indicates that the user provided no specific status code to be used, and
-- therefore the default status code should be used. For normal responses, this -- therefore the default status code should be used. For normal responses, this

20
yesod-core/Yesod/Core/Internal/Run.hs
View File

@ -230,7 +230,11 @@ runFakeHandler fakeSessionMap logger site handler = liftIO $ do
, remoteHost = error "runFakeHandler-remoteHost" , remoteHost = error "runFakeHandler-remoteHost"
, pathInfo = ["runFakeHandler", "pathInfo"] , pathInfo = ["runFakeHandler", "pathInfo"]
, queryString = [] , queryString = []
#if MIN_VERSION_wai(3, 0, 0)
, requestBody = return mempty
#else
, requestBody = mempty , requestBody = mempty
#endif
, vault = mempty , vault = mempty
, requestBodyLength = KnownLength 0 , requestBodyLength = KnownLength 0
} }
@ -253,8 +257,13 @@ yesodRunner :: (ToTypedContent res, Yesod site)
-> YesodRunnerEnv site -> YesodRunnerEnv site
-> Maybe (Route site) -> Maybe (Route site)
-> Application -> Application
#if MIN_VERSION_wai(3, 0, 0)
yesodRunner handler' YesodRunnerEnv {..} route req sendResponse
| Just maxLen <- mmaxLen, KnownLength len <- requestBodyLength req, maxLen < len = sendResponse tooLargeResponse
#else
yesodRunner handler' YesodRunnerEnv {..} route req yesodRunner handler' YesodRunnerEnv {..} route req
| Just maxLen <- mmaxLen, KnownLength len <- requestBodyLength req, maxLen < len = return tooLargeResponse | Just maxLen <- mmaxLen, KnownLength len <- requestBodyLength req, maxLen < len = return tooLargeResponse
#endif
| otherwise = do | otherwise = do
let dontSaveSession _ = return [] let dontSaveSession _ = return []
(session, saveSession) <- liftIO $ do (session, saveSession) <- liftIO $ do
@ -281,6 +290,16 @@ yesodRunner handler' YesodRunnerEnv {..} route req
rhe = rheSafe rhe = rheSafe
{ rheOnError = runHandler rheSafe . errorHandler { rheOnError = runHandler rheSafe . errorHandler
} }
#if MIN_VERSION_wai(3, 0, 0)
E.bracket createInternalState closeInternalState $ \is -> do
yreq' <- yreq
yar <- runInternalState (runHandler rhe handler yreq') is
res <- yarToResponse yar saveSession yreq' req is
sendResponse res
#else
#if MIN_VERSION_wai(2, 0, 0) #if MIN_VERSION_wai(2, 0, 0)
bracketOnError createInternalState closeInternalState $ \is -> do bracketOnError createInternalState closeInternalState $ \is -> do
yar <- runInternalState (runHandler rhe handler yreq) is yar <- runInternalState (runHandler rhe handler yreq) is
@ -288,6 +307,7 @@ yesodRunner handler' YesodRunnerEnv {..} route req
#else #else
yar <- runHandler rhe handler yreq yar <- runHandler rhe handler yreq
liftIO $ yarToResponse yar saveSession yreq req liftIO $ yarToResponse yar saveSession yreq req
#endif
#endif #endif
where where
mmaxLen = maximumContentLength yreSite route mmaxLen = maximumContentLength yreSite route

5
yesod-core/test/YesodCoreTest/CleanPath.hs
View File

@ -1,6 +1,7 @@
{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances, ViewPatterns #-} {-# LANGUAGE FlexibleInstances, ViewPatterns #-}
{-# LANGUAGE CPP #-}
module YesodCoreTest.CleanPath (cleanPathTest, Widget) where module YesodCoreTest.CleanPath (cleanPathTest, Widget) where
import Test.Hspec import Test.Hspec
@ -32,7 +33,11 @@ instance ParseRoute Subsite where
parseRoute (x, _) = Just $ SubsiteRoute x parseRoute (x, _) = Just $ SubsiteRoute x
instance YesodSubDispatch Subsite master where instance YesodSubDispatch Subsite master where
#if MIN_VERSION_wai(3, 0, 0)
yesodSubDispatch _ req f = f $ responseLBS
#else
yesodSubDispatch _ req = return $ responseLBS yesodSubDispatch _ req = return $ responseLBS
#endif
status200 status200
[ ("Content-Type", "SUBSITE") [ ("Content-Type", "SUBSITE")
] $ L8.pack $ show (pathInfo req) ] $ L8.pack $ show (pathInfo req)

7
yesod-core/test/YesodCoreTest/ErrorHandling.hs
View File

@ -128,7 +128,7 @@ errorHandlingTest = describe "Test.ErrorHandling" $ do
it "builder includes content-length" caseGoodBuilder it "builder includes content-length" caseGoodBuilder
forM_ [1..10] $ \i -> it ("error case " ++ show i) (caseError i) forM_ [1..10] $ \i -> it ("error case " ++ show i) (caseError i)
runner :: Session () -> IO () runner :: Session a -> IO a
runner f = toWaiApp App >>= runSession f runner f = toWaiApp App >>= runSession f
caseNotFound :: IO () caseNotFound :: IO ()
@ -175,11 +175,10 @@ caseErrorInBody = runner $ do
caseErrorInBodyNoEval :: IO () caseErrorInBodyNoEval :: IO ()
caseErrorInBodyNoEval = do caseErrorInBodyNoEval = do
eres <- try $ runner $ do eres <- try $ runner $ do
_ <- request defaultRequest { pathInfo = ["error-in-body-noeval"] } request defaultRequest { pathInfo = ["error-in-body-noeval"] }
return ()
case eres of case eres of
Left (_ :: SomeException) -> return () Left (_ :: SomeException) -> return ()
Right _ -> error "Expected an exception" Right x -> error $ "Expected an exception, got: " ++ show x
caseOverrideStatus :: IO () caseOverrideStatus :: IO ()
caseOverrideStatus = runner $ do caseOverrideStatus = runner $ do

3
yesod-core/test/YesodCoreTest/InternalRequest.hs
View File

@ -12,6 +12,7 @@ import Data.Monoid (mempty)
import Data.Map (singleton) import Data.Map (singleton)
import Yesod.Core import Yesod.Core
import Data.Word (Word64) import Data.Word (Word64)
import System.IO.Unsafe (unsafePerformIO)
randomStringSpecs :: Spec randomStringSpecs :: Spec
randomStringSpecs = describe "Yesod.Internal.Request.randomString" $ do randomStringSpecs = describe "Yesod.Internal.Request.randomString" $ do
@ -36,7 +37,7 @@ parseWaiRequest' :: Request
-> Bool -> Bool
-> Word64 -> Word64
-> YesodRequest -> YesodRequest
parseWaiRequest' a b c d = parseWaiRequest' a b c d = unsafePerformIO $ -- ugly hack, just to ease migration, should be removed
case parseWaiRequest a b c (Just d) of case parseWaiRequest a b c (Just d) of
Left yreq -> yreq Left yreq -> yreq
Right needGen -> needGen g Right needGen -> needGen g

4
yesod-core/test/YesodCoreTest/RequestBodySize.hs
View File

@ -83,8 +83,8 @@ specs :: Spec
specs = describe "Test.RequestBodySize" $ do specs = describe "Test.RequestBodySize" $ do
caseHelper "lookupPostParam- large" "post" "foobarbaz=bin" 413 413 caseHelper "lookupPostParam- large" "post" "foobarbaz=bin" 413 413
caseHelper "lookupPostParam- small" "post" "foo=bin" 200 200 caseHelper "lookupPostParam- small" "post" "foo=bin" 200 200
caseHelper "consume- large" "consume" "this is longer than 10" 413 413 caseHelper "total consume- large" "consume" "this is longer than 10" 413 413
caseHelper "consume- small" "consume" "smaller" 200 200 caseHelper "total consume- small" "consume" "smaller" 200 200
caseHelper "partial consume- large" "partial-consume" "this is longer than 10" 200 413 caseHelper "partial consume- large" "partial-consume" "this is longer than 10" 200 413
caseHelper "partial consume- small" "partial-consume" "smaller" 200 200 caseHelper "partial consume- small" "partial-consume" "smaller" 200 200
caseHelper "unused- large" "unused" "this is longer than 10" 200 413 caseHelper "unused- large" "unused" "this is longer than 10" 200 413

6
yesod-core/test/YesodCoreTest/WaiSubsite.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, OverloadedStrings #-} {-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, OverloadedStrings #-}
module YesodCoreTest.WaiSubsite (specs, Widget) where module YesodCoreTest.WaiSubsite (specs, Widget) where
import YesodCoreTest.YesodTest import YesodCoreTest.YesodTest
@ -6,7 +6,11 @@ import Yesod.Core
import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types as H
myApp :: Application myApp :: Application
#if MIN_VERSION_wai(3, 0, 0)
myApp _ f = f $ responseLBS H.status200 [("Content-type", "text/plain")] "WAI"
#else
myApp _ = return $ responseLBS H.status200 [("Content-type", "text/plain")] "WAI" myApp _ = return $ responseLBS H.status200 [("Content-type", "text/plain")] "WAI"
#endif
getApp :: a -> WaiSubsite getApp :: a -> WaiSubsite
getApp _ = WaiSubsite myApp getApp _ = WaiSubsite myApp

5
yesod-core/yesod-core.cabal
View File

@ -1,5 +1,5 @@
name: yesod-core name: yesod-core
version: 1.2.15.2 version: 1.2.16
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -38,7 +38,7 @@ library
, shakespeare-css >= 1.0 , shakespeare-css >= 1.0
, shakespeare-i18n >= 1.0 , shakespeare-i18n >= 1.0
, blaze-builder >= 0.2.1.4 && < 0.4 , blaze-builder >= 0.2.1.4 && < 0.4
, transformers >= 0.2.2 && < 0.4 , transformers >= 0.2.2
, mtl , mtl
, clientsession >= 0.9 && < 0.10 , clientsession >= 0.9 && < 0.10
, random >= 1.0.0.2 && < 1.1 , random >= 1.0.0.2 && < 1.1
@ -131,6 +131,7 @@ test-suite tests
, conduit-extra , conduit-extra
, shakespeare , shakespeare
, streaming-commons , streaming-commons
, wai-extra
ghc-options: -Wall ghc-options: -Wall
extensions: TemplateHaskell extensions: TemplateHaskell

13
yesod-eventsource/Yesod/EventSource.hs
View File

@ -46,7 +46,18 @@ repEventSource :: (EventSourcePolyfill -> C.Source (HandlerT site IO) ES.ServerE
-> HandlerT site IO TypedContent -> HandlerT site IO TypedContent
repEventSource src = repEventSource src =
prepareForEventSource >>= prepareForEventSource >>=
respondEventStream . ES.sourceToSource . src respondEventStream . sourceToSource . src
-- | Convert a ServerEvent source into a Builder source of serialized
-- events.
sourceToSource :: Monad m => C.Source m ES.ServerEvent -> C.Source m (C.Flush Builder)
sourceToSource src =
src C.$= C.awaitForever eventToFlushBuilder
where
eventToFlushBuilder event =
case ES.eventToBuilder event of
Nothing -> return ()
Just x -> C.yield (C.Chunk x) >> C.yield C.Flush
-- | Return a Server-Sent Event stream given a 'HandlerT' action -- | Return a Server-Sent Event stream given a 'HandlerT' action

3
yesod-eventsource/yesod-eventsource.cabal
View File

@ -1,5 +1,5 @@
name: yesod-eventsource name: yesod-eventsource
version: 1.1.0.2 version: 1.1.1
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Felipe Lessa <felipe.lessa@gmail.com> author: Felipe Lessa <felipe.lessa@gmail.com>
@ -32,6 +32,7 @@ library
, conduit >= 0.5 && < 1.2 , conduit >= 0.5 && < 1.2
, wai >= 1.3 , wai >= 1.3
, wai-eventsource >= 1.3 , wai-eventsource >= 1.3
, wai-extra
, blaze-builder , blaze-builder
, transformers , transformers
exposed-modules: Yesod.EventSource exposed-modules: Yesod.EventSource

2
yesod-form/yesod-form.cabal
View File

@ -1,5 +1,5 @@
name: yesod-form name: yesod-form
version: 1.3.9.1 version: 1.3.10
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>

5
yesod-persistent/yesod-persistent.cabal
View File

@ -1,5 +1,5 @@
name: yesod-persistent name: yesod-persistent
version: 1.2.2.3 version: 1.2.3
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -17,7 +17,7 @@ library
, yesod-core >= 1.2.2 && < 1.3 , yesod-core >= 1.2.2 && < 1.3
, persistent >= 1.2 && < 2.1 , persistent >= 1.2 && < 2.1
, persistent-template >= 1.2 && < 2.1 , persistent-template >= 1.2 && < 2.1
, transformers >= 0.2.2 && < 0.4 , transformers >= 0.2.2
, blaze-builder , blaze-builder
, conduit , conduit
, resourcet >= 0.4.5 , resourcet >= 0.4.5
@ -34,6 +34,7 @@ test-suite test
build-depends: base build-depends: base
, hspec , hspec
, wai-test , wai-test
, wai-extra
, yesod-core , yesod-core
, persistent-sqlite , persistent-sqlite
, yesod-persistent , yesod-persistent

2
yesod-platform/to-cabal.hs
View File

@ -3,7 +3,7 @@ import Control.Applicative ((<$>))
main = do main = do
pkgs <- map (intercalate " == ") pkgs <- map (intercalate " == ")
. filter (\xs -> not $ any (`isPrefixOf` xs) $ map return ["parsec", "text", "transformers", "mtl", "HUnit", "QuickCheck", "binary", "zlib", "stm", "regex-compat", "hashable", "vault"]) . filter (\xs -> not $ any (`isPrefixOf` xs) $ map return ["parsec", "text", "transformers", "mtl", "HUnit", "QuickCheck", "binary", "zlib", "stm", "regex-compat", "hashable", "vault", "integer-gmp"])
. map words . map words
. filter (not . null) . filter (not . null)
. lines . lines

117
yesod-platform/yesod-platform.cabal
View File

@ -1,5 +1,5 @@
name: yesod-platform name: yesod-platform
version: 1.2.10 version: 1.2.12
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -15,32 +15,32 @@ homepage: http://www.yesodweb.com/
library library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, SHA == 1.6.4 , SHA == 1.6.4
, aeson == 0.7.0.3 , aeson == 0.7.0.6
, ansi-terminal == 0.6.1.1 , ansi-terminal == 0.6.1.1
, ansi-wl-pprint == 0.6.7.1 , ansi-wl-pprint == 0.6.7.1
, asn1-encoding == 0.8.1.3 , asn1-encoding == 0.8.1.3
, asn1-parse == 0.8.1 , asn1-parse == 0.8.1
, asn1-types == 0.2.3 , asn1-types == 0.2.3
, async == 2.0.1.5 , async == 2.0.1.5
, attoparsec == 0.11.2.1 , attoparsec == 0.12.0.0
, attoparsec-conduit == 1.1.0 , attoparsec-conduit == 1.1.0
, authenticate == 1.3.2.8 , authenticate == 1.3.2.8
, base-unicode-symbols == 0.2.2.4
, base16-bytestring == 0.1.1.6 , base16-bytestring == 0.1.1.6
, base64-bytestring == 1.0.0.1 , base64-bytestring == 1.0.0.1
, blaze-builder == 0.3.3.2 , blaze-builder == 0.3.3.2
, blaze-builder-conduit == 1.1.0 , blaze-builder-conduit == 1.1.0
, blaze-html == 0.7.0.1 , blaze-html == 0.7.0.2
, blaze-markup == 0.6.0.0 , blaze-markup == 0.6.1.0
, byteable == 0.1.1 , byteable == 0.1.1
, byteorder == 1.0.4 , byteorder == 1.0.4
, case-insensitive == 1.2.0.0 , case-insensitive == 1.2.0.0
, cereal == 0.4.0.1 , cereal == 0.4.0.1
, cipher-aes == 0.2.7 , cipher-aes == 0.2.7
, cipher-des == 0.0.6
, cipher-rc4 == 0.1.4 , cipher-rc4 == 0.1.4
, clientsession == 0.9.0.3 , clientsession == 0.9.0.3
, conduit == 1.1.0.2 , conduit == 1.1.6
, conduit-extra == 1.1.0.1 , conduit-extra == 1.1.0.4
, connection == 0.2.1 , connection == 0.2.1
, cookie == 0.4.1.1 , cookie == 0.4.1.1
, cprng-aes == 0.5.2 , cprng-aes == 0.5.2
@ -50,7 +50,7 @@ library
, crypto-pubkey == 0.2.4 , crypto-pubkey == 0.2.4
, crypto-pubkey-types == 0.4.2.2 , crypto-pubkey-types == 0.4.2.2
, crypto-random == 0.0.7 , crypto-random == 0.0.7
, cryptohash == 0.11.4 , cryptohash == 0.11.5
, cryptohash-conduit == 0.1.1 , cryptohash-conduit == 0.1.1
, css-text == 0.1.2.1 , css-text == 0.1.2.1
, data-default == 0.5.3 , data-default == 0.5.3
@ -61,46 +61,47 @@ library
, data-default-instances-old-locale == 0.0.1 , data-default-instances-old-locale == 0.0.1
, dlist == 0.7.0.1 , dlist == 0.7.0.1
, email-validate == 2.0.1 , email-validate == 2.0.1
, entropy == 0.2.2.4 , entropy == 0.3
, esqueleto == 1.3.12 , esqueleto == 1.4.1.2
, exceptions == 0.5 , exceptions == 0.6.1
, fast-logger == 2.1.5 , fast-logger == 2.1.5
, file-embed == 0.0.6 , file-embed == 0.0.7
, hamlet == 1.2.0 , hamlet == 1.2.0
, hjsmin == 0.1.4.6 , hjsmin == 0.1.4.6
, hspec == 1.9.2 , hspec == 1.9.5
, hspec-expectations == 0.5.0.1 , hspec-expectations == 0.5.0.1
, html-conduit == 1.1.0.4 , html-conduit == 1.1.0.5
, http-client == 0.3.1.1 , http-client == 0.3.3
, http-client-tls == 0.2.1.1 , http-client-tls == 0.2.1.1
, http-conduit == 2.1.1 , http-conduit == 2.1.2
, http-date == 0.0.4 , http-date == 0.0.4
, http-reverse-proxy == 0.3.1.5 , http-reverse-proxy == 0.3.1.8
, http-types == 0.8.4 , http-types == 0.8.5
, language-javascript == 0.5.12 , language-javascript == 0.5.13
, lifted-base == 0.2.2.1 , lifted-base == 0.2.2.2
, mime-mail == 0.4.5.1 , mime-mail == 0.4.5.2
, mime-types == 0.1.0.4 , mime-types == 0.1.0.4
, mmorph == 1.0.2 , mmorph == 1.0.3
, monad-control == 0.3.2.3 , monad-control == 0.3.3.0
, monad-logger == 0.3.6 , monad-logger == 0.3.6.1
, monad-loops == 0.4.2 , monad-loops == 0.4.2
, nats == 0.2
, network-conduit == 1.1.0 , network-conduit == 1.1.0
, optparse-applicative == 0.8.0.1 , optparse-applicative == 0.8.1
, path-pieces == 0.1.3.1 , path-pieces == 0.1.3.1
, pem == 0.2.2 , pem == 0.2.2
, persistent == 1.3.0.6 , persistent == 1.3.1.1
, persistent-template == 1.3.1.3 , persistent-template == 1.3.1.4
, primitive == 0.5.2.1 , primitive == 0.5.3.0
, publicsuffixlist == 0.1 , publicsuffixlist == 0.1
, pwstore-fast == 2.4.1 , pwstore-fast == 2.4.1
, quickcheck-io == 0.1.1 , quickcheck-io == 0.1.1
, resource-pool == 0.2.1.1 , resource-pool == 0.2.3.0
, resourcet == 1.1.2 , resourcet == 1.1.2.2
, safe == 0.3.4 , safe == 0.3.4
, scientific == 0.2.0.2 , scientific == 0.3.2.1
, securemem == 0.1.3 , securemem == 0.1.3
, semigroups == 0.13.0.1 , semigroups == 0.15
, setenv == 0.1.1.1 , setenv == 0.1.1.1
, shakespeare == 2.0.0.3 , shakespeare == 2.0.0.3
, shakespeare-css == 1.1.0 , shakespeare-css == 1.1.0
@ -112,47 +113,47 @@ library
, skein == 1.0.9 , skein == 1.0.9
, socks == 0.5.4 , socks == 0.5.4
, stm-chans == 3.0.0.2 , stm-chans == 3.0.0.2
, streaming-commons == 0.1.1 , streaming-commons == 0.1.3
, stringsearch == 0.3.6.5 , stringsearch == 0.3.6.5
, system-fileio == 0.3.12 , system-fileio == 0.3.14
, system-filepath == 0.4.10 , system-filepath == 0.4.12
, tagged == 0.7.1 , tagged == 0.7.2
, tagsoup == 0.13.1 , tagsoup == 0.13.1
, tagstream-conduit == 0.5.5.1 , tagstream-conduit == 0.5.5.1
, tf-random == 0.5 , tf-random == 0.5
, tls == 1.2.6 , tls == 1.2.8
, transformers-base == 0.4.1 , transformers-base == 0.4.2
-- , transformers-compat == 0.3.3.4
, unix-compat == 0.4.1.1 , unix-compat == 0.4.1.1
, unordered-containers == 0.2.4.0 , unordered-containers == 0.2.4.0
, utf8-string == 0.3.7 , utf8-string == 0.3.8
, vector == 0.10.9.1 , vector == 0.10.11.0
, void == 0.6.1 , void == 0.6.1
, wai == 2.1.0.2 , wai == 3.0.0
, wai-app-static == 2.0.1 , wai-app-static == 3.0.0
, wai-extra == 2.1.1.1 , wai-extra == 3.0.0
, wai-logger == 2.1.1 , wai-logger == 2.1.1
, wai-test == 2.0.1.1 , wai-test == 3.0.0
, warp == 2.1.4 , warp == 3.0.0
, warp-tls == 2.0.3.3 , warp-tls == 3.0.0
, word8 == 0.0.4 , word8 == 0.0.4
, x509 == 1.4.11 , x509 == 1.4.11
, x509-store == 1.4.4 , x509-store == 1.4.4
, x509-system == 1.4.2 , x509-system == 1.4.5
, x509-validation == 1.5.0 , x509-validation == 1.5.0
, xml-conduit == 1.2.0.1 , xml-conduit == 1.2.0.2
, xml-types == 0.3.4 , xml-types == 0.3.4
, xss-sanitize == 0.3.5.2 , xss-sanitize == 0.3.5.2
, yaml == 0.8.8.2 , yaml == 0.8.8.3
, yesod == 1.2.5.2 , yesod == 1.2.6
, yesod-auth == 1.3.0.4 , yesod-auth == 1.3.1
, yesod-auth-hashdb == 1.3.0.1 , yesod-auth-hashdb == 1.3.0.1
, yesod-core == 1.2.14 , yesod-core == 1.2.16
, yesod-form == 1.3.8.2 , yesod-form == 1.3.10
, yesod-persistent == 1.2.2.3 , yesod-persistent == 1.2.3
, yesod-routes == 1.2.0.6 , yesod-routes == 1.2.0.6
, yesod-static == 1.2.2.5 , yesod-static == 1.2.4
, yesod-test == 1.2.1.2 , yesod-test == 1.2.3
, zlib-conduit == 1.1.0
exposed-modules: Yesod.Platform exposed-modules: Yesod.Platform

5
yesod-static/Yesod/EmbeddedStatic.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
@ -89,7 +90,11 @@ instance Yesod master => YesodSubDispatch EmbeddedStatic (HandlerT master IO) wh
resp = case pathInfo req of resp = case pathInfo req of
("res":_) -> stApp site req ("res":_) -> stApp site req
("widget":_) -> staticApp (widgetSettings site) req ("widget":_) -> staticApp (widgetSettings site) req
#if MIN_VERSION_wai(3,0,0)
_ -> ($ responseLBS status404 [] "Not Found")
#else
_ -> return $ responseLBS status404 [] "Not Found" _ -> return $ responseLBS status404 [] "Not Found"
#endif
-- | Create the haskell variable for the link to the entry -- | Create the haskell variable for the link to the entry
mkRoute :: ComputedEntry -> Q [Dec] mkRoute :: ComputedEntry -> Q [Dec]

24
yesod-static/Yesod/EmbeddedStatic/Internal.hs
View File

@ -106,12 +106,22 @@ prodEmbed e = do
} }
return $ ComputedEntry (ebHaskellName e) st link return $ ComputedEntry (ebHaskellName e) st link
toApp :: (Request -> IO Response) -> Application
#if MIN_VERSION_wai(3, 0, 0)
toApp f req g = f req >>= g
#else
toApp = id
#endif
tryExtraDevelFiles :: [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application tryExtraDevelFiles :: [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application
tryExtraDevelFiles [] _ = return $ responseLBS status404 [] "" tryExtraDevelFiles = toApp . tryExtraDevelFiles'
tryExtraDevelFiles (f:fs) r = do
tryExtraDevelFiles' :: [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Request -> IO Response
tryExtraDevelFiles' [] _ = return $ responseLBS status404 [] ""
tryExtraDevelFiles' (f:fs) r = do
mct <- liftIO $ f $ drop 1 $ pathInfo r -- drop the initial "res" mct <- liftIO $ f $ drop 1 $ pathInfo r -- drop the initial "res"
case mct of case mct of
Nothing -> tryExtraDevelFiles fs r Nothing -> tryExtraDevelFiles' fs r
Just (mime, ct) -> do Just (mime, ct) -> do
let hash = T.encodeUtf8 $ T.pack $ base64md5 ct let hash = T.encodeUtf8 $ T.pack $ base64md5 ct
let headers = [ ("Content-Type", mime) let headers = [ ("Content-Type", mime)
@ -123,11 +133,19 @@ tryExtraDevelFiles (f:fs) r = do
-- | Helper to create the development application at runtime -- | Helper to create the development application at runtime
develApp :: StaticSettings -> [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application develApp :: StaticSettings -> [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application
#if MIN_VERSION_wai(3, 0, 0)
develApp settings extra req sendResponse = do
staticApp settings {ssMaxAge = NoMaxAge} req $ \resp ->
if statusCode (responseStatus resp) == 404
then tryExtraDevelFiles extra req sendResponse
else sendResponse resp
#else
develApp settings extra req = do develApp settings extra req = do
resp <- staticApp settings {ssMaxAge = NoMaxAge} req resp <- staticApp settings {ssMaxAge = NoMaxAge} req
if statusCode (responseStatus resp) == 404 if statusCode (responseStatus resp) == 404
then tryExtraDevelFiles extra req then tryExtraDevelFiles extra req
else return resp else return resp
#endif
-- | The type of 'addStaticContent' -- | The type of 'addStaticContent'
type AddStaticContent site = T.Text -> T.Text -> BL.ByteString type AddStaticContent site = T.Text -> T.Text -> BL.ByteString

3
yesod-static/yesod-static.cabal
View File

@ -1,5 +1,5 @@
name: yesod-static name: yesod-static
version: 1.2.3 version: 1.2.4
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -82,6 +82,7 @@ test-suite tests
, hspec >= 1.3 , hspec >= 1.3
, yesod-test >= 1.2 , yesod-test >= 1.2
, wai-test , wai-test
, wai-extra
, HUnit , HUnit
-- copy from above -- copy from above

3
yesod-test/yesod-test.cabal
View File

@ -1,5 +1,5 @@
name: yesod-test name: yesod-test
version: 1.2.2 version: 1.2.3
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Nubis <nubis@woobiz.com.ar> author: Nubis <nubis@woobiz.com.ar>
@ -20,6 +20,7 @@ library
, transformers >= 0.2.2 , transformers >= 0.2.2
, wai >= 1.3 , wai >= 1.3
, wai-test >= 1.3 , wai-test >= 1.3
, wai-extra
, network >= 2.2 , network >= 2.2
, http-types >= 0.7 , http-types >= 0.7
, HUnit >= 1.2 , HUnit >= 1.2

2
yesod-websockets/Yesod/WebSockets.hs
View File

@ -46,7 +46,7 @@ webSockets :: (Y.MonadBaseControl IO m, Y.MonadHandler m) => WebSocketsT m () ->
webSockets inner = do webSockets inner = do
req <- Y.waiRequest req <- Y.waiRequest
when (WaiWS.isWebSocketsReq req) $ when (WaiWS.isWebSocketsReq req) $
Y.sendRawResponse $ \src sink -> control $ \runInIO -> WaiWS.runWebSockets Y.sendRawResponseNoConduit $ \src sink -> control $ \runInIO -> WaiWS.runWebSockets
WS.defaultConnectionOptions WS.defaultConnectionOptions
(WaiWS.getRequestHead req) (WaiWS.getRequestHead req)
(\pconn -> do (\pconn -> do

2
yesod-websockets/yesod-websockets.cabal
View File

@ -2,7 +2,7 @@
-- documentation, see http://haskell.org/cabal/users-guide/ -- documentation, see http://haskell.org/cabal/users-guide/
name: yesod-websockets name: yesod-websockets
version: 0.1.0.0 version: 0.1.1
synopsis: WebSockets support for Yesod synopsis: WebSockets support for Yesod
description: WebSockets support for Yesod description: WebSockets support for Yesod
homepage: https://github.com/yesodweb/yesod homepage: https://github.com/yesodweb/yesod

4
yesod/yesod.cabal
View File

@ -1,5 +1,5 @@
name: yesod name: yesod
version: 1.2.5.3 version: 1.2.6
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -27,7 +27,7 @@ library
, yesod-persistent >= 1.2 && < 1.3 , yesod-persistent >= 1.2 && < 1.3
, yesod-form >= 1.3 && < 1.4 , yesod-form >= 1.3 && < 1.4
, monad-control >= 0.3 && < 0.4 , monad-control >= 0.3 && < 0.4
, transformers >= 0.2.2 && < 0.4 , transformers >= 0.2.2
, wai >= 1.3 , wai >= 1.3
, wai-extra >= 1.3 , wai-extra >= 1.3
, hamlet >= 1.1 , hamlet >= 1.1