From 7f17d829b3c9b9b48ba4dae6b9744be973a00b45 Mon Sep 17 00:00:00 2001
From: Sibi Prabakaran <sibi@psibi.in>
Date: Sun, 20 Nov 2016 03:59:32 +0530
Subject: [PATCH] Fix CSRF security vulnerability in registerHelper function

Return a 403 status code if the csrf tokens are matched. This currently
affects two endpoints: During registration and during password reset
forms.

This curl request demonstrates how this can be exploited to register new
email:

curl -i --header "Accept: application/json" --request POST -F
"email=sibi@psibi.in" http://localhost:3005/auth/page/email/register

With the patch applied, it will respond with this:

{"message":"Permission Denied. A valid CSRF token wasn't present in HTTP
headers or POST parameters. Because the request could have been forged,
it's been rejected altogether. Check the Yesod.Core.Handler docs of the
yesod-core package for details on CSRF protection."}
---
 yesod-auth/Yesod/Auth/Email.hs | 27 +++++++++++++++++----------
 1 file changed, 17 insertions(+), 10 deletions(-)

diff --git a/yesod-auth/Yesod/Auth/Email.hs b/yesod-auth/Yesod/Auth/Email.hs
index 777be439..1148f51a 100644
--- a/yesod-auth/Yesod/Auth/Email.hs
+++ b/yesod-auth/Yesod/Auth/Email.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE QuasiQuotes             #-}
 {-# LANGUAGE Rank2Types              #-}
 {-# LANGUAGE TypeFamilies            #-}
+{-# LANGUAGE DoAndIfThenElse         #-}
 -- | A Yesod plugin for Authentication via e-mail
 --
 -- This plugin works out of the box by only setting a few methods on the type class
@@ -383,19 +384,22 @@ registerHelper :: YesodAuthEmail master
                -> HandlerT Auth (HandlerT master IO) TypedContent
 registerHelper allowUsername dest = do
     y <- lift getYesod
+    req <- getRequest
     midentifier <- lookupPostParam "email"
-    let eidentifier = case midentifier of
-            Nothing -> Left Msg.NoIdentifierProvided
-            Just x
-                | Just x' <- Text.Email.Validate.canonicalizeEmail (encodeUtf8 x) ->
-                    Right $ normalizeEmailAddress y $ decodeUtf8With lenientDecode x'
-                | allowUsername -> Right $ TS.strip x
-                | otherwise -> Left Msg.InvalidEmailAddress
-
-    case eidentifier of
+    csrfToken <- lookupPostParam "_token"
+    if (csrfToken /= reqToken req)
+    then permissionDenied csrfErrorMessage
+    else do
+      let eidentifier = case midentifier of
+                          Nothing -> Left Msg.NoIdentifierProvided
+                          Just x
+                              | Just x' <- Text.Email.Validate.canonicalizeEmail (encodeUtf8 x) ->
+                                         Right $ normalizeEmailAddress y $ decodeUtf8With lenientDecode x'
+                              | allowUsername -> Right $ TS.strip x
+                              | otherwise -> Left Msg.InvalidEmailAddress
+      case eidentifier of
         Left route -> loginErrorMessageI dest route
         Right identifier -> do
-
             mecreds <- lift $ getEmailCreds identifier
             registerCreds <-
                 case mecreds of
@@ -709,6 +713,9 @@ setLoginLinkKey aid = do
     now <- liftIO getCurrentTime
     setSession loginLinkKey $ TS.pack $ show (toPathPiece aid, now)
 
+csrfErrorMessage :: Text
+csrfErrorMessage = "A valid CSRF token wasn't present in HTTP headers or POST parameters. Because the request could have been forged, it's been rejected altogether. Check the Yesod.Core.Handler docs of the yesod-core package for details on CSRF protection."
+
 
 -- See https://github.com/yesodweb/yesod/issues/1245 for discussion on this
 -- use of unsafePerformIO.