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

Question

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

当然，如果我需要它，Snap给我这么高的细节是很棒的，但我没有。 更糟糕的是，我没有编写文件上传处理程序的示例。 我handleFileUploadsSimple :: MonadSnap snap => snap [File]期望一个handleFileUploadsSimple :: MonadSnap snap => snap [File] 。 有点像Scotty的files动作 ，你猜对了，给了我上传的文件，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来检查它所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

您仍然需要像我之前提到的那样从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

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