bump to a newer version of stack

src/Network/Wai/Auth/Config.hs

@@ -11,7 +11,7 @@ module Network.Wai.Auth.Config
   , decodeKey
   ) where
 
-import           Data.Aeson
+import           Data.Aeson hiding      (Key)
 import           Data.Aeson.TH          (deriveJSON)
 import qualified Data.Text              as T
 import           Data.Text.Encoding     (encodeUtf8)

src/Network/Wai/Auth/Internal.hs

@@ -12,6 +12,7 @@ module Network.Wai.Auth.Internal
   , refreshTokens
   ) where
 
+import           Control.Monad.Except                 (runExceptT)
 import qualified Data.Aeson                           as Aeson
 import           Data.Binary                          (Binary(get, put), encode,
                                                       decodeOrFail)
@@ -68,12 +69,12 @@ oauth2Login
   -> Manager
   -> Maybe [T.Text]
   -> T.Text
-  -> Request 
+  -> Request
   -> [T.Text]
   -> (AuthLoginState -> IO Response)
   -> (Status -> S.ByteString -> IO Response)
   -> IO Response
-oauth2Login oauth2 man oa2Scope providerName req suffix onSuccess onFailure = 
+oauth2Login oauth2 man oa2Scope providerName req suffix onSuccess onFailure =
   case suffix of
     [] -> do
       -- https://tools.ietf.org/html/rfc6749#section-3.3
@@ -92,7 +93,7 @@ oauth2Login oauth2 man oa2Scope providerName req suffix onSuccess onFailure =
       let params = queryString req
       in case lookup "code" params of
             Just (Just code) -> do
-              eRes <- OA2.fetchAccessToken man oauth2 $ getExchangeToken code
+              eRes <- runExceptT $ OA2.fetchAccessToken man oauth2 $ getExchangeToken code
               case eRes of
                 Left err    -> onFailure status501 $ S8.pack $ show err
                 Right token -> onSuccess $ encodeToken token
@@ -115,11 +116,11 @@ oauth2Login oauth2 man oa2Scope providerName req suffix onSuccess onFailure =
     _ -> onFailure status404 "Page not found. Please continue with login."
 
 refreshTokens :: OA2.OAuth2Token -> Manager -> OA2.OAuth2 -> IO (Maybe OA2.OAuth2Token)
-refreshTokens tokens manager oauth2 = 
+refreshTokens tokens manager oauth2 =
   case OA2.refreshToken tokens of
     Nothing -> pure Nothing
     Just refreshToken -> do
-      res <- OA2.refreshAccessToken manager oauth2 refreshToken
+      res <- runExceptT $ OA2.refreshAccessToken manager oauth2 refreshToken
       case res of
         Left _ -> pure Nothing
         Right newTokens -> pure (Just newTokens)

src/Network/Wai/Middleware/Auth/OAuth2.hs

@@ -84,11 +84,11 @@ instance AuthProvider OAuth2 where
     callbackURI <- parseAbsoluteURI $ renderUrl (ProviderUrl ["complete"]) []
     let oauth2 =
           OA2.OAuth2
