async-refresh-tokens-0.3.0.0: test/Spec.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Control.Concurrent                      (threadDelay)
import           Control.Concurrent.Async.Refresh.Tokens
import           Control.Concurrent.STM
import           Control.Monad.IO.Class
import           Control.Monad.Logger
import           Data.Function                           ((&))
import           Data.Proxy
import           Test.Framework                          (defaultMain,
                                                          testGroup)
import           Test.Framework.Providers.HUnit          (testCase)
import           Test.HUnit                              ((@?=))

data TokenFoo

instance IsToken TokenFoo where
  tokenScopes _ = ["foo.read", "foo.write"]

createTokenStoreFoo :: LoggingT IO (TokenStore TokenFoo)
createTokenStoreFoo = do
  tokenFoo <- newEmptyTokenStore
  let conf = defaultTokenConf
             & tokenConfAddRequest (RequestToken tokenFoo actionFoo)
  _ <- newTokenRefresher conf
  return tokenFoo

  where actionFoo :: (MonadIO m, IsToken t) => m (RefreshResult (Token t))
        actionFoo =
          return $ RefreshResult (Token "secret-foo-token") Nothing

oneTimeRefresh :: IO ()
oneTimeRefresh = runStderrLoggingT $ do
  tokenFoo <- createTokenStoreFoo
  liftIO $ threadDelay (10 ^ 6 + 10 ^ 5)
  (Right token) <- liftIO . atomically $ readTVar tokenFoo
  liftIO $ token @?= Token "secret-foo-token"

main :: IO ()
main = do
  putStrLn ""
  defaultMain tests

  where tests = [ testGroup "Test Suite" [ testCase "Simple one-time refreshing" oneTimeRefresh ] ]