Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Yesod redirect on POST request when using a WAI subsite #951

Closed
fgaray opened this Issue Mar 10, 2015 · 10 comments

Comments

Projects
None yet
2 participants
@fgaray
Copy link

fgaray commented Mar 10, 2015

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 MySubsite WaiSubsite getApiSubsite

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 _ = undefined

Part of Foundation.hs

getApiSubsite :: App -> WaiSubsite
getApiSubsite app = WaiSubsite $ apiToApplication (runApi $ ServerData $ appConnPool app) api

ghci code that run wai alone with the api:

run 3001 $ apiToApplication (runApi $ ServerData $ undefined) 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.

@snoyberg

This comment has been minimized.

Copy link
Member

snoyberg commented Mar 10, 2015

I haven't had a chance to look at this yet, but it sounds like it may be an
issue of path cleanup (stripping trailing slash, for example).

On Tue, Mar 10, 2015 at 11:30 PM Felipe Garay notifications@github.com
wrote:

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 MySubsite WaiSubsite getApiSubsite

Api/Api.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}module Api.Api where

import Control.Applicativeimport Control.Monad.IO.Class (liftIO)import Control.Monad.Readerimport Control.Monad.Trans (MonadIO)import Control.Monad.Trans.Class (lift)import Control.Monad.Trans.Except (ExceptT)import Data.Aeson.THimport Data.JSON.Schema hiding (content)import Data.Text (Text)import Data.Typeableimport Database.Persist.Class hiding (get)import Database.Persist.Sql hiding (get)import Modelimport Preludeimport Restimport Rest.Apiimport Yesod.Core.Handler (HandlerT)import qualified Rest as Restimport 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 _ = undefined

Part of Foundation.hs

getApiSubsite :: App -> WaiSubsite
getApiSubsite app = WaiSubsite $ apiToApplication (runApi $ ServerData $ appConnPool app) api

ghci code that run wai alone with the api:

run 3001 $ apiToApplication (runApi $ ServerData $ undefined) 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.


Reply to this email directly or view it on GitHub
#951.

@fgaray

This comment has been minimized.

Copy link
Author

fgaray commented Mar 10, 2015

How can I help you to test that?

@snoyberg

This comment has been minimized.

Copy link
Member

snoyberg commented Mar 11, 2015

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.

@fgaray

This comment has been minimized.

Copy link
Author

fgaray commented Mar 11, 2015

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 t2

You 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

@snoyberg

This comment has been minimized.

Copy link
Member

snoyberg commented Mar 11, 2015

Can you try using:

    cleanPath _ = Right

in your Yesod instance and see if that fixes it?

@fgaray

This comment has been minimized.

Copy link
Author

fgaray commented Mar 11, 2015

Yes, that fixes it.

Thanks you!

@fgaray fgaray closed this Mar 12, 2015

@snoyberg

This comment has been minimized.

Copy link
Member

snoyberg commented Mar 12, 2015

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?

@snoyberg snoyberg reopened this Mar 12, 2015

@snoyberg

This comment has been minimized.

Copy link
Member

snoyberg commented Mar 15, 2015

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?

snoyberg added a commit that referenced this issue Mar 15, 2015

@fgaray

This comment has been minimized.

Copy link
Author

fgaray commented Mar 19, 2015

@snoyberg

Without cleanPath I got this in the logs.

127.0.0.1 - - [19/Mar/2015:10:59:16 -0300] "POST /api/latest/name/ HTTP/1.1" 307 - "" "Mozilla/5.0 (X11; Linux x86_64; rv:36.0) Gecko/20100101 Firefox/36.0 Iceweasel/36.0.1"
127.0.0.1 - - [19/Mar/2015:10:59:16 -0300] "POST /api/latest/name HTTP/1.1" 200 - "" "Mozilla/5.0 (X11; Linux x86_64; rv:36.0) Gecko/20100101 Firefox/36.0 Iceweasel/36.0.1"

All works fine.

@snoyberg

This comment has been minimized.

Copy link
Member

snoyberg commented Mar 19, 2015

Thanks, this is now on Hackage.

@snoyberg snoyberg closed this Mar 19, 2015

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.