chore(oauth2): fix build
This commit is contained in:
parent
c7d21b34c7
commit
15195752d7
@ -19,6 +19,7 @@ module Auth.OAuth2
|
||||
|
||||
-- import qualified Data.CaseInsensitive as CI
|
||||
import Data.Maybe (fromJust)
|
||||
import qualified Data.Set as Set
|
||||
import Data.Text
|
||||
|
||||
import Import.NoFoundation hiding (pack, unpack)
|
||||
@ -195,31 +196,31 @@ mkBaseUrls = do
|
||||
|
||||
refreshOAuth2Token :: forall m.
|
||||
( MonadHandler m
|
||||
, HasAppSettings (HandlerSite m)
|
||||
, MonadThrow m
|
||||
)
|
||||
=> (Maybe AccessToken, Maybe RefreshToken)
|
||||
-> String
|
||||
-> Bool
|
||||
-> ExceptT UserDataException m OAuth2Token
|
||||
refreshOAuth2Token (_, rToken) url secure
|
||||
| isJust rToken = do
|
||||
refreshOAuth2Token (_, Nothing) _ _ = throwE $ UserDataInternalException "Could not refresh access token. Refresh token is missing."
|
||||
refreshOAuth2Token (_, Just rToken) url secure = getsYesod (view $ _appUserAuthConf . _userAuthConfSingleSource) >>= \case
|
||||
AuthSourceConfAzureAdV2 AzureConf{..} -> do
|
||||
req <- parseRequest $ "POST " ++ url
|
||||
let
|
||||
body =
|
||||
[ ("grant_type", "refresh_token")
|
||||
, ("refresh_token", encodeUtf8 . rtoken $ fromJust rToken)
|
||||
, ("refresh_token", encodeUtf8 $ rtoken rToken)
|
||||
]
|
||||
body' <- if secure then do
|
||||
clientID <- liftIO $ fromJust <$> lookupEnv "CLIENT_ID"
|
||||
clientSecret <- liftIO $ fromJust <$> lookupEnv "CLIENT_SECRET"
|
||||
return $ body ++ [("client_id", fromString clientID), ("client_secret", fromString clientSecret), scopeParam " " ["openid","profile"," offline_access"]] -- TODO read from config
|
||||
else return $ scopeParam " " ["openid","profile","offline_access"] : body -- TODO read from config
|
||||
$logDebugS "\27[31mAdmin Handler\27[0m" $ tshow (requestBody $ urlEncodedBody body' req{ secure = secure })
|
||||
body'
|
||||
| secure = body ++ [("client_id", fromString $ show azureConfClientId), ("client_secret", fromString $ unpack azureConfClientSecret), scopeParam " " $ Set.toList azureConfScopes]
|
||||
| otherwise = scopeParam " " (Set.toList azureConfScopes) : body
|
||||
$logInfoS "\27[31mAdmin Handler\27[0m" $ tshow (requestBody $ urlEncodedBody body' req{ secure = secure })
|
||||
eResult <- lift $ getResponseBody <$> httpJSONEither @m @OAuth2Token (urlEncodedBody body' req{ secure = secure })
|
||||
case eResult of
|
||||
Left x -> throwE $ UserDataJSONException x
|
||||
Right x -> return x
|
||||
| otherwise = throwE $ UserDataInternalException "Could not refresh access token. Refresh token is missing."
|
||||
_other -> throwE $ UserDataInternalException "Could not refresh access token. Invalid/Conflicting auth source configuration."
|
||||
|
||||
instance Show RequestBody where
|
||||
show (RequestBodyLBS x) = show x
|
||||
|
||||
@ -144,7 +144,7 @@ instance YesodAuth UniWorX where
|
||||
let azurePlugins = P.filter ((`elem` [apAzureMock, apAzure]) . apName) plugins
|
||||
in if
|
||||
| (plugin:_) <- azurePlugins
|
||||
, PluginR _ p <- oauth2Url (apName plugin) -> do
|
||||
, PluginR _ pieces <- oauth2Url (apName plugin) -> do
|
||||
$logInfoS "SSO" "Azure plugin with plugin url as expected. Calling apDispatch..."
|
||||
void $ apDispatch plugin "GET" pieces
|
||||
| not (null azurePlugins) -> do
|
||||
|
||||
Reference in New Issue
Block a user