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

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 的 files 操作在输出中而不是以这种处理程序的方式提供了这个。

上传处理程序

您需要实际的文件处理程序。这是在上传时执行 grunt 的函数。要求您将其编写为处理程序，而不是仅仅为您提供数据，可以让您以更加静态、模块化的方式编写代码，因此我认为它比仅仅抛出数据更有优势。

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

您仍然需要像我之前提到的那样从System.Directory 传递tempDir，但这个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

嗯，差不多就是这样。点击一下其实并不难。