HaskellYesod

File uploads with Yesod

Posted on by

Any reasonable web project also contains an area to upload (media) files. It can be an administration area or just for users who can upload their profile picture. In this blog post you will learn:

  • How to configure upload directories on the server
  • How to create upload directories in your application and serve uploaded files
  • How to create database models for your files
  • How to upload a file by using a simple form
  • How to remove an uploaded file from database and server

Let's start with some pre-requisites:

Step 1: Configure upload directory

To make the upload directory more flexible (development vs production settings) we are going to add a new settings parameter fileUploadDirectory. Since we are dependent on this parameter we will make this parameter not optional. Open the config/settings.yml and add the following line (of course replace the path to a proper location on your development/production machine):

fileUploadDirectory: /opt/myapplication/upload

To read this settings parameter we need to modify our AppSettings as well. Please open Settings.hs in the root directory of your project and find the AppSettings data construction. Add the following code:

-- | Runtime settings to configure this application. These settings can be
-- loaded from various sources: defaults, environment variables, config files,
-- theoretically even a database.
data AppSettings = AppSettings
    { appStaticDir              :: String
    -- ^ Directory from which to serve static files.

    -- more settings here which were removed for demonstration 

    , appFileUploadDirectory        :: Text
    -- ^ Directory where uploaded files should be stored at
    }

At this point, we have told Yesod that we have a new settings parameter. But it still does not know how to fill this parameter from settings.yml. Let's change this and add the following line to instance FromJSON AppSettings where inside the parseJSON function:

appFileUploadDirectory  <- o .:  "fileUploadDirectory"

That's all. Now we can access the new parameter setting by calling:

-- we will make use of this in the next steps
appFileUploadDirectory $ appSettings app

Step 2: Creating a base upload directory and serve files

Now that we have configured a proper upload directory we have to ensure it exists when our application runs. Hence, we will hook into our Application.hs inside the root directory and add the following lines to makeFoundation:

-- Ensure file upload directory is created
createDirectoryIfMissing True (appFileUploadDirectory appSettings)

appUploadStatic <- static (appFileUploadDirectory appSettings)

With the first line, we ensure that the directory is created. Don't forget to import:

import System.Directory (createDirectoryIfMissing)

The second line will be our configuration for separate uploaded files. We will use it in our Application definition in Foundation.hs like this:

-- | The foundation datatype for your application. This can be a good place to
-- keep settings and values requiring initialization before your application
-- starts running, such as database connections. Every handler will have
-- access to the data present here.
data App = App
    { appSettings     :: AppSettings
    , appStatic       :: Static -- ^ Settings for static file serving.
    , appUploadStatic :: Static
    , appConnPool     :: ConnectionPool -- ^ Database connection pool.
    , appHttpManager  :: Manager
    , appLogger       :: Logger
    }

Now, to make Yesod serve our static files, we will define e new route in config/routes and add this Route to the authorized routes in Foundation.hs:

/files StaticUploadFilesR Static appUploadStatic
isAuthorized (StaticUploadFilesR _) _ = return Authorized

To test our new configuration and route, you can compile your application and place any file to the upload directory you configured in the settings file. By browsing to http://localhost:3000/files/myfile.jpg you should see the file in the browser.

Step 3: Defining database models for files

We would like to keep track of our files, so we can refer to them and remove them as well. Let's define a simple database model (I will use uuid here, but it will work the same for Integer ids):

UploadFile
  uuid Text
  fileName Text
  size Int
  createdAt UTCTime
  UniqueUploadFileUuid uuid
  Primary uuid

The model itself is very simple and can be extended to your needs (maybe you would like to add fileType information or any related details if its and image). For now we will just store the fileName and the size of the file.

Step 4: Creating the upload form and Handler

Now that we have a simple database model, we can serve a list of uploaded files inside a new Handler Files.hs

module Handler.Files where

import Import


getFilesListR :: Handler Html
getFilesListR = do
  entries <- selectList [] [Desc UploadFileCreatedAt]
  defaultLayout $ do
    setTitle "Uploaded files"
    $(widgetFile "fileupload/list")

Of course, we create a new route and add the new Route to the Foundation authorization:

/files FilesListR GET
isAuthorized FilesListR _ = pure Authorized

We will skip the contents of the list.hamlet file in the templates directory and focus on the Form for uploading the files instead:

data UploadForm = UploadForm
  { fileInfo :: FileInfo }



getUploadFileR :: Handler Html
getUploadFileR = postUploadFileR


postUploadFileR :: Handler Html
postUploadFileR = do
  ((result, formWidget), enctype) <- runFormPost buildForm
  master <- getYesod
  case result of
    FormSuccess formData -> do
      uuid <- 
      createdAt <- 
      _ <- writeToServer (appUploadFolder $ appSettings master) (fileInfo formData)
      _ <- runDB $ insert $ UploadFile
        uuid
        (fileName $  fileInfo formData)
        createdAt
      setMessage "File uploaded!"
      redirect FilesListR
    _ -> pure ()
  defaultLayout $ do
    setTitle "Upload a new file"
    $(widgetFile "fileupload/form-new")


buildForm :: Form UploadForm
buildForm = renderDivs $ UploadForm
  <$> fileAFormReq "File to upload"


writeToServer :: String -> FileInfo -> Handler FilePath
writeToServer uploadFolder file = do
  let fileName = unpack $ fileName file
    path = imageFilePath uploadFolder fileName
  liftIO $ fileMove file path
  return filename


imageFilePath :: String -> String -> FileInfo
imageFilePath uploadFolder fileName = uploadFolder </> fileName

Step 5: Remove uploaded files from server

Usually, to remove files we would use a DELETE request which is called from a JavaScript implementation. To keep things simple and avoid any JavaScript in this tutorial, we will use a GET request to remove files.

getDeleteFileR :: UploadFileId -> Handler Html
getDeleteFileR uploadFileId = do
  file <- runDB $ get404 uploadFileId
  let fileName = uploadFileFileName file
    path = imageFilePath (appFileUploadDirectory $ appSettings master) fileName
  liftIO $ removeFile path
  stillExists <- liftIO $ doesFileExist path

  case stillExists of
    True -> do
       setMessage "Could not remove file from server."
       redirect FilesListR
    False -> do
      _ <- runDB $ delete uploadFileId
     setMessage "File removed"
     redirect FilesListR

First of all, we ensure the file with the given id exists. Afterwards we remove the file from the server and only if this was successful, we finally remove the database entry and redirect to the files list.

You will need two additional imports from System.Directory to make this code work:

import System.Directory (removeFile, doesFileExist)

With this code you should have a good idea of how to upload, serve and remove files in Yesod. We skipped some topics (JavaScript handling, how do templates look like). Furthermore we could have saved the file within a sub-folder (maybe created dynamically according to the upload date). Let me know if you would like to see those topics in upcoming blog posts. And as always, if you have any comments, questions or other hints, just use the section below.