-          { oauthClientId = getClientId oa2ClientId
-          , oauthClientSecret = Just $ getClientSecret oa2ClientSecret
-          , oauthOAuthorizeEndpoint = authEndpointURI
-          , oauthAccessTokenEndpoint = accessTokenEndpointURI
-          , oauthCallback = Just callbackURI
+          { oauth2ClientId = getClientId oa2ClientId
+          , oauth2ClientSecret = getClientSecret oa2ClientSecret
+          , oauth2AuthorizeEndpoint = authEndpointURI
+          , oauth2TokenEndpoint = accessTokenEndpointURI
+          , oauth2RedirectUri = callbackURI
           }
     man <- getGlobalManager
     oauth2Login
@@ -111,17 +111,17 @@ instance AuthProvider OAuth2 where
         if tokenExpired user now tokens then do
           let oauth2 =
                 OA2.OAuth2
-                { oauthClientId = getClientId oa2ClientId
-                , oauthClientSecret = Just (getClientSecret oa2ClientSecret)
-                , oauthOAuthorizeEndpoint = authEndpointURI
-                , oauthAccessTokenEndpoint = accessTokenEndpointURI
-                -- Setting callback endpoint to `Nothing` below is a lie.
+                { oauth2ClientId = getClientId oa2ClientId
+                , oauth2ClientSecret = getClientSecret oa2ClientSecret
+                , oauth2AuthorizeEndpoint = authEndpointURI
+                , oauth2TokenEndpoint = accessTokenEndpointURI
+                -- Setting callback endpoint to `error` below is a okay.
                 -- We do have a callback endpoint but in this context
                 -- don't have access to the function that can render it.
                 -- We get away with this because the callback endpoint is
                 -- not needed for obtaining a refresh token, the only
                 -- way we use the config here constructed.
-                , oauthCallback = Nothing
+                , oauth2RedirectUri = error "No redirect URI available."
                 }
           man <- getGlobalManager
           rRes <- refreshTokens tokens man oauth2

src/Network/Wai/Middleware/Auth/OIDC.hs

@@ -1,5 +1,5 @@
-{-# LANGUAGE FlexibleInstances   #-}     
-{-# LANGUAGE RecordWildCards   #-}     
+{-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE RecordWildCards   #-}
 {-# LANGUAGE OverloadedStrings #-}
 -- | An OpenID connect provider.
 --
@@ -163,7 +163,7 @@ instance AuthProvider OpenIDConnect where
                             authLoginTime = fromIntegral now
                           }
                     pure (Just (storeClaims claims req, newUser))
-          Just claims -> 
+          Just claims ->
             pure (Just (storeClaims claims req, user))
 
 -- | Fetch configuration for a provider from its discovery
@@ -183,7 +183,7 @@ discoverURI :: U.URI -> IO OpenIDConnect
 discoverURI uri = do
   metadata <- fetchMetadata uri
   jwkset <- fetchJWKSet (jwksUri metadata)
-  pure OpenIDConnect 
+  pure OpenIDConnect
     { oidcClientId = ""
     , oidcClientSecret = ""
     , oidcMetadata = metadata
@@ -199,23 +199,23 @@ defProviderInfo = ProviderInfo "OpenID Connect Provider" "" ""
 
 fetchMetadata :: U.URI -> IO Metadata
 fetchMetadata metadataEndpoint = do
-  req <- parseRequestThrow (S8.unpack $ U.serializeURIRef' metadataEndpoint) 
+  req <- parseRequestThrow (S8.unpack $ U.serializeURIRef' metadataEndpoint)
   getResponseBody <$> httpJSON req
 
 fetchJWKSet :: T.Text -> IO JOSE.JWKSet
 fetchJWKSet jwkSetEndpoint = do
-  req <- parseRequestThrow (T.unpack jwkSetEndpoint) 
+  req <- parseRequestThrow (T.unpack jwkSetEndpoint)
   getResponseBody <$> httpJSON req
 
 mkOauth2 :: OpenIDConnect -> Maybe (Text.Hamlet.Render ProviderUrl) -> IO OA2.OAuth2
 mkOauth2 OpenIDConnect {..} renderUrl = do
   callbackURI <- for renderUrl $ \render -> parseAbsoluteURI $ render (ProviderUrl ["complete"]) []
   pure OA2.OAuth2
-        { oauthClientId = oidcClientId
-        , oauthClientSecret = Just oidcClientSecret
-        , oauthOAuthorizeEndpoint = authorizationEndpoint oidcMetadata
-        , oauthAccessTokenEndpoint = tokenEndpoint oidcMetadata
-        , oauthCallback = callbackURI
+        { oauth2ClientId = oidcClientId
+        , oauth2ClientSecret = oidcClientSecret
+        , oauth2AuthorizeEndpoint = authorizationEndpoint oidcMetadata
+        , oauth2TokenEndpoint = tokenEndpoint oidcMetadata
+        , oauth2RedirectUri = maybe (error "No callback URI found") id callbackURI
         }
 
 validateIdToken :: OpenIDConnect -> OA2.IdToken -> IO (Either JWT.JWTError JWT.ClaimsSet)
@@ -224,7 +224,7 @@ validateIdToken oidc (OA2.IdToken idToken) = runExceptT $ do
   JWT.verifyClaims (validationSettings oidc) (oidcJwkSet oidc) signedJwt
 
 validateIdToken' :: OpenIDConnect -> OA2.OAuth2Token -> IO (Maybe JWT.ClaimsSet)
-validateIdToken' oidc tokens = 
+validateIdToken' oidc tokens =
   case OA2.idToken tokens of
     Nothing -> pure Nothing
     Just idToken ->

src/Network/Wai/Middleware/Auth/Provider.hs

@@ -30,7 +30,7 @@ import           Control.Arrow                 (second)
 import           Data.Aeson                    (FromJSON (..), Object,
                                                 Result (..), Value)
 import           Data.Aeson.Types              (parseEither)
-
+import           Data.Aeson.KeyMap             (toHashMapText)
 import           Data.Aeson.TH                 (defaultOptions, deriveJSON,
                                                 fieldLabelModifier)
 import           Data.Aeson.Types              (Parser)
@@ -107,12 +107,12 @@ class AuthProvider ap where
 
   -- | Check if the login state in a session is still valid, and have the
   -- opportunity to update it. Return `Nothing` to indicate a session has
-  -- expired, and the user will be directed to re-authenticate. 
+  -- expired, and the user will be directed to re-authenticate.
   --
   -- The default implementation never invalidates a session once set.
   --
   -- @since 0.2.3.0
-  refreshLoginState 
+  refreshLoginState
     :: ap
     -> Request
     -> AuthUser
@@ -132,7 +132,7 @@ instance AuthProvider Provider where
 
   handleLogin (Provider p) = handleLogin p
 
-  refreshLoginState (Provider p) = refreshLoginState p 
+  refreshLoginState (Provider p) = refreshLoginState p
 
 -- | Collection of supported providers.
 type Providers = HM.HashMap T.Text Provider
@@ -184,13 +184,14 @@ mkProviderParser _ =
 
 -- | Parse configuration for providers from an `Object`.
 parseProviders :: Object -> [ProviderParser] -> Result Providers
-parseProviders unparsedProvidersHM providerParsers =
+parseProviders unparsedProvidersO providerParsers =
   if HM.null unrecognized
     then sequence $ HM.intersectionWith parseProvider unparsedProvidersHM parsersHM
     else Error $
          "Provider name(s) are not recognized: " ++
          T.unpack (T.intercalate ", " $ HM.keys unrecognized)
   where
+    unparsedProvidersHM = toHashMapText unparsedProvidersO
     parsersHM = HM.fromList providerParsers
     unrecognized = HM.difference unparsedProvidersHM parsersHM
     parseProvider v p = either Error Success $ parseEither p v

stack.yaml

@@ -1 +1 @@
-resolver: lts-17.12
+resolver: lts-19.1

stack.yaml.lock

@@ -6,7 +6,7 @@
 packages: []
 snapshots:
 - completed:
-    size: 565712
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/6.yaml
-    sha256: 4e5e581a709c88e3fe26a9ce8bf331435729bead762fb5c190064c6c5bb1b835
-  original: lts-17.6
+    size: 617355
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/1.yaml
+    sha256: cbd5e8593869445794924668479b5bd9f1738d075898623dceacc13b2576b6e3
+  original: lts-19.1