Merge branch 'master' into yesod-1.4
Conflicts: yesod-core/test/YesodCoreTest/CleanPath.hs yesod-persistent/yesod-persistent.cabal
This commit is contained in:
commit
b93a5d1993
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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>
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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@.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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>
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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]
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user