@@ -23,8 +23,8 @@ import Network.HTTP.Client.TLS
2323import Network.OAuth.OAuth2 as OAuth
2424import Network.TLS as TLS
2525import URI.ByteString
26- import Web.JWT as JWT
2726import Web.OIDC.Client.Discovery as OIDC
27+ import Jose.Jwt
2828
2929import qualified Data.ByteString as BS
3030import qualified Data.ByteString.Base64 as B64
@@ -66,20 +66,23 @@ instance Exception OIDCAuthParsingException
6666getToken :: OIDCAuth -> IO Text
6767getToken o@ (OIDCAuth {.. }) = do
6868 now <- getPOSIXTime
69+ maybeIdToken <- readTVarIO idTokenTVar
70+ case maybeIdToken of
71+ Nothing -> fetchToken o
72+ Just idToken -> do
73+ let maybeExp = decodeClaims (Text. encodeUtf8 idToken)
74+ & rightToMaybe
75+ & fmap snd
76+ & (>>= jwtExp)
77+ case maybeExp of
78+ Nothing -> fetchToken o
79+ Just (IntDate expiryDate) -> if now < expiryDate
80+ then pure idToken
81+ else fetchToken o
82+
83+ fetchToken :: OIDCAuth -> IO Text
84+ fetchToken o@ (OIDCAuth {.. }) = do
6985 mgr <- newManager tlsManagerSettings
70- idToken <- readTVarIO idTokenTVar
71- let maybeExp = idToken
72- & (>>= decode)
73- & (fmap claims)
74- & (>>= JWT. exp )
75- & (fmap secondsSinceEpoch)
76- isValidToken = fromMaybe False (fmap (now < ) maybeExp)
77- if not isValidToken
78- then fetchToken mgr o
79- else maybe (throwM $ OIDCGetTokenException " impossible" ) pure idToken
80-
81- fetchToken :: Manager -> OIDCAuth -> IO Text
82- fetchToken mgr o@ (OIDCAuth {.. }) = do
8386 maybeToken <- readTVarIO refreshTokenTVar
8487 case maybeToken of
8588 Nothing -> throwM $ OIDCGetTokenException " cannot refresh id-token without a refresh token"
0 commit comments