An invitation form (15)

I'm expecting most invitation information for this system to come from a separate database, but I'm expecting to want to be able to manually invite people too - for example if they aren't in the database, or are tagged incorrectly in the database. Having a manual invitation facility will be useful for testing too.

So I'm going to build an invitation form: that will take basic information (but not everything - just enough to make an invitation), and on submission, generate a URL, and send it in email. Unlike the registration form, it won't be directly backed by its own table: this is more of a form used to issue a command, rather than a form used to edit a database record.

The invitation form is going to collect name, and email address; somewhere in here, a nonce needs generating too.

I'm going to model the form contents a Haskell data type a bit like the Registration datatype. In src/Invitation.hs, write:

module Invitation where

data Invitation = Invitation {
  firstname :: String,
  lastname :: String,
  email :: String
}

Unlike Registration, we won't need any typeclass instances for this because we aren't expecting to send it into the database.

When we import this into app/Main.hs, we run into a problem: each of the field names defined in Invitation define a function to access those field names. So there is a function:

firstname :: Invitation -> String

... which is how you can write things like firstname someinvitation to extract the first name field.

But. the same applies for everything else, including Registration which also implicitly defines a function:

firstname :: Registration -> String

Those are two different functions, and so with a plain import, it is ambiguous which one you mean. (although if the input type is known, it isn't actually ambiguous. Have a look at duplicate record fields if you'd like to see more; the Haskell-like language Idris can also disambiguate this properly but it has its own problems).

So instead, lets import Invitation qualified with an short identifier:

import qualified Invitation as I

That way, firstname on its own refers to only the Registration version; if we mean the invitation version, we have to write I.firstname. We could also qualify the import of Registration as R and then we'd have to put the R. prefix in front of everything to do with registrations. Avoiding potential overlapping names is half of the reason why most of the library imports I've done so far have been qualified like this.

We'll need to define GET and POST API endpoints to get access to our form - GET to provide an initial form, and POST to send in the completed form. Unlike the registration form, there is no identifier in the URL. An invitation form doesn't have any long term presence in the server environment that can be identified: if you close your browser before you've used it to perform an actual invitation, you lose what you've typed in.

type InvitationGetAPI = "admin" :> "invite" :> S.Get '[SB.HTML] B.Html
type InvitationPostAPI = "admin" :> "invite" :> S.ReqBody '[S.FormUrlEncoded] [(String,String)] :> S.Post '[SB.HTML] B.Html

... and add them into the main API:

type API = 
...
      :<|> InvitationGetAPI
      :<|> InvitationPostAPI

... make sure that the server handles them:

server :: S.Server API
server = handlePing :<|> handleHtmlPing :<|> handleRegistration
    :<|> handleRegistrationPost :<|> handleCSV
    :<|> handleInvitationGet :<|> handleInvitationPost

... and (later in the post) provide implementations for the GET and POST methods.

This form will use digestive-functors so we'll need:

invitationDigestiveForm :: Monad m => DF.Form B.Html m I.Invitation
invitationDigestiveForm =
  I.Invitation
    <$> "firstname" .: nonEmptyString Nothing
    <*> "lastname" .: nonEmptyString Nothing
    <*> "email" .: nonEmptyString Nothing

invitationDigestiveForm doesn't take an initialising parameter - this is another difference from registrationDigestiveForm, and again is because we aren't ever loading/restoring form state from somewhere else. You can only ever start with a blank invitation.

Most of the basic mechanics of getting this form rendered to HTML and interacting with GET and POST are the same as with registrations: we need handleInvitationGet and handleInvitationPost to respond, and two helpers: htmlForInvitation which will give an HTML rendering of a form, and doInvitation which is going to actually do whatever needs to be done when an invitation command is submitted. The first three I've pasted below without comment.

handleInvitationGet :: S.Handler B.Html
handleInvitationGet = do
  view <- DF.getForm "Invitation" invitationDigestiveForm
  return $ B.docTypeHtml $ do
    B.body $ do
      B.h1 $ "New Invitation"
      htmlForInvitation view

handleInvitationPost :: [(String, String)] -> S.Handler B.Html
handleInvitationPost reqBody = do

  viewValue <- DF.postForm "Invitation" invitationDigestiveForm (servantPathEnv reqBody)

  case viewValue of
    (view, Nothing) -> 
      return $ B.docTypeHtml $ do
        B.body $ do
          B.h1 $ "New Invitation (there were errors): "
          htmlForInvitation view

    (_, Just newInvitation) -> liftIO $ doInvitation newInvitation

htmlForInvitation :: DF.View B.Html -> B.Html
htmlForInvitation view = 
  B.form
    ! BA.method "post"
    $ do
      B.p $ do  "First name: "
                DB.errorList "firstname" view
                DB.inputText "firstname" view
      B.p $ do  "Last name: "
                DB.errorList "lastname" view
                DB.inputText "lastname" view
      B.p $ do  "email: "
                DB.errorList "email" view
                DB.inputText "email" view
      B.p $     DB.inputSubmit "Save" 

Now, in doInvitation, for now, I want to: generate a Registration record, store it into the database, and return some HTML to the inviting administrator with a URL to send on. (another time, we'll make that URL be emailed, but not today).

We begin by constructing a Registration record: mostly by copying values from the invitation or setting them to a default. The nonce comes from a helper function generateNonce which I'll talk about later. It returns a random alphabetical string to use as a nonce value.

doInvitation :: I.Invitation -> IO B.Html
doInvitation invitation = do

  newNonce <- generateNonce

  let registration = Registration {
    firstname = I.firstname invitation,
    lastname = I.lastname invitation,
    dob = "",
    swim = False,
    nonce = Just newNonce,
    email = Just (I.email invitation),
    status = "N"
    
  }

Once we have a Registration, we can write it to the database:

  liftIO $ bracket
    (PG.connectPostgreSQL "user='postgres'")
    PG.close
    $ \conn -> do
      PGS.ginsertInto conn "registration" registration

... and then return a suitable HTML response:

  let url = "http://localhost:8080/registration/" ++ newNonce

  return $ B.docTypeHtml $ do
    B.head $ do
      B.title "Invitation Processed"
    B.body $ do
      B.h1 "Invitation processed."
      B.p $ "Please ask the participant to complete the form at "
            <> (B.a ! BA.href (fromString url)) (fromString url)

generateNonce uses the Haskell system random number generator in this one-liner:

import System.Random (randomRIO)
...
generateNonce :: IO String
generateNonce = sequence $ take 32 $ repeat $ randomRIO ('a', 'z')

randomRIO is an IO action that returns a character between a-z. We build an infinite list of such IO actions using repeat, and then take the first 32 elements, giving a list that holds 32 IO actions that each return a character. sequence then executes each IO action in turn, and returns the list of results: 32 random characters.

Now you can invite as many people to register as you want.

Here's the commit for this post.

Next, I'm going to add support for a configuration file: you'll see there's a hardcoded localhost above that I'd like to be able to configure; and when it is time to send email, there will be a few server parameters there that need configuring.