about summary refs log tree commit diff
path: root/website/sandbox/learnpianochords/src/server/GoogleSignIn.hs
diff options
context:
space:
mode:
authorWilliam Carroll <wpcarro@gmail.com>2020-08-08T16·55+0100
committerWilliam Carroll <wpcarro@gmail.com>2020-08-08T16·57+0100
commite8f35f0d10a1696ffa80e31434882287bea30fe3 (patch)
tree8d125f26cd6963dc49f048c7dae64a699233e5e3 /website/sandbox/learnpianochords/src/server/GoogleSignIn.hs
parent8a7a3b29a9413d634b8f8a71119cc54a6132df41 (diff)
Consume GoogleSignIn.validateJWT
TL;DR:
- Consume GoogleSignIn.validateJWT in the Handler for /verify
- Rename validation fn to validateJWT
- Prefer Text to String type
Diffstat (limited to 'website/sandbox/learnpianochords/src/server/GoogleSignIn.hs')
-rw-r--r--website/sandbox/learnpianochords/src/server/GoogleSignIn.hs30
1 files changed, 24 insertions, 6 deletions
diff --git a/website/sandbox/learnpianochords/src/server/GoogleSignIn.hs b/website/sandbox/learnpianochords/src/server/GoogleSignIn.hs
index e83ec2cfdb45..ab315a1876a4 100644
--- a/website/sandbox/learnpianochords/src/server/GoogleSignIn.hs
+++ b/website/sandbox/learnpianochords/src/server/GoogleSignIn.hs
@@ -3,7 +3,7 @@
 module GoogleSignIn where
 --------------------------------------------------------------------------------
 import Data.String.Conversions (cs)
-import Data.Text (Text)
+import Data.Text
 import Web.JWT
 import Utils
 
@@ -14,10 +14,16 @@ import qualified Data.Time.Clock.POSIX as POSIX
 --------------------------------------------------------------------------------
 
 newtype EncodedJWT = EncodedJWT Text
+  deriving (Show)
+
+newtype DecodedJWT = DecodedJWT (JWT UnverifiedJWT)
+  deriving (Show)
+
+instance Eq DecodedJWT where
+  (DecodedJWT _) == (DecodedJWT _) = True
 
--- | Some of the errors that a JWT
 data ValidationResult
-  = Valid
+  = Valid DecodedJWT
   | DecodeError
   | GoogleSaysInvalid Text
   | NoMatchingClientIDs [StringOrURI]
@@ -36,10 +42,10 @@ data ValidationResult
 -- * The `exp` time has not passed
 --
 -- Set `skipHTTP` to `True` to avoid making the network request for testing.
-jwtIsValid :: Bool
+validateJWT :: Bool
            -> EncodedJWT
            -> IO ValidationResult
-jwtIsValid skipHTTP (EncodedJWT encodedJWT) = do
+validateJWT skipHTTP (EncodedJWT encodedJWT) = do
   case encodedJWT |> decode of
     Nothing -> pure DecodeError
     Just jwt -> do
@@ -91,4 +97,16 @@ jwtIsValid skipHTTP (EncodedJWT encodedJWT) = do
                       if not $ currentTime <= jwtExpiry then
                         pure $ StaleExpiry jwtExpiry
                       else
-                        pure Valid
+                        pure $ jwt |> DecodedJWT |> Valid
+
+-- | Attempt to explain the `ValidationResult` to a human.
+explainResult :: ValidationResult -> String
+explainResult (Valid _) = "Everything appears to be valid"
+explainResult DecodeError = "We had difficulty decoding the provided JWT"
+explainResult (GoogleSaysInvalid x) = "After checking with Google, they claimed that the provided JWT was invalid: " ++ cs x
+explainResult (NoMatchingClientIDs audFields) = "None of the values in the `aud` field on the provided JWT match our client ID: " ++ show audFields
+explainResult (WrongIssuer issuer) = "The `iss` field in the provided JWT does not match what we expect: " ++ show issuer
+explainResult (StringOrURIParseFailure x) = "We had difficulty parsing values as URIs" ++ show x
+explainResult TimeConversionFailure = "We had difficulty converting the current time to a value we can use to compare with the JWT's `exp` field"
+explainResult (MissingRequiredClaim claim) = "Your JWT is missing the following claim: " ++ cs claim
+explainResult (StaleExpiry x) = "The `exp` field on your JWT has expired" ++ x |> show |> cs