Use CPP to get 2.7.0 to compile

Resolves #164

CHANGELOG.md

@@ -2,7 +2,7 @@
 
 ## [v0.7.0.3](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.0.2...v0.7.0.3)
 
-WIP, fill this in
+- Support `hoauth-2.7`
 
 ## [v0.7.0.2](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.0.1...v0.7.0.2)
 

src/Network/OAuth/OAuth2/Compat.hs

@@ -3,6 +3,7 @@
 module Network.OAuth.OAuth2.Compat
     ( OAuth2(..)
     , OAuth2Result
+    , Error
     , authorizationUrl
     , fetchAccessToken
     , fetchAccessToken2
@@ -15,6 +16,14 @@ module Network.OAuth.OAuth2.Compat
 import Data.ByteString.Lazy (ByteString)
 import Data.Text (Text)
 import Network.HTTP.Conduit (Manager)
+#if MIN_VERSION_hoauth2(2,7,0)
+import Network.OAuth.OAuth2
+    ( AccessToken(..)
+    , ExchangeToken(..)
+    , OAuth2Token(..)
+    , RefreshToken(..)
+    )
+#else
 import Network.OAuth.OAuth2
     ( AccessToken(..)
     , ExchangeToken(..)
@@ -22,8 +31,13 @@ import Network.OAuth.OAuth2
     , OAuth2Token(..)
     , RefreshToken(..)
     )
+#endif
 import qualified Network.OAuth.OAuth2 as OAuth2
+#if MIN_VERSION_hoauth2(2,7,0)
+import Network.OAuth.OAuth2.TokenRequest (TokenRequestError)
+#else
 import Network.OAuth.OAuth2.TokenRequest (Errors)
+#endif
 import URI.ByteString
 
 #if MIN_VERSION_hoauth2(2,2,0)
@@ -39,7 +53,13 @@ data OAuth2 = OAuth2
     , oauth2RedirectUri :: Maybe (URIRef Absolute)
     }
 
-type OAuth2Result err a = Either (OAuth2Error err) a
+#if MIN_VERSION_hoauth2(2,7,0)
+type Error = TokenRequestError
+#else
+type Error = OAuth2Error Errors
+#endif
+
+type OAuth2Result a = Either Error a
 
 authorizationUrl :: OAuth2 -> URI
 authorizationUrl = OAuth2.authorizationUrl . getOAuth2
@@ -48,14 +68,14 @@ fetchAccessToken
     :: Manager
     -> OAuth2
     -> ExchangeToken
-    -> IO (OAuth2Result Errors OAuth2Token)
+    -> IO (OAuth2Result OAuth2Token)
 fetchAccessToken = fetchAccessTokenBasic
 
 fetchAccessToken2
     :: Manager
     -> OAuth2
     -> ExchangeToken
-    -> IO (OAuth2Result Errors OAuth2Token)
+    -> IO (OAuth2Result OAuth2Token)
 fetchAccessToken2 = fetchAccessTokenPost
 
 authGetBS :: Manager -> AccessToken -> URI -> IO (Either ByteString ByteString)
@@ -131,7 +151,7 @@ fetchAccessTokenBasic
     :: Manager
     -> OAuth2
     -> ExchangeToken
-    -> IO (OAuth2Result Errors OAuth2Token)
+    -> IO (OAuth2Result OAuth2Token)
 fetchAccessTokenBasic m o e = runOAuth2 $ f m (getOAuth2 o) e
   where
 #if MIN_VERSION_hoauth2(2,6,0)
@@ -146,7 +166,7 @@ fetchAccessTokenPost
     :: Manager
     -> OAuth2
     -> ExchangeToken
-    -> IO (OAuth2Result Errors OAuth2Token)
+    -> IO (OAuth2Result OAuth2Token)
 fetchAccessTokenPost m o e = runOAuth2 $ f m (getOAuth2 o) e
   where
 #if MIN_VERSION_hoauth2(2, 6, 0)

src/Yesod/Auth/OAuth2/Dispatch.hs

@@ -18,9 +18,8 @@ import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Network.HTTP.Conduit (Manager)
 import Network.OAuth.OAuth2.Compat
