Avoid + in state token, to fix ClassLink

.env.example

@@ -14,6 +14,9 @@ BATTLE_NET_CLIENT_SECRET=x
 BITBUCKET_CLIENT_ID=x
 BITBUCKET_CLIENT_SECRET=x
 
+CLASSLINK_CLIENT_ID=x
+CLASSLINK_CLIENT_SECRET=x
+
 EVE_ONLINE_CLIENT_ID=x
 EVE_ONLINE_CLIENT_SECRET=x
 

example/Main.hs

@@ -38,6 +38,7 @@ import Yesod.Auth
 import Yesod.Auth.OAuth2.AzureAD
 import Yesod.Auth.OAuth2.BattleNet
 import Yesod.Auth.OAuth2.Bitbucket
+import Yesod.Auth.OAuth2.ClassLink
 import Yesod.Auth.OAuth2.EveOnline
 import Yesod.Auth.OAuth2.GitHub
 import Yesod.Auth.OAuth2.GitLab
@@ -46,8 +47,8 @@ import Yesod.Auth.OAuth2.Nylas
 import Yesod.Auth.OAuth2.Salesforce
 import Yesod.Auth.OAuth2.Slack
 import Yesod.Auth.OAuth2.Spotify
-import Yesod.Auth.OAuth2.WordPressDotCom
 import Yesod.Auth.OAuth2.Upcase
+import Yesod.Auth.OAuth2.WordPressDotCom
 
 data App = App
     { appHttpManager :: Manager
@@ -73,10 +74,9 @@ instance YesodAuth App where
 
     -- Copy the Creds response into the session for viewing after
     authenticate c = do
-        mapM_ (uncurry setSession) $
-            [ ("credsIdent", credsIdent c)
-            , ("credsPlugin", credsPlugin c)
-            ] ++ credsExtra c
+        mapM_ (uncurry setSession)
+            $ [("credsIdent", credsIdent c), ("credsPlugin", credsPlugin c)]
+            ++ credsExtra c
 
         return $ Authenticated "1"
 
@@ -138,6 +138,7 @@ mkFoundation = do
         [ loadPlugin oauth2AzureAD "AZURE_AD"
         , loadPlugin (oauth2BattleNet [whamlet|TODO|] "en") "BATTLE_NET"
         , loadPlugin oauth2Bitbucket "BITBUCKET"
+        , loadPlugin oauth2ClassLink "CLASSLINK"
         , loadPlugin (oauth2Eve Plain) "EVE_ONLINE"
         , loadPlugin oauth2GitHub "GITHUB"
         , loadPlugin oauth2GitLab "GITLAB"
@@ -150,7 +151,7 @@ mkFoundation = do
         , loadPlugin oauth2Upcase "UPCASE"
         ]
 
-    return App {..}
+    return App { .. }
   where
     loadPlugin f prefix = do
         clientId <- getEnv $ prefix <> "_CLIENT_ID"

src/Yesod/Auth/OAuth2/ClassLink.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Yesod.Auth.OAuth2.ClassLink
+    ( oauth2ClassLink
+    , oauth2ClassLinkScoped
+    )
+where
+
+import Yesod.Auth.OAuth2.Prelude
+
+import qualified Data.Text as T
+
+newtype User = User Int
+
+instance FromJSON User where
+    parseJSON = withObject "User" $ \o -> User <$> o .: "UserId"
+
+pluginName :: Text
+pluginName = "classlink"
+
+defaultScopes :: [Text]
+defaultScopes = ["profile", "oneroster"]
+
+oauth2ClassLink :: YesodAuth m => Text -> Text -> AuthPlugin m
+oauth2ClassLink = oauth2ClassLinkScoped defaultScopes
+
+oauth2ClassLinkScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
+oauth2ClassLinkScoped scopes clientId clientSecret =
+    authOAuth2 pluginName oauth2 $ \manager token -> do
+        (User userId, userResponse) <- authGetProfile
+            pluginName
+            manager
+            token
+            "https://nodeapi.classlink.com/v2/my/info"
+
+        pure Creds
+            { credsPlugin = pluginName
+            , credsIdent = T.pack $ show userId
+            , credsExtra = setExtra token userResponse
+            }
+  where
+    oauth2 = OAuth2
+        { oauthClientId = clientId
+        , oauthClientSecret = Just clientSecret
+        , oauthOAuthorizeEndpoint =
+            "https://launchpad.classlink.com/oauth2/v2/auth"
+                `withQuery` [scopeParam "," scopes]
+        , oauthAccessTokenEndpoint =
+            "https://launchpad.classlink.com/oauth2/v2/token"
+        , oauthCallback = Nothing
+        }

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