diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,24 +1,21 @@ -# async-refresh-tokens +# async-refresh-tokens [![Hackage version](https://img.shields.io/hackage/v/async-refresh-tokens.svg?label=Hackage)](https://hackage.haskell.org/package/async-refresh-tokens) [![Stackage version](https://www.stackage.org/package/async-refresh-tokens/badge/lts?label=Stackage)](https://www.stackage.org/package/async-refresh-tokens) [![Build Status](https://travis-ci.org/mtesseract/async-refresh-tokens.svg?branch=master)](https://travis-ci.org/mtesseract/async-refresh-tokens) -About -===== +### About This is Haskell library built on top of the async-refresh package implementing the logic for refreshing of expiring access tokens. -Usage -===== +### Usage -- Create new token types. Using the `DataKinds` extension we can do - this via `data MyAppTokens = TokenFoo | TokenBar`. +- Create new token types. - Make the tokens be instances of the `IsToken` type classes by defining the `tokenScopes` method and (optionally) `tokenName` (a human readable label for this token). -- Create new token stores (which are basically `TVar's containing the - tokens wrapped in `Either SomeException`) using - `newEmptyTokenStore`. +- Use `newEmptyTokenStore` to create a new token stores (token stores + are basically `TVar`s containing the tokens wrapped in `Either + SomeException`). - Create a new configuration by adjusting `defaultTokenConf` using the functions `tokenConfAddRequest` and `tokenConfSetFactor`. The @@ -29,22 +26,22 @@ - Use `newTokenRefresher` to initiate token refreshing for each registered token refreshing request. -Example -======= +- To use the current token, extract it from the `TVar` using + `readTVar` (and pattern matching on `Right`). +### Example + ``` -{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} -data MyAppTokens = TokenFoo | TokenBar +data TokenFoo -instance IsToken 'TokenFoo where +instance IsToken TokenFoo where tokenScopes _ = ["foo.read", "foo.write"] -createTokenStoreFoo :: IO (TokenStore 'TokenFoo) -createTokenStoreFoo = runStderrLoggingT $ do - tokenFoo <- newEmptyTokenStore (Proxy :: Proxy 'TokenFoo) +createTokenStoreFoo :: LoggingT IO (TokenStore TokenFoo) +createTokenStoreFoo = do + tokenFoo <- newEmptyTokenStore (Proxy :: Proxy TokenFoo) let conf = defaultTokenConf & tokenConfAddRequest (RequestToken tokenFoo actionFoo) _ <- newTokenRefresher conf diff --git a/async-refresh-tokens.cabal b/async-refresh-tokens.cabal --- a/async-refresh-tokens.cabal +++ b/async-refresh-tokens.cabal @@ -1,5 +1,5 @@ name: async-refresh-tokens -version: 0.1.0 +version: 0.2.0.0 synopsis: Package implementing core logic for refreshing of expiring access tokens description: This package can be used for renewal of expiring access tokens according to user-provided actions. Tokens will be stored in a @@ -23,11 +23,12 @@ , Control.Concurrent.Async.Refresh.Tokens.Prelude , Control.Concurrent.Async.Refresh.Tokens.Conf build-depends: base >= 4.7 && < 5 - , async-refresh + , async-refresh >= 0.2.0.2 , monad-logger , lifted-async , stm - , lens + , microlens >= 0.4 + , microlens-th >= 0.4 , text , monad-control , safe-exceptions diff --git a/src/Control/Concurrent/Async/Refresh/Tokens.hs b/src/Control/Concurrent/Async/Refresh/Tokens.hs --- a/src/Control/Concurrent/Async/Refresh/Tokens.hs +++ b/src/Control/Concurrent/Async/Refresh/Tokens.hs @@ -44,7 +44,7 @@ import Control.Concurrent.Async.Refresh.Tokens.Conf import qualified Control.Concurrent.Async.Refresh.Tokens.Lenses as Lens import Control.Concurrent.Async.Refresh.Tokens.Types -import Control.Lens +import Lens.Micro -- | Start a new token refresher for the provided configuration. -- Returns a 'TokenRefresher' handle representing the running token diff --git a/src/Control/Concurrent/Async/Refresh/Tokens/Conf.hs b/src/Control/Concurrent/Async/Refresh/Tokens/Conf.hs --- a/src/Control/Concurrent/Async/Refresh/Tokens/Conf.hs +++ b/src/Control/Concurrent/Async/Refresh/Tokens/Conf.hs @@ -19,7 +19,7 @@ import qualified Control.Concurrent.Async.Refresh.Tokens.Lenses as Lens import Control.Concurrent.Async.Refresh.Tokens.Types -import Control.Lens +import Lens.Micro -- | Produce default token configuration. defaultTokenConf :: TokenConf m diff --git a/src/Control/Concurrent/Async/Refresh/Tokens/Lenses.hs b/src/Control/Concurrent/Async/Refresh/Tokens/Lenses.hs --- a/src/Control/Concurrent/Async/Refresh/Tokens/Lenses.hs +++ b/src/Control/Concurrent/Async/Refresh/Tokens/Lenses.hs @@ -15,7 +15,7 @@ module Control.Concurrent.Async.Refresh.Tokens.Lenses where -import Control.Lens +import Lens.Micro.TH import Control.Concurrent.Async.Refresh.Tokens.Types makeFields ''TokenConf diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} module Main where @@ -16,24 +14,29 @@ import Test.Framework.Providers.HUnit (testCase) import Test.HUnit ((@?=)) -data TestTokens = TokenFoo | TokenBar +data TokenFoo -instance IsToken 'TokenFoo where - tokenScopes _ = ["foo.read"] +instance IsToken TokenFoo where + tokenScopes _ = ["foo.read", "foo.write"] -oneTimeRefresh :: IO () -oneTimeRefresh = runStderrLoggingT $ do - tokenFoo <- newEmptyTokenStore (Proxy :: Proxy 'TokenFoo) +createTokenStoreFoo :: LoggingT IO (TokenStore TokenFoo) +createTokenStoreFoo = do + tokenFoo <- newEmptyTokenStore (Proxy :: Proxy TokenFoo) let conf = defaultTokenConf & tokenConfAddRequest (RequestToken tokenFoo actionFoo) _ <- newTokenRefresher conf - liftIO $ threadDelay (10 ^ 6 + 10 ^ 5) - (Right token) <- liftIO . atomically $ readTVar tokenFoo - liftIO $ token @?= Token "foo" + return tokenFoo where actionFoo :: (MonadIO m, IsToken t) => m (RefreshResult (Token t)) actionFoo = - return $ RefreshResult (Token "foo") Nothing + 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