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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
module Fig.Frontend.Auth where
import Fig.Prelude
import qualified Network.HTTP.Req as R
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Jose.Jwk as Jwk
import qualified Jose.Jwt as Jwt
import qualified Web.Scotty as Sc
import qualified Web.Scotty.Cookie as Sc.C
import Fig.Frontend.Utils
data TokenContents = TokenContents
{ aud :: !Text
, exp :: !Int
, iat :: !Int
, iss :: !Text
, sub :: !Text
, azp :: !Text
, nonce :: !Text
, preferred_username :: !Text
} deriving (Show, Eq, Generic)
instance Aeson.FromJSON TokenContents
fetchJwk :: MonadIO m => m (Maybe Jwk.Jwk)
fetchJwk = do
resp <- R.responseBody <$> R.runReq R.defaultHttpConfig do
R.req R.GET (R.https "id.twitch.tv" R./: "oauth2" R./: "keys") R.NoReqBody R.jsonResponse mempty
let mkeys = Aeson.parseMaybe (Aeson..: "keys") resp
let mjwk = mkeys >>= headMay
log $ tshow mjwk
pure mjwk
validateToken :: MonadIO m => ByteString -> m (Maybe TokenContents)
validateToken encodedToken = fetchJwk >>= \case
Nothing -> pure Nothing
Just jwk -> liftIO (Jwt.decode [jwk] Nothing encodedToken) >>= \case
Left err -> do
log $ "Failed to decode token: " <> tshow err
pure Nothing
Right jwt -> do
let contents = case jwt of
Jwt.Unsecured bs -> bs
Jwt.Jws (_, bs) -> bs
Jwt.Jwe (_, bs) -> bs
log $ tshow contents
pure $ Aeson.decodeStrict contents
data Auth = Auth { id :: !Text, name :: !Text } deriving Show
checkAuth :: Config -> Sc.ActionM (Maybe Auth)
checkAuth cfg = (,)
<$> Sc.C.getCookie "id_token"
<*> Sc.C.getCookie "authnonce"
>>= \case
(Just token, Just nonce) -> do
validateToken (encodeUtf8 token) >>= \case
Just tc
| tc.aud == cfg.clientId
, tc.nonce == nonce
-> do
log $ tshow tc
pure . Just $ Auth
{ name = tc.preferred_username
, id = tc.sub
}
_else -> pure Nothing
_else -> pure Nothing
authed :: Config -> (Auth -> Sc.ActionM ()) -> Sc.ActionM ()
authed cfg f = checkAuth cfg >>= \case
Nothing -> do
Sc.status status401
Sc.text "unauthorized"
Just auth -> f auth
|
