3

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

基本步骤如下（在 scotty 服务器后面运行）：

  1. 从 IDP 接收令牌
  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 中，但我认为有更好的方法可用。

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

4

1 回答 1

2

如果您通过三层（设计模式）之类的东西， 那么将or缓存在 a 中的环境部分将是可行的方法。（应该足够了。）ReaderTIORefTVarReaderT YourEnv IOatomicModifyIORef'

Holmusk 链接将推荐该jwt软件包，但刚刚以另一种工作语言添加了 Google 的 OAuth2 证书的内存缓存，在 Haskell 中选择 JWT 库也看起来非常像功能权衡：

例如，jwt 明确声明它不检查exp过期时间戳，但据我所知，jose-jwt 它甚至没有解决exp它解码的过期时间戳。google-oauth2-jwt确实，并嵌入了端点（无论好坏，更难模拟），但除此之外没有提供很多人体工程学。（编辑：似乎确实可以处理过期问题，而且它也是我在 Hackage 中提到的最受欢迎的。）jose

于 2019-10-11T08:30:52.803 回答