Merge branch 'master' into yesod-1.4

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

View File

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

View File

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

View File

@ -129,7 +129,6 @@ import Yesod
import Yesod.Static
import Yesod.Auth
import Yesod.Auth.BrowserId
import Yesod.Auth.GoogleEmail
import Yesod.Default.Config
import Yesod.Default.Util (addStaticContentExternal)
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
authPlugins _ = [authBrowserId def, authGoogleEmail]
authPlugins _ = [authBrowserId def]
authHttpManager = httpManager
@ -355,7 +354,6 @@ infixr 5 <>
{-# START_FILE Model.hs #-}
module Model where
import Prelude
import Yesod
import Data.Text (Text)
import Database.Persist.Quasi
@ -427,11 +425,11 @@ library
, shakespeare >= 2.0 && < 2.1
, hjsmin >= 0.1 && < 0.2
, monad-control >= 0.3 && < 0.4
, wai-extra >= 2.1 && < 2.2
, wai-extra >= 3.0 && < 3.1
, yaml >= 0.8 && < 0.9
, http-conduit >= 2.1 && < 2.2
, directory >= 1.1 && < 1.3
, warp >= 2.1 && < 2.2
, warp >= 3.0 && < 3.1
, data-default
, aeson >= 0.6 && < 0.8
, conduit >= 1.0 && < 2.0

View File

@ -132,7 +132,6 @@ import Yesod
import Yesod.Static
import Yesod.Auth
import Yesod.Auth.BrowserId
import Yesod.Auth.GoogleEmail
import Yesod.Default.Config
import Yesod.Default.Util (addStaticContentExternal)
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
authPlugins _ = [authBrowserId def, authGoogleEmail]
authPlugins _ = [authBrowserId def]
authHttpManager = httpManager
@ -387,7 +386,6 @@ infixr 5 <>
{-# START_FILE Model.hs #-}
module Model where
import Prelude
import Yesod
import Data.Text (Text)
import Database.Persist.Quasi
@ -464,11 +462,11 @@ library
, template-haskell
, shakespeare >= 2.0 && < 2.1
, monad-control >= 0.3 && < 0.4
, wai-extra >= 2.1 && < 2.2
, wai-extra >= 3.0 && < 3.1
, yaml >= 0.8 && < 0.9
, http-conduit >= 2.1 && < 2.2
, directory >= 1.1 && < 1.3
, warp >= 2.1 && < 2.2
, warp >= 3.0 && < 3.1
, data-default
, aeson >= 0.6 && < 0.8
, conduit >= 1.0 && < 2.0

View File

@ -129,7 +129,6 @@ import Yesod
import Yesod.Static
import Yesod.Auth
import Yesod.Auth.BrowserId
import Yesod.Auth.GoogleEmail
import Yesod.Default.Config
import Yesod.Default.Util (addStaticContentExternal)
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
authPlugins _ = [authBrowserId def, authGoogleEmail]
authPlugins _ = [authBrowserId def]
authHttpManager = httpManager
@ -355,7 +354,6 @@ infixr 5 <>
{-# START_FILE Model.hs #-}
module Model where
import Prelude
import Yesod
import Data.Text (Text)
import Database.Persist.Quasi
@ -427,11 +425,11 @@ library
, shakespeare >= 2.0 && < 2.1
, hjsmin >= 0.1 && < 0.2
, monad-control >= 0.3 && < 0.4
, wai-extra >= 2.1 && < 2.2
, wai-extra >= 3.0 && < 3.1
, yaml >= 0.8 && < 0.9
, http-conduit >= 2.1 && < 2.2
, directory >= 1.1 && < 1.3
, warp >= 2.1 && < 2.2
, warp >= 3.0 && < 3.1
, data-default
, aeson >= 0.6 && < 0.8
, conduit >= 1.0 && < 2.0

View File

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

View File

@ -129,7 +129,6 @@ import Yesod
import Yesod.Static
import Yesod.Auth
import Yesod.Auth.BrowserId
import Yesod.Auth.GoogleEmail
import Yesod.Default.Config
import Yesod.Default.Util (addStaticContentExternal)
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
authPlugins _ = [authBrowserId def, authGoogleEmail]
authPlugins _ = [authBrowserId def]
authHttpManager = httpManager
@ -355,7 +354,6 @@ infixr 5 <>
{-# START_FILE Model.hs #-}
module Model where
import Prelude
import Yesod
import Data.Text (Text)
import Database.Persist.Quasi
@ -427,11 +425,11 @@ library
, shakespeare >= 2.0 && < 2.1
, hjsmin >= 0.1 && < 0.2
, monad-control >= 0.3 && < 0.4
, wai-extra >= 2.1 && < 2.2
, wai-extra >= 3.0 && < 3.1
, yaml >= 0.8 && < 0.9
, http-conduit >= 2.1 && < 2.2
, directory >= 1.1 && < 1.3
, warp >= 2.1 && < 2.2
, warp >= 3.0 && < 3.1
, data-default
, aeson >= 0.6 && < 0.8
, conduit >= 1.0 && < 2.0

View File

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

View File

@ -92,8 +92,13 @@ toWaiAppYre yre req =
where
site = yreSite yre
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 =
return $ W.responseLBS status301
#endif
[ ("Content-Type", "text/plain")
, ("Location", Blaze.ByteString.Builder.toByteString dest')
] "Redirecting"

View File

@ -93,6 +93,9 @@ module Yesod.Core.Handler
, sendWaiResponse
#if MIN_VERSION_wai(2, 1, 0)
, sendRawResponse
#endif
#if MIN_VERSION_wai(3, 0, 0)
, sendRawResponseNoConduit
#endif
-- * Different representations
-- $representations
@ -198,6 +201,8 @@ import Control.Exception (throwIO)
import Blaze.ByteString.Builder (Builder)
import Safe (headMay)
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
#if MIN_VERSION_wai(2, 0, 0)
#else
@ -368,7 +373,11 @@ handlerToIO =
where
oldReq = handlerRequest oldHandlerData
oldWaiReq = reqWaiRequest oldReq
#if MIN_VERSION_wai(3, 0, 0)
newWaiReq = oldWaiReq { W.requestBody = return mempty
#else
newWaiReq = oldWaiReq { W.requestBody = mempty
#endif
, W.requestBodyLength = W.KnownLength 0
}
oldEnv = handlerEnv oldHandlerData
@ -576,6 +585,24 @@ sendResponseCreated url = do
sendWaiResponse :: MonadHandler m => W.Response -> m b
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)
-- | 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.,
@ -585,6 +612,19 @@ sendWaiResponse = handlerError . HCWai
sendRawResponse :: (MonadHandler m, MonadBaseControl IO m)
=> (Source IO S8.ByteString -> Sink S8.ByteString IO () -> m ())
-> 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 ->
runInIO $ sendWaiResponse $ flip W.responseRaw fallback
$ \src sink -> runInIO (raw src sink) >> return ()
@ -592,6 +632,7 @@ sendRawResponse raw = control $ \runInIO ->
fallback = W.responseLBS H.status500 [("Content-Type", "text/plain")]
"sendRawResponse: backend does not support raw responses"
#endif
#endif
-- | Return a 404 not found page. Also denotes no handler available.
notFound :: MonadHandler m => m a
@ -1068,6 +1109,14 @@ provideRepType ct handler =
rawRequestBody :: MonadHandler m => Source m S.ByteString
rawRequestBody = do
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
#if MIN_VERSION_wai(2, 0, 0)
liftIO
@ -1075,6 +1124,7 @@ rawRequestBody = do
liftResourceT
#endif
(W.requestBody req)
#endif
-- | Stream the data from the file. Since Yesod 1.2, this has been generalized
-- to work in any @MonadResource@.

View File

@ -44,11 +44,28 @@ import Control.Monad.Trans.Resource (runResourceT, ResourceT)
import Control.Exception (throwIO)
import Yesod.Core.Types
import qualified Data.Map as Map
import Data.IORef
-- | 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 =
req { W.requestBody = W.requestBody req $= limit maxLen }
return req { W.requestBody = W.requestBody req $= limit maxLen }
where
tooLarge = liftIO $ throwIO $ HCWai tooLargeResponse
@ -63,6 +80,7 @@ limitRequestBody maxLen req =
else do
yield bs
limit $ remaining - len
#endif
tooLargeResponse :: W.Response
tooLargeResponse = W.responseLBS
@ -75,7 +93,7 @@ parseWaiRequest :: RandomGen g
-> SessionMap
-> Bool
-> Maybe Word64 -- ^ max body size
-> (Either YesodRequest (g -> YesodRequest))
-> (Either (IO YesodRequest) (g -> IO YesodRequest))
parseWaiRequest env session useToken mmaxBodySize =
-- 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
@ -85,17 +103,19 @@ parseWaiRequest env session useToken mmaxBodySize =
Left token -> Left $ mkRequest token
Right mkToken -> Right $ mkRequest . mkToken
where
mkRequest token' = YesodRequest
{ reqGetParams = gets
, reqCookies = cookies
, reqWaiRequest = maybe id limitRequestBody mmaxBodySize env
, reqLangs = langs''
, reqToken = token'
, reqSession = if useToken
then Map.delete tokenKey session
else session
, reqAccept = httpAccept env
}
mkRequest token' = do
envLimited <- maybe return limitRequestBody mmaxBodySize env
return YesodRequest
{ reqGetParams = gets
, reqCookies = cookies
, reqWaiRequest = envLimited
, reqLangs = langs''
, reqToken = token'
, reqSession = if useToken
then Map.delete tokenKey session
else session
, reqAccept = httpAccept env
}
gets = textQueryString env
reqCookie = lookup "Cookie" $ W.requestHeaders env
cookies = maybe [] parseCookiesText reqCookie

View File

@ -33,7 +33,49 @@ import qualified Data.ByteString.Lazy as L
import qualified Data.Map as Map
import Yesod.Core.Internal.Request (tokenKey)
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
-> (SessionMap -> IO [Header]) -- ^ save session
-> YesodRequest
@ -106,6 +148,7 @@ yarToResponse (YRPlain s' hs ct c newSess) saveSession yreq req
s
| s' == defaultStatus = H.status200
| otherwise = s'
#endif
-- | 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

View File

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

View File

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

View File

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

View File

@ -12,6 +12,7 @@ import Data.Monoid (mempty)
import Data.Map (singleton)
import Yesod.Core
import Data.Word (Word64)
import System.IO.Unsafe (unsafePerformIO)
randomStringSpecs :: Spec
randomStringSpecs = describe "Yesod.Internal.Request.randomString" $ do
@ -36,7 +37,7 @@ parseWaiRequest' :: Request
-> Bool
-> Word64
-> 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
Left yreq -> yreq
Right needGen -> needGen g

View File

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

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
import YesodCoreTest.YesodTest
@ -6,7 +6,11 @@ import Yesod.Core
import qualified Network.HTTP.Types as H
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"
#endif
getApp :: a -> WaiSubsite
getApp _ = WaiSubsite myApp

View File

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

View File

@ -46,7 +46,18 @@ repEventSource :: (EventSourcePolyfill -> C.Source (HandlerT site IO) ES.ServerE
-> HandlerT site IO TypedContent
repEventSource src =
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

View File

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

View File

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

View File

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

View File

@ -3,7 +3,7 @@ import Control.Applicative ((<$>))
main = do
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
. filter (not . null)
. lines

View File

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

View File

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

View File

@ -106,12 +106,22 @@ prodEmbed e = do
}
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 [] _ = return $ responseLBS status404 [] ""
tryExtraDevelFiles (f:fs) r = do
tryExtraDevelFiles = toApp . tryExtraDevelFiles'
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"
case mct of
Nothing -> tryExtraDevelFiles fs r
Nothing -> tryExtraDevelFiles' fs r
Just (mime, ct) -> do
let hash = T.encodeUtf8 $ T.pack $ base64md5 ct
let headers = [ ("Content-Type", mime)
@ -123,11 +133,19 @@ tryExtraDevelFiles (f:fs) r = do
-- | Helper to create the development application at runtime
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
resp <- staticApp settings {ssMaxAge = NoMaxAge} req
if statusCode (responseStatus resp) == 404
then tryExtraDevelFiles extra req
else return resp
#endif
-- | The type of 'addStaticContent'
type AddStaticContent site = T.Text -> T.Text -> BL.ByteString

View File

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

View File

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

View File

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

View File

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

View File

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