如何使用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

嗯，這就是它。 一旦點擊它就不難。