Update auth lib to allow multiple issuers

app/Env.hs

@@ -93,6 +93,7 @@ withEnv action = do
             | otherwise = Nothing
        in r {Redis.connectTLSParams = tlsParams}
   let acceptedAudiences = Set.singleton apiOrigin
+  let acceptedIssuers = Set.singleton apiOrigin
   let legacyKey = JWT.KeyDescription {JWT.key = hs256Key, JWT.alg = JWT.HS256}
   let signingKey = JWT.KeyDescription {JWT.key = edDSAKey, JWT.alg = JWT.Ed25519}
   hashJWTJWK <- case JWT.keyDescToJWK legacyKey of
@@ -102,7 +103,7 @@ withEnv action = do
   -- version of the key is used for validation, which is needed for HashJWTs which are signed
   -- with a 'kid'.
   let validationKeys = Set.fromList [legacyKey]
-  jwtSettings <- case JWT.defaultJWTSettings signingKey (Just legacyKey) validationKeys acceptedAudiences apiOrigin of
+  jwtSettings <- case JWT.defaultJWTSettings signingKey (Just legacyKey) validationKeys acceptedAudiences acceptedIssuers of
     Left cryptoError -> throwIO cryptoError
     Right settings -> pure settings
   let cookieSettings = Cookies.defaultCookieSettings Deployment.onLocal (Just (realToFrac cookieSessionTTL))

share-auth/example/src/Lib.hs

@@ -78,7 +78,7 @@ main = do
   redisConn <- R.checkedConnect R.defaultConnectInfo
   putStrLn "booting up"
 
-  jwtSettings <- case JWT.defaultJWTSettings signingKey (Just legacyKey) rotatedKeys acceptedAudiences issuer of
+  jwtSettings <- case JWT.defaultJWTSettings signingKey (Just legacyKey) rotatedKeys acceptedAudiences acceptedIssuers of
     Left cryptoError -> throwIO cryptoError
     Right jwtS -> do
       pure jwtS
@@ -138,3 +138,4 @@ main = do
     serviceAudience = api
     acceptedAudiences = Set.singleton serviceAudience
     issuer = unsafeURI "http://localhost:5424"
+    acceptedIssuers = Set.singleton issuer

share-auth/src/Share/JWT.hs

@@ -87,12 +87,10 @@ defaultJWTSettings ::
   --
   -- E.g. https://api.unison.cloud
   Set URI ->
-  -- | The token issuer.
-  --
-  -- E.g. https://api.unison-lang.org
-  URI ->
+  -- | Valid issuers when validating tokens
+  Set URI ->
   Either CryptoError JWTSettings
-defaultJWTSettings signingKey legacyKey oldValidKeys acceptedAudiences issuer = do
+defaultJWTSettings signingKey legacyKey oldValidKeys acceptedAudiences acceptedIssuers = do
   sjwk@(_, signingJWK) <- keyDescToJWK signingKey
   verificationJWKs <- (sjwk :) <$> traverse keyDescToJWK (Set.toList oldValidKeys)
   let byKeyId = Map.fromList verificationJWKs
@@ -101,10 +99,8 @@ defaultJWTSettings signingKey legacyKey oldValidKeys acceptedAudiences issuer =
     JWTSettings
       { signingJWK,
         validationKeys = KeyMap {byKeyId, legacyKey},
-        audienceMatches = \s ->
-          (review JWT.stringOrUri s) `Set.member` (Set.map (show @URI) acceptedAudiences),
         acceptedAudiences,
-        issuer
+        acceptedIssuers
       }
 
 -- | Converts a 'KeyDescription' to a 'JWK' and a 'KeyThumbprint'.
@@ -164,7 +160,7 @@ signJWTWithJWK jwk v = runExceptT $ do
 --
 -- Any other checks should be performed on the returned claims.
 verifyJWT :: forall claims m. (AsJWTClaims claims, MonadIO m) => JWTSettings -> JWT.SignedJWT -> m (Either JWT.JWTError claims)
-verifyJWT JWTSettings {validationKeys, issuer, acceptedAudiences} signedJWT = runExceptT do
+verifyJWT JWTSettings {validationKeys, acceptedAudiences, acceptedIssuers} signedJWT = runExceptT do
   jwtClaimsMap <- ExceptT . liftIO . runExceptT $ JWT.verifyJWT validators validationKeys signedJWT
   case fromClaims jwtClaimsMap of
     Left err -> throwError $ JWT.JWTClaimsSetDecodeError (Text.unpack err)
@@ -175,9 +171,14 @@ verifyJWT JWTSettings {validationKeys, issuer, acceptedAudiences} signedJWT = ru
       -- Annoyingly StringOrURI doesn't have an ord instance.
       Set.toList acceptedAudiences
         & map (review CryptoJWT.uri)
+    issuers :: [CryptoJWT.StringOrURI]
+    issuers =
+      -- Annoyingly StringOrURI doesn't have an ord instance.
+      Set.toList acceptedIssuers
+        & map (review CryptoJWT.uri)
     validators =
       CryptoJWT.defaultJWTValidationSettings (`elem` auds)
-        & CryptoJWT.issuerPredicate .~ (== review CryptoJWT.uri issuer)
+        & CryptoJWT.issuerPredicate .~ (`elem` issuers)
         & CryptoJWT.validationSettings
           .~ ( CryptoJWT.defaultValidationSettings
                  -- Limiting the algorithms to ones we use helps limit algorithm substitution attacks.

share-auth/src/Share/JWT/Types.hs

@@ -135,12 +135,10 @@ data JWTSettings = JWTSettings
     signingJWK :: Jose.JWK,
     -- | Keys used to validate JWT.
     validationKeys :: KeyMap,
-    -- | An @aud@ predicate. The @aud@ is a string or URI that identifies the
-    -- intended recipient of the JWT.
-    audienceMatches :: JWT.StringOrURI -> Bool,
     -- | The set of audiences the app accepts tokens for.
     acceptedAudiences :: Set URI,
-    issuer :: URI
+    -- | The set of issuers the app accepts tokens from.
+    acceptedIssuers :: Set URI
   }
   deriving (Show) via Censored JWTSettings