version 0.1.3.8: allow service tokens (#27)

CHANGELOG.md

@@ -6,6 +6,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 
+## [0.1.3.8] - 2021-06-22
+### Added
+- Possibility to accept Service Token in `OIDCAuth`. Token is considered a Service Token if it
+  lacks the `object_guid` claim. `preferred_username` claim is used as user id instead.
+
 ## [0.1.3.7] - 2021-06-10
 ### Added
 - Add a way to describe fields in Swagger schemas.

src/Web/Template/Servant/Auth.hs

@@ -137,6 +137,8 @@ data OIDCConfig
         -- ^ cache - storing validation keys
       , oidcDefaultExpiration :: NominalDiffTime
         -- ^ Default expiration time for discovery document and JWKS
+      , oidcAllowServiceToken :: Bool
+        -- ^ Whether to accept service token (defined as "token without object_guid claim")
       }
 
 defaultOIDCCfg :: MonadIO m => m OIDCConfig
@@ -151,6 +153,7 @@ defaultOIDCCfg = do
     , oidcIssuer = error "discovery uri not set"
     , oidcClientId = error "client id not set"
     , oidcDefaultExpiration = 10 * 60 -- 10 minutes
+    , oidcAllowServiceToken = False
     }
 
 instance ( HasServer api context
@@ -178,10 +181,13 @@ instance ( HasServer api context
 
         claims <- getClaims cfg jwt jwkSet
 
+        let guid = claims ^? unregisteredClaims . ix "object_guid" . _String
+        let username = claims ^? unregisteredClaims . ix "preferred_username" . _String
+
         uid <- maybe
           (die ERROR unauth401 ("No object_guid found" :: Text))
           return
-          $ claims ^? unregisteredClaims . ix "object_guid" . _String
+          (guid <|> (if oidcAllowServiceToken cfg then username else Nothing))
 
         liftIO $ sequence_ $ catMaybes
           [ userIdVaultKey <?> req <&> flip writeIORef (Just uid)

web-template.cabal

@@ -1,5 +1,5 @@
 name:                web-template
-version:             0.1.3.7
+version:             0.1.3.8
 synopsis:            Web template
 description:
             Web template includes: