将上传的文件保存在数据库中(无法将类型“ConduitM () ByteString (ResourceT IO) ()”与“HandlerT App IO ByteString”匹配)

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

我试图使用 yesod 将上传的文件保存在数据库中。 为此,我想提取字节串并将其持久化,但我仍然需要代码进行类型检查。

实际问题是

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;
       .... }

相关部分是这个函数(参见: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>
       |]

帮助代码:

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

仍在查看文档,但我认为用例很常见,可以提出问题。 FileInfo 的数据类型是:

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

感谢您的关注。

编辑:我假设解决方案包含在此处的文档中 http://www.yesodweb.com/blog/2013/03/simpler-streaming-responses?

更新: 它看起来像这些链接之一

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

Yesod handlers, content of POSTed files

包含解决方案。

更新2: 使用(Data.Conduit.Binary 是 DCB)

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

给我留下

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

看起来缺少的函数在这里: Many types of String (ByteString)

最终代码为

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