diff --git a/example/Main.hs b/example/Main.hs index 2799a80..25b63b4 100644 --- a/example/Main.hs +++ b/example/Main.hs @@ -78,7 +78,7 @@ 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)] + $ [("credsIdent", credsIdent c), ("credsPlugin", credsPlugin c)] ++ credsExtra c return $ Authenticated "1" @@ -131,7 +131,7 @@ mkFoundation :: IO App mkFoundation = do loadEnv - auth0Host <- getEnv "AUTH0_HOST" + auth0Host <- getEnv "AUTH0_HOST" appHttpManager <- newManager tlsManagerSettings appAuthPlugins <- sequence @@ -140,28 +140,28 @@ mkFoundation = do -- -- FIXME: oauth2BattleNet is quite annoying! -- - [ loadPlugin oauth2AzureAD "AZURE_AD" + [ loadPlugin oauth2AzureAD "AZURE_AD" , loadPlugin (oauth2Auth0Host $ fromString auth0Host) "AUTH0" - , loadPlugin (oauth2BattleNet [whamlet|TODO|] "en") "BATTLE_NET" - , loadPlugin oauth2Bitbucket "BITBUCKET" - , loadPlugin oauth2ClassLink "CLASSLINK" - , loadPlugin (oauth2Eve Plain) "EVE_ONLINE" - , loadPlugin oauth2GitHub "GITHUB" - , loadPlugin oauth2GitLab "GITLAB" - , loadPlugin oauth2Google "GOOGLE" - , loadPlugin oauth2Nylas "NYLAS" - , loadPlugin oauth2Salesforce "SALES_FORCE" - , loadPlugin oauth2Slack "SLACK" - , loadPlugin (oauth2Spotify []) "SPOTIFY" - , loadPlugin oauth2Twitch "TWITCH" - , loadPlugin oauth2WordPressDotCom "WORDPRESS_DOT_COM" - , loadPlugin oauth2Upcase "UPCASE" + , loadPlugin (oauth2BattleNet [whamlet|TODO|] "en") "BATTLE_NET" + , loadPlugin oauth2Bitbucket "BITBUCKET" + , loadPlugin oauth2ClassLink "CLASSLINK" + , loadPlugin (oauth2Eve Plain) "EVE_ONLINE" + , loadPlugin oauth2GitHub "GITHUB" + , loadPlugin oauth2GitLab "GITLAB" + , loadPlugin oauth2Google "GOOGLE" + , loadPlugin oauth2Nylas "NYLAS" + , loadPlugin oauth2Salesforce "SALES_FORCE" + , loadPlugin oauth2Slack "SLACK" + , loadPlugin (oauth2Spotify []) "SPOTIFY" + , loadPlugin oauth2Twitch "TWITCH" + , loadPlugin oauth2WordPressDotCom "WORDPRESS_DOT_COM" + , loadPlugin oauth2Upcase "UPCASE" ] return App { .. } where loadPlugin f prefix = do - clientId <- getEnv $ prefix <> "_CLIENT_ID" + clientId <- getEnv $ prefix <> "_CLIENT_ID" clientSecret <- getEnv $ prefix <> "_CLIENT_SECRET" pure $ f (T.pack clientId) (T.pack clientSecret) diff --git a/src/URI/ByteString/Extension.hs b/src/URI/ByteString/Extension.hs index a5931c0..ac04ec2 100644 --- a/src/URI/ByteString/Extension.hs +++ b/src/URI/ByteString/Extension.hs @@ -13,30 +13,26 @@ import qualified Data.ByteString.Char8 as C8 import URI.ByteString instance IsString Scheme where - fromString = Scheme . fromString + fromString = Scheme . fromString instance IsString Host where - fromString = Host . fromString + fromString = Host . fromString instance IsString (URIRef Absolute) where - fromString = either (error . show) id - . parseURI strictURIParserOptions - . C8.pack + fromString = + either (error . show) id . parseURI strictURIParserOptions . C8.pack instance IsString (URIRef Relative) where - fromString = either (error . show) id - . parseRelativeRef strictURIParserOptions - . C8.pack + fromString = + either (error . show) id . parseRelativeRef strictURIParserOptions . C8.pack fromText :: Text -> Maybe URI -fromText = either (const Nothing) Just - . parseURI strictURIParserOptions - . encodeUtf8 +fromText = + either (const Nothing) Just . parseURI strictURIParserOptions . encodeUtf8 unsafeFromText :: Text -> URI -unsafeFromText = either (error . show) id - . parseURI strictURIParserOptions - . encodeUtf8 +unsafeFromText = + either (error . show) id . parseURI strictURIParserOptions . encodeUtf8 toText :: URI -> Text toText = decodeUtf8 . serializeURIRef' @@ -46,8 +42,8 @@ fromRelative s h = flip withHost h . toAbsolute s withHost :: URIRef a -> Host -> URIRef a withHost u h = u & authorityL %~ maybe - (Just $ Authority Nothing h Nothing) - (\a -> Just $ a & authorityHostL .~ h) + (Just $ Authority Nothing h Nothing) + (\a -> Just $ a & authorityHostL .~ h) withPath :: URIRef a -> ByteString -> URIRef a withPath u p = u & pathL .~ p diff --git a/src/UnliftIO/Except.hs b/src/UnliftIO/Except.hs index 728951e..865deb2 100644 --- a/src/UnliftIO/Except.hs +++ b/src/UnliftIO/Except.hs @@ -1,12 +1,12 @@ {-# OPTIONS_GHC -Wno-orphans #-} module UnliftIO.Except - () where + () where import Control.Monad.Except import UnliftIO instance (MonadUnliftIO m, Exception e) => MonadUnliftIO (ExceptT e m) where - withRunInIO exceptToIO = ExceptT $ try $ do - withRunInIO $ \runInIO -> - exceptToIO (runInIO . (either throwIO pure <=< runExceptT)) + withRunInIO exceptToIO = ExceptT $ try $ do + withRunInIO $ \runInIO -> + exceptToIO (runInIO . (either throwIO pure <=< runExceptT)) diff --git a/src/Yesod/Auth/OAuth2/Auth0.hs b/src/Yesod/Auth/OAuth2/Auth0.hs index 6b7f397..b1a1cb8 100644 --- a/src/Yesod/Auth/OAuth2/Auth0.hs +++ b/src/Yesod/Auth/OAuth2/Auth0.hs @@ -36,21 +36,22 @@ oauth2Auth0HostScopes :: YesodAuth m => URI -> [Text] -> Text -> Text -> AuthPlugin m oauth2Auth0HostScopes host scopes clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do - (User uid, userResponse) <- authGetProfile pluginName - manager - token - (host `withPath` "/userinfo") - pure Creds { credsPlugin = pluginName - , credsIdent = uid - , credsExtra = setExtra token userResponse - } + (User uid, userResponse) <- authGetProfile + pluginName + manager + token + (host `withPath` "/userinfo") + pure Creds + { credsPlugin = pluginName + , credsIdent = uid + , credsExtra = setExtra token userResponse + } where oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = host - `withPath` "/authorize" - `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = host `withPath` "/oauth/token" - , oauth2RedirectUri = Nothing + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + host `withPath` "/authorize" `withQuery` [scopeParam " " scopes] + , oauth2TokenEndpoint = host `withPath` "/oauth/token" + , oauth2RedirectUri = Nothing } diff --git a/src/Yesod/Auth/OAuth2/AzureAD.hs b/src/Yesod/Auth/OAuth2/AzureAD.hs index b12266a..6538646 100644 --- a/src/Yesod/Auth/OAuth2/AzureAD.hs +++ b/src/Yesod/Auth/OAuth2/AzureAD.hs @@ -37,19 +37,20 @@ oauth2AzureADScoped scopes clientId clientSecret = token "https://graph.microsoft.com/v1.0/me" - pure Creds { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } + pure Creds + { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } where oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret , oauth2AuthorizeEndpoint = "https://login.windows.net/common/oauth2/authorize" `withQuery` [ scopeParam "," scopes , ("resource", "https://graph.microsoft.com") ] - , oauth2TokenEndpoint = "https://login.windows.net/common/oauth2/token" - , oauth2RedirectUri = Nothing + , oauth2TokenEndpoint = "https://login.windows.net/common/oauth2/token" + , oauth2RedirectUri = Nothing } diff --git a/src/Yesod/Auth/OAuth2/BattleNet.hs b/src/Yesod/Auth/OAuth2/BattleNet.hs index 87e778e..f84ba2f 100644 --- a/src/Yesod/Auth/OAuth2/BattleNet.hs +++ b/src/Yesod/Auth/OAuth2/BattleNet.hs @@ -39,27 +39,28 @@ oauth2BattleNet widget region clientId clientSecret = authGetProfile pluginName manager token $ fromRelative "https" (apiHost $ T.toLower region) "/account/user" - pure Creds { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + pure Creds + { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } where - host = wwwHost $ T.toLower region + host = wwwHost $ T.toLower region oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret , oauth2AuthorizeEndpoint = fromRelative "https" host "/oauth/authorize" - , oauth2TokenEndpoint = fromRelative "https" host "/oauth/token" - , oauth2RedirectUri = Nothing + , oauth2TokenEndpoint = fromRelative "https" host "/oauth/token" + , oauth2RedirectUri = Nothing } apiHost :: Text -> Host -apiHost "cn" = "api.battlenet.com.cn" +apiHost "cn" = "api.battlenet.com.cn" apiHost region = Host $ encodeUtf8 $ region <> ".api.battle.net" wwwHost :: Text -> Host -wwwHost "cn" = "www.battlenet.com.cn" +wwwHost "cn" = "www.battlenet.com.cn" wwwHost region = Host $ encodeUtf8 $ region <> ".battle.net" oAuth2BattleNet diff --git a/src/Yesod/Auth/OAuth2/Bitbucket.hs b/src/Yesod/Auth/OAuth2/Bitbucket.hs index a1b7b53..0c53819 100644 --- a/src/Yesod/Auth/OAuth2/Bitbucket.hs +++ b/src/Yesod/Auth/OAuth2/Bitbucket.hs @@ -38,22 +38,24 @@ oauth2BitbucketScoped scopes clientId clientSecret = token "https://api.bitbucket.com/2.0/user" - pure Creds { credsPlugin = pluginName + pure Creds + { credsPlugin = pluginName -- FIXME: Preserved bug. This should just be userId (it's already -- a Text), but because this code was shipped, folks likely have -- Idents in their database like @"\"...\""@, and if we fixed this -- they would need migrating. We're keeping it for now as it's a -- minor wart. Breaking typed APIs is one thing, causing data to go -- invalid is another. - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } where oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = "https://bitbucket.com/site/oauth2/authorize" - `withQuery` [scopeParam "," scopes] - , oauth2TokenEndpoint = "https://bitbucket.com/site/oauth2/access_token" - , oauth2RedirectUri = Nothing + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://bitbucket.com/site/oauth2/authorize" + `withQuery` [scopeParam "," scopes] + , oauth2TokenEndpoint = "https://bitbucket.com/site/oauth2/access_token" + , oauth2RedirectUri = Nothing } diff --git a/src/Yesod/Auth/OAuth2/ClassLink.hs b/src/Yesod/Auth/OAuth2/ClassLink.hs index 53ce1e5..0cc6146 100644 --- a/src/Yesod/Auth/OAuth2/ClassLink.hs +++ b/src/Yesod/Auth/OAuth2/ClassLink.hs @@ -32,16 +32,18 @@ oauth2ClassLinkScoped scopes clientId clientSecret = token "https://nodeapi.classlink.com/v2/my/info" - pure Creds { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + pure Creds + { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } where oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = "https://launchpad.classlink.com/oauth2/v2/auth" - `withQuery` [scopeParam "," scopes] + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://launchpad.classlink.com/oauth2/v2/auth" + `withQuery` [scopeParam "," scopes] , oauth2TokenEndpoint = "https://launchpad.classlink.com/oauth2/v2/token" - , oauth2RedirectUri = Nothing + , oauth2RedirectUri = Nothing } diff --git a/src/Yesod/Auth/OAuth2/Dispatch.hs b/src/Yesod/Auth/OAuth2/Dispatch.hs index 7b795b4..ff1dbe0 100644 --- a/src/Yesod/Auth/OAuth2/Dispatch.hs +++ b/src/Yesod/Auth/OAuth2/Dispatch.hs @@ -62,7 +62,7 @@ dispatchForward -> OAuth2 -> m TypedContent dispatchForward name oauth2 = do - csrf <- setSessionCSRF $ tokenSessionKey name + csrf <- setSessionCSRF $ tokenSessionKey name oauth2' <- withCallbackAndState name oauth2 csrf redirect $ toText $ authorizationUrl oauth2' @@ -81,11 +81,11 @@ dispatchCallback -> m TypedContent dispatchCallback name oauth2 getToken getCreds = do onErrorResponse $ throwError . OAuth2HandshakeError - csrf <- verifySessionCSRF $ tokenSessionKey name - code <- requireGetParam "code" + csrf <- verifySessionCSRF $ tokenSessionKey name + code <- requireGetParam "code" manager <- authHttpManager oauth2' <- withCallbackAndState name oauth2 csrf - token <- either (throwError . OAuth2ResultError) pure + token <- either (throwError . OAuth2ResultError) pure =<< liftIO (getToken manager oauth2' $ ExchangeToken code) creds <- liftIO (getCreds manager token) @@ -100,12 +100,12 @@ withCallbackAndState -> Text -> m OAuth2 withCallbackAndState name oauth2 csrf = do - uri <- ($ PluginR name ["callback"]) <$> getParentUrlRender + uri <- ($ PluginR name ["callback"]) <$> getParentUrlRender callback <- maybe (throwError $ InvalidCallbackUri uri) pure $ fromText uri pure oauth2 - { oauth2RedirectUri = Just callback - , oauth2AuthorizeEndpoint = oauth2AuthorizeEndpoint oauth2 - `withQuery` [("state", encodeUtf8 csrf)] + { oauth2RedirectUri = Just callback + , oauth2AuthorizeEndpoint = + oauth2AuthorizeEndpoint oauth2 `withQuery` [("state", encodeUtf8 csrf)] } getParentUrlRender :: MonadHandler m => m (Route (SubHandlerSite m) -> Text) @@ -130,11 +130,12 @@ setSessionCSRF sessionKey = do verifySessionCSRF :: (MonadError DispatchError m, MonadHandler m) => Text -> m Text verifySessionCSRF sessionKey = do - token <- requireGetParam "state" + token <- requireGetParam "state" sessionToken <- lookupSession sessionKey deleteSession sessionKey - token <$ unless (sessionToken == Just token) - (throwError $ InvalidStateToken sessionToken token) + token <$ unless + (sessionToken == Just token) + (throwError $ InvalidStateToken sessionToken token) requireGetParam :: (MonadError DispatchError m, MonadHandler m) => Text -> m Text diff --git a/src/Yesod/Auth/OAuth2/DispatchError.hs b/src/Yesod/Auth/OAuth2/DispatchError.hs index 434294b..1dcf920 100644 --- a/src/Yesod/Auth/OAuth2/DispatchError.hs +++ b/src/Yesod/Auth/OAuth2/DispatchError.hs @@ -50,10 +50,10 @@ dispatchErrorMessage = \case InvalidCallbackUri{} -> "Callback URI was not valid, this server may be misconfigured (no approot)" OAuth2HandshakeError er -> "OAuth2 handshake failure: " <> erUserMessage er - OAuth2ResultError{} -> "Login failed, please try again" - FetchCredsIOException{} -> "Login failed, please try again" + OAuth2ResultError{} -> "Login failed, please try again" + FetchCredsIOException{} -> "Login failed, please try again" FetchCredsYesodOAuth2Exception{} -> "Login failed, please try again" - OtherDispatchError{} -> "Login failed, please try again" + OtherDispatchError{} -> "Login failed, please try again" handleDispatchError :: MonadAuthHandler site m @@ -69,9 +69,10 @@ onDispatchError err = do let suffix = " [errorId=" <> errorId <> "]" $(logError) $ pack (displayException err) <> suffix - let message = dispatchErrorMessage err <> suffix - messageValue = - object ["error" .= object ["id" .= errorId, "message" .= message]] + let + message = dispatchErrorMessage err <> suffix + messageValue = + object ["error" .= object ["id" .= errorId, "message" .= message]] loginR <- ($ LoginR) <$> getRouteToParent diff --git a/src/Yesod/Auth/OAuth2/ErrorResponse.hs b/src/Yesod/Auth/OAuth2/ErrorResponse.hs index eb21126..3692d42 100644 --- a/src/Yesod/Auth/OAuth2/ErrorResponse.hs +++ b/src/Yesod/Auth/OAuth2/ErrorResponse.hs @@ -4,13 +4,12 @@ -- -- module Yesod.Auth.OAuth2.ErrorResponse - ( ErrorResponse(..) - , erUserMessage - , ErrorName(..) - , onErrorResponse - , unknownError - ) -where + ( ErrorResponse(..) + , erUserMessage + , ErrorName(..) + , onErrorResponse + , unknownError + ) where import Data.Foldable (traverse_) import Data.Text (Text) @@ -29,30 +28,27 @@ data ErrorName deriving Show data ErrorResponse = ErrorResponse - { erName :: ErrorName - , erDescription :: Maybe Text - , erURI :: Maybe Text - } - deriving Show + { erName :: ErrorName + , erDescription :: Maybe Text + , erURI :: Maybe Text + } + deriving Show -- | Textual value suitable for display to a User erUserMessage :: ErrorResponse -> Text erUserMessage err = case erName err of - InvalidRequest -> "Invalid request" - UnauthorizedClient -> "Unauthorized client" - AccessDenied -> "Access denied" - UnsupportedResponseType -> "Unsupported response type" - InvalidScope -> "Invalid scope" - ServerError -> "Server error" - TemporarilyUnavailable -> "Temporarily unavailable" - Unknown _ -> "Unknown error" + InvalidRequest -> "Invalid request" + UnauthorizedClient -> "Unauthorized client" + AccessDenied -> "Access denied" + UnsupportedResponseType -> "Unsupported response type" + InvalidScope -> "Invalid scope" + ServerError -> "Server error" + TemporarilyUnavailable -> "Temporarily unavailable" + Unknown _ -> "Unknown error" unknownError :: Text -> ErrorResponse -unknownError x = ErrorResponse - { erName = Unknown x - , erDescription = Nothing - , erURI = Nothing - } +unknownError x = + ErrorResponse { erName = Unknown x, erDescription = Nothing, erURI = Nothing } -- | Check query parameters for an error, if found run the given action -- @@ -64,12 +60,12 @@ onErrorResponse f = traverse_ f =<< checkErrorResponse checkErrorResponse :: MonadHandler m => m (Maybe ErrorResponse) checkErrorResponse = do - merror <- lookupGetParam "error" + merror <- lookupGetParam "error" - for merror $ \err -> - ErrorResponse (readErrorName err) - <$> lookupGetParam "error_description" - <*> lookupGetParam "error_uri" + for merror $ \err -> + ErrorResponse (readErrorName err) + <$> lookupGetParam "error_description" + <*> lookupGetParam "error_uri" readErrorName :: Text -> ErrorName readErrorName "invalid_request" = InvalidRequest diff --git a/src/Yesod/Auth/OAuth2/EveOnline.hs b/src/Yesod/Auth/OAuth2/EveOnline.hs index 1918348..b31f948 100644 --- a/src/Yesod/Auth/OAuth2/EveOnline.hs +++ b/src/Yesod/Auth/OAuth2/EveOnline.hs @@ -63,19 +63,19 @@ oauth2EveScoped scopes widgetType clientId clientSecret = token "https://login.eveonline.com/oauth/verify" - pure Creds { credsPlugin = "eveonline" + pure Creds + { credsPlugin = "eveonline" -- FIXME: Preserved bug. See similar comment in Bitbucket provider. - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } where oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = "https://login.eveonline.com/oauth/authorize" - `withQuery` [ ("response_type", "code") - , scopeParam " " scopes - ] - , oauth2TokenEndpoint = "https://login.eveonline.com/oauth/token" - , oauth2RedirectUri = Nothing + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://login.eveonline.com/oauth/authorize" + `withQuery` [("response_type", "code"), scopeParam " " scopes] + , oauth2TokenEndpoint = "https://login.eveonline.com/oauth/token" + , oauth2RedirectUri = Nothing } diff --git a/src/Yesod/Auth/OAuth2/Exception.hs b/src/Yesod/Auth/OAuth2/Exception.hs index ac9da44..22b169a 100644 --- a/src/Yesod/Auth/OAuth2/Exception.hs +++ b/src/Yesod/Auth/OAuth2/Exception.hs @@ -1,8 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-} module Yesod.Auth.OAuth2.Exception - ( YesodOAuth2Exception(..) - ) where + ( YesodOAuth2Exception(..) + ) where import Control.Exception.Safe import Data.ByteString.Lazy (ByteString) diff --git a/src/Yesod/Auth/OAuth2/GitHub.hs b/src/Yesod/Auth/OAuth2/GitHub.hs index c02fd7b..753ba82 100644 --- a/src/Yesod/Auth/OAuth2/GitHub.hs +++ b/src/Yesod/Auth/OAuth2/GitHub.hs @@ -38,16 +38,18 @@ oauth2GitHubScoped scopes clientId clientSecret = token "https://api.github.com/user" - pure Creds { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + pure Creds + { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } where oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = "https://github.com/login/oauth/authorize" - `withQuery` [scopeParam "," scopes] - , oauth2TokenEndpoint = "https://github.com/login/oauth/access_token" - , oauth2RedirectUri = Nothing + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://github.com/login/oauth/authorize" + `withQuery` [scopeParam "," scopes] + , oauth2TokenEndpoint = "https://github.com/login/oauth/access_token" + , oauth2RedirectUri = Nothing } diff --git a/src/Yesod/Auth/OAuth2/GitLab.hs b/src/Yesod/Auth/OAuth2/GitLab.hs index 87b636c..72d0bbd 100644 --- a/src/Yesod/Auth/OAuth2/GitLab.hs +++ b/src/Yesod/Auth/OAuth2/GitLab.hs @@ -43,17 +43,17 @@ oauth2GitLabHostScopes host scopes clientId clientSecret = (User userId, userResponse) <- authGetProfile pluginName manager token $ host `withPath` "/api/v4/user" - pure Creds { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + pure Creds + { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } where oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = host - `withPath` "/oauth/authorize" - `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = host `withPath` "/oauth/token" - , oauth2RedirectUri = Nothing + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + host `withPath` "/oauth/authorize" `withQuery` [scopeParam " " scopes] + , oauth2TokenEndpoint = host `withPath` "/oauth/token" + , oauth2RedirectUri = Nothing } diff --git a/src/Yesod/Auth/OAuth2/Google.hs b/src/Yesod/Auth/OAuth2/Google.hs index 9c16e4a..2e293ae 100644 --- a/src/Yesod/Auth/OAuth2/Google.hs +++ b/src/Yesod/Auth/OAuth2/Google.hs @@ -69,16 +69,18 @@ oauth2GoogleScopedWidget widget scopes clientId clientSecret = token "https://www.googleapis.com/oauth2/v3/userinfo" - pure Creds { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } + pure Creds + { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } where oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = "https://accounts.google.com/o/oauth2/auth" - `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = "https://www.googleapis.com/oauth2/v3/token" - , oauth2RedirectUri = Nothing + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://accounts.google.com/o/oauth2/auth" + `withQuery` [scopeParam " " scopes] + , oauth2TokenEndpoint = "https://www.googleapis.com/oauth2/v3/token" + , oauth2RedirectUri = Nothing } diff --git a/src/Yesod/Auth/OAuth2/Nylas.hs b/src/Yesod/Auth/OAuth2/Nylas.hs index 7ccb8e5..99b5dce 100644 --- a/src/Yesod/Auth/OAuth2/Nylas.hs +++ b/src/Yesod/Auth/OAuth2/Nylas.hs @@ -34,33 +34,33 @@ oauth2Nylas clientId clientSecret = -- FIXME: was this working? I'm 95% sure that the client will throw its -- own exception on unsuccessful status codes. unless (HT.statusIsSuccessful $ responseStatus resp) - $ throwIO - $ YesodOAuth2Exception.GenericError pluginName - $ "Unsuccessful HTTP response: " + $ throwIO + $ YesodOAuth2Exception.GenericError pluginName + $ "Unsuccessful HTTP response: " <> BL8.unpack userResponse either (throwIO . YesodOAuth2Exception.JSONDecodingError pluginName) - (\(User userId) -> pure Creds { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } + (\(User userId) -> pure Creds + { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } ) $ eitherDecode userResponse where oauth = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = "https://api.nylas.com/oauth/authorize" - `withQuery` [ ("response_type", "code") - , ( "client_id" - , encodeUtf8 clientId - ) + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://api.nylas.com/oauth/authorize" + `withQuery` [ ("response_type", "code") + , ("client_id", encodeUtf8 clientId) -- N.B. The scopes delimeter is unknown/untested. Verify that before -- extracting this to an argument and offering a Scoped function. In -- its current state, it doesn't matter because it's only one scope. - , scopeParam "," defaultScopes - ] - , oauth2TokenEndpoint = "https://api.nylas.com/oauth/token" - , oauth2RedirectUri = Nothing + , scopeParam "," defaultScopes + ] + , oauth2TokenEndpoint = "https://api.nylas.com/oauth/token" + , oauth2RedirectUri = Nothing } diff --git a/src/Yesod/Auth/OAuth2/Prelude.hs b/src/Yesod/Auth/OAuth2/Prelude.hs index 600860d..aa2dff7 100644 --- a/src/Yesod/Auth/OAuth2/Prelude.hs +++ b/src/Yesod/Auth/OAuth2/Prelude.hs @@ -85,7 +85,7 @@ authGetProfile -> URI -> IO (a, BL.ByteString) authGetProfile name manager token url = do - resp <- fromAuthGet name =<< authGetBS manager (accessToken token) url + resp <- fromAuthGet name =<< authGetBS manager (accessToken token) url decoded <- fromAuthJSON name resp pure (decoded, resp) diff --git a/src/Yesod/Auth/OAuth2/Random.hs b/src/Yesod/Auth/OAuth2/Random.hs index 52b6072..b69835b 100644 --- a/src/Yesod/Auth/OAuth2/Random.hs +++ b/src/Yesod/Auth/OAuth2/Random.hs @@ -1,8 +1,8 @@ {-# LANGUAGE TypeApplications #-} module Yesod.Auth.OAuth2.Random - ( randomText - ) where + ( randomText + ) where import Crypto.Random (MonadRandom, getRandomBytes) import Data.ByteArray.Encoding (Base(Base64), convertToBase) @@ -11,9 +11,9 @@ import Data.Text (Text) import Data.Text.Encoding (decodeUtf8) randomText - :: MonadRandom m - => Int + :: MonadRandom m + => Int -- ^ Size in Bytes (note necessarily characters) - -> m Text + -> m Text randomText size = - decodeUtf8 . convertToBase @ByteString Base64 <$> getRandomBytes size + decodeUtf8 . convertToBase @ByteString Base64 <$> getRandomBytes size diff --git a/src/Yesod/Auth/OAuth2/Salesforce.hs b/src/Yesod/Auth/OAuth2/Salesforce.hs index a86b019..0fbff78 100644 --- a/src/Yesod/Auth/OAuth2/Salesforce.hs +++ b/src/Yesod/Auth/OAuth2/Salesforce.hs @@ -61,15 +61,16 @@ salesforceHelper name profileUri authorizeUri tokenUri scopes clientId clientSec = authOAuth2 name oauth2 $ \manager token -> do (User userId, userResponse) <- authGetProfile name manager token profileUri - pure Creds { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } + pure Creds + { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } where oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret , oauth2AuthorizeEndpoint = authorizeUri `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = tokenUri - , oauth2RedirectUri = Nothing + , oauth2TokenEndpoint = tokenUri + , oauth2RedirectUri = Nothing } diff --git a/src/Yesod/Auth/OAuth2/Slack.hs b/src/Yesod/Auth/OAuth2/Slack.hs index 8bf9a28..c844ad7 100644 --- a/src/Yesod/Auth/OAuth2/Slack.hs +++ b/src/Yesod/Auth/OAuth2/Slack.hs @@ -14,7 +14,7 @@ module Yesod.Auth.OAuth2.Slack import Yesod.Auth.OAuth2.Prelude import Network.HTTP.Client - (httpLbs, parseUrlThrow, responseBody, setQueryString) + (httpLbs, parseUrlThrow, responseBody, setQueryString) import Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception data SlackScope @@ -24,9 +24,9 @@ data SlackScope | SlackAvatarScope scopeText :: SlackScope -> Text -scopeText SlackBasicScope = "identity.basic" -scopeText SlackEmailScope = "identity.email" -scopeText SlackTeamScope = "identity.team" +scopeText SlackBasicScope = "identity.basic" +scopeText SlackEmailScope = "identity.email" +scopeText SlackTeamScope = "identity.team" scopeText SlackAvatarScope = "identity.avatar" newtype User = User Text @@ -56,20 +56,20 @@ oauth2SlackScoped scopes clientId clientSecret = either (throwIO . YesodOAuth2Exception.JSONDecodingError pluginName) - (\(User userId) -> pure Creds { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } + (\(User userId) -> pure Creds + { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } ) $ eitherDecode userResponse where oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = "https://slack.com/oauth/authorize" - `withQuery` [ scopeParam "," - $ map scopeText scopes - ] - , oauth2TokenEndpoint = "https://slack.com/api/oauth.access" - , oauth2RedirectUri = Nothing + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://slack.com/oauth/authorize" + `withQuery` [scopeParam "," $ map scopeText scopes] + , oauth2TokenEndpoint = "https://slack.com/api/oauth.access" + , oauth2RedirectUri = Nothing } diff --git a/src/Yesod/Auth/OAuth2/Spotify.hs b/src/Yesod/Auth/OAuth2/Spotify.hs index 1890742..93bcc48 100644 --- a/src/Yesod/Auth/OAuth2/Spotify.hs +++ b/src/Yesod/Auth/OAuth2/Spotify.hs @@ -26,16 +26,18 @@ oauth2Spotify scopes clientId clientSecret = token "https://api.spotify.com/v1/me" - pure Creds { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } + pure Creds + { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } where oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = "https://accounts.spotify.com/authorize" - `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = "https://accounts.spotify.com/api/token" - , oauth2RedirectUri = Nothing + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://accounts.spotify.com/authorize" + `withQuery` [scopeParam " " scopes] + , oauth2TokenEndpoint = "https://accounts.spotify.com/api/token" + , oauth2RedirectUri = Nothing } diff --git a/src/Yesod/Auth/OAuth2/Twitch.hs b/src/Yesod/Auth/OAuth2/Twitch.hs index 4fcc56f..cfa066f 100644 --- a/src/Yesod/Auth/OAuth2/Twitch.hs +++ b/src/Yesod/Auth/OAuth2/Twitch.hs @@ -38,19 +38,22 @@ oauth2TwitchScoped scopes clientId clientSecret = token "https://id.twitch.tv/oauth2/validate" - pure Creds { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } + pure Creds + { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } where oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = "https://id.twitch.tv/oauth2/authorize" - `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = "https://id.twitch.tv/oauth2/token" - `withQuery` [ ("client_id", T.encodeUtf8 clientId) - , ("client_secret", T.encodeUtf8 clientSecret) - ] - , oauth2RedirectUri = Nothing + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://id.twitch.tv/oauth2/authorize" + `withQuery` [scopeParam " " scopes] + , oauth2TokenEndpoint = + "https://id.twitch.tv/oauth2/token" + `withQuery` [ ("client_id", T.encodeUtf8 clientId) + , ("client_secret", T.encodeUtf8 clientSecret) + ] + , oauth2RedirectUri = Nothing } diff --git a/src/Yesod/Auth/OAuth2/Upcase.hs b/src/Yesod/Auth/OAuth2/Upcase.hs index c2898ef..3d69474 100644 --- a/src/Yesod/Auth/OAuth2/Upcase.hs +++ b/src/Yesod/Auth/OAuth2/Upcase.hs @@ -33,15 +33,16 @@ oauth2Upcase clientId clientSecret = token "http://upcase.com/api/v1/me.json" - pure Creds { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + pure Creds + { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } where oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret , oauth2AuthorizeEndpoint = "http://upcase.com/oauth/authorize" - , oauth2TokenEndpoint = "http://upcase.com/oauth/token" - , oauth2RedirectUri = Nothing + , oauth2TokenEndpoint = "http://upcase.com/oauth/token" + , oauth2RedirectUri = Nothing } diff --git a/src/Yesod/Auth/OAuth2/WordPressDotCom.hs b/src/Yesod/Auth/OAuth2/WordPressDotCom.hs index bd73529..4c6b36d 100644 --- a/src/Yesod/Auth/OAuth2/WordPressDotCom.hs +++ b/src/Yesod/Auth/OAuth2/WordPressDotCom.hs @@ -28,18 +28,19 @@ oauth2WordPressDotCom clientId clientSecret = token "https://public-api.wordpress.com/rest/v1/me/" - pure Creds { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + pure Creds + { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } where oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret , oauth2AuthorizeEndpoint = "https://public-api.wordpress.com/oauth2/authorize" `withQuery` [scopeParam "," ["auth"]] - , oauth2TokenEndpoint = "https://public-api.wordpress.com/oauth2/token" - , oauth2RedirectUri = Nothing + , oauth2TokenEndpoint = "https://public-api.wordpress.com/oauth2/token" + , oauth2RedirectUri = Nothing } diff --git a/test/URI/ByteString/ExtensionSpec.hs b/test/URI/ByteString/ExtensionSpec.hs index 2f3ac38..a5ea600 100644 --- a/test/URI/ByteString/ExtensionSpec.hs +++ b/test/URI/ByteString/ExtensionSpec.hs @@ -1,8 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} module URI.ByteString.ExtensionSpec - ( spec - ) where + ( spec + ) where import Test.Hspec @@ -14,65 +14,68 @@ import URI.ByteString.QQ spec :: Spec spec = do - describe "IsString Scheme" $ it "works" $ do - "https" `shouldBe` Scheme "https" + describe "IsString Scheme" $ it "works" $ do + "https" `shouldBe` Scheme "https" - describe "IsString Host" $ it "works" $ do - "example.com" `shouldBe` Host "example.com" + describe "IsString Host" $ it "works" $ do + "example.com" `shouldBe` Host "example.com" - describe "IsString URIRef Relative" $ it "works" $ do - "example.com/foo?bar=baz" - `shouldBe` [relativeRef|example.com/foo?bar=baz|] + describe "IsString URIRef Relative" $ it "works" $ do + "example.com/foo?bar=baz" `shouldBe` [relativeRef|example.com/foo?bar=baz|] - describe "IsString URIRef Absolute" $ it "works" $ do - "https://example.com/foo?bar=baz" - `shouldBe` [uri|https://example.com/foo?bar=baz|] + describe "IsString URIRef Absolute" $ it "works" $ do + "https://example.com/foo?bar=baz" + `shouldBe` [uri|https://example.com/foo?bar=baz|] - describe "fromText" $ do - it "returns Just a URI for valid values, as the quasi-quoter would" $ do - fromText "http://example.com/foo?bar=baz" - `shouldBe` Just [uri|http://example.com/foo?bar=baz|] + describe "fromText" $ do + it "returns Just a URI for valid values, as the quasi-quoter would" $ do + fromText "http://example.com/foo?bar=baz" + `shouldBe` Just [uri|http://example.com/foo?bar=baz|] - it "returns Nothing for invalid values" $ do - fromText "Oh my, what did I do?" `shouldBe` Nothing + it "returns Nothing for invalid values" $ do + fromText "Oh my, what did I do?" `shouldBe` Nothing - describe "unsafeFromText" $ do - it "returns a URI for valid values, as the quasi-quoter would" $ do - unsafeFromText "http://example.com/foo?bar=baz" - `shouldBe` [uri|http://example.com/foo?bar=baz|] + describe "unsafeFromText" $ do + it "returns a URI for valid values, as the quasi-quoter would" $ do + unsafeFromText "http://example.com/foo?bar=baz" + `shouldBe` [uri|http://example.com/foo?bar=baz|] - it "raises for invalid values" $ do - evaluate (unsafeFromText "Oh my, what did I do?") - `shouldThrow` errorContaining "MissingColon" + it "raises for invalid values" $ do + evaluate (unsafeFromText "Oh my, what did I do?") + `shouldThrow` errorContaining "MissingColon" - describe "toText" $ do - it "serializes the URI to text" $ do - toText [uri|https://example.com/foo?bar=baz|] - `shouldBe` "https://example.com/foo?bar=baz" + describe "toText" $ do + it "serializes the URI to text" $ do + toText [uri|https://example.com/foo?bar=baz|] + `shouldBe` "https://example.com/foo?bar=baz" - describe "fromRelative" $ do - it "makes a URI absolute with a given host" $ do - fromRelative "ftp" "foo.com" [relativeRef|/bar?baz=bat|] - `shouldBe` [uri|ftp://foo.com/bar?baz=bat|] + describe "fromRelative" $ do + it "makes a URI absolute with a given host" $ do + fromRelative "ftp" "foo.com" [relativeRef|/bar?baz=bat|] + `shouldBe` [uri|ftp://foo.com/bar?baz=bat|] - describe "withQuery" $ do - it "appends a query to a URI" $ do - let uriWithQuery = [uri|http://example.com|] `withQuery` [("foo", "bar")] + describe "withQuery" $ do + it "appends a query to a URI" $ do + let uriWithQuery = [uri|http://example.com|] `withQuery` [("foo", "bar")] - uriWithQuery `shouldBe` [uri|http://example.com?foo=bar|] + uriWithQuery `shouldBe` [uri|http://example.com?foo=bar|] - it "handles a URI with an existing query" $ do - let uriWithQuery = [uri|http://example.com?foo=bar|] `withQuery` [("baz", "bat")] + it "handles a URI with an existing query" $ do + let + uriWithQuery = + [uri|http://example.com?foo=bar|] `withQuery` [("baz", "bat")] - uriWithQuery `shouldBe` [uri|http://example.com?foo=bar&baz=bat|] + uriWithQuery `shouldBe` [uri|http://example.com?foo=bar&baz=bat|] - -- This is arguably testing the internals of another package, but IMO - -- it's worthwhile to show that you don't (and can't) pre-sanitize when - -- using this function. - it "handles santization of the query" $ do - let uriWithQuery = [uri|http://example.com|] `withQuery` [("foo", "bar baz")] + -- This is arguably testing the internals of another package, but IMO + -- it's worthwhile to show that you don't (and can't) pre-sanitize when + -- using this function. + it "handles santization of the query" $ do + let + uriWithQuery = + [uri|http://example.com|] `withQuery` [("foo", "bar baz")] - toText uriWithQuery `shouldBe` "http://example.com?foo=bar%20baz" + toText uriWithQuery `shouldBe` "http://example.com?foo=bar%20baz" errorContaining :: String -> Selector ErrorCall errorContaining msg = (msg `isInfixOf`) . show