github-app-token 0.0.0.1 → 0.0.1.1

raw patch · 5 files changed

+163/−2 lines, 5 filesdep +hspecPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−1
• github-app-token.cabal +36/−1
• src/GitHub/App/Token/Refresh.hs +70/−0
• tests/GitHub/App/Token/RefreshSpec.hs +51/−0
• tests/Main.hs +1/−0

@@ -1,4 +1,8 @@-## [_Unreleased_](https://github.com/freckle/github-app-token/compare/v0.0.0.1...main)+## [_Unreleased_](https://github.com/freckle/github-app-token/compare/v0.0.1.1...main)++## [v0.0.1.0](https://github.com/freckle/github-app-token/tree/v0.0.1.1)++- Add `GitHub.App.Token.Refresh`  ## [v0.0.0.1](https://github.com/freckle/github-app-token/tree/v0.0.0.1) 

@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            github-app-token-version:         0.0.0.1+version:         0.0.1.1 license:         MIT license-file:    LICENSE maintainer:      Freckle Education@@ -25,6 +25,7 @@         GitHub.App.Token.Generate         GitHub.App.Token.JWT         GitHub.App.Token.Prelude+        GitHub.App.Token.Refresh      hs-source-dirs:     src     other-modules:      Paths_github_app_token@@ -90,6 +91,40 @@         lens-aeson >=1.2.2,         markdown-unlit >=0.5.1,         text >=1.2.5.0++    if impl(ghc >=9.8)+        ghc-options:+            -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures++test-suite spec+    type:               exitcode-stdio-1.0+    main-is:            Main.hs+    hs-source-dirs:     tests+    other-modules:+        GitHub.App.Token.RefreshSpec+        Paths_github_app_token++    default-language:   GHC2021+    default-extensions:+        DataKinds DeriveAnyClass DerivingVia DerivingStrategies+        DuplicateRecordFields GADTs LambdaCase NoImplicitPrelude+        NoMonomorphismRestriction OverloadedRecordDot OverloadedStrings+        RecordWildCards TypeFamilies++    ghc-options:+        -fignore-optim-changes -fwrite-ide-info -Weverything+        -Wno-all-missed-specialisations -Wno-missing-exported-signatures+        -Wno-missing-import-lists -Wno-missing-kind-signatures+        -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode+        -Wno-monomorphism-restriction -Wno-prepositive-qualified-module+        -Wno-safe -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N++    build-depends:+        base >=4.16.4.0 && <5,+        github-app-token,+        hspec >=2.9.7,+        time >=1.11.1.1,+        unliftio >=0.2.25.0      if impl(ghc >=9.8)         ghc-options:

@@ -0,0 +1,70 @@+module GitHub.App.Token.Refresh+  ( HasExpiresAt (..)+  , Refresh+  , refreshing+  , getRefresh+  , cancelRefresh+  ) where++import GitHub.App.Token.Prelude++import Control.Monad (forever)+import Data.Time (getCurrentTime)+import Data.Void (Void)+import GitHub.App.Token.Generate (AccessToken (..))+import UnliftIO (MonadUnliftIO)+import UnliftIO.Async (Async, async, cancel)+import UnliftIO.Concurrent (threadDelay)+import UnliftIO.IORef (IORef, newIORef, readIORef, writeIORef)++class HasExpiresAt a where+  expiresAt :: a -> UTCTime++instance HasExpiresAt AccessToken where+  expiresAt = (.expires_at)++data Refresh a = Refresh+  { ref :: IORef a+  , thread :: Async Void+  }++-- | Run an action to (e.g.) generate a token and create a thread to refresh it+--+-- 'refreshing' will create an initial token and a thread that checks its+-- 'expires_at' on a loop. When it has expired, the action is used again to+-- replace the token.+--+-- @+-- ref <- 'refreshing' $ 'generateInstallationToken' creds installationId+-- @+--+-- Use 'getRefresh' to access the (possibly) updated token.+--+-- @+-- for_ repos $ \repo -> do+--   token <- 'getRefresh'+--   makeSomeRequest token repo+-- @+--+-- If you can't rely on program exit to clean up this background thread, you can+-- manually cancel it:+--+-- @+-- 'cancelRefresh' ref+-- @+refreshing :: (MonadUnliftIO m, HasExpiresAt a) => m a -> m (Refresh a)+refreshing f = do+  x <- f+  ref <- newIORef x+  thread <- async $ forever $ do+    threadDelay $ round @Double $ 0.5 * 1000000 -- 0.5s+    now <- liftIO getCurrentTime+    isExpired <- (<= now) . expiresAt <$> readIORef ref+    when isExpired $ writeIORef ref =<< f+  pure Refresh {ref, thread}++getRefresh :: MonadIO m => Refresh a -> m a+getRefresh = readIORef . (.ref)++cancelRefresh :: MonadIO m => Refresh a -> m ()+cancelRefresh = cancel . (.thread)

@@ -0,0 +1,51 @@+module GitHub.App.Token.RefreshSpec+  ( spec+  ) where++import GitHub.App.Token.Prelude++import Data.Time (addUTCTime, getCurrentTime)+import GitHub.App.Token.Refresh+import Test.Hspec+import UnliftIO.Concurrent (threadDelay)+import UnliftIO.IORef++data TestToken = TestToken+  { identifier :: Int+  , expires_at :: UTCTime+  }+  deriving stock (Eq, Show)++instance HasExpiresAt TestToken where+  expiresAt = (.expires_at)++updateTestToken :: IORef (Maybe TestToken) -> IO TestToken+updateTestToken ref = do+  now <- getCurrentTime+  mtoken <- readIORef ref++  let+    past = addUTCTime (negate 5) now+    future = addUTCTime 3600 now+    updated = case mtoken of+      Nothing -> TestToken {identifier = 1, expires_at = past}+      Just token -> TestToken {identifier = token.identifier + 1, expires_at = future}++  updated <$ writeIORef ref (Just updated)++spec :: Spec+spec = do+  describe "refreshing" $ do+    it "refreshes a token in backgound" $ do+      state <- newIORef Nothing+      ref <- refreshing $ updateTestToken state++      token1 <- getRefresh ref+      token1.identifier `shouldBe` 1++      threadDelay $ 1 * 1000000++      token2 <- getRefresh ref+      token2.identifier `shouldBe` 2++      cancelRefresh ref

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -Wno-missing-export-lists #-}