Haskell: Submitting OddJobs in a Yesod Application

Posted on August 6, 2023

Let’s take a look at integrating OddJobs - a Haskell-native job queue - into a Yesod application.

Note that OddJobs is PostgreSQL-exclusive, so your Yesod app must have a connection to a Postgres server for this to work. We’re going to build off of the yesod-postgres template in this post, which can be found here.

Submitting a Job

Let’s consider a simple Yesod route: a JSON POST endpoint that accepts a job request.

data JobRequest = JobRequest
    { jobType :: Text
    , args :: Value
    }
    deriving (Generic, Show)
instance FromJSON JobRequest
instance ToJSON JobRequest

data SubmitJobResponse = SubmitJobResponse
    { jobId :: Int
    }
    deriving (Generic, Show)
instance FromJSON SubmitJobResponse
instance ToJSON SubmitJobResponse

postJobRequestR :: Handler Value
postJobRequestR = do
    request <- (requireCheckJsonBody :: Handler JobRequest)
    job <- createJob -- TODO: How can we submit jobs?

    returnJson $ SubmitJobResponse (jobId job)

createJob here is stubbed with no arguments - how do we actually create the Job?

OddJob provides the createJob method that runs in the IO Monad. We could run this in our Yesod app’s Handler monad with liftIO:

postJobRequestR :: Handler Value
postJobRequestR = do
    request <- (requireCheckJsonBody :: Handler JobRequest)
    conn <- getConn -- TODO: How do we get the Database connection?
    job <- liftIO $ createJob conn "jobs" request

    returnJson $ SubmitJobResponse $ jobId job

But we’re still missing the Database connection - we could try to get a connection from the connection pool here in our handler, but is there a way to make this easily available to all of our handlers?

If we look at the Postgres sample app’s Foundation.hs, we can see that our app’s normal Database connectivity is defined by providing an instance of the YesodPersist monad.

instance YesodPersist App where
    type YesodPersistBackend App = SqlBackend
    runDB :: SqlPersistT Handler a -> Handler a
    runDB action = do
        master <- getYesod
        runSqlPool action $ appConnPool master

After providing this instance, the runDB function of the YesodPersist type class is available in all of our handlers.

Let’s define a YesodOddJob type class using the YesodPersist monad’s type class definition as a reference.

class Monad (YesodDB site) => YesodOddJob site where
    createOddJob :: ToJSON p => TableName -> p -> HandlerFor site Job

Here, createOddJob’s signature looks a lot like createJob, but instead of passing a connection directly, we expect the instance to handle getting the connection. It will also return an action that returns a Job in our app’s Handler monad.

Now, let’s provide an instance of YesodOddJob for our app:

instance YesodOddJob App where
    createOddJob tableName p =  do
        master <- getYesod
        let pool = appConnPool master

        liftIO $
            runIfPostgres pool $ \conn -> createJob conn tableName p

runIfPostgres :: Pool SqlBackend -> (Connection -> IO a) -> IO a
runIfPostgres pool action = 
    -- getSimpleConn will only provide a connection if we're running against a Postgres server
    withResource pool $ maybe (error "OddJob must be run against a Postgres server.") action . getSimpleConn

Now, revisiting our original handler, we can simply use createOddJob:

postJobRequestR :: Handler Value
postJobRequestR = do
    request <- (requireCheckJsonBody :: Handler JobRequest)
    job <- createOddJob "jobs" request

    returnJson $ SubmitJobResponse $ jobId job

Note the runIfPostgres function used by the YesodOddJob instance. We’re diving into the Persistence libraries used by Yesod here: peristent-postgresql provides getSimpleConn that can provide us with the raw Postgres connection.

Creating OddJob’s job table(s)

This is enough for submitting jobs, but we still haven’t touched on creating the job table. Depending on your use case, this could be done outside of the lifecycle of your Yesod app entirely. For completeness, I’ll show how to create job tables on app initialization.

For reference, here’s the line that creates tables (or migrates them) in Application.hs’s makeFoundation. This gets run on app startup:

runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc

After that, we can initialize our OddJob table like so, where “jobs” is the name of our table:

runIfPostgres pool $ \conn -> createJobTable conn "jobs"

Now, the only piece missing here is the OddJob worker. This can be set up as usual - follow steps 2-6 in the OddJobs guide

References