Add tests for "exp" field of the JWT

Assert that the exp field of the JWT is "fresh".

1 files changed, 18 insertions, 6 deletions

diff --git a/website/sandbox/learnpianochords/src/server/GoogleSignIn.hs b/website/sandbox/learnpianochords/src/server/GoogleSignIn.hs
index f138f2b615c8..e83ec2cfdb45 100644
--- a/website/sandbox/learnpianochords/src/server/GoogleSignIn.hs
+++ b/website/sandbox/learnpianochords/src/server/GoogleSignIn.hs
@@ -9,6 +9,8 @@ import Utils
 
 import qualified Network.HTTP.Simple as HTTP
 import qualified Data.Text as Text
+import qualified Web.JWT as JWT
+import qualified Data.Time.Clock.POSIX as POSIX
 --------------------------------------------------------------------------------
 
 newtype EncodedJWT = EncodedJWT Text
@@ -21,7 +23,9 @@ data ValidationResult
   | NoMatchingClientIDs [StringOrURI]
   | WrongIssuer StringOrURI
   | StringOrURIParseFailure Text
-  | MissingIssuer
+  | TimeConversionFailure
+  | MissingRequiredClaim Text
+  | StaleExpiry NumericDate
   deriving (Eq, Show)
 
 -- | Returns True when the supplied `jwt` meets the following criteria:
@@ -73,10 +77,18 @@ jwtIsValid skipHTTP (EncodedJWT encodedJWT) = do
           if not $ clientID `elem` audValues then
             pure $ NoMatchingClientIDs audValues
           else
-            case jwt |> claims |> iss of
-              Nothing -> pure MissingIssuer
-              Just jwtIssuer ->
+            case (jwt |> claims |> iss, jwt |> claims |> JWT.exp) of
+              (Nothing, _) -> pure $ MissingRequiredClaim "iss"
+              (_, Nothing) -> pure $ MissingRequiredClaim "exp"
+              (Just jwtIssuer, Just jwtExpiry) ->
                 if not $ jwtIssuer `elem` parsedIssuers then
                   pure $ WrongIssuer jwtIssuer
-                else
-                  pure Valid
+                else do
+                  mCurrentTime <- POSIX.getPOSIXTime |> fmap numericDate
+                  case mCurrentTime of
+                    Nothing -> pure TimeConversionFailure
+                    Just currentTime ->
+                      if not $ currentTime <= jwtExpiry then
+                        pure $ StaleExpiry jwtExpiry
+                      else
+                        pure Valid