Persisting an uploaded file in the database (Couldn't match type ‘ConduitM () ByteString (ResourceT IO) ()’ with ‘HandlerT App IO ByteString’)

Question

Using yesod I am trying to persist an uploaded file in the database. To do this, I want to extract the bytestring and persist it, but I still need the code to typecheck.

The actual problem is

Couldn't match type ‘ConduitM () ByteString (ResourceT IO) ()’
               with ‘HandlerT App IO ByteString’
Expected type: HandlerT App IO ByteString
  Actual type: Source (ResourceT IO) ByteString
In a stmt of a 'do' block: file <- (fileSourceRaw fileinfo)
In the expression:
  do { setMessageI $ MsgUploadedImg;
       uuidWrapped <- liftIO (U4.nextRandom);
       let uuid = fromString $ U.toString $ uuidWrapped;
       transactionId <- runDB $ insert $ Transaction userId;
       .... }

The relevant part is this function (see: file <- (fileSourceRaw fileinfo)).

getImgR :: Handler Html
getImgR = do
    oldImages <- runDB $ selectList [] []
    mauthId <- maybeAuthId
    ((res, widget), enctype) <- runFormPost $ form Nothing Nothing ""
    case (mauthId,res) of
      (Just userId, FormSuccess (title,fileinfo)) -> do
        transactionId <- runDB $ insert $ Transaction userId
        file <- (fileSourceRaw fileinfo)
        let newImg = Img {imgFile = Just file, imgTitle = title , imgDesc = Nothing, imgFiletype = Nothing, imgTransactionId = Just transactionId, imgUserId = Just userId}
        _ <- runDB $ insert newImg
        redirect $ ImgR
      _ -> defaultLayout
        [whamlet|
            $if null oldImages
                <p>There are no images
            $else
                <ul>
                    $forall Entity imgId img  <- oldImages
                        <li>
                            <p>#{imgTitle img}
            $if mauthId == Nothing
               <form method=post action=@{ImgR} enctype=#{enctype}>
                   <input type=submit value=_{MsgPleaseLogin}>
            $else
                <form method=post action=@{ImgR} enctype=#{enctype}>
                    ^{widget}
                    <input type=submit>
       |]

Helper code:

type MyForm = Html -> MForm Handler (FormResult (Text, FileInfo), Widget)
form :: Maybe UserId -> Maybe TransactionId -> Text -> MyForm
form userId transactionId uuid = renderBootstrap  $ (,)
    <$> areq textField "Title" Nothing
    <*> fileAFormReq "Image file"

Img
   title         Text
   filetype      Text          Maybe
   desc          Textarea      Maybe
   file          ByteString    Maybe
   transactionId TransactionId Maybe
   userId        UserId        Maybe
   deriving Show

Still going over the documentation, but I thought the use case was common enough to ask a question. The datatype of FileInfo is:

   data FileInfo = FileInfo
       { fileName        :: !Text
       , fileContentType :: !Text
       , fileSourceRaw   :: !(Source (ResourceT IO) ByteString)
       , fileMove        :: !(FilePath -> IO ())
       }

Thank you for your attention.

Edit: I assume the solution is contained in the documentation here http://www.yesodweb.com/blog/2013/03/simpler-streaming-responses?

Update: It looks like one of those links

How can I post FileInfo to a web service using Yesod and Http-Conduit?

https://www.schoolofhaskell.com/school/to-infinity-and-beyond/competition-winners/part-5

Yesod handlers, content of POSTed files

contain the solution.

Update2: Using (Data.Conduit.Binary is DCB)

file <- runResourceT $ fileSource fileinfo $$ DCB.sinkLbs

leaves me with

Handler/Img.hs:62:42:
    Couldn't match expected type ‘ByteString’
                with actual type ‘Data.ByteString.Lazy.Internal.ByteString’
NB: ‘ByteString’ is defined in ‘Data.ByteString.Internal’
    ‘Data.ByteString.Lazy.Internal.ByteString’
      is defined in ‘Data.ByteString.Lazy.Internal’
In the first argument of ‘Just’, namely ‘file’
In the ‘imgFile’ field of a record

score 0 · Accepted Answer · edited May 23 '17 at 11:59

Looks like the missing function is here: Many types of String (ByteString)

The final code is

module Handler.Img where

import Import
import LambdaCms.Core -- for UserId
import Database.Persist.Sql (toSqlKey)
-- for uuids
import qualified Data.UUID as U
import qualified Data.UUID.V4 as U4
import Yesod.Core.Types

import qualified Data.Conduit.List as CL
import qualified Data.Conduit.Binary as DCB

import Data.ByteString as BS
import Data.ByteString.Lazy as LBS

type MyForm = Html -> MForm Handler (FormResult (Text, FileInfo), Widget)
form :: Maybe UserId -> Maybe TransactionId -> Text -> MyForm
form userId transactionId uuid = renderBootstrap  $ (,) 
    <$> areq textField "Title" Nothing
    <*> fileAFormReq "Image file"


lazyToStrictBS :: LBS.ByteString -> BS.ByteString
lazyToStrictBS x = BS.concat $ LBS.toChunks x

getImgR :: Handler Html
getImgR = do
    oldImages <- runDB $ selectList [] []
    mauthId <- maybeAuthId
    ((res, widget), enctype) <- runFormPost $ form Nothing Nothing ""
    case (mauthId,res) of
      (Just userId, FormSuccess (title,fileinfo)) -> do
        setMessageI $ MsgUploadedImg
        transactionId <- runDB $ insert $ Transaction userId
        file <- runResourceT $ fileSource fileinfo $$ DCB.sinkLbs
        let newImg = Img {imgFile = Just (lazyToStrictBS file), imgTitle = title , imgDesc = Nothing, imgFiletype = Nothing, imgTransactionId = Just transactionId, imgUserId = Just userId}
        _ <- runDB $ insert newImg
        redirect $ ImgR
      _ -> defaultLayout
        [whamlet|
            $if Import.null oldImages
                <p>There are no images
            $else
                <ul>
                    $forall Entity imgId img  <- oldImages
                       <li>
                            <p>#{imgTitle img}
            $if mauthId == Nothing
                <form method=post action=@{ImgR} enctype=#{enctype}>
                    <input type=submit value=_{MsgPleaseLogin}>
            $else
                <form method=post action=@{ImgR} enctype=#{enctype}>
                    ^{widget}
                    <input type=submit>
        |]

   postImgR :: Handler Html
   postImgR = getImgR

Persisting an uploaded file in the database (Couldn't match type ‘ConduitM () ByteString (ResourceT IO) ()’ with ‘HandlerT App IO ByteString’)

1 Answers1