Haskell - Caching third party API token across requests

Question

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
fireApiRequest
 :: 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)
readCachedToken
 :: 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)
updateTokenRef
 :: MonadUnliftIO m
 => (UTCTime, Text)
 -> ReaderT APIDefaults m ()
updateTokenRef value = do
 tokenRef <- asks apidefTokenRef
 void $ liftIO (tryPutMVar tokenRef value)
fetchToken
 :: 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

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.