From a09528a07f01576c57377dee052e3fda631e39db Mon Sep 17 00:00:00 2001
From: patrick brisbin <pbrisbin@gmail.com>
Date: Wed, 13 Jan 2021 10:41:14 -0500
Subject: [PATCH] Exclude + from state tokens

When the state token is sent to an OAuth2 provider, it undergoes
%-encoding as a URL parameter. Presumably, the OAuth2 provider decodes
it as part of handling things (because it would take work to prevent
their own web frameworks from doing so), and then re-%-encodes it coming
back to us again as a callback parameter.

For us, and all existing providers, + is not a %-encoded character, so
it's sent as-is and sent back as-is. So far so good.

ClassLink, though, chooses to decode + to space. I'm not aware of the
actual spec or if this is a reasonable thing to do, but they do. This
results in them sending %20 back to us, which doesn't match and we fail.

We can't predict or prescribe what providers do in this area, so our
options are:

- Look for a match in our Session as-is OR with spaces replaced by +

  This is harder than it sounds: a token could contain +'s or spaces,
  and we'd be getting back only spaces. To succeed, we'd actually have
  to check every permutation of space/+ substitution.

- Filter + from our tokens

  The only downside is we may generate slightly fewer than 30
  characters, and so produce slightly less secure tokens.

  I chose this option.

- Generate tokens without + to begin with

  This would be ideal, but I'm just not familiar enough with
  Crypto.Random. I would happily accept a PR to use this option.
---
 src/Yesod/Auth/OAuth2/Dispatch.hs | 25 +++++++++++++++++++++----
 1 file changed, 21 insertions(+), 4 deletions(-)

diff --git a/src/Yesod/Auth/OAuth2/Dispatch.hs b/src/Yesod/Auth/OAuth2/Dispatch.hs
index fb6dd8d..746d35d 100644
--- a/src/Yesod/Auth/OAuth2/Dispatch.hs
+++ b/src/Yesod/Auth/OAuth2/Dispatch.hs
@@ -156,14 +156,25 @@ withCallbackAndState name oauth2 csrf = do
 getParentUrlRender :: MonadHandler m => m (Route (SubHandlerSite m) -> Text)
 getParentUrlRender = (.) <$> getUrlRender <*> getRouteToParent
 
--- | Set a random, 30-character value in the session
+-- | Set a random, ~30-character value in the session
+--
+-- Some (but not all) providers decode a @+@ in the state token as a space when
+-- sending it back to us. We don't expect this and fail. And if we did code for
+-- it, we'd then fail on the providers that /don't/ do that.
+--
+-- Therefore, we just exclude @+@ in our tokens, which means this function may
+-- return slightly less than 30 characters.
+--
 setSessionCSRF :: MonadHandler m => Text -> m Text
 setSessionCSRF sessionKey = do
     csrfToken <- liftIO randomToken
     csrfToken <$ setSession sessionKey csrfToken
   where
     randomToken =
-        decodeUtf8 . convertToBase @ByteString Base64 <$> getRandomBytes 64
+        T.filter (/= '+')
+            . decodeUtf8
+            . convertToBase @ByteString Base64
+            <$> getRandomBytes 64
 
 -- | Verify the callback provided the same CSRF token as in our session
 verifySessionCSRF :: MonadHandler m => Text -> m Text
@@ -172,8 +183,14 @@ verifySessionCSRF sessionKey = do
     sessionToken <- lookupSession sessionKey
     deleteSession sessionKey
 
-    unless (sessionToken == Just token)
-        $ permissionDenied "Invalid OAuth2 state token"
+    unless (sessionToken == Just token) $ do
+        $(logError)
+            $ "state token does not match. "
+            <> "Param: "
+            <> tshow token
+            <> "State: "
+            <> tshow sessionToken
+        permissionDenied "Invalid OAuth2 state token"
 
     return token