Изменяемая, но блокируемая структура данных в Haskell?

Question

Есть ли в * 1037 стандартная структура данных, которая может изменяться, как IORef, но, если требуется, также может быть "заблокирована", как MVar? Вот то, чего я пытаюсь достичь:

• Есть несколько потоков, вызывающих API на основе OAuth, и все они нуждаются в AccessToken
• Однако, AccessToken может истекает, и один из этих потоков узнает первым об этом (так как он получит ответ 401). Давайте назовем этот поток T1
• T1 немедленно вызовет функцию refreshToken, прежде чем повторить исходный вызов API. На этом этапе код должен убедиться в двух вещах:
  1. Все новые потоки блокируются при попытке прочитать AccessToken - до тех пор, пока он не обновится, и новый AccessToken не станет доступен в эта общая структура данных
  2. Все остальные потоки, которые могли получить 401 вскоре после T1, блокируются при вызове функции refreshToken.

Я уже использовал IORef для хранения AccessToken в изменяемой форме. Однако я не уверен, стоит ли мне использовать отдельный MVar для защиты одновременного доступа к функции refreshToken. Есть ли встроенная структура данных, которая это уже делает?

Answer 1

Я не знаком с этим конкретным c API, но мне кажется, что вы можете просто сохранить токен и счетчик, указывающий, сколько раз он обновлялся, в MVar. Один поток отвечает за первоначальное заполнение MVar токеном. Каждый поток, которому нужен токен, вызывает readMVar, чтобы получить его.

Когда поток обнаруживает, что токен истек, он вызывает tryTakeMVar, чтобы получить контроль над токеном. Если это не удается, тогда какой-то другой поток получает контроль, и этот возвращается к readMVar. Если это успешно, это проверяет, что счетчик - то, что он ожидал. Если это не так, какой-то другой поток уже обновил токен, и он просто возвращает его обратно. Если это так, то он обновляет токен, увеличивает счетчик и помещает их в MVar, прежде чем продолжить свой путь. Вы должны быть осторожны с безопасностью исключений, как обычно для блокировки протоколов; Есть несколько MVar функций, которые могут помочь с этим.

Как я уже описал, схема требует, чтобы один поток отвечал за инициализацию. Если вы хотите приобрести токен только тогда, когда он вам нужен, вам нужно сделать одну небольшую корректировку: сохранить Maybe в MVar, инициализированном Nothing.

. Следующий код предполагает функции acquireToken и refreshToken для первоначального получения токена и обновления sh существующего, соответственно. Очевидно, что вы можете настроить соответственно, если эти операции на самом деле выполняются одинаково. 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