Haskell 中可变但可锁定的数据结构？

Question

Haskell 中是否有一个标准数据结构，它像 一样可变IORef，但是，如果需要，也可以“锁定”，例如MVar？这是我想要实现的目标：

• 有多个线程调用基于 OAuth 的 API，它们都需要 AccessToken
• 但是，AccessToken可能会过期，并且其中一个线程将是第一个知道的（因为它将得到401响应）。让我们调用这个线程T1
• T1将refreshToken在重试原始 API 调用之前立即调用该函数。此时，代码需要确定两件事：
  1. 尝试读取AccessToken--时所有新线程都被阻塞，直到它被刷新，并且AccessToken在此共享数据结构中提供了一个新线程
  2. 所有其他线程，可能在401之后不久收到了T1，在调用refreshToken函数时被阻塞。

我已经使用 anIORef以AccessToken可变方式存储。但是，我不确定是否应该使用单独的MVar来保护对refreshToken函数的并发访问。是否有内置的数据结构可以做到这一点？

Answer 1

我不熟悉那个特定的 API，但在我看来，您可能只想将令牌和一个指示它刷新次数的计数器存储在MVar. 一个线程负责最初MVar用令牌填充。每个需要令牌调用的线程readMVar来获取它。

当线程发现令牌已过期时，它会调用tryTakeMVar以控制令牌。如果失败，则其他线程已取得控制权，而此线程将返回到readMVar. 如果成功，它会检查计数器是否符合预期。如果不是，则其他线程已经刷新了令牌，然后将其放回原处。如果是，那么它会刷新令牌，增加计数器，然后MVar在继续前进之前将它们放入。对于锁定协议，您需要像往常一样小心异常安全；有一些MVar功能可以帮助解决这个问题。

正如我所描述的，该方案要求一个线程负责初始化。如果您只想在第一次需要时获取令牌，则必须进行一个小调整：将 a 存储Maybe在 中MVar，初始化为Nothing。

以下代码分别假设函数acquireToken和refreshToken初始获取令牌并刷新现有令牌。显然，如果这些操作实际上以相同的方式完成，您可以相应地进行调整。在restore下面的情况下，刷新令牌使用涉及计算显着量; 我们不想让线程在这样做时无法杀死。

newtype TokBox = TB (MVar (Maybe (Word, AccessToken)))

newTokBox :: IO TokBox
newTokBox = TB <$> newMVar Nothing

-- | Get a (possibly expired) token and an action to use if that
-- token is expired. The result
-- should only be used once.
getToken :: TokBox -> IO (AccessToken, IO ())
getToken tb@(TB mv) = do
  contents <- readMVar mv
  case contents of
    Nothing -> refresh Nothing tb
    Just (_, t) -> pure (t, refresh contents tb)

-- Refresh the access token, expecting the MVar to have particular contents.
refresh :: Maybe (Word, AccessToken) -> TokBox -> IO ()
refresh old (TB mv) =
  mask $ \restore ->
    tryTakeMVar mv >>= \case
      -- Another thread is refreshing
      Nothing -> pure ()
      Just cont
        -- Another thread refreshed; we restore the MVar
        | not $ sameContents cont old
        = putMVar mv cont
        | otherwise
        = (restore $ case cont of
             Nothing -> do
               tok <- acquireToken
               putMVar mv (Just (0, tok))
             Just (count, tok) -> do
               tok' <- refreshToken tok
               putMVar mv (Just (count + 1, tok')))
                `onException`
                  putMVar cont

sameContents :: Maybe (Word, a) -> Maybe (Word, b) -> Bool
sameContents Nothing Nothing = True
sameContents (Just (m, _)) (Just (n, _)) = m == n
sameContents _ _ = False