blob: 72fa608c47b40000565b94c166aaff86588905fc (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
module GoogleSignIn where
--------------------------------------------------------------------------------
import Data.String.Conversions (cs)
import Data.Text (Text)
import Web.JWT
import Utils
import qualified Network.HTTP.Simple as HTTP
--------------------------------------------------------------------------------
newtype EncodedJWT = EncodedJWT Text
-- | Some of the errors that a JWT
data ValidationResult
= Valid
| DecodeError
| GoogleSaysInvalid Text
| NoMatchingClientIDs [StringOrURI]
| ClientIDParseFailure Text
deriving (Eq, Show)
-- | Returns True when the supplied `jwt` meets the following criteria:
-- * The token has been signed by Google
-- * The value of `aud` matches my Google client's ID
-- * The value of `iss` matches is "accounts.google.com" or
-- "https://accounts.google.com"
-- * The `exp` time has not passed
--
-- Set `skipHTTP` to `True` to avoid making the network request for testing.
jwtIsValid :: Bool
-> EncodedJWT
-> IO ValidationResult
jwtIsValid skipHTTP (EncodedJWT encodedJWT) = do
case encodedJWT |> decode of
Nothing -> pure DecodeError
Just jwt -> do
if skipHTTP then
continue jwt
else do
let request = "https://oauth2.googleapis.com/tokeninfo"
|> HTTP.setRequestQueryString [ ( "id_token", Just (cs encodedJWT) ) ]
res <- HTTP.httpLBS request
if HTTP.getResponseStatusCode res /= 200 then
pure $ GoogleSaysInvalid (res |> HTTP.getResponseBody |> cs)
else
continue jwt
where
continue :: JWT UnverifiedJWT -> IO ValidationResult
continue jwt = do
let audValues = jwt |> claims |> auds
mClientID = stringOrURI "771151720060-buofllhed98fgt0j22locma05e7rpngl.apps.googleusercontent.com"
case mClientID of
Nothing ->
pure $ ClientIDParseFailure "771151720060-buofllhed98fgt0j22locma05e7rpngl.apps.googleusercontent.com"
Just clientID ->
-- TODO: Prefer reading clientID from a config. I'm thinking of the
-- AppContext type having my Configuration
if not $ clientID `elem` audValues then
pure $ NoMatchingClientIDs audValues
else
pure Valid
|
