gistfile1.hs

findUserByEmailAddress :: Connection -> EmailAddress -> IO (Maybe User)
findUserByEmailAddress conn (EmailAddress emailAddress) =
    let sql = "select id, email_address, password_hash from users where email_address = $1"
     in safeHead (fromRows `fmap` query conn sql (Only emailAddress)) >>= makeUser
    where makeUser :: (String, String, ByteString) -> Maybe User
          makeUser (id, emailAddress, passwordHash) =
              Just $ User (UserID . fromJust . UUID.fromString $ id)
                          (EmailAddress emailAddress)
                          (PasswordHash passwordHash)