Using monadic validation with Digestive Functors and Snap - forms

Question

I try quite a while now to wrap my head around how to use validation in a digestive functors form field, that requires access to another monad. To cut it short I have a digestive form like this
studentRegistrationForm :: Monad m => Form Text m StudentRegistrationData
studentRegistrationForm = StudentRegistrationData
<$> "school" .: choice schools Nothing
<*> "studentId" .: check studentIdErrMsg (not . T.null) (text Nothing)
<*> "firstName" .: check firstNameErrMsg (not . T.null) (text Nothing)
<*> "lastName" .: check lastNameErrMsg (not . T.null) (text Nothing)
<*> "email" .: check emailErrMsg (E.isValid . T.unpack) (text Nothing)
(studentId is basically the username)
and would like to use the function usernameExists of Snap.Snaplet.Auth to check if the entered username is unique.
Just for completeness, here is the corresponding data type:
data StudentRegistrationData = StudentRegistrationData
{ school :: School -- ^ school the student is enroled
, studentId :: Text -- ^ matriculation number of the student
, firstName :: Text -- ^ first name of the student
, lastName :: Text -- ^ last name of the student
, email :: Text -- ^ email for sending password
} deriving (Show)
I create my form in a handler like:
studentRegistrationHandler :: AppHandler ()
studentRegistrationHandler = do
(view, registrationData) <- runForm "form" SRF.studentRegistrationForm
maybe (showForm "registration" view) createUser registrationData
showForm :: String -> View Text -> AppHandler ()
showForm name view =
heistLocal (bindDigestiveSplices view) $ render template
where
template = BS.pack $ "student-" ++ name ++ "-form"
So the problem I have now is to understand how to access the state of the Auth snaplet inside the form. Is it passed already or do I have to passed it myself? Would the functions checkM respectively validateM in the Text.Digestive.Form help me there?
I have found several examples of how to use digestive functors and snap auth and session, like:
snap example
digestive functors tutorial
postgres example
Getting started with Snap-Auth
But none shows Snap.Snaplet.Auth and digestive functors working together directly, and I am still such a noob when it comes to monad transformers and lifting... maybe it is too easy for me to see. :(
I can upload a standalone example on github, which shows my problem if it helps to illustrate it. Any hints, pointers and suggestions are very welcome! :)
Hannes
add on: I created an example application demonstrating basic authentication functionality, you may have a look here: digestive-functors-snap-auth-example enjoy!

Answer 1

I haven't tried this out to see if everything type checks, but here's the general idea. You are correct that you want to use either checkM or validateM to do your monadic validation. The type signature for checkM is informative:
checkM :: Monad m => v -> (a -> m Bool) -> Form v m a -> Form v m a
This tells us that the validation function will need to have the type (a -> m Bool) and the m must be the same as the m in the form. This means that you need to change the type of your form to something like this:
studentRegistrationForm :: Form Text AppHandler StudentRegistrationData
Now let's write the validator. Since we plan on using the usernameExists function in our validator, we need to look at that type signature:
usernameExists :: Text -> Handler b (AuthManager b) Bool
This actually looks a lot like the (a -> m Bool) type signature that we need. In fact, it's an exact match because Handler b (AuthManager b) is a monad. But even though it matches the (a -> m Bool) pattern exactly doesn't mean we're done quite yet. When you run your form, you're in the AppHandler monad which is probably just a type alias for Handler App App where App is your application's top-level snaplet state type. So what we need to do is convert Handler b (AuthManager b) into Handler b b which will unify with Handler App App. The with function from the snaplet API is exactly what we need. This makes our validation function quite simple:
validUser :: Text -> Handler App App Bool
validUser = liftM not . with auth . usernameExists
With this, you can use checkM usernameErrMsg validUser just like you use check in the above code.