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

【问题标题】：Mutable, but lockable, data-structure in Haskell?Haskell 中的可变但可锁定的数据结构？
【发布时间】：2020-01-20 02:18:45
【问题描述】：

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

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

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

【问题讨论】：

标签： haskell concurrency

【解决方案1】：

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

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

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

【讨论】：