From f5263b01dd28383de3fc3585b55c8849e59399e2 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Fri, 25 Feb 2022 14:33:34 -0500 Subject: [PATCH] Support hoauth2-2.2 and 2.3 This required a lot of CPP refactoring and extension. I plan to shift our lower bound and target only the newer hoauth2 soon, but I'd like to get out a compatible version first, which this aims to do. The comments in Compat.hs try to explain the gymnastics we have to endure to get there. I'm sorry, it's not ideal. --- .github/workflows/ci.yml | 2 + package.yaml | 1 + src/Network/OAuth/OAuth2/Compat.hs | 137 ++++++++++++++++++++++++----- stack-hoauth2-2.2.yaml | 3 + stack-hoauth2-2.2.yaml.lock | 19 ++++ stack-hoauth2-2.3.yaml | 3 + stack-hoauth2-2.3.yaml.lock | 19 ++++ yesod-auth-oauth2.cabal | 3 +- 8 files changed, 164 insertions(+), 23 deletions(-) create mode 100644 stack-hoauth2-2.2.yaml create mode 100644 stack-hoauth2-2.2.yaml.lock create mode 100644 stack-hoauth2-2.3.yaml create mode 100644 stack-hoauth2-2.3.yaml.lock diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 285b745..cf558d8 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -14,6 +14,8 @@ jobs: stack-yaml: - stack.yaml - stack-hoauth2-2.0.yaml + - stack-hoauth2-2.2.yaml + - stack-hoauth2-2.3.yaml - stack-lts-17.4.yaml - stack-lts-16.10.yaml - stack-lts-13.2.yaml diff --git a/package.yaml b/package.yaml index b35d577..c147854 100644 --- a/package.yaml +++ b/package.yaml @@ -38,6 +38,7 @@ library: - mtl - safe-exceptions - text >=0.7 + - transformers - uri-bytestring - yesod-auth >=1.6.0 - yesod-core >=1.6.0 diff --git a/src/Network/OAuth/OAuth2/Compat.hs b/src/Network/OAuth/OAuth2/Compat.hs index 36e3f74..5919d57 100644 --- a/src/Network/OAuth/OAuth2/Compat.hs +++ b/src/Network/OAuth/OAuth2/Compat.hs @@ -2,27 +2,34 @@ module Network.OAuth.OAuth2.Compat ( OAuth2(..) + , OAuth2Result , authorizationUrl , fetchAccessToken , fetchAccessToken2 + , authGetBS + + -- * Re-exports , module Network.OAuth.OAuth2 ) where +import Data.ByteString.Lazy (ByteString) +import Data.Text (Text) import Network.HTTP.Conduit (Manager) -import Network.OAuth.OAuth2 hiding - (OAuth2(..), authorizationUrl, fetchAccessToken, fetchAccessToken2) +import Network.OAuth.OAuth2 + ( AccessToken(..) + , ExchangeToken(..) + , OAuth2Error + , OAuth2Token(..) + , RefreshToken(..) + ) import qualified Network.OAuth.OAuth2 as OAuth2 import Network.OAuth.OAuth2.TokenRequest (Errors) import URI.ByteString -#if MIN_VERSION_hoauth2(2,0,0) -import Network.OAuth.OAuth2 (OAuth2(..)) - -getOAuth2 :: OAuth2 -> OAuth2 -getOAuth2 = id - -#else -import Data.Text (Text) +#if MIN_VERSION_hoauth2(2,2,0) +import Control.Monad.Trans.Except (ExceptT, runExceptT) +import Data.Maybe (fromMaybe) +#endif data OAuth2 = OAuth2 { oauth2ClientId :: Text @@ -32,16 +39,7 @@ data OAuth2 = OAuth2 , oauth2RedirectUri :: Maybe (URIRef Absolute) } -getOAuth2 :: OAuth2 -> OAuth2.OAuth2 -getOAuth2 o = OAuth2.OAuth2 - { OAuth2.oauthClientId = oauth2ClientId o - , OAuth2.oauthClientSecret = oauth2ClientSecret o - , OAuth2.oauthOAuthorizeEndpoint = oauth2AuthorizeEndpoint o - , OAuth2.oauthAccessTokenEndpoint = oauth2TokenEndpoint o - , OAuth2.oauthCallback = oauth2RedirectUri o - } - -#endif +type OAuth2Result err a = Either (OAuth2Error err) a authorizationUrl :: OAuth2 -> URI authorizationUrl = OAuth2.authorizationUrl . getOAuth2 @@ -51,11 +49,106 @@ fetchAccessToken -> OAuth2 -> ExchangeToken -> IO (OAuth2Result Errors OAuth2Token) -fetchAccessToken m = OAuth2.fetchAccessToken m . getOAuth2 +fetchAccessToken = fetchAccessTokenBasic fetchAccessToken2 :: Manager -> OAuth2 -> ExchangeToken -> IO (OAuth2Result Errors OAuth2Token) -fetchAccessToken2 m = OAuth2.fetchAccessToken2 m . getOAuth2 +fetchAccessToken2 = fetchAccessTokenPost + +authGetBS :: Manager -> AccessToken -> URI -> IO (Either ByteString ByteString) +authGetBS m a u = runOAuth2 $ OAuth2.authGetBS m a u + +-- Normalize the rename of record fields at hoauth2-2.0. Our type is the newer +-- names and we up-convert if hoauth2-1.x is in use. getClientSecret and +-- getRedirectUri handle the differences in hoauth2-2.2 and 2.3. + +#if MIN_VERSION_hoauth2(2,0,0) +getOAuth2 :: OAuth2 -> OAuth2.OAuth2 +getOAuth2 o = OAuth2.OAuth2 + { OAuth2.oauth2ClientId = oauth2ClientId o + , OAuth2.oauth2ClientSecret = getClientSecret $ oauth2ClientSecret o + , OAuth2.oauth2AuthorizeEndpoint = oauth2AuthorizeEndpoint o + , OAuth2.oauth2TokenEndpoint = oauth2TokenEndpoint o + , OAuth2.oauth2RedirectUri = getRedirectUri $ oauth2RedirectUri o + } +#else +getOAuth2 :: OAuth2 -> OAuth2.OAuth2 +getOAuth2 o = OAuth2.OAuth2 + { OAuth2.oauthClientId = oauth2ClientId o + , OAuth2.oauthClientSecret = getClientSecret $ oauth2ClientSecret o + , OAuth2.oauthOAuthorizeEndpoint = oauth2AuthorizeEndpoint o + , OAuth2.oauthAccessTokenEndpoint = oauth2TokenEndpoint o + , OAuth2.oauthCallback = getRedirectUri $ oauth2RedirectUri o + } +#endif + +-- hoauth2-2.2 made oauth2ClientSecret non-Maybe, after 2.0 had just made it +-- Maybe so we have to adjust, twice. TODO: change ours type to non-Maybe (major +-- bump) and reverse this to up-convert with Just in pre-2.2. + +#if MIN_VERSION_hoauth2(2,2,0) +getClientSecret :: Maybe Text -> Text +getClientSecret = + fromMaybe $ error "Cannot use OAuth2.oauth2ClientSecret with Nothing" +#else +getClientSecret :: Maybe Text -> Maybe Text +getClientSecret = id +#endif + +-- hoauth2-2.3 then made oauth2RedirectUri non-Maybe too. We logically rely on +-- instantiating with Nothing at definition-time, then setting it to the +-- callback at use-time, which means we can't just change our type and invert +-- this shim; we'll have to do something much more pervasive to avoid this +-- fromMaybe. + +#if MIN_VERSION_hoauth2(2,3,0) +getRedirectUri :: Maybe (URIRef Absolute) -> (URIRef Absolute) +getRedirectUri = + fromMaybe $ error "Cannot use OAuth2.oauth2RedirectUri with Nothing" +#else +getRedirectUri :: Maybe (URIRef Absolute) -> Maybe (URIRef Absolute) +getRedirectUri = id +#endif + +-- hoauth-2.2 moved most IO-Either functions to ExceptT. This reverses that. + +#if MIN_VERSION_hoauth2(2,2,0) +runOAuth2 :: ExceptT e m a -> m (Either e a) +runOAuth2 = runExceptT +#else +runOAuth2 :: IO (Either e a) -> IO (Either e a) +runOAuth2 = id +#endif + +-- The fetchAccessToken functions grew a nicer interface in hoauth2-2.3. This +-- up-converts the older ones. We should update our code to use these functions +-- directly. + +fetchAccessTokenBasic + :: Manager + -> OAuth2 + -> ExchangeToken + -> IO (OAuth2Result Errors OAuth2Token) +fetchAccessTokenBasic m o e = runOAuth2 $ f m (getOAuth2 o) e + where +#if MIN_VERSION_hoauth2(2,3,0) + f = OAuth2.fetchAccessTokenInternal OAuth2.ClientSecretBasic +#else + f = OAuth2.fetchAccessToken +#endif + +fetchAccessTokenPost + :: Manager + -> OAuth2 + -> ExchangeToken + -> IO (OAuth2Result Errors OAuth2Token) +fetchAccessTokenPost m o e = runOAuth2 $ f m (getOAuth2 o) e + where +#if MIN_VERSION_hoauth2(2,3,0) + f = OAuth2.fetchAccessTokenInternal OAuth2.ClientSecretPost +#else + f = OAuth2.fetchAccessToken2 +#endif diff --git a/stack-hoauth2-2.2.yaml b/stack-hoauth2-2.2.yaml new file mode 100644 index 0000000..164e32f --- /dev/null +++ b/stack-hoauth2-2.2.yaml @@ -0,0 +1,3 @@ +resolver: nightly-2022-02-25 +extra-deps: + - hoauth2-2.2.0@sha256:83a96156717d9e2c93394b35bef4151f82b90dc88b83d0e35c0bf1158bd41c6c,2801 diff --git a/stack-hoauth2-2.2.yaml.lock b/stack-hoauth2-2.2.yaml.lock new file mode 100644 index 0000000..db1c551 --- /dev/null +++ b/stack-hoauth2-2.2.yaml.lock @@ -0,0 +1,19 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: hoauth2-2.2.0@sha256:83a96156717d9e2c93394b35bef4151f82b90dc88b83d0e35c0bf1158bd41c6c,2801 + pantry-tree: + size: 593 + sha256: d6e2d12e0e66eb9392301ec97d50677afb71608568f3664eb466a4451c66ba59 + original: + hackage: hoauth2-2.2.0@sha256:83a96156717d9e2c93394b35bef4151f82b90dc88b83d0e35c0bf1158bd41c6c,2801 +snapshots: +- completed: + size: 611886 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2022/2/25.yaml + sha256: b18614ab8986a4ba6d469921a2c18decab244af78309effa3d2dab85dbdfef80 + original: nightly-2022-02-25 diff --git a/stack-hoauth2-2.3.yaml b/stack-hoauth2-2.3.yaml new file mode 100644 index 0000000..14bd122 --- /dev/null +++ b/stack-hoauth2-2.3.yaml @@ -0,0 +1,3 @@ +resolver: nightly-2022-02-25 +extra-deps: + - hoauth2-2.3.0@sha256:213744356007a4686ff3bb72105843d478bc0ba6229659429cbe241a99f55095,2816 diff --git a/stack-hoauth2-2.3.yaml.lock b/stack-hoauth2-2.3.yaml.lock new file mode 100644 index 0000000..bcb69dd --- /dev/null +++ b/stack-hoauth2-2.3.yaml.lock @@ -0,0 +1,19 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: hoauth2-2.3.0@sha256:213744356007a4686ff3bb72105843d478bc0ba6229659429cbe241a99f55095,2816 + pantry-tree: + size: 594 + sha256: e559c811165a2e75cfe649b68396466b3bd0b6a5353a9d6476605e6a40e0eb37 + original: + hackage: hoauth2-2.3.0@sha256:213744356007a4686ff3bb72105843d478bc0ba6229659429cbe241a99f55095,2816 +snapshots: +- completed: + size: 611886 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2022/2/25.yaml + sha256: b18614ab8986a4ba6d469921a2c18decab244af78309effa3d2dab85dbdfef80 + original: nightly-2022-02-25 diff --git a/yesod-auth-oauth2.cabal b/yesod-auth-oauth2.cabal index 5127c88..01daf71 100644 --- a/yesod-auth-oauth2.cabal +++ b/yesod-auth-oauth2.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 8398e07d0350eca21c712113661776348b39af510ee4559e6e070215c0fe216f +-- hash: 7646b72bdcb5d287b18834964921442a91e35e844ec3b9e5daa4222cd06d6964 name: yesod-auth-oauth2 version: 0.7.0.0 @@ -79,6 +79,7 @@ library , mtl , safe-exceptions , text >=0.7 + , transformers , unliftio , uri-bytestring , yesod-auth >=1.6.0