"wrapTillBound did not finish" when deferring streaming from uploads

[edgmnt]

I'm trying to stream uploaded files from a source. I have defined:

instance Yesod App where
    -- ...

    fileUpload _ _ = FileUploadSource $ \_ _ act -> do
        return . fix $ \loop -> do
            bs <- liftIO act
            unless (BS.null bs) $ do
                yield bs
                loop

    -- ...

Then I use fileSource to get the upload. However, all uploads fail with this error:

[Error#yesod-core] wrapTillBound did not finish @(yesod_Lb73QJbBttWIs689R935aO:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:628:5)

I suspect the caller of the backend doesn't like it that I don't read the input. Looking at the types, it should definitely be possible:

data FileUpload = {- ... -}
    | FileUploadSource !(BackEnd (Source (ResourceT IO) ByteString))

... which means...

data FileUpload = {- ... -}
    | FileUploadSource !(ByteString -> FileInfo () -> IO ByteString -> IO (Source (ResourceT IO) ByteString))

Thoughts?

[gregwebs]

@snoyberg implemented the file streaming stuff

[snoyberg]

There's definitely some missing documentation here, but it does appear that there's an implicit requirement to drain the input completely. Options:

1. Modify your FileUploadSource to have a finalizer that continues to call act until there's no more data
2. Move that logic into Yesod

I don't have a strong opinion on which approach should be taken, but whichever way we approach it should involve a documentation fix.

Can you try the finalizer approach first to confirm it works?

[edgmnt]

@snoyberg, using yieldOr doesn't seem to fix it:

    fileUpload _ _ = FileUploadSource $ \_ _ act -> do
        return . fix $ \loop -> do
            bs <- liftIO act
            unless (BS.null bs) $ do
                yieldOr bs . fix $ \loop' -> do
                    bs' <- liftIO act
                    unless (BS.null bs') loop'
                loop

I also tried bracketP over the whole thing:

    fileUpload _ _ = FileUploadSource $ \_ _ act -> do
        return . drain act $ \() -> fix $ \loop -> do
            bs <- liftIO act
            unless (BS.null bs) $ do
                yield bs
                loop
        where
            drain act = bracketP (return ()) $ \() -> fix $ \loop -> do
                bs <- act
                unless (BS.null bs) loop

Interestingly, the error happens immediately upon submission, as if the source isn't unwound at all or the handler doesn't even run. So I guess the caller doesn't like that I don't read all data immediately (which is what I'm trying to avoid in the first place).

[snoyberg]

Oh, I see. Yes, this is inherent in the way the parsing works: you do need to consume the entire body immediately, since there really isn't any other way to parse a multipart request body. This constructor is intended for things like streaming into a file and then returning a Source to read the content out of that file.