Add tests for "exp" field of the JWT

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

website/sandbox/learnpianochords/src/server/Fixtures.hs

@@ -9,6 +9,8 @@ import Utils
 import qualified Data.Map as Map
 import qualified GoogleSignIn
 import qualified TestUtils
+import qualified Data.Time.Clock.POSIX as POSIX
+import qualified System.IO.Unsafe as Unsafe
 --------------------------------------------------------------------------------
 
 -- | These are the JWT fields that I'd like to overwrite in the `googleJWT`
@@ -17,15 +19,23 @@ data JWTFields = JWTFields
   { overwriteSigner :: Signer
   , overwriteAuds :: [StringOrURI]
   , overwriteIss :: StringOrURI
+  , overwriteExp :: NumericDate
   }
 
 defaultJWTFields :: JWTFields
-defaultJWTFields = JWTFields
+defaultJWTFields = do
-  { overwriteSigner = hmacSecret "secret"
+  let tenDaysFromToday = POSIX.getPOSIXTime
-  , overwriteAuds = ["771151720060-buofllhed98fgt0j22locma05e7rpngl.apps.googleusercontent.com"]
+                         |> Unsafe.unsafePerformIO
-                    |> fmap TestUtils.unsafeStringOrURI
+                         |> (\x -> x * 60 * 60 * 25 * 10)
-  , overwriteIss = TestUtils.unsafeStringOrURI "accounts.google.com"
+                         |> numericDate
-  }
+                         |> TestUtils.unsafeJust
+  JWTFields
+    { overwriteSigner = hmacSecret "secret"
+    , overwriteAuds = ["771151720060-buofllhed98fgt0j22locma05e7rpngl.apps.googleusercontent.com"]
+                      |> fmap TestUtils.unsafeStringOrURI
+    , overwriteIss = TestUtils.unsafeStringOrURI "accounts.google.com"
+    , overwriteExp = tenDaysFromToday
+    }
 
 googleJWT :: JWTFields -> GoogleSignIn.EncodedJWT
 googleJWT JWTFields{..} =
@@ -49,7 +59,7 @@ googleJWT JWTFields{..} =
       , sub = stringOrURI "114079822315085727057"
       , aud = overwriteAuds |> Right |> Just
       -- TODO: Replace date creation with a human-readable date constructor.
-      , Web.JWT.exp = numericDate 1596756453
+      , Web.JWT.exp = Just overwriteExp
       , nbf = Nothing
       -- TODO: Replace date creation with a human-readable date constructor.
       , iat = numericDate 1596752853

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
+            case (jwt |> claims |> iss, jwt |> claims |> JWT.exp) of
-              Nothing -> pure MissingIssuer
+              (Nothing, _) -> pure $ MissingRequiredClaim "iss"
-              Just jwtIssuer ->
+              (_, Nothing) -> pure $ MissingRequiredClaim "exp"
+              (Just jwtIssuer, Just jwtExpiry) ->
                 if not $ jwtIssuer `elem` parsedIssuers then
                   pure $ WrongIssuer jwtIssuer
-                else
+                else do
-                  pure Valid
+                  mCurrentTime <- POSIX.getPOSIXTime |> fmap numericDate
+                  case mCurrentTime of
+                    Nothing -> pure TimeConversionFailure
+                    Just currentTime ->
+                      if not $ currentTime <= jwtExpiry then
+                        pure $ StaleExpiry jwtExpiry
+                      else
+                        pure Valid

website/sandbox/learnpianochords/src/server/Spec.hs

@@ -4,11 +4,13 @@ module Spec where
 --------------------------------------------------------------------------------
 import Test.Hspec
 import Utils
+import Web.JWT (numericDate)
 import GoogleSignIn (ValidationResult(..))
 
 import qualified GoogleSignIn
 import qualified Fixtures as F
 import qualified TestUtils
+import qualified Data.Time.Clock.POSIX as POSIX
 --------------------------------------------------------------------------------
 
 main :: IO ()
@@ -44,3 +46,23 @@ main = hspec $ do
             encodedJWT = F.defaultJWTFields { F.overwriteIss = erroneousIssuer }
                          |> F.googleJWT
         jwtIsValid' encodedJWT `shouldReturn` Valid
+
+      it "fails validation when the exp field has expired" $ do
+        let mErroneousExp = numericDate 0
+        case mErroneousExp of
+          Nothing -> True `shouldBe` False
+          Just erroneousExp -> do
+            let encodedJWT = F.defaultJWTFields { F.overwriteExp = erroneousExp }
+                             |> F.googleJWT
+            jwtIsValid' encodedJWT `shouldReturn` StaleExpiry erroneousExp
+
+      it "passes validation when the exp field is current" $ do
+        mFreshExp <- POSIX.getPOSIXTime
+                     |> fmap (\x -> x * 60 * 60 * 24 * 10) -- 10 days later
+                     |> fmap numericDate
+        case mFreshExp of
+          Nothing -> True `shouldBe` False
+          Just freshExp -> do
+            let encodedJWT = F.defaultJWTFields { F.overwriteExp = freshExp }
+                             |> F.googleJWT
+            jwtIsValid' encodedJWT `shouldReturn` Valid

website/sandbox/learnpianochords/src/server/TestUtils.hs

@@ -10,3 +10,7 @@ unsafeStringOrURI x =
   case stringOrURI (cs x) of
     Nothing -> error $ "Failed to convert to StringOrURI: " ++ x
     Just x  -> x
+
+unsafeJust :: Maybe a -> a
+unsafeJust Nothing = error "Attempted to force a Nothing to be a something"
+unsafeJust (Just x) = x