code:

registerForm :: SnapForm (Handler App App) T.Text HeistView Register
registerForm = Register
               <$> input "username" Nothing `validateMany` [nonEmpty, notInUse] <++ errors
               <*> input "password" Nothing `validate` nonEmpty <++ errors
  where nonEmpty = check "Field must not be empty" (not . null)
        notInUse = checkM "User exists" (liftM not . userExists . T.pack)

registerH :: Handler App App ()
registerH = do
  r <- eitherSnapForm registerForm "register-form"
  case r of                                                                
    Left splices ->                                                    
      renderWithSplices "register" $ map (second liftHeist) splices         
    Right (Register username password) -> do                                     
      with auth $ createUser (T.pack username) (B.pack password)        
      writeText . T.pack $ "created user " ++ username                         
                                                                                                           
userExists :: T.Text -> Handler App App Bool                                     
userExists username = with auth $ do                                                
  (AuthManager r _ _ _ _ _ _ _) <- get                                                  
  liftIO $ isJust <$> lookupByLogin r username