The following code is designed to cache a (UTCTime, Text) value that keeps the Text token around until it expires, preventing needing to re-fetch the token each time this third party API is called. I feel like this duplication in APIDefaults and APIEnv could be removed, perhaps through a type parameter, though there may be a better way of doing this than storing the MVar inside APIDefaults.

APIError and getApiToken are just stubbed out as their detail is not relevant here, but in my code these are not implemented as they are below, so you can just ignore those.

data APIDefaults = APIDefaults
  { apidefManager :: Manager
  , apidefPool :: ConnectionPool
  , apidefTokenRef :: MVar (UTCTime, Text)

data APIEnv = APIEnv
  { apienvManager :: Manager
  , apienvPool :: ConnectionPool
  , apienvToken :: Text

data APIToken = APIToken
  { apiTokenAccessToken :: Text
  , apiTokenExpiresIn :: Int

data APIError

  :: MonadLogger m
  => MonadUnliftIO m
  => ReaderT APIEnv m (Either APIError a)
  -> ReaderT APIDefaults m (Either APIError a)
fireApiRequest req = runExceptT $ do
  env <- do
    t <- lift readCachedToken
    case t of
      Nothing -> fetchToken
      Just (savedExpiry, token) -> lift $ do
        updateTokenRef (savedExpiry, token)
        apd <- ask
        return (createAPIEnv apd token)
  ExceptT $ lift (runReaderT req env)

  :: MonadUnliftIO m
  => ReaderT APIDefaults m (Maybe (UTCTime, Text))
readCachedToken = runMaybeT $ do
  mv <- lift (asks apidefTokenRef)
  (savedExpiry, token) <- MaybeT $ liftIO (tryTakeMVar mv)
  now <- getCurrentTime
  guard (savedExpiry > now)
  return (savedExpiry, token)

  :: MonadUnliftIO m
  => (UTCTime, Text)
  -> ReaderT APIDefaults m ()
updateTokenRef value = do
  tokenRef <- asks apidefTokenRef
  void $ liftIO (tryPutMVar tokenRef value)

  :: MonadLogger m
  => MonadUnliftIO m
  => ExceptT APIError (ReaderT APIDefaults m) APIEnv
fetchToken = do
  now <- getCurrentTime
  adef <- lift ask
  token <- getApiToken
  let expiration = addUTCTime (fromIntegral $ apiTokenExpiresIn token) now
  lift $ updateTokenRef (expiration, apiTokenAccessToken token)
  return $ createAPIEnv adef (apiTokenAccessToken token)

getApiToken :: Monad m => m APIToken
getApiToken =
  return undefined

createAPIEnv :: APIDefaults -> Text -> APIEnv
createAPIEnv adef token =
  APIEnv (apidefManager adef) (apidefPool adef) token

1 Answer 1


I think the type of apidefTokenRef unnecessarily exposes internal details. Perhaps it would better to parameterize APIDefaults with a monad and hide the code that gets the token behind a monadic action, like this:

data APIDefaults m = APIDefaults
  { apidefManager :: Manager
  , apidefPool :: ConnectionPool
  , apidefTokenAction :: m APIToken 

I'm also making it return the APIToken type instead of Text. It's good to have a more precise type for it than Text, let's not fall prey to primitive obsession!

Now APIEnv seems a bit redundant. Instead of reading the token from APIEnv, functions in need of it can simply execute the token action each time. Or perhaps we could define a function like

sequenceToken :: Monad m => APIDefaults m -> m (APIDefaults Identity)
sequenceToken r = do
    token <- apidefTokenAction r
    pure (r { apidefTokenAction = Identity token })

But how to define the token action itself? Here I will indulge in a bit of over-abstraction and define this typeclass:

class Perishable p where
    lifetime :: p -> NominalDiffTime

for values which have a certain lifetime during which they are valid. Of course, APIToken will have an instance.

What type should the function which creates the token action have? It will be something like

makeRefresher :: Perishable p => IO p -> IO (IO p)

(Working in IO for simplicity, the real function would likely work in MonadUnliftIO.)

The argument is an action that obtains the perishable value. But why the outer IO in the result? because makeRefresher will have to set up some reference—like an MVar—that will be used across successive invocations of the resulting action:

makeRefresher obtain = do
    ref <- newMVar _initialValueHole
    return $ _actualTokenActionHole

What should be on the MVar? Perhaps a Maybe (UTCTime, p). It would be Nothing initially to signify that no perishable value has been obtained yet, and later it would become Just (someTime,somePerishable). We have the time of creation and the expected lifetime of the Perishable, so we can decide whether to return the current value or invoke obtain again.

Instead of Maybe, I would perhaps use my own type, for clarity:

data PerishableState p = NoPerishableYet
                       | PerishableObtainedAt UTCTime p

Also, I would try to manipulate the MVar with functions like modifyMVar_ to avoid deadlocks if there's an exception while obtaining the token.

One potential disadvantage of this solution is that the token "state" becomes harder to inspect because it's hidden behind an opaque action. Perhaps some logging effect should be added.


Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.