Yesod redirect on POST request when using a WAI subsite #951
Comments
|
I haven't had a chance to look at this yet, but it sounds like it may be an On Tue, Mar 10, 2015 at 11:30 PM Felipe Garay notifications@github.com
|
|
How can I help you to test that? |
|
Would you be able to put together a reproducing test case? A single source file would be ideal, but if it has to be a multi file project, a cloneable Github repo would be great as well. |
|
Here it is. {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
import Yesod hiding (Object, Field, get)
import Rest.Driver.Perform (Rest (..))
import Rest.Driver.Wai (apiToApplication)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Reader
import Control.Monad.Trans (MonadIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (ExceptT)
import Data.Text (Text)
import Rest hiding (Handler)
import Rest.Api
import Control.Applicative (Applicative)
import qualified Rest.Resource as R
import qualified Rest as Rest
import Data.Typeable
import Data.Aeson.TH
import Data.JSON.Schema hiding (content)
import Network.Wai.Handler.Warp (run)
import Control.Concurrent
data Name = Name
{ name :: Text
} deriving Typeable
$(deriveJSON defaultOptions ''Name)
data App = App
mkYesod "App" [parseRoutes|
/ HomeR GET
/api MySubsite WaiSubsite getApiSubsite
|]
instance Yesod App
getHomeR :: Handler Html
getHomeR = defaultLayout [whamlet|Hello World!|]
data ServerData = ServerData
{ app :: App
}
instance JSONSchema Name where
schema x = Object [ Field "name" True (schema . fmap name $ x) ]
newtype ApiMonad a = ApiMonad { unApiMonad :: ReaderT ServerData IO a }
deriving (
Applicative
, Functor
, Monad
, MonadIO
, MonadReader ServerData
)
getApiSubsite :: App -> WaiSubsite
getApiSubsite app = WaiSubsite $ apiToApplication (runApi $ ServerData $ app) api
runApi :: ServerData -> ApiMonad a -> IO a
runApi env = flip runReaderT env . unApiMonad
routesApi :: Router ApiMonad ApiMonad
routesApi = root -/ route resource
api :: Api ApiMonad
api = [
(mkVersion 0 0 0, Some1 routesApi)
]
get :: Rest.Handler WithApiMonad
get = mkIdHandler jsonO $ \_ _ -> return $ Name "Felipe"
type WithApiMonad = ReaderT Name ApiMonad
resource :: Resource ApiMonad WithApiMonad Name Void Void
resource = mkResourceReader
{ R.name = "name"
, R.create = Just create
}
create :: Rest.Handler ApiMonad
create = mkInputHandler (jsonE . jsonI . jsonO) handler
where
handler :: Name -> ExceptT (Reason Void) ApiMonad Text
handler _ = return "Ok"
mainYesod :: IO ()
mainYesod = warp 3001 App
mainWai :: IO ()
mainWai = run 3002 $ apiToApplication (runApi $ undefined) api
main :: IO ()
main = do
t1 <- forkIO $ mainYesod
t2 <- forkIO $ mainWai
linea <- getLine
killThread t1
killThread t2You need to install: yesod-core, rest-core and rest-wai. The app running on 3001 is using yesod and the one running in 3002 only wai. You have to send a POST request to http://localhost:3001/api/latest/name/ with a JSON in the body like : '{"name": "felipe"}' and you will see in the logs in the console the redirect. Something like this: https://i.imgur.com/JJdMmf5.png . The server respond with "" because I have not defined a GET route on the resource. This doesn't happens with wai alone: https://i.imgur.com/MjLzaJu.png |
|
Can you try using: cleanPath _ = Rightin your Yesod instance and see if that fixes it? |
|
Yes, that fixes it. Thanks you! |
|
Actually, I think this is still an issue. It seems to me that Yesod should be using 307 instead of a 301 redirect, at least when the request was made as a non-GET method. @gregwebs does that make sense to you? |
|
I've just pushed a commit to address this with a 307 redirect. @fgaray Would you be able to test your original code with this new version of yesod-core to see if it also solves the problem? |
|
Without cleanPath I got this in the logs. All works fine. |
|
Thanks, this is now on Hackage. |
I don't know if this is a problem with yesod or I am using the functions in WaiSubsite in the wrong way. I was trying to use the rest framework with the wai driver (http://hackage.haskell.org/package/rest-wai) on yesod. To do this, I use a wai subsite. This works well when a request is a GET, but when is a POST (to create a resource), yesod redirect this request to a GET in the same route.
I know that this is problem of yesod because if I run wai alone, the POST request is performed as expected.
Some relevant code:
config/routes
Api/Api.hs
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Api.Api where import Control.Applicative import Control.Monad.IO.Class (liftIO) import Control.Monad.Reader import Control.Monad.Trans (MonadIO) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Data.Aeson.TH import Data.JSON.Schema hiding (content) import Data.Text (Text) import Data.Typeable import Database.Persist.Class hiding (get) import Database.Persist.Sql hiding (get) import Model import Prelude import Rest import Rest.Api import Yesod.Core.Handler (HandlerT) import qualified Rest as Rest import qualified Rest.Resource as R type Nombre = Text data NombreD = NombreD { title :: Nombre } deriving Typeable data UsuarioCrear = UsuarioCrear { nombreUsuario :: Text } deriving Typeable data ServerData = ServerData { pool :: ConnectionPool } $(deriveJSON defaultOptions ''NombreD) $(deriveJSON defaultOptions ''UsuarioCrear) instance JSONSchema NombreD where schema x = Object [ Field "title" True (schema . fmap title $ x) ] instance JSONSchema UsuarioCrear where schema x = Object [ Field "nombreUsuario" True (schema . fmap nombreUsuario $ x) ] newtype ApiMonad a = ApiMonad { unApiMonad :: ReaderT ServerData IO a } deriving ( Applicative , Functor , Monad , MonadIO , MonadReader ServerData ) runApi :: ServerData -> ApiMonad a -> IO a runApi env = flip runReaderT env . unApiMonad routesApi :: Router ApiMonad ApiMonad routesApi = root -/ route resource api :: Api ApiMonad api = [ (mkVersion 0 0 0, Some1 routesApi) ] type WithApiMonad = ReaderT NombreD ApiMonad resource :: Resource ApiMonad WithApiMonad NombreD () Void resource = mkResourceReader { R.name = "nombre" , R.description = "Un nombre de usuario en la base de datos" , R.schema = withListing () $ named [("get", single (NombreD "hola"))] , R.list = const list , R.get = Just get , R.create = Just create } get :: Rest.Handler WithApiMonad get = mkIdHandler jsonO $ \_ _ -> return $ NombreD "Felipe" list :: ListHandler ApiMonad list = mkListing jsonO $ \_ -> return $ [NombreD "Felipe", NombreD "Canela"] create :: Rest.Handler ApiMonad create = mkInputHandler (jsonE . jsonI . jsonO) handler where handler :: UsuarioCrear -> ExceptT (Reason Void) ApiMonad NombreD handler _ = undefinedPart of Foundation.hs
ghci code that run wai alone with the api:
There are some undefined in the code but I should except from the server a 500 error when doing a POST on /api/latest/nombre and not a 301 redirect.
The text was updated successfully, but these errors were encountered: