Question

Snap框架提供Snap.Util.FileUploads module，但它非常不友好。我正在编写一个简单的HTTP服务器，我并不真正关心文件大小限制，上传速率限制限制，担心找到一些与操作系统无关的临时目录以放入上传的文件，编写多部分数据流处理器等等。

当然，如果我需要的话，Snap给我这么详细的细节是很棒的，但我没有。更糟糕的是，我没有编写文件上传处理程序的示例。我原以为handleFileUploadsSimple :: MonadSnap snap => snap [File]。像Scotty's files action这样的东西，你猜对了，它给了我上传的文件，bish-bash-bosh。

如果确实存在，那么它在哪里？如果没有，我应该怎么写呢？

Answer 1

这些政策是重要的安全功能;想要他们。

策略

首先，您需要制定默认政策。我会坚持使用默认值进行速率限制等，但设置的最大文件大小为2Mb而不是默认的128Kb。

maxMb = 2
megaByte = 2^(20::Int)

myDefaultPolicy :: UploadPolicy
myDefaultPolicy = setMaximumFormInputSize (maxMb * megaByte) defaultUploadPolicy

接下来，我们需要按部件制定政策。您似乎不想查看有关上传的任何内容，我认为这很奇怪，但我们将保持2Mb限制。我们将使用allowWithMaximumSize :: Int64 -> PartUploadPolicy函数：

myPerPartPolicy :: PartInfo -> PartUploadPolicy
myPerPartPolicy _ = allowWithMaximumSize (maxMb * megaByte)

请记住，这是Snap期待你看看mime类型等的地方，因为

data PartInfo =
    PartInfo { partFieldName   :: !ByteString
             , partFileName    :: !(Maybe ByteString)
             , partContentType :: !ByteString
             }

因此您可以定义一个更智能的myPerPartPolicy来检查它所在的字段，并且它位于mime类型的白名单中，而不是忽略该信息。也许你正计划这样做，因为Scotty的文件操作在输出中而不是以这种处理程序方式提供。

上传处理程序

您需要实际的文件处理程序。这是使用grount上传的功能。要求您将其编写为处理程序而不是仅仅为您提供数据允许您以更静态，模块化的方式编写代码，因此我认为它比仅仅抛出数据更有优势。

myBusinessLogic :: MonadSnap m => PartInfo -> FilePath -> m ()
myBusinessLogic = undefined -- whatever you actually want to do with your uploads

警告：

用户处理程序运行后（但在响应主体枚举器流式传输到客户端之前），文件将从磁盘中删除;因此，如果要在生成的响应中保留或使用上载的文件，则需要移动或以其他方式处理它们。

让我们把它包装成忽略错误上传的东西，并在有效的上传中实现业务逻辑，一次一个。请注意，我们已经限制自己不返回任何内容，因此我们可以使用mapM_逐个遍历整个批次，但如果您愿意，可以通过过滤掉您没有的内容来做一些更聪明的事情想从列表中获取，并返回比()更有趣的内容。无论如何我都使用过滤器指向那个方向：

myUploadHandler :: MonadSnap m => [(PartInfo, Either PolicyViolationException FilePath)] -> m () myUploadHandler xs = mapM_ handleOne (filter wanted xs) where wanted (_,Left _) = False wanted (_,Right _) = True handleOne (partInfo,Right filepath) = myBusinessLogic partInfo filepath

您无需担心与操作系统无关的临时文件文件夹，因为如果您import System.Directory，则可以使用getTemporaryDirectory :: IO FilePath来获取临时目录。（如果您愿意，可以使用createDirectoryIfMissing:: Bool -> FilePath -> IO ()和getAppUserDataDirectory :: String -> IO FilePath在当前用户空间中使用特定于应用程序的目录。）无论如何，您需要将从此处获得的文件路径传递给你的经纪人。

一起

现在

handleFileUploads :: MonadSnap m => FilePath -> UploadPolicy -> (PartInfo -> PartUploadPolicy) -> ([(PartInfo, Either PolicyViolationException FilePath)] -> m a) -> m a

所以你可以写

myHandleFileUploads :: MonadSnap m => FilePath -> m () myHandleFileUploads tempDir = handleFileUploads tempDir myDefaultPolicy myPerPartPolicy myUploadHandler

你仍然需要像我之前提到的tempDir内容那样传递System.Directory，但myHandleFileUploads已经准备就绪了。

Answer 2

我感觉到你。在事情开始变得有意义之前，我有一些大脑挑选和头脑搔痒。

所以就这样了。

--------------------------------------------------------------------------------------
-- | Handle file uploads
uploadFiles :: AppHandler ()
uploadFiles = do
  files <- handleMultipart defaultUploadPolicy $ \part -> do
    content <-  liftM B.concat EL.consume
    return (part, content)
  if any (\(_,c) -> (B.length c) > 16000000) files
    then error "One of the uploaded files is bigger then 16Mb limit size!"
    else saveFiles files
  syncDB
  redirect "/files/all"

这是mongoDB特有的，所以我也检查了16MB的文件大小。

“saveFiles”功能是特定于文件存储的。就我而言，它是mongoDB。我会把它包括在内以防万一。

--------------------------------------------------------------------------------------
-- | Save uploaded files to the database
saveFiles :: [(PartInfo, ByteString)] -> AppHandler ()
saveFiles fs = do
  let filedoc p c =
    [ "name"     =: maybe "Filename" T.decodeUtf8 (partFileName p)
    , "category" =: "Unassigned"
    , "desc"     =: "Unassigned"
    , "type"     =: T.decodeUtf8 (partContentType p)
    , "size"     =: B.length c
    , "blob"     =: Binary c
    ]
  r <- eitherWithDB $ insertMany "files" [filedoc p c | (p,c) <- fs]
  either (error . show) (const $ return () ) r

嗯，这就是它。一旦点击它就不难。

如何使用Haskell Snap框架获取上传的文件？

2 个答案:

策略

上传处理程序

一起