From 1a6f4df194bb49c9a989caeb2ec3b53d2873ecc0 Mon Sep 17 00:00:00 2001 From: Maciej Bielecki Date: Fri, 28 Feb 2025 12:38:36 +0000 Subject: [PATCH 1/6] Github API success test --- package.yaml | 3 ++ src/CommitStatus.hs | 7 ++-- taskrunner.cabal | 3 ++ test/FakeGithubApi.hs | 71 +++++++++++++++++++++++++++++++++ test/Spec.hs | 59 +++++++++++++++++++-------- test/fake-github-key.pem | 28 +++++++++++++ test/t/github-commit-status.out | 7 ++++ test/t/github-commit-status.txt | 12 ++++++ 8 files changed, 171 insertions(+), 19 deletions(-) create mode 100644 test/FakeGithubApi.hs create mode 100644 test/fake-github-key.pem create mode 100644 test/t/github-commit-status.out create mode 100644 test/t/github-commit-status.txt diff --git a/package.yaml b/package.yaml index 85e1edb..019eaae 100644 --- a/package.yaml +++ b/package.yaml @@ -132,3 +132,6 @@ tests: - taskrunner - tasty - tasty-golden + - wai + - warp + - http-types diff --git a/src/CommitStatus.hs b/src/CommitStatus.hs index 827bd73..ecb4e9c 100644 --- a/src/CommitStatus.hs +++ b/src/CommitStatus.hs @@ -11,7 +11,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Network.HTTP.Client as HTTP import Network.HTTP.Client.TLS (tlsManagerSettings) -import System.Environment (getEnv) +import System.Environment (getEnv, lookupEnv) import Network.HTTP.Types.Status (Status(..)) import Data.Aeson.Decoding (eitherDecode) import qualified Data.Text as Text @@ -36,6 +36,7 @@ newtype InstallationTokenResponse = InstallationTokenResponse updateCommitStatus :: MonadIO m => AppState -> StatusRequest -> m () updateCommitStatus appState statusRequest = liftIO do -- Load environment variables + apiUrl <- fromMaybe "https://api.github.com" <$> lookupEnv "GITHUB_API_URL" appId <- getEnv "GITHUB_APP_ID" installationId <- getEnv "GITHUB_INSTALLATION_ID" privateKeyStr <- getEnv "GITHUB_APP_PRIVATE_KEY" @@ -59,7 +60,7 @@ updateCommitStatus appState statusRequest = liftIO do manager <- HTTP.newManager tlsManagerSettings -- Get the installation access token - let installUrl = "https://api.github.com/app/installations/" ++ installationId ++ "/access_tokens" + let installUrl = apiUrl <> "/app/installations/" ++ installationId ++ "/access_tokens" initRequest <- HTTP.parseRequest installUrl let request = initRequest { HTTP.method = "POST" @@ -80,7 +81,7 @@ updateCommitStatus appState statusRequest = liftIO do let accessToken = tokenResponse.token -- Prepare the status update request - let statusUrl = "https://api.github.com/repos/" ++ owner ++ "/" ++ repo ++ "/statuses/" ++ toString sha + let statusUrl = apiUrl <> "/repos/" ++ owner ++ "/" ++ repo ++ "/statuses/" ++ toString sha initStatusRequest <- HTTP.parseRequest statusUrl let statusReq = initStatusRequest { HTTP.method = "POST" diff --git a/taskrunner.cabal b/taskrunner.cabal index b50777a..6a22964 100644 --- a/taskrunner.cabal +++ b/taskrunner.cabal @@ -208,6 +208,7 @@ test-suite taskrunner-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: + FakeGithubApi Paths_taskrunner autogen-modules: Paths_taskrunner @@ -291,5 +292,7 @@ test-suite taskrunner-test , transformers , universum , unix + , wai + , warp , zstd default-language: Haskell2010 diff --git a/test/FakeGithubApi.hs b/test/FakeGithubApi.hs new file mode 100644 index 0000000..84eae6b --- /dev/null +++ b/test/FakeGithubApi.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecursiveDo #-} + +module FakeGithubApi (Server, start, stop, clearOutput, getOutput) where + +import Universum + +import Network.Wai +import qualified Network.Wai.Handler.Warp as Warp +import Network.HTTP.Types (status200, status201, status400, status404, methodPost) +import Data.Aeson (encode, object, (.=)) + +import Control.Concurrent (forkIO, ThreadId, killThread) + +-- Mock handler function +app :: Server -> Application +app server req respond = do + let path = pathInfo req + case path of + ["app", "installations", instId, "access_tokens"] -> + handleAccessTokenRequest server instId req respond + ["repos", owner, repo, "statuses", commitSha] -> + handleCommitStatusRequest server owner repo commitSha req respond + _ -> respond $ responseLBS status404 [] "Not Found" + +handleAccessTokenRequest :: Server -> Text -> Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived +handleAccessTokenRequest server instId req respond = + if requestMethod req == methodPost + then do + addOutput server $ "Requested access token for installation " <> instId + respond $ responseLBS status200 [("Content-Type", "application/json")] + (encode $ object ["token" .= ("mock-access-token" :: Text), "installation_id" .= instId]) + else respond $ responseLBS status400 [] "Bad Request" + +handleCommitStatusRequest :: Server -> Text -> Text -> Text -> Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived +handleCommitStatusRequest server owner repo commitSha req respond = + if requestMethod req == methodPost + then do + body <- strictRequestBody req + -- Note: commit SHA omitted because it's nondeterministic + addOutput server $ "Updated commit status for " <> owner <> "/" <> repo <> " to " <> decodeUtf8 body + respond $ responseLBS status201 [("Content-Type", "application/json")] + (encode $ object ["state" .= ("success" :: Text), "sha" .= commitSha, "repository" .= repo, "owner" .= owner]) + else respond $ responseLBS status400 [] "Bad Request" + +data Server = Server + { tid :: ThreadId + , output :: IORef [Text] + } + +start :: Int -> IO Server +start port = mdo + started <- newEmptyMVar + output <- newIORef [] + let settings = Warp.setPort port $ Warp.setBeforeMainLoop (putMVar started ()) Warp.defaultSettings + tid <- forkIO $ Warp.runSettings settings $ app server + let server = Server {tid, output} + takeMVar started + pure server + +stop :: Server -> IO () +stop (Server {tid}) = killThread tid + +addOutput :: Server -> Text -> IO () +addOutput (Server {output}) msg = modifyIORef output (msg :) + +clearOutput :: Server -> IO () +clearOutput (Server {output}) = writeIORef output [] + +getOutput :: Server -> IO [Text] +getOutput (Server {output}) = reverse <$> readIORef output diff --git a/test/Spec.hs b/test/Spec.hs index 0fff0ef..c1aaf07 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE LambdaCase #-} + import Universum import Test.Tasty (defaultMain, TestTree, testGroup) +import qualified Test.Tasty as Tasty import Test.Tasty.Golden (findByExtension, goldenVsStringDiff) import qualified Data.ByteString.Lazy as LBS import System.FilePath (takeBaseName, replaceExtension) @@ -23,10 +26,15 @@ import Amazonka.S3.Types.Delete (Delete(..)) import Amazonka.S3.ListObjectsV2 (ListObjectsV2Response(..)) import Amazonka.S3.Types.ObjectIdentifier (newObjectIdentifier) import Amazonka.S3.Types.Object (Object(..)) +import qualified FakeGithubApi as FakeGithubApi +import qualified Data.Text as Text main :: IO () main = defaultMain =<< goldenTests +fakeGithubPort :: Int +fakeGithubPort = 12345 + goldenTests :: IO TestTree goldenTests = do skipSlow <- (==Just "1") <$> lookupEnv "SKIP_SLOW_TESTS" @@ -34,18 +42,23 @@ goldenTests = do let inputFiles | skipSlow = filter (\filename -> not ("/slow/" `isInfixOf` filename)) inputFiles0 | otherwise = inputFiles0 - return $ testGroup "tests" - [ goldenVsStringDiff - (takeBaseName inputFile) -- test name - (\ref new -> ["diff", "-u", ref, new]) - outputFile -- golden file path - (System.IO.readFile inputFile >>= runTest) -- action whose result is tested - | inputFile <- inputFiles - , let outputFile = replaceExtension inputFile ".out" - ] - -runTest :: String -> IO LBS.ByteString -runTest source = do + pure $ Tasty.withResource (FakeGithubApi.start fakeGithubPort) FakeGithubApi.stop \fakeGithubServer -> + testGroup "tests" + [ goldenVsStringDiff + (takeBaseName inputFile) -- test name + (\ref new -> ["diff", "-u", ref, new]) + outputFile -- golden file path + (do + server <- fakeGithubServer + source <- System.IO.readFile inputFile + runTest server source + ) + | inputFile <- inputFiles + , let outputFile = replaceExtension inputFile ".out" + ] + +runTest :: FakeGithubApi.Server -> String -> IO LBS.ByteString +runTest fakeGithubServer source = do withSystemTempDirectory "testrunner-test" \dir -> do let options = getOptions (toText source) @@ -64,7 +77,10 @@ runTest source = do | otherwise = proc "bash" bashArgs - maybeWithBucket options \s3ExtraEnv -> + maybeWithBucket options \s3ExtraEnv -> do + -- Generate a fake GitHub key with command: openssl genrsa -out test/fake-github-key.pem 2048 + githubKey <- System.IO.readFile "test/fake-github-key.pem" + withCreateProcess initialProc { std_out = UseHandle pipeWrite, std_err = UseHandle pipeWrite , env = Just @@ -77,6 +93,14 @@ runTest source = do , ("GIT_AUTHOR_EMAIL", "test@example.com") , ("GIT_COMMITTER_NAME", "test") , ("GIT_COMMITTER_EMAIL", "test@example.com") + + , ("GITHUB_API_URL", "http://localhost:" <> show fakeGithubPort) + , ("GITHUB_APP_ID", "666") + , ("GITHUB_INSTALLATION_ID", "123") + , ("GITHUB_APP_PRIVATE_KEY", githubKey) + , ("GITHUB_REPOSITORY_OWNER", "fakeowner") + , ("GITHUB_REPOSITORY", "fakerepo") + , ("PATH", path) ] <> s3ExtraEnv) , cwd = Just dir @@ -88,10 +112,13 @@ runTest source = do exitCode <- waitForProcess processHandle checkFiles <- - forM options.checkFileGlobs \glob' -> - if glob' == "output" then + forM options.checkFileGlobs \case + "output" -> pure ["-- output:\n" <> output] - else do + "github" -> do + out <- FakeGithubApi.getOutput fakeGithubServer + pure ["-- github:\n" <> encodeUtf8 (Text.intercalate "\n" out)] + glob' -> do files <- globDir1 (Glob.compile (toString glob')) dir forM files \file -> do content <- LBS.readFile file diff --git a/test/fake-github-key.pem b/test/fake-github-key.pem new file mode 100644 index 0000000..d7d9c22 --- /dev/null +++ b/test/fake-github-key.pem @@ -0,0 +1,28 @@ +-----BEGIN PRIVATE KEY----- +MIIEvQIBADANBgkqhkiG9w0BAQEFAASCBKcwggSjAgEAAoIBAQCbLMCqEBrdiUqy +PQdj2mo7R47u+waJmCJyesLIkVACQbiEPIEnt6Apx1x2Ama9+bET6gutD8AcVovJ +NOeygcfJvhYftFhvXQp9XKeU6Fa6cHMetV42Pmw5zchn3inU+1a9E+Ea93hZoyiq +PZVjh0H31ZnkqsN5Z4EHVeEPa0AZ4NfM+CYng54U9z+kIDymcYEj0W0KINa4NLna +JsegxVb+OIx+qROveNKjdu4JEhsyHLe40QjcbLOVNCbY4+NKlezlbmyY8gjHFr1L +yG6YXdFdhyAR03SNpQRLGhr9Qs+SFzEOfpINzSRWDtVydGlHQ5qNJ6kgcxfZLBD8 +tqBPZSgPAgMBAAECggEALNjxUfVXnmF4mizzPtO4UiurTrx0Nj4m7ok2VHtS8WQH +LQjDlzQF8S0yNtUY1p0cpZHGEB12O3pz6hIFSN0jXdY3VLBtwrnUN0kZEftYXYf0 +bZKjiO/fnZEw83wNAQYnGnxtWbreKKH0NceYrmxAD53HXYRQ/HyCmRkj863el9ul +YsgNM3hwkKz4+CB/3cOHqA/C5LLieQSaGqwXVfUTjdkP7nq4UkLfw3Qz1Xbny+B3 +GUexyVmw7Dg+8VVCqT+nl1P9TOP/a3TVZkYMnVRL6IJiQ0+aHawn3IToJsFg8lSH +BBMp6yLj7S1AjNtAZKGV2tjc5mHoJvaWuE6DamhFQQKBgQC5mKFor3YVYyd6Ycnj +otXtugS+QZt6OgjOIVEBDnKwNM4siBrV6F/zYkkrbW2RFNnTB3nXrJc+6ozzr32m +o37s3my+ki1V7FukHV8JP8qMZUFBGcrEvjl/Pr5P4dgKiY50EuMH1y/u0CmEprvQ +rKReBEcCpgHudRSadWLW4zER4QKBgQDWCeFX58BHK0vqp9VhpaQ70ue29DvLFEn2 +5U/77kOn3npk1b6MiKAKs/e4gLWllL/p2HwWxtMBddvT3lgc9xI7MvqI99fRsOV/ +uR3mIa0G7A0DgX1t4I3eijFDmo05n5CuRQkjb64FjhjsDHNB5xSSoxaUyHGIa9pn +T7iCW8JX7wKBgARCXHHqlOsou18zn056Di7GdhVnrAnCCzGv0gwUKM2iaJjdBsCh +9JHBT6yPdlQ+BkGxijpI26+18kYlYNzSI7eL4zL8Z83w/qllgyjTLfLK4BR+Ywjg +1LD236c1p5+WSI6hYFRtu8vfOxSwPt8rFxqRPo/w/1pZlX918i68SAQBAoGAfwtW +SksxAg1c/meobFFZbnj9OMc3Ro9AZ+As3ajLV7TiiT+l3typwjCYdVdQenwUfcUV +wp85V8CRPuzW+DpfA+x6cRpLbBfH4UwLxzFt9pHeF5qgzLtg+hqkqy/ta6qewhIQ +HoyHipyRhmrNbuyudWuAV8eyO/too7HaHuZAMNkCgYEAgSFqmujO9d2e1dVzi49V +QJnLuXaP4q2ILYjnZ1qPcDB9K8yAG26tKRPPTpFeduyDZ7sZtP2gfWMxAiEagQFN +ym/Pi6qKi9tkFaX4Kk+fZCY/zxbafgEKhp0fi+YMGvTqK1Ao04sY3x9WOFInVvq0 +jUa+MWMXRYx+T1Cm88vnseI= +-----END PRIVATE KEY----- diff --git a/test/t/github-commit-status.out b/test/t/github-commit-status.out new file mode 100644 index 0000000..fa9a06e --- /dev/null +++ b/test/t/github-commit-status.out @@ -0,0 +1,7 @@ +-- output: +[mytask] stdout | Success +-- github: +Requested access token for installation 123 +Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":"not cached","state":"pending","target_url":null} +Requested access token for installation 123 +Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":null,"state":"success","target_url":null} \ No newline at end of file diff --git a/test/t/github-commit-status.txt b/test/t/github-commit-status.txt new file mode 100644 index 0000000..33597c9 --- /dev/null +++ b/test/t/github-commit-status.txt @@ -0,0 +1,12 @@ +# check output github +# no toplevel + +export TASKRUNNER_ENABLE_COMMIT_STATUS=1 + +git init -q +git commit --allow-empty -q -m "Initial commit" + +taskrunner -n mytask bash -e -c ' + snapshot -n --commit-status + echo Success +' From 8637b0f0f0c286d93a83c49be36223a526437a9b Mon Sep 17 00:00:00 2001 From: Maciej Bielecki Date: Fri, 28 Feb 2025 12:46:15 +0000 Subject: [PATCH 2/6] More tests --- test/t/github-commit-status-failure-nested.out | 10 ++++++++++ test/t/github-commit-status-failure-nested.txt | 16 ++++++++++++++++ test/t/github-commit-status-failure.out | 6 ++++++ test/t/github-commit-status-failure.txt | 13 +++++++++++++ test/t/github-commit-status-nested-partial.out | 7 +++++++ test/t/github-commit-status-nested-partial.txt | 17 +++++++++++++++++ test/t/github-commit-status-nested.out | 11 +++++++++++ test/t/github-commit-status-nested.txt | 15 +++++++++++++++ test/t/github-commit-status.out | 2 +- 9 files changed, 96 insertions(+), 1 deletion(-) create mode 100644 test/t/github-commit-status-failure-nested.out create mode 100644 test/t/github-commit-status-failure-nested.txt create mode 100644 test/t/github-commit-status-failure.out create mode 100644 test/t/github-commit-status-failure.txt create mode 100644 test/t/github-commit-status-nested-partial.out create mode 100644 test/t/github-commit-status-nested-partial.txt create mode 100644 test/t/github-commit-status-nested.out create mode 100644 test/t/github-commit-status-nested.txt diff --git a/test/t/github-commit-status-failure-nested.out b/test/t/github-commit-status-failure-nested.out new file mode 100644 index 0000000..110294a --- /dev/null +++ b/test/t/github-commit-status-failure-nested.out @@ -0,0 +1,10 @@ +-- output: +[othertask] stdout | FAIL +-- github: +Requested access token for installation 123 +Updated commit status for fakeowner/fakerepo to {"context":"othertask","description":"not cached","state":"pending","target_url":null} +Requested access token for installation 123 +Updated commit status for fakeowner/fakerepo to {"context":"othertask","description":null,"state":"failure","target_url":null} +Requested access token for installation 123 +Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":null,"state":"failure","target_url":null} +-- exit code: 1 diff --git a/test/t/github-commit-status-failure-nested.txt b/test/t/github-commit-status-failure-nested.txt new file mode 100644 index 0000000..53ff567 --- /dev/null +++ b/test/t/github-commit-status-failure-nested.txt @@ -0,0 +1,16 @@ +# check output github +# no toplevel + +export TASKRUNNER_ENABLE_COMMIT_STATUS=1 + +git init -q +git commit --allow-empty -q -m "Initial commit" + +taskrunner -n mytask bash -e -c ' + snapshot -n + taskrunner -n othertask bash -e -c " + snapshot -n --commit-status + echo FAIL + exit 1 + " +' diff --git a/test/t/github-commit-status-failure.out b/test/t/github-commit-status-failure.out new file mode 100644 index 0000000..151f764 --- /dev/null +++ b/test/t/github-commit-status-failure.out @@ -0,0 +1,6 @@ +-- output: +[mytask] stdout | FAIL +-- github: +Requested access token for installation 123 +Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":null,"state":"failure","target_url":null} +-- exit code: 1 diff --git a/test/t/github-commit-status-failure.txt b/test/t/github-commit-status-failure.txt new file mode 100644 index 0000000..fc8fdb2 --- /dev/null +++ b/test/t/github-commit-status-failure.txt @@ -0,0 +1,13 @@ +# check output github +# no toplevel + +export TASKRUNNER_ENABLE_COMMIT_STATUS=1 + +git init -q +git commit --allow-empty -q -m "Initial commit" + +taskrunner -n mytask bash -e -c ' + snapshot -n + echo FAIL + exit 1 +' diff --git a/test/t/github-commit-status-nested-partial.out b/test/t/github-commit-status-nested-partial.out new file mode 100644 index 0000000..435ecca --- /dev/null +++ b/test/t/github-commit-status-nested-partial.out @@ -0,0 +1,7 @@ +-- output: +[othertask] stdout | Success +-- github: +Requested access token for installation 123 +Updated commit status for fakeowner/fakerepo to {"context":"othertask","description":"not cached","state":"pending","target_url":null} +Requested access token for installation 123 +Updated commit status for fakeowner/fakerepo to {"context":"othertask","description":null,"state":"success","target_url":null} diff --git a/test/t/github-commit-status-nested-partial.txt b/test/t/github-commit-status-nested-partial.txt new file mode 100644 index 0000000..0c01834 --- /dev/null +++ b/test/t/github-commit-status-nested-partial.txt @@ -0,0 +1,17 @@ +# check output github +# no toplevel + +export TASKRUNNER_ENABLE_COMMIT_STATUS=1 + +git init -q +git commit --allow-empty -q -m "Initial commit" + +# Note: first task doesn't report success status (as opposed to github-commit-status-nested test) + +taskrunner -n mytask bash -e -c ' + snapshot -n + taskrunner -n othertask bash -e -c " + snapshot -n --commit-status + echo Success + " +' diff --git a/test/t/github-commit-status-nested.out b/test/t/github-commit-status-nested.out new file mode 100644 index 0000000..6dfb723 --- /dev/null +++ b/test/t/github-commit-status-nested.out @@ -0,0 +1,11 @@ +-- output: +[othertask] stdout | Success +-- github: +Requested access token for installation 123 +Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":"not cached","state":"pending","target_url":null} +Requested access token for installation 123 +Updated commit status for fakeowner/fakerepo to {"context":"othertask","description":"not cached","state":"pending","target_url":null} +Requested access token for installation 123 +Updated commit status for fakeowner/fakerepo to {"context":"othertask","description":null,"state":"success","target_url":null} +Requested access token for installation 123 +Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":null,"state":"success","target_url":null} diff --git a/test/t/github-commit-status-nested.txt b/test/t/github-commit-status-nested.txt new file mode 100644 index 0000000..f8d7c9d --- /dev/null +++ b/test/t/github-commit-status-nested.txt @@ -0,0 +1,15 @@ +# check output github +# no toplevel + +export TASKRUNNER_ENABLE_COMMIT_STATUS=1 + +git init -q +git commit --allow-empty -q -m "Initial commit" + +taskrunner -n mytask bash -e -c ' + snapshot -n --commit-status + taskrunner -n othertask bash -e -c " + snapshot -n --commit-status + echo Success + " +' diff --git a/test/t/github-commit-status.out b/test/t/github-commit-status.out index fa9a06e..6f677c7 100644 --- a/test/t/github-commit-status.out +++ b/test/t/github-commit-status.out @@ -4,4 +4,4 @@ Requested access token for installation 123 Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":"not cached","state":"pending","target_url":null} Requested access token for installation 123 -Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":null,"state":"success","target_url":null} \ No newline at end of file +Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":null,"state":"success","target_url":null} From 427a9abce75312d2dd9122433ca22f6dd16c7df8 Mon Sep 17 00:00:00 2001 From: Maciej Bielecki Date: Fri, 28 Feb 2025 13:00:10 +0000 Subject: [PATCH 3/6] Cache access token within one process --- src/App.hs | 1 + src/CommitStatus.hs | 87 ++++++++++++------- src/Types.hs | 16 ++++ test/Spec.hs | 5 +- .../t/github-commit-status-failure-nested.out | 1 - .../t/github-commit-status-nested-partial.out | 1 - test/t/github-commit-status-nested.out | 2 - test/t/github-commit-status.out | 1 - 8 files changed, 76 insertions(+), 38 deletions(-) diff --git a/src/App.hs b/src/App.hs index 2f8659e..377881c 100644 --- a/src/App.hs +++ b/src/App.hs @@ -145,6 +145,7 @@ main = do (subprocessStderrRead, subprocessStderr) <- createPipe appState <- AppState settings jobName buildId isToplevel <$> newIORef Nothing <*> newIORef Nothing <*> newIORef False <*> pure toplevelStderr <*> pure subprocessStderr <*> pure logFile + <*> newIORef Nothing logDebug appState $ "Running command: " <> show (args.cmd : args.args) logDebug appState $ " buildId: " <> show buildId diff --git a/src/CommitStatus.hs b/src/CommitStatus.hs index ecb4e9c..6e42004 100644 --- a/src/CommitStatus.hs +++ b/src/CommitStatus.hs @@ -16,7 +16,7 @@ import Network.HTTP.Types.Status (Status(..)) import Data.Aeson.Decoding (eitherDecode) import qualified Data.Text as Text import Utils (getCurrentCommit, logError, logDebug) -import Types (AppState) +import Types (AppState(..), GithubClient(..)) -- Define the data types for the status update data StatusRequest = StatusRequest @@ -33,8 +33,18 @@ newtype InstallationTokenResponse = InstallationTokenResponse } deriving (Show, Generic) deriving anyclass (FromJSON) -updateCommitStatus :: MonadIO m => AppState -> StatusRequest -> m () -updateCommitStatus appState statusRequest = liftIO do +getClient :: AppState -> IO GithubClient +getClient appState = do + mClient <- readIORef appState.githubClient + case mClient of + Just client -> pure client + Nothing -> do + client <- initClient appState + writeIORef appState.githubClient $ Just client + pure client + +initClient :: AppState -> IO GithubClient +initClient appState = do -- Load environment variables apiUrl <- fromMaybe "https://api.github.com" <$> lookupEnv "GITHUB_API_URL" appId <- getEnv "GITHUB_APP_ID" @@ -42,8 +52,8 @@ updateCommitStatus appState statusRequest = liftIO do privateKeyStr <- getEnv "GITHUB_APP_PRIVATE_KEY" owner <- getEnv "GITHUB_REPOSITORY_OWNER" repo <- getEnv "GITHUB_REPOSITORY" - - sha <- getCurrentCommit appState + -- Prepare the HTTP manager + manager <- HTTP.newManager tlsManagerSettings let privateKeyBytes = encodeUtf8 $ Text.replace "|" "\n" $ toText privateKeyStr let privateKey = fromMaybe (error "Invalid github key") $ readRsaSecret privateKeyBytes @@ -56,9 +66,6 @@ updateCommitStatus appState statusRequest = liftIO do } let jwt = encodeSigned (EncodeRSAPrivateKey privateKey) (mempty { alg = Just RS256 }) claims - -- Prepare the HTTP manager - manager <- HTTP.newManager tlsManagerSettings - -- Get the installation access token let installUrl = apiUrl <> "/app/installations/" ++ installationId ++ "/access_tokens" initRequest <- HTTP.parseRequest installUrl @@ -72,32 +79,50 @@ updateCommitStatus appState statusRequest = liftIO do } response <- HTTP.httpLbs request manager let mTokenResponse = eitherDecode @InstallationTokenResponse (HTTP.responseBody response) - case mTokenResponse of + accessToken <- case mTokenResponse of Left err -> do logError appState $ "CommitStatus: Failed to parse installation token response: " <> show err logError appState $ "CommitStatus: Response: " <> decodeUtf8 response.responseBody + + -- FIXME: handle the error better exitFailure - Right tokenResponse -> do - let accessToken = tokenResponse.token + Right tokenResponse -> + pure tokenResponse.token + - -- Prepare the status update request - let statusUrl = apiUrl <> "/repos/" ++ owner ++ "/" ++ repo ++ "/statuses/" ++ toString sha - initStatusRequest <- HTTP.parseRequest statusUrl - let statusReq = initStatusRequest - { HTTP.method = "POST" - , HTTP.requestHeaders = - [ ("Authorization", "Bearer " <> TE.encodeUtf8 accessToken) - , ("Accept", "application/vnd.github.v3+json") - , ("Content-Type", "application/json") - , ("User-Agent", "restaumatic-bot") - ] - , HTTP.requestBody = HTTP.RequestBodyLBS $ encode statusRequest + pure $ GithubClient { apiUrl = T.pack apiUrl + , appId = T.pack appId + , installationId = T.pack installationId + , privateKey = T.pack privateKeyStr + , owner = T.pack owner + , repo = T.pack repo + , manager = manager + , accessToken = accessToken } - statusResponse <- HTTP.httpLbs statusReq manager - if statusResponse.responseStatus.statusCode == 201 - then - logDebug appState "Commit status updated successfully" - else do - logError appState $ "CommitStatus: Failed to update commit status: " <> show statusResponse - logError appState $ "CommitStatus: Response: " <> decodeUtf8 response.responseBody - exitFailure + +updateCommitStatus :: MonadIO m => AppState -> StatusRequest -> m () +updateCommitStatus appState statusRequest = liftIO do + client <- getClient appState + sha <- getCurrentCommit appState + + -- Prepare the status update request + let statusUrl = toString client.apiUrl <> "/repos/" ++ toString client.owner ++ "/" ++ toString client.repo ++ "/statuses/" ++ toString sha + initStatusRequest <- HTTP.parseRequest statusUrl + let statusReq = initStatusRequest + { HTTP.method = "POST" + , HTTP.requestHeaders = + [ ("Authorization", "Bearer " <> TE.encodeUtf8 client.accessToken) + , ("Accept", "application/vnd.github.v3+json") + , ("Content-Type", "application/json") + , ("User-Agent", "restaumatic-bot") + ] + , HTTP.requestBody = HTTP.RequestBodyLBS $ encode statusRequest + } + statusResponse <- HTTP.httpLbs statusReq client.manager + if statusResponse.responseStatus.statusCode == 201 + then + logDebug appState "Commit status updated successfully" + else do + logError appState $ "CommitStatus: Failed to update commit status: " <> show statusResponse + logError appState $ "CommitStatus: Response: " <> decodeUtf8 statusResponse.responseBody + exitFailure diff --git a/src/Types.hs b/src/Types.hs index 7044cdd..24c13c0 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -3,6 +3,7 @@ module Types where import Universum import SnapshotCliArgs (SnapshotCliArgs) import Data.Aeson (FromJSON, ToJSON) +import qualified Network.HTTP.Client as HTTP data Settings = Settings { stateDirectory :: FilePath @@ -48,4 +49,19 @@ data AppState = AppState , toplevelStderr :: Handle , subprocessStderr :: Handle , logOutput :: Handle + + -- | Lazily initialized Github client + , githubClient :: IORef (Maybe GithubClient) + } + +-- Unfortunately the type has to live there due to circular dependencies (AppState -> GithubClient -> AppState) +data GithubClient = GithubClient + { apiUrl :: Text + , appId :: Text + , installationId :: Text + , privateKey :: Text + , owner :: Text + , repo :: Text + , manager :: HTTP.Manager + , accessToken :: Text } diff --git a/test/Spec.hs b/test/Spec.hs index c1aaf07..7f6a710 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -27,7 +27,6 @@ import Amazonka.S3.ListObjectsV2 (ListObjectsV2Response(..)) import Amazonka.S3.Types.ObjectIdentifier (newObjectIdentifier) import Amazonka.S3.Types.Object (Object(..)) import qualified FakeGithubApi as FakeGithubApi -import qualified Data.Text as Text main :: IO () main = defaultMain =<< goldenTests @@ -50,6 +49,8 @@ goldenTests = do outputFile -- golden file path (do server <- fakeGithubServer + FakeGithubApi.clearOutput server + source <- System.IO.readFile inputFile runTest server source ) @@ -117,7 +118,7 @@ runTest fakeGithubServer source = do pure ["-- output:\n" <> output] "github" -> do out <- FakeGithubApi.getOutput fakeGithubServer - pure ["-- github:\n" <> encodeUtf8 (Text.intercalate "\n" out)] + pure ["-- github:\n" <> encodeUtf8 (foldMap (<>"\n") out)] glob' -> do files <- globDir1 (Glob.compile (toString glob')) dir forM files \file -> do diff --git a/test/t/github-commit-status-failure-nested.out b/test/t/github-commit-status-failure-nested.out index 110294a..15e1923 100644 --- a/test/t/github-commit-status-failure-nested.out +++ b/test/t/github-commit-status-failure-nested.out @@ -3,7 +3,6 @@ -- github: Requested access token for installation 123 Updated commit status for fakeowner/fakerepo to {"context":"othertask","description":"not cached","state":"pending","target_url":null} -Requested access token for installation 123 Updated commit status for fakeowner/fakerepo to {"context":"othertask","description":null,"state":"failure","target_url":null} Requested access token for installation 123 Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":null,"state":"failure","target_url":null} diff --git a/test/t/github-commit-status-nested-partial.out b/test/t/github-commit-status-nested-partial.out index 435ecca..a38abf4 100644 --- a/test/t/github-commit-status-nested-partial.out +++ b/test/t/github-commit-status-nested-partial.out @@ -3,5 +3,4 @@ -- github: Requested access token for installation 123 Updated commit status for fakeowner/fakerepo to {"context":"othertask","description":"not cached","state":"pending","target_url":null} -Requested access token for installation 123 Updated commit status for fakeowner/fakerepo to {"context":"othertask","description":null,"state":"success","target_url":null} diff --git a/test/t/github-commit-status-nested.out b/test/t/github-commit-status-nested.out index 6dfb723..d8a3191 100644 --- a/test/t/github-commit-status-nested.out +++ b/test/t/github-commit-status-nested.out @@ -5,7 +5,5 @@ Requested access token for installation 123 Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":"not cached","state":"pending","target_url":null} Requested access token for installation 123 Updated commit status for fakeowner/fakerepo to {"context":"othertask","description":"not cached","state":"pending","target_url":null} -Requested access token for installation 123 Updated commit status for fakeowner/fakerepo to {"context":"othertask","description":null,"state":"success","target_url":null} -Requested access token for installation 123 Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":null,"state":"success","target_url":null} diff --git a/test/t/github-commit-status.out b/test/t/github-commit-status.out index 6f677c7..100f0ac 100644 --- a/test/t/github-commit-status.out +++ b/test/t/github-commit-status.out @@ -3,5 +3,4 @@ -- github: Requested access token for installation 123 Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":"not cached","state":"pending","target_url":null} -Requested access token for installation 123 Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":null,"state":"success","target_url":null} From 6bde1fea02e8172852639c9a10aab5c72e07b256 Mon Sep 17 00:00:00 2001 From: Maciej Bielecki Date: Fri, 28 Feb 2025 14:01:54 +0000 Subject: [PATCH 4/6] Reuse cached token in subprocesses --- src/App.hs | 49 +++++++------ src/CommitStatus.hs | 71 +++++++++++-------- test/FakeGithubApi.hs | 7 +- .../t/github-commit-status-failure-nested.out | 1 - test/t/github-commit-status-nested.out | 1 - 5 files changed, 73 insertions(+), 56 deletions(-) diff --git a/src/App.hs b/src/App.hs index 377881c..d90e3e5 100644 --- a/src/App.hs +++ b/src/App.hs @@ -1,5 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE RecursiveDo #-} {-# OPTIONS_GHC -Wno-ambiguous-fields #-} module App where @@ -39,6 +40,7 @@ import Utils import qualified RemoteCache import RemoteCache (getLatestBuildHash) import CommitStatus (updateCommitStatus, StatusRequest (..)) +import qualified CommitStatus import qualified System.Process as Process import Control.Monad.EarlyReturn (withEarlyReturn, earlyReturn) import Data.Time.Format.ISO8601 (iso8601Show) @@ -124,28 +126,35 @@ main = do responsePipeReadFd <- handleToFd responsePipeRead hSetBuffering responsePipeWrite LineBuffering - parentEnv <- getEnvironment - - cwd <- getCurrentDirectory - - -- TODO: handle spawn error here - -- TODO: should we use withCreateProcess? - -- TODO: should we use delegate_ctlc or DIY? See https://hackage.haskell.org/package/process-1.6.20.0/docs/System-Process.html#g:4 - -- -> We should DIY because we need to flush stream etc. - (Nothing, Just stdoutPipe, Just stderrPipe, processHandle) <- Process.createProcess - (proc args.cmd args.args) { std_in = UseHandle devnull, std_out = CreatePipe - , std_err = CreatePipe - , env=Just $ nubOrdOn fst $ - [ ("BASH_FUNC_snapshot%%", "() {\n" <> $(embedStringFile "src/snapshot.sh") <> "\n}") - , ("_taskrunner_request_pipe", show requestPipeWriteFd) - , ("_taskrunner_response_pipe", show responsePipeReadFd) - ] <> parentEnv - } + -- Recursive: AppState is used before process is started (mostly for logging) + rec + + appState <- AppState settings jobName buildId isToplevel <$> newIORef Nothing <*> newIORef Nothing <*> newIORef False <*> pure toplevelStderr <*> pure subprocessStderr <*> pure logFile + <*> newIORef Nothing + + when isToplevel do + -- Note: potentially sets env for subprocesses + void $ CommitStatus.getClient appState - (subprocessStderrRead, subprocessStderr) <- createPipe + parentEnv <- getEnvironment + + cwd <- getCurrentDirectory + + -- TODO: handle spawn error here + -- TODO: should we use withCreateProcess? + -- TODO: should we use delegate_ctlc or DIY? See https://hackage.haskell.org/package/process-1.6.20.0/docs/System-Process.html#g:4 + -- -> We should DIY because we need to flush stream etc. + (Nothing, Just stdoutPipe, Just stderrPipe, processHandle) <- Process.createProcess + (proc args.cmd args.args) { std_in = UseHandle devnull, std_out = CreatePipe + , std_err = CreatePipe + , env=Just $ nubOrdOn fst $ + [ ("BASH_FUNC_snapshot%%", "() {\n" <> $(embedStringFile "src/snapshot.sh") <> "\n}") + , ("_taskrunner_request_pipe", show requestPipeWriteFd) + , ("_taskrunner_response_pipe", show responsePipeReadFd) + ] <> parentEnv + } - appState <- AppState settings jobName buildId isToplevel <$> newIORef Nothing <*> newIORef Nothing <*> newIORef False <*> pure toplevelStderr <*> pure subprocessStderr <*> pure logFile - <*> newIORef Nothing + (subprocessStderrRead, subprocessStderr) <- createPipe logDebug appState $ "Running command: " <> show (args.cmd : args.args) logDebug appState $ " buildId: " <> show buildId diff --git a/src/CommitStatus.hs b/src/CommitStatus.hs index 6e42004..0e31d20 100644 --- a/src/CommitStatus.hs +++ b/src/CommitStatus.hs @@ -11,7 +11,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Network.HTTP.Client as HTTP import Network.HTTP.Client.TLS (tlsManagerSettings) -import System.Environment (getEnv, lookupEnv) +import System.Environment (getEnv, lookupEnv, setEnv) import Network.HTTP.Types.Status (Status(..)) import Data.Aeson.Decoding (eitherDecode) import qualified Data.Text as Text @@ -55,40 +55,49 @@ initClient appState = do -- Prepare the HTTP manager manager <- HTTP.newManager tlsManagerSettings - let privateKeyBytes = encodeUtf8 $ Text.replace "|" "\n" $ toText privateKeyStr - let privateKey = fromMaybe (error "Invalid github key") $ readRsaSecret privateKeyBytes + let createToken = do + let privateKeyBytes = encodeUtf8 $ Text.replace "|" "\n" $ toText privateKeyStr + let privateKey = fromMaybe (error "Invalid github key") $ readRsaSecret privateKeyBytes - -- Create the JWT token - now <- getPOSIXTime - let claims = mempty { iss = stringOrURI $ T.pack appId - , iat = numericDate now - , exp = numericDate (now + 5 * 60) - } - let jwt = encodeSigned (EncodeRSAPrivateKey privateKey) (mempty { alg = Just RS256 }) claims + -- Create the JWT token + now <- getPOSIXTime + let claims = mempty { iss = stringOrURI $ T.pack appId + , iat = numericDate now + , exp = numericDate (now + 5 * 60) + } + let jwt = encodeSigned (EncodeRSAPrivateKey privateKey) (mempty { alg = Just RS256 }) claims - -- Get the installation access token - let installUrl = apiUrl <> "/app/installations/" ++ installationId ++ "/access_tokens" - initRequest <- HTTP.parseRequest installUrl - let request = initRequest - { HTTP.method = "POST" - , HTTP.requestHeaders = - [ ("Authorization", "Bearer " <> TE.encodeUtf8 jwt) - , ("Accept", "application/vnd.github.v3+json") - , ("User-Agent", "restaumatic-bot") - ] - } - response <- HTTP.httpLbs request manager - let mTokenResponse = eitherDecode @InstallationTokenResponse (HTTP.responseBody response) - accessToken <- case mTokenResponse of - Left err -> do - logError appState $ "CommitStatus: Failed to parse installation token response: " <> show err - logError appState $ "CommitStatus: Response: " <> decodeUtf8 response.responseBody + -- Get the installation access token + let installUrl = apiUrl <> "/app/installations/" ++ installationId ++ "/access_tokens" + initRequest <- HTTP.parseRequest installUrl + let request = initRequest + { HTTP.method = "POST" + , HTTP.requestHeaders = + [ ("Authorization", "Bearer " <> TE.encodeUtf8 jwt) + , ("Accept", "application/vnd.github.v3+json") + , ("User-Agent", "restaumatic-bot") + ] + } + response <- HTTP.httpLbs request manager + let mTokenResponse = eitherDecode @InstallationTokenResponse (HTTP.responseBody response) + case mTokenResponse of + Left err -> do + logError appState $ "CommitStatus: Failed to parse installation token response: " <> show err + logError appState $ "CommitStatus: Response: " <> decodeUtf8 response.responseBody - -- FIXME: handle the error better - exitFailure - Right tokenResponse -> - pure tokenResponse.token + -- FIXME: handle the error better + exitFailure + Right tokenResponse -> + pure tokenResponse.token + -- Try to read token from environment variable + -- Otherwise generate a new one, and set env for future uses (also in child processes) + accessToken <- lookupEnv "_taskrunner_github_access_token" >>= \case + Just token -> pure $ T.pack token + Nothing -> do + token <- createToken + setEnv "_taskrunner_github_access_token" $ T.unpack token + pure token pure $ GithubClient { apiUrl = T.pack apiUrl , appId = T.pack appId diff --git a/test/FakeGithubApi.hs b/test/FakeGithubApi.hs index 84eae6b..9f34a31 100644 --- a/test/FakeGithubApi.hs +++ b/test/FakeGithubApi.hs @@ -49,12 +49,13 @@ data Server = Server } start :: Int -> IO Server -start port = mdo +start port = do started <- newEmptyMVar output <- newIORef [] let settings = Warp.setPort port $ Warp.setBeforeMainLoop (putMVar started ()) Warp.defaultSettings - tid <- forkIO $ Warp.runSettings settings $ app server - let server = Server {tid, output} + rec + let server = Server {tid, output} + tid <- forkIO $ Warp.runSettings settings $ app server takeMVar started pure server diff --git a/test/t/github-commit-status-failure-nested.out b/test/t/github-commit-status-failure-nested.out index 15e1923..b221aa5 100644 --- a/test/t/github-commit-status-failure-nested.out +++ b/test/t/github-commit-status-failure-nested.out @@ -4,6 +4,5 @@ Requested access token for installation 123 Updated commit status for fakeowner/fakerepo to {"context":"othertask","description":"not cached","state":"pending","target_url":null} Updated commit status for fakeowner/fakerepo to {"context":"othertask","description":null,"state":"failure","target_url":null} -Requested access token for installation 123 Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":null,"state":"failure","target_url":null} -- exit code: 1 diff --git a/test/t/github-commit-status-nested.out b/test/t/github-commit-status-nested.out index d8a3191..d74ca89 100644 --- a/test/t/github-commit-status-nested.out +++ b/test/t/github-commit-status-nested.out @@ -3,7 +3,6 @@ -- github: Requested access token for installation 123 Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":"not cached","state":"pending","target_url":null} -Requested access token for installation 123 Updated commit status for fakeowner/fakerepo to {"context":"othertask","description":"not cached","state":"pending","target_url":null} Updated commit status for fakeowner/fakerepo to {"context":"othertask","description":null,"state":"success","target_url":null} Updated commit status for fakeowner/fakerepo to {"context":"mytask","description":null,"state":"success","target_url":null} From 375a6dcb30963ef2c4c1abaa7605b50246cf4d67 Mon Sep 17 00:00:00 2001 From: Maciej Bielecki Date: Mon, 3 Mar 2025 12:18:00 +0000 Subject: [PATCH 5/6] Only fetch token at top level if the feature is actually enabled --- src/App.hs | 4 +-- test/Spec.hs | 31 +++++++++++++------ .../t/github-commit-status-failure-nested.txt | 1 + test/t/github-commit-status-failure.txt | 1 + .../t/github-commit-status-nested-partial.txt | 1 + test/t/github-commit-status-nested.txt | 1 + test/t/github-commit-status.txt | 1 + 7 files changed, 29 insertions(+), 11 deletions(-) diff --git a/src/App.hs b/src/App.hs index d90e3e5..d24e6f9 100644 --- a/src/App.hs +++ b/src/App.hs @@ -132,8 +132,8 @@ main = do appState <- AppState settings jobName buildId isToplevel <$> newIORef Nothing <*> newIORef Nothing <*> newIORef False <*> pure toplevelStderr <*> pure subprocessStderr <*> pure logFile <*> newIORef Nothing - when isToplevel do - -- Note: potentially sets env for subprocesses + when (isToplevel && appState.settings.enableCommitStatus) do + -- Note: sets env for subprocesses, so has to be called before starting subprocess void $ CommitStatus.getClient appState parentEnv <- getEnvironment diff --git a/test/Spec.hs b/test/Spec.hs index 7f6a710..cc9d562 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -26,7 +26,7 @@ import Amazonka.S3.Types.Delete (Delete(..)) import Amazonka.S3.ListObjectsV2 (ListObjectsV2Response(..)) import Amazonka.S3.Types.ObjectIdentifier (newObjectIdentifier) import Amazonka.S3.Types.Object (Object(..)) -import qualified FakeGithubApi as FakeGithubApi +import qualified FakeGithubApi main :: IO () main = defaultMain =<< goldenTests @@ -95,15 +95,17 @@ runTest fakeGithubServer source = do , ("GIT_COMMITTER_NAME", "test") , ("GIT_COMMITTER_EMAIL", "test@example.com") - , ("GITHUB_API_URL", "http://localhost:" <> show fakeGithubPort) - , ("GITHUB_APP_ID", "666") - , ("GITHUB_INSTALLATION_ID", "123") - , ("GITHUB_APP_PRIVATE_KEY", githubKey) - , ("GITHUB_REPOSITORY_OWNER", "fakeowner") - , ("GITHUB_REPOSITORY", "fakerepo") - , ("PATH", path) - ] <> s3ExtraEnv) + ] <> + mwhen options.githubKeys + [ ("GITHUB_API_URL", "http://localhost:" <> show fakeGithubPort) + , ("GITHUB_APP_ID", "666") + , ("GITHUB_INSTALLATION_ID", "123") + , ("GITHUB_APP_PRIVATE_KEY", githubKey) + , ("GITHUB_REPOSITORY_OWNER", "fakeowner") + , ("GITHUB_REPOSITORY", "fakerepo") + ] <> + s3ExtraEnv) , cwd = Just dir } \_ _ _ processHandle -> do @@ -137,6 +139,9 @@ data Options = Options { checkFileGlobs :: [Text] , toplevel :: Bool , s3 :: Bool + -- | Whether to provide GitHub app credentials in environment. + -- If github status is disabled, taskrunner should work without them. + , githubKeys :: Bool } instance Default Options where @@ -144,6 +149,7 @@ instance Default Options where { checkFileGlobs = ["output"] , toplevel = True , s3 = False + , githubKeys = False } getOptions :: Text -> Options @@ -160,6 +166,9 @@ getOptions source = flip execState def $ go (lines source) ["#", "s3"] -> do modify (\s -> s { s3 = True }) go rest + ["#", "github", "keys"] -> do + modify (\s -> s { githubKeys = True }) + go rest -- TODO: validate? _ -> -- stop iteration @@ -200,3 +209,7 @@ maybeWithBucket Options{s3=True} block = do , ("TASKRUNNER_REMOTE_CACHE_BUCKET", bucketName) , ("TASKRUNNER_REMOTE_CACHE_PREFIX", "") ] + +mwhen :: Monoid a => Bool -> a -> a +mwhen True x = x +mwhen False _ = mempty diff --git a/test/t/github-commit-status-failure-nested.txt b/test/t/github-commit-status-failure-nested.txt index 53ff567..d30426d 100644 --- a/test/t/github-commit-status-failure-nested.txt +++ b/test/t/github-commit-status-failure-nested.txt @@ -1,5 +1,6 @@ # check output github # no toplevel +# github keys export TASKRUNNER_ENABLE_COMMIT_STATUS=1 diff --git a/test/t/github-commit-status-failure.txt b/test/t/github-commit-status-failure.txt index fc8fdb2..7caff8b 100644 --- a/test/t/github-commit-status-failure.txt +++ b/test/t/github-commit-status-failure.txt @@ -1,5 +1,6 @@ # check output github # no toplevel +# github keys export TASKRUNNER_ENABLE_COMMIT_STATUS=1 diff --git a/test/t/github-commit-status-nested-partial.txt b/test/t/github-commit-status-nested-partial.txt index 0c01834..8d6e5be 100644 --- a/test/t/github-commit-status-nested-partial.txt +++ b/test/t/github-commit-status-nested-partial.txt @@ -1,5 +1,6 @@ # check output github # no toplevel +# github keys export TASKRUNNER_ENABLE_COMMIT_STATUS=1 diff --git a/test/t/github-commit-status-nested.txt b/test/t/github-commit-status-nested.txt index f8d7c9d..afb8212 100644 --- a/test/t/github-commit-status-nested.txt +++ b/test/t/github-commit-status-nested.txt @@ -1,5 +1,6 @@ # check output github # no toplevel +# github keys export TASKRUNNER_ENABLE_COMMIT_STATUS=1 diff --git a/test/t/github-commit-status.txt b/test/t/github-commit-status.txt index 33597c9..8250b0a 100644 --- a/test/t/github-commit-status.txt +++ b/test/t/github-commit-status.txt @@ -1,5 +1,6 @@ # check output github # no toplevel +# github keys export TASKRUNNER_ENABLE_COMMIT_STATUS=1 From 87f03718504875ce3fa90e84bae32926b5ff45e8 Mon Sep 17 00:00:00 2001 From: Maciej Bielecki Date: Mon, 3 Mar 2025 12:20:45 +0000 Subject: [PATCH 6/6] Github told me to update actions/cache https://github.com/actions/cache/discussions/1510 --- .github/workflows/build.yml | 2 +- .github/workflows/release.yml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 29e852e..75e3beb 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -22,7 +22,7 @@ jobs: enable-stack: true stack-version: 'latest' - name: Cache - uses: actions/cache@v1 + uses: actions/cache@v4 env: cache-name: cache-stack with: diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml index b8ec7af..77429ed 100644 --- a/.github/workflows/release.yml +++ b/.github/workflows/release.yml @@ -28,7 +28,7 @@ jobs: enable-stack: true stack-version: 'latest' - name: Cache - uses: actions/cache@v1 + uses: actions/cache@v4 env: cache-name: cache-stack with: