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

Question

The Snap framework provides the Snap.Util.FileUploads module , but it's pretty unfriendly. I'm writing a simple HTTP server for which I don't really care about file size restrictions, upload rate limit restrictions, worrying about finding some OS-agnostic temporary directory to put uploaded files in, writing multipart data stream processors, et cetera.

Sure, it's great that Snap gives me this level of detail if I need it, but I don't. Worse, there are zero examples of how I could write a file upload handler. I would have expected a handleFileUploadsSimple :: MonadSnap snap => snap [File] . Something like Scotty's files action , which, you guessed it, gives me the uploaded files, bish-bash-bosh.

If this does exist, where is it? If it doesn't, how should I write it?

Answer 1

The policies are important safety features; want them.

Policies

First you need to make your default policy. I'll stick with their defaults for rate limiting etc, but set a maximum filesize of 2Mb instead of their default 128Kb.

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

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

Next we need a per-part policy. You don't seem to want to check anything about your uploads, which I think is odd, but we'll keep with the 2Mb limit. We'll use the allowWithMaximumSize :: Int64 -> PartUploadPolicy function:

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

bear in mind that this is where Snap was expecting you to have a look at the mime type etc, since

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

so you could define a more intelligent myPerPartPolicy that checks what field it came in on, and that it's in your whitelist of mime types, instead of ignoring the information. Perhaps you were planning on doing that since Scotty's files action provides this in the output rather than in this handler way.

Upload Handler

You need your actual file handler. This is the function that does the grunt work with the uploads. Asking you to write it as a handler instead of just giving you the data allows you to write your code in a more static, modular kind of way, so I see it as an advantage over just throwing data out.

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

Warning :

After the user handler runs (but before the Response body Enumerator is streamed to the client), the files are deleted from disk; so if you want to retain or use the uploaded files in the generated response, you would need to move or otherwise process them.

Let's wrap that into something that ignores bad uploads and implements your business logic on valid ones, one at a time. Notice that we've restricted ourselves to returning nothing so we can just run through the whole lot one-by-one using mapM_ , but if you like, you could do something cleverer by filtering out the ones you didn't want from the list, and returning something more interesting than () . I've used a filter anyway to point in that direction:

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       

You don't need to worry about OS-agnostic temporary files folder, because if you import System.Directory , you can use getTemporaryDirectory :: IO FilePath to get a temporary directory. (If you prefer, you could use an application-specific directory in the current userspace, using the createDirectoryIfMissing:: Bool -> FilePath -> IO () and getAppUserDataDirectory :: String -> IO FilePath .) In any case, you'll need to pass the filepath you get from there to your handler.

All together

Now

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

so you can write

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

You'll still need to pass the tempDir from the System.Directory stuff like I mentioned earlier, but this myHandleFileUploads is ready to roll.

Answer 2

I feel you. I had some brain picking and head scratching to do before things started to make sense.

So here it goes.

--------------------------------------------------------------------------------------
-- | 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"

This is specific to mongoDB so I also check for 16MB file size.

The "saveFiles" function is file storage specific. In my case it is mongoDB. I'll include it just in case.

--------------------------------------------------------------------------------------
-- | 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

Well, this is it pretty much. It is not hard really once it clicks.