@@ -23,8 +23,8 @@ import Network.HTTP.Client.TLS
23
23
import Network.OAuth.OAuth2 as OAuth
24
24
import Network.TLS as TLS
25
25
import URI.ByteString
26
- import Web.JWT as JWT
27
26
import Web.OIDC.Client.Discovery as OIDC
27
+ import Jose.Jwt
28
28
29
29
import qualified Data.ByteString as BS
30
30
import qualified Data.ByteString.Base64 as B64
@@ -66,20 +66,23 @@ instance Exception OIDCAuthParsingException
66
66
getToken :: OIDCAuth -> IO Text
67
67
getToken o@ (OIDCAuth {.. }) = do
68
68
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
69
85
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
83
86
maybeToken <- readTVarIO refreshTokenTVar
84
87
case maybeToken of
85
88
Nothing -> throwM $ OIDCGetTokenException " cannot refresh id-token without a refresh token"
0 commit comments