-import Network.OAuth.OAuth2.TokenRequest (Errors)
-import URI.ByteString.Extension
 import UnliftIO.Exception
+import URI.ByteString.Extension
 import Yesod.Auth hiding (ServerError)
 import Yesod.Auth.OAuth2.DispatchError
 import Yesod.Auth.OAuth2.ErrorResponse
@@ -32,7 +31,7 @@ import Yesod.Core hiding (ErrorResponse)
 -- This will be 'fetchAccessToken' or 'fetchAccessToken2'
 --
 type FetchToken
-  = Manager -> OAuth2 -> ExchangeToken -> IO (OAuth2Result Errors OAuth2Token)
+  = Manager -> OAuth2 -> ExchangeToken -> IO (OAuth2Result OAuth2Token)
 
 -- | How to take an @'OAuth2Token'@ and retrieve user credentials
 type FetchCreds m = Manager -> OAuth2Token -> IO (Creds m)

src/Yesod/Auth/OAuth2/DispatchError.hs

@@ -9,15 +9,14 @@
 {-# LANGUAGE TypeFamilies #-}
 
 module Yesod.Auth.OAuth2.DispatchError
-    ( DispatchError(..)
-    , handleDispatchError
-    , onDispatchError
-    ) where
+  ( DispatchError(..)
+  , handleDispatchError
+  , onDispatchError
+  ) where
 
 import Control.Monad.Except
 import Data.Text (Text, pack)
-import Network.OAuth.OAuth2
-import Network.OAuth.OAuth2.TokenRequest (Errors)
+import Network.OAuth.OAuth2.Compat (Error)
 import UnliftIO.Except ()
 import UnliftIO.Exception
 import Yesod.Auth hiding (ServerError)
@@ -31,7 +30,7 @@ data DispatchError
     | InvalidStateToken (Maybe Text) Text
     | InvalidCallbackUri Text
     | OAuth2HandshakeError ErrorResponse
-    | OAuth2ResultError (OAuth2Error Errors)
+    | OAuth2ResultError Error
     | FetchCredsIOException IOException
     | FetchCredsYesodOAuth2Exception YesodOAuth2Exception
     | OtherDispatchError Text
@@ -45,37 +44,37 @@ data DispatchError
 --
 dispatchErrorMessage :: DispatchError -> Text
 dispatchErrorMessage = \case
-    MissingParameter name ->
-        "Parameter '" <> name <> "' is required, but not present in the URL"
-    InvalidStateToken{} -> "State token is invalid, please try again"
-    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"
-    FetchCredsYesodOAuth2Exception{} -> "Login failed, please try again"
-    OtherDispatchError{} -> "Login failed, please try again"
+  MissingParameter name ->
+    "Parameter '" <> name <> "' is required, but not present in the URL"
+  InvalidStateToken{} -> "State token is invalid, please try again"
+  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"
+  FetchCredsYesodOAuth2Exception{} -> "Login failed, please try again"
+  OtherDispatchError{}             -> "Login failed, please try again"
 
 handleDispatchError
-    :: MonadAuthHandler site m
-    => ExceptT DispatchError m TypedContent
-    -> m TypedContent
+  :: MonadAuthHandler site m
+  => ExceptT DispatchError m TypedContent
+  -> m TypedContent
 handleDispatchError f = do
-    result <- runExceptT f
-    either onDispatchError pure result
+  result <- runExceptT f
+  either onDispatchError pure result
 
 onDispatchError :: MonadAuthHandler site m => DispatchError -> m TypedContent
 onDispatchError err = do
-    errorId <- liftIO $ randomText 16
-    let suffix = " [errorId=" <> errorId <> "]"
-    $(logError) $ pack (displayException err) <> suffix
+  errorId <- liftIO $ randomText 16
+  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
+  loginR <- ($ LoginR) <$> getRouteToParent
 
-    selectRep $ do
-        provideRep @_ @Html $ onErrorHtml loginR message
-        provideRep @_ @Value $ pure messageValue
+  selectRep $ do
+    provideRep @_ @Html $ onErrorHtml loginR message
+    provideRep @_ @Value $ pure messageValue