fix(tokens): introduce clock leniency and remove start for downloads

config/settings.yml

@@ -179,9 +179,13 @@ server-sessions:
   absolute-timeout: 604801
   timeout-resolution: 601
   persistent-cookies: true
+session-token-start: null
 session-token-expiration: 28807
 session-token-encoding: HS256
 
+session-token-clock-leniency-start: 5
+bearer-token-clock-leniency-start: 5
+
 cookies:
   SESSION:
     same-site: lax

src/Foundation/Yesod/Session.hs

@@ -31,12 +31,14 @@ makeSessionBackend app@UniWorX{ appSettings' = AppSettings{..}, ..} = noCreateFo
     -> return Nothing
   where
     cfg = JwtSession.ServerSessionJwtConfig
-      { sJwtJwkSet     = appJSONWebKeySet
-      , sJwtStart      = Nothing
-      , sJwtExpiration = appSessionTokenExpiration
-      , sJwtEncoding   = appSessionTokenEncoding
-      , sJwtIssueBy    = appInstanceID
-      , sJwtIssueFor   = appClusterID
+      { sJwtJwkSet             = appJSONWebKeySet
+      , sJwtStart              = appSessionTokenStart
+      , sJwtExpiration         = appSessionTokenExpiration
+      , sJwtEncoding           = appSessionTokenEncoding
+      , sJwtIssueBy            = appInstanceID
+      , sJwtIssueFor           = appClusterID
+      , sJwtClockLeniencyStart = appSessionTokenClockLeniencyStart
+      , sJwtClockLeniencyEnd   = appSessionTokenClockLeniencyEnd
       }
     mkBackend :: forall sto.
                ( ServerSession.SessionData sto ~ Map Text ByteString

src/Handler/Utils/Download.hs

@@ -67,7 +67,7 @@ withFileDownloadTokenMaybe' mSource route = maybeT (return $ SomeRoute route) $
     (HashMap.singleton BearerTokenRouteAccess . HashSet.singleton $ urlRoute route)
     Nothing
     (Just . Just $ addUTCTime expireOffset now)
-    (Just now)
+    Nothing
   encodedBearer <- lift $ encodeBearer bearer
 
   lift . setDownload $ SomeRoute @UniWorX route

src/Settings.hs

@@ -108,8 +108,11 @@ data AppSettings = AppSettings
     , appServerSessionConfig    :: ServerSessionSettings
     , appServerSessionAcidFallback :: Bool
     , appSessionMemcachedConf   :: Maybe MemcachedConf
+    , appSessionTokenStart
     , appSessionTokenExpiration :: Maybe NominalDiffTime
     , appSessionTokenEncoding   :: JwtEncoding
+    , appSessionTokenClockLeniencyStart, appSessionTokenClockLeniencyEnd
+    , appBearerTokenClockLeniencyStart, appBearerTokenClockLeniencyEnd :: Maybe NominalDiffTime
     
     , appMailObjectDomain       :: Text
     , appMailVerp               :: VerpMode
@@ -567,9 +570,16 @@ instance FromJSON AppSettings where
                     httpOnlyCookie = maybe id ServerSession.setHttpOnlyCookies . cookieHttpOnly $ appCookieSettings CookieSession
                     secureCookie :: forall a. ServerSession.State a -> ServerSession.State a
                     secureCookie = maybe id ServerSession.setSecureCookies . cookieSecure $ appCookieSettings CookieSession
+        appSessionTokenStart       <- o .:? "session-token-start"
         appSessionTokenExpiration  <- o .:? "session-token-expiration"
         appSessionTokenEncoding    <- o .: "session-token-encoding"
 
+
+        appSessionTokenClockLeniencyStart <- o .:? "session-token-clock-leniency-start"
+        appSessionTokenClockLeniencyEnd <- o .:? "session-token-clock-leniency-end"
+        appBearerTokenClockLeniencyStart <- o .:? "bearer-token-clock-leniency-start"
+        appBearerTokenClockLeniencyEnd <- o .:? "bearer-token-clock-leniency-end"
+
         appFavouritesQuickActionsBurstsize <- o .: "favourites-quick-actions-burstsize"
         appFavouritesQuickActionsAvgInverseRate <- o .: "favourites-quick-actions-avg-inverse-rate"
         appFavouritesQuickActionsTimeout <- o .: "favourites-quick-actions-timeout"

src/Utils/Tokens.hs

@@ -115,6 +115,7 @@ decodeBearer :: forall m.
                , MonadCrypto m
                , ParseRoute (HandlerSite m)
                , Hashable (Route (HandlerSite m))
+               , HasAppSettings (HandlerSite m)
                )
             => Jwt -> m (BearerToken (HandlerSite m))
 -- ^ Decode a `Jwt` and call `bearerParseJSON`
@@ -130,9 +131,10 @@ decodeBearer (Jwt bs) = do
   parser <- bearerParseJSON'
   bearer@BearerToken{..} <- either (throwM . BearerTokenInvalidFormat . uncurry JSON.formatError) return $ JSON.eitherDecodeStrictWith JSON.jsonEOF' (JSON.iparse parser) content'
   now <- liftIO getCurrentTime
-  unless (NTop bearerExpiresAt > NTop (Just now)) $
+  (clockLeniencyStart, clockLeniencyEnd) <- getsYesod $ (,) <$> view _appBearerTokenClockLeniencyStart <*> view _appBearerTokenClockLeniencyEnd
+  unless (NTop bearerExpiresAt > NTop (Just $ maybe id addUTCTime (negate <$> clockLeniencyEnd) now)) $
     throwM BearerTokenExpired
-  unless (bearerStartsAt <= Just now) $
+  unless (bearerStartsAt <= Just (maybe id addUTCTime clockLeniencyStart now)) $
     throwM BearerTokenNotStarted
   return bearer
 

src/Web/ServerSession/Frontend/Yesod/Jwt.hs

@@ -46,6 +46,7 @@ data ServerSessionJwtConfig = ServerSessionJwtConfig
   , sJwtEncoding   :: JwtEncoding
   , sJwtIssueBy    :: InstanceId
   , sJwtIssueFor   :: ClusterId
+  , sJwtClockLeniencyStart, sJwtClockLeniencyEnd :: Maybe NominalDiffTime
   }
 
 
@@ -147,9 +148,9 @@ decodeSession ServerSessionJwtConfig{..} (Jwt bs) = do
   session@SessionToken{..} <- either (throwM . SessionTokenInvalidFormat) return $ JSON.eitherDecodeStrict content'
 
   now <- liftIO getCurrentTime
-  unless (NTop sessionExpiresAt > NTop (Just now)) $
+  unless (NTop sessionExpiresAt > NTop (Just $ maybe id addUTCTime (negate <$> sJwtClockLeniencyEnd) now)) $
     throwM SessionTokenExpired
-  unless (sessionStartsAt <= Just now) $
+  unless (sessionStartsAt <= Just (maybe id addUTCTime sJwtClockLeniencyStart now)) $
     throwM SessionTokenNotStarted
 
   return session