haskell - OAuth2 证书应该如何存储在 Haskell 中

Question

在 haskell 中存储 OAuth2 jwk 的正确方法是什么？我正在检索的证书来自 https://www.googleapis.com/oauth2/v3/certs我想避免每次需要验证 token 上的签名时都需要证书。这些选项似乎是 MVar、TVar、IORef 或状态 monad，尽管我不太确定如何为此实现状态 monad。

基本步骤如下(在 scotty 服务器后面运行):

1. 从 IDP 接收 token
2. 使用 JWk 解码 Jwt
3. 如果由于签名错误导致解码失败，请检查端点是否有新证书并修改包含证书的当前变量

我现在正在使用 jose-jwt、wreq 和 scotty，并且有一些可行的方法，但我想实现我所询问的方法，而不是我现有的方法。

module Main where


import ClassyPrelude
import Web.Scotty as S
import Network.Wreq as W
import Control.Lens as CL
import qualified Data.Text.Lazy as TL
import qualified Network.URI.Encode as URI
import Network.Wai.Middleware.RequestLogger
import Jose.Jwe
import Jose.Jwa
import Jose.Jwk
import Jose.Jwt
import Jose.Jws
import Data.Aeson
import qualified Data.HashMap.Strict as HM 
import qualified Data.Text as T
import qualified Data.List as DL
import qualified Data.ByteString.Base64 as B64

main :: IO ()
main = scotty 8080 $ do
  middleware logStdoutDev
  redirectCallback
  oauthCallback
  oauthGen
  home

home :: ScottyM ()
home = do
  S.get "/:word" $ do
    beam <- S.param "word"
    html $ mconcat ["<h1>Scotty, ", beam, " me up!</h1>"]

redirectCallback :: ScottyM ()
redirectCallback = do
  S.get "/redirect" $ do
    let v = uriSchemeBuilder
    redirect $ TL.fromStrict v

oauthCallback :: ScottyM ()
oauthCallback = do
  matchAny "/goauth2callback" $ do
    val <- body
    pars <- S.params
    c <- S.param "code" `rescue` (\_ -> return "haskell")
    let c1 = c <> (""::Text)
    r <- liftIO $ W.post "https://oauth2.googleapis.com/token" 
     [ "code" := (encodeUtf8 (c))
     , "client_id" := (encodeUtf8 consumerAccess)
     , "client_secret" := (encodeUtf8 consumerSecret)
     , "redirect_uri" := (encodeUtf8 redirectURI)
     , "grant_type" := ("authorization_code"::ByteString)
     , "access_type" := ("offline"::ByteString)
     ] 
    let newUser = (r ^? responseBody)
    case newUser of
     Just b -> do
      let jwt = decodeStrict (toStrict b) :: Maybe Value
      case jwt of
       Just (Object v) -> do
        let s = HM.lookup "id_token" v
        case s of
         Just (String k) -> do
          isValid <- liftIO $ validateToken (encodeUtf8 k)
          liftIO $ print isValid
          redirect "/hello_world" 
         _ -> redirect "/hello_world"  
       _ -> redirect "/hello_world"       
     Nothing -> redirect "/hello_world"


oauthGen :: ScottyM ()
oauthGen = do
  matchAny "/callback_gen" $ do
    val <- body
    redirect "/hello_world"

consumerAccess :: Text
consumerAccess = "google public key"

consumerSecret :: Text
consumerSecret = "google secret key"

oAuthScopes :: Text
oAuthScopes = "https://www.googleapis.com/auth/userinfo.profile https://www.googleapis.com/auth/userinfo.email"

redirectURI :: Text
redirectURI = "http://localhost:8080/goauth2callback"

authURI :: Text
authURI = "https://accounts.google.com/o/oauth2/auth"

tokenURI :: Text
tokenURI = "https://oauth2.googleapis.com/token"

projectId :: Text
projectId = "project name"

responseType :: Text
responseType = "code"

oAuthUriBuilder :: [(Text, Text)]
oAuthUriBuilder = 
  [ ("client_id", consumerAccess)
  , ("redirect_uri", redirectURI)
  , ("scope", oAuthScopes)
  , ("response_type", responseType)
  ]

uriSchemeBuilder :: Text
uriSchemeBuilder = authURI <> "?" <> (foldr (\x y -> (fst x ++ "=" ++ (URI.encodeText $ snd x)) ++ "&" ++ y) "" oAuthUriBuilder)

validateToken :: ByteString -> IO (Either JwtError  JwtContent)
validateToken b = do
  keySet <- retrievePublicKeys
  case keySet of
   Left e -> return $ Left $ KeyError "No keyset supplied"
   Right k -> do
    let header = JwsEncoding RS256
    Jose.Jwt.decode k (Just $ header) b

retrievePublicKeys :: IO (Either String [Jwk])
retrievePublicKeys = do
 r <- liftIO $ W.get "https://www.googleapis.com/oauth2/v3/certs"
 case (r ^? responseBody) of
  Nothing -> return $ Left "No body in response from google oauth api"
  Just a -> do
   let v = eitherDecode a :: Either String Value
   case v of
    Left e -> return $ Left e
    Right (Object a) -> do
     let keySet = HM.lookup "keys" a
     case keySet of
      Just k -> do
       let kS = eitherDecode (Data.Aeson.encode k) :: Either String [Jwk]
       return $ kS
      _      -> return $ Left "No Key set provided"
    _ -> return $ Left $ "Incorrect response type from https://www.googleapis.com/oauth2/v3/certs"

我有兴趣替换的具体部分是:

retrievePublicKeys :: IO (Either String [Jwk])
retrievePublicKeys = do
 r <- liftIO $ W.get "https://www.googleapis.com/oauth2/v3/certs"
 case (r ^? responseBody) of
  Nothing -> return $ Left "No body in response from google oauth api"
  Just a -> do
   let v = eitherDecode a :: Either String Value
   case v of
    Left e -> return $ Left e
    Right (Object a) -> do
     let keySet = HM.lookup "keys" a
     case keySet of
      Just k -> do
       let kS = eitherDecode (Data.Aeson.encode k) :: Either String [Jwk]
       return $ kS
      _      -> return $ Left "No Key set provided"
    _ -> return $ Left $ "Incorrect response type from https://www.googleapis.com/oauth2/v3/certs"

我考虑过将 Jwk 存储在 redis 中，但我认为有更好的方法可用。

预期的结果是能够安全地修改我从谷歌获得的证书并在后续解码中使用它，而无需不断地访问端点。
(注意:是的，我知道自行实现安全性是不好的做法，但这只是出于兴趣)

Answer 1

如果您输入类似 three 的内容layers ( ReaderT design pattern )，然后在 ReaderT YourEnv IO 的环境部分缓存 IORef 或 TVar 将是可行的方法。 ( atomicModifyIORef' 应该足够了。)

霍尔马斯克链接将推荐 jwt包，但刚刚在工作中的另一种语言中添加了 Google OAuth2 证书的内存缓存，在 Haskell 中选择 JWT 库也看起来非常像一种功能权衡:

例如，jwt explicitly states它不会检查 exp 过期时间戳，但据我所知，jose-jwt doesn't even address它解码的 exp 过期时间戳。 google-oauth2-jwt确实如此，并嵌入了端点(无论好坏，都很难模拟)，但除此之外没有提供很多人体工程学设计。 (编辑:看起来 jose does handle expiration ，它也是我在 Hackage 上提到的最受欢迎的一个。)