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.
This commit is contained in:
patrick brisbin 2022-02-25 14:33:34 -05:00
parent 48c386ced5
commit ff70022355
No known key found for this signature in database
GPG Key ID: C6A68C15A00FB52B
8 changed files with 164 additions and 23 deletions

View File

@ -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

View File

@ -38,6 +38,7 @@ library:
- mtl
- safe-exceptions
- text >=0.7
- transformers
- uri-bytestring
- yesod-auth >=1.6.0
- yesod-core >=1.6.0

View File

@ -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

3
stack-hoauth2-2.2.yaml Normal file
View File

@ -0,0 +1,3 @@
resolver: nightly-2022-02-25
extra-deps:
- hoauth2-2.2.0@sha256:83a96156717d9e2c93394b35bef4151f82b90dc88b83d0e35c0bf1158bd41c6c,2801

View File

@ -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

3
stack-hoauth2-2.3.yaml Normal file
View File

@ -0,0 +1,3 @@
resolver: nightly-2022-02-25
extra-deps:
- hoauth2-2.3.0@sha256:213744356007a4686ff3bb72105843d478bc0ba6229659429cbe241a99f55095,2816

View File

@ -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

View File

@ -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