mirror of
https://github.com/ryantm/nixpkgs-update.git
synced 2024-09-11 05:45:45 +03:00
commit
0572aa48da
@ -116,7 +116,8 @@ commandParser =
|
|||||||
|
|
||||||
checkVulnerable :: O.Parser Command
|
checkVulnerable :: O.Parser Command
|
||||||
checkVulnerable =
|
checkVulnerable =
|
||||||
CheckVulnerable <$> O.strArgument (O.metavar "PRODUCT_ID")
|
CheckVulnerable
|
||||||
|
<$> O.strArgument (O.metavar "PRODUCT_ID")
|
||||||
<*> O.strArgument (O.metavar "OLD_VERSION")
|
<*> O.strArgument (O.metavar "OLD_VERSION")
|
||||||
<*> O.strArgument (O.metavar "NEW_VERSION")
|
<*> O.strArgument (O.metavar "NEW_VERSION")
|
||||||
|
|
||||||
|
23
flake.lock
23
flake.lock
@ -54,7 +54,28 @@
|
|||||||
"root": {
|
"root": {
|
||||||
"inputs": {
|
"inputs": {
|
||||||
"mmdoc": "mmdoc",
|
"mmdoc": "mmdoc",
|
||||||
"nixpkgs": "nixpkgs"
|
"nixpkgs": "nixpkgs",
|
||||||
|
"treefmt-nix": "treefmt-nix"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"treefmt-nix": {
|
||||||
|
"inputs": {
|
||||||
|
"nixpkgs": [
|
||||||
|
"nixpkgs"
|
||||||
|
]
|
||||||
|
},
|
||||||
|
"locked": {
|
||||||
|
"lastModified": 1711963903,
|
||||||
|
"narHash": "sha256-N3QDhoaX+paWXHbEXZapqd1r95mdshxToGowtjtYkGI=",
|
||||||
|
"owner": "numtide",
|
||||||
|
"repo": "treefmt-nix",
|
||||||
|
"rev": "49dc4a92b02b8e68798abd99184f228243b6e3ac",
|
||||||
|
"type": "github"
|
||||||
|
},
|
||||||
|
"original": {
|
||||||
|
"owner": "numtide",
|
||||||
|
"repo": "treefmt-nix",
|
||||||
|
"type": "github"
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
|
19
flake.nix
19
flake.nix
@ -4,17 +4,32 @@
|
|||||||
inputs.mmdoc.url = "github:ryantm/mmdoc";
|
inputs.mmdoc.url = "github:ryantm/mmdoc";
|
||||||
inputs.mmdoc.inputs.nixpkgs.follows = "nixpkgs";
|
inputs.mmdoc.inputs.nixpkgs.follows = "nixpkgs";
|
||||||
|
|
||||||
|
inputs.treefmt-nix.url = "github:numtide/treefmt-nix";
|
||||||
|
inputs.treefmt-nix.inputs.nixpkgs.follows = "nixpkgs";
|
||||||
|
|
||||||
nixConfig.extra-substituters = "https://nix-community.cachix.org";
|
nixConfig.extra-substituters = "https://nix-community.cachix.org";
|
||||||
nixConfig.extra-trusted-public-keys = "nix-community.cachix.org-1:mB9FSh9qf2dCimDSUo8Zy7bkq5CX+/rkCWyvRCYg3Fs=";
|
nixConfig.extra-trusted-public-keys = "nix-community.cachix.org-1:mB9FSh9qf2dCimDSUo8Zy7bkq5CX+/rkCWyvRCYg3Fs=";
|
||||||
|
|
||||||
outputs = { self, nixpkgs, mmdoc } @ args:
|
outputs = { self, nixpkgs, mmdoc, treefmt-nix } @ args:
|
||||||
|
let
|
||||||
|
systems = [ "x86_64-linux" "aarch64-linux" "x86_64-darwin" "aarch64-darwin" ];
|
||||||
|
eachSystem = f: nixpkgs.lib.genAttrs systems (system: f nixpkgs.legacyPackages.${system});
|
||||||
|
treefmtEval = eachSystem (pkgs: treefmt-nix.lib.evalModule pkgs {
|
||||||
|
projectRootFile = ".git/config";
|
||||||
|
programs.ormolu.enable = true;
|
||||||
|
});
|
||||||
|
in
|
||||||
{
|
{
|
||||||
checks.x86_64-linux =
|
checks.x86_64-linux =
|
||||||
let
|
let
|
||||||
packages = nixpkgs.lib.mapAttrs' (n: nixpkgs.lib.nameValuePair "package-${n}") self.packages.x86_64-linux;
|
packages = nixpkgs.lib.mapAttrs' (n: nixpkgs.lib.nameValuePair "package-${n}") self.packages.x86_64-linux;
|
||||||
devShells = nixpkgs.lib.mapAttrs' (n: nixpkgs.lib.nameValuePair "devShell-${n}") self.devShells.x86_64-linux;
|
devShells = nixpkgs.lib.mapAttrs' (n: nixpkgs.lib.nameValuePair "devShell-${n}") self.devShells.x86_64-linux;
|
||||||
in
|
in
|
||||||
packages // devShells;
|
packages // devShells // {
|
||||||
|
treefmt = treefmtEval.x86_64-linux.config.build.check self;
|
||||||
|
};
|
||||||
|
|
||||||
|
formatter = eachSystem (pkgs: treefmtEval.${pkgs.system}.config.build.wrapper);
|
||||||
|
|
||||||
packages.x86_64-linux = import ./pkgs/default.nix (args // { system = "x86_64-linux"; });
|
packages.x86_64-linux = import ./pkgs/default.nix (args // { system = "x86_64-linux"; });
|
||||||
devShells.x86_64-linux.default = self.packages."x86_64-linux".devShell;
|
devShells.x86_64-linux.default = self.packages."x86_64-linux".devShell;
|
||||||
|
@ -16,6 +16,7 @@ where
|
|||||||
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
( FromJSON,
|
( FromJSON,
|
||||||
|
Key,
|
||||||
Object,
|
Object,
|
||||||
eitherDecode,
|
eitherDecode,
|
||||||
parseJSON,
|
parseJSON,
|
||||||
@ -23,7 +24,6 @@ import Data.Aeson
|
|||||||
(.!=),
|
(.!=),
|
||||||
(.:),
|
(.:),
|
||||||
(.:!),
|
(.:!),
|
||||||
Key,
|
|
||||||
)
|
)
|
||||||
import Data.Aeson.Types (Parser, prependFailure)
|
import Data.Aeson.Types (Parser, prependFailure)
|
||||||
import qualified Data.ByteString.Lazy.Char8 as BSL
|
import qualified Data.ByteString.Lazy.Char8 as BSL
|
||||||
|
30
src/Check.hs
30
src/Check.hs
@ -8,7 +8,7 @@ module Check
|
|||||||
( result,
|
( result,
|
||||||
-- exposed for testing:
|
-- exposed for testing:
|
||||||
hasVersion,
|
hasVersion,
|
||||||
versionWithoutPath
|
versionWithoutPath,
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -50,10 +50,10 @@ isNonWordCharacter c = not (isWordCharacter c)
|
|||||||
-- | Construct regex: /.*\b${version}\b.*/s
|
-- | Construct regex: /.*\b${version}\b.*/s
|
||||||
versionRegex :: Text -> RE' ()
|
versionRegex :: Text -> RE' ()
|
||||||
versionRegex version =
|
versionRegex version =
|
||||||
(\_ -> ()) <$> (
|
(\_ -> ())
|
||||||
(((many RE.anySym) <* (RE.psym isNonWordCharacter)) <|> (RE.pure ""))
|
<$> ( (((many RE.anySym) <* (RE.psym isNonWordCharacter)) <|> (RE.pure ""))
|
||||||
*> (RE.string version) <*
|
*> (RE.string version)
|
||||||
((RE.pure "") <|> ((RE.psym isNonWordCharacter) *> (many RE.anySym)))
|
<* ((RE.pure "") <|> ((RE.psym isNonWordCharacter) *> (many RE.anySym)))
|
||||||
)
|
)
|
||||||
|
|
||||||
hasVersion :: Text -> Text -> Bool
|
hasVersion :: Text -> Text -> Bool
|
||||||
@ -63,10 +63,9 @@ hasVersion contents expectedVersion =
|
|||||||
checkTestsBuild :: Text -> IO Bool
|
checkTestsBuild :: Text -> IO Bool
|
||||||
checkTestsBuild attrPath = do
|
checkTestsBuild attrPath = do
|
||||||
let timeout = "10m"
|
let timeout = "10m"
|
||||||
let
|
let args =
|
||||||
args =
|
[T.unpack timeout, "nix-build"]
|
||||||
[ T.unpack timeout, "nix-build" ] ++
|
++ nixBuildOptions
|
||||||
nixBuildOptions
|
|
||||||
++ [ "-E",
|
++ [ "-E",
|
||||||
"{ config }: (import ./. { inherit config; })."
|
"{ config }: (import ./. { inherit config; })."
|
||||||
++ (T.unpack attrPath)
|
++ (T.unpack attrPath)
|
||||||
@ -99,8 +98,8 @@ versionWithoutPath resultPath expectedVersion =
|
|||||||
-- This can be done with negative lookbehind e.g
|
-- This can be done with negative lookbehind e.g
|
||||||
-- /^(?<!${storePathWithoutVersion})${version}/
|
-- /^(?<!${storePathWithoutVersion})${version}/
|
||||||
-- Note we also escape the version with \Q/\E for grep -P
|
-- Note we also escape the version with \Q/\E for grep -P
|
||||||
let storePath = fromMaybe (T.pack resultPath) $ T.stripPrefix "/nix/store/" (T.pack resultPath) in
|
let storePath = fromMaybe (T.pack resultPath) $ T.stripPrefix "/nix/store/" (T.pack resultPath)
|
||||||
case T.breakOn expectedVersion storePath of
|
in case T.breakOn expectedVersion storePath of
|
||||||
(_, "") ->
|
(_, "") ->
|
||||||
-- no version in prefix, just match version
|
-- no version in prefix, just match version
|
||||||
"\\Q"
|
"\\Q"
|
||||||
@ -140,7 +139,8 @@ foundVersionInFileNames expectedVersion resultPath =
|
|||||||
( do
|
( do
|
||||||
(_, contents) <-
|
(_, contents) <-
|
||||||
shell ("find " <> resultPath) & ourReadProcessInterleaved
|
shell ("find " <> resultPath) & ourReadProcessInterleaved
|
||||||
(contents =~ versionRegex expectedVersion) & hoistMaybe
|
(contents =~ versionRegex expectedVersion)
|
||||||
|
& hoistMaybe
|
||||||
& noteT (T.pack "Expected version not found")
|
& noteT (T.pack "Expected version not found")
|
||||||
return $
|
return $
|
||||||
"- found "
|
"- found "
|
||||||
@ -157,7 +157,8 @@ treeGist resultPath =
|
|||||||
( do
|
( do
|
||||||
contents <- procTree [resultPath] & ourReadProcessInterleavedBS_
|
contents <- procTree [resultPath] & ourReadProcessInterleavedBS_
|
||||||
g <-
|
g <-
|
||||||
shell gistBin & setStdin (byteStringInput contents)
|
shell gistBin
|
||||||
|
& setStdin (byteStringInput contents)
|
||||||
& ourReadProcessInterleaved_
|
& ourReadProcessInterleaved_
|
||||||
return $ "- directory tree listing: " <> g <> "\n"
|
return $ "- directory tree listing: " <> g <> "\n"
|
||||||
)
|
)
|
||||||
@ -169,7 +170,8 @@ duGist resultPath =
|
|||||||
( do
|
( do
|
||||||
contents <- proc "du" [resultPath] & ourReadProcessInterleavedBS_
|
contents <- proc "du" [resultPath] & ourReadProcessInterleavedBS_
|
||||||
g <-
|
g <-
|
||||||
shell gistBin & setStdin (byteStringInput contents)
|
shell gistBin
|
||||||
|
& setStdin (byteStringInput contents)
|
||||||
& ourReadProcessInterleaved_
|
& ourReadProcessInterleaved_
|
||||||
return $ "- du listing: " <> g <> "\n"
|
return $ "- du listing: " <> g <> "\n"
|
||||||
)
|
)
|
||||||
|
32
src/GH.hs
32
src/GH.hs
@ -23,7 +23,7 @@ import Data.Aeson (FromJSON)
|
|||||||
import Data.Bitraversable (bitraverse)
|
import Data.Bitraversable (bitraverse)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as T
|
import qualified Data.Text.Encoding as T
|
||||||
import Data.Time.Clock (getCurrentTime, addUTCTime)
|
import Data.Time.Clock (addUTCTime, getCurrentTime)
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified GitHub as GH
|
import qualified GitHub as GH
|
||||||
@ -54,12 +54,14 @@ pr env title body prHead base = do
|
|||||||
tryPR `catchE` \case
|
tryPR `catchE` \case
|
||||||
-- If creating the PR returns a 422, most likely cause is that the
|
-- If creating the PR returns a 422, most likely cause is that the
|
||||||
-- branch was deleted, so push it again and retry once.
|
-- branch was deleted, so push it again and retry once.
|
||||||
GH.HTTPError (HttpExceptionRequest _ (StatusCodeException r _)) | statusCode (responseStatus r) == 422 ->
|
GH.HTTPError (HttpExceptionRequest _ (StatusCodeException r _))
|
||||||
|
| statusCode (responseStatus r) == 422 ->
|
||||||
Git.push env >> withExceptT (T.pack . show) tryPR
|
Git.push env >> withExceptT (T.pack . show) tryPR
|
||||||
e ->
|
e ->
|
||||||
throwE . T.pack . show $ e
|
throwE . T.pack . show $ e
|
||||||
where
|
where
|
||||||
tryPR = ExceptT $
|
tryPR =
|
||||||
|
ExceptT $
|
||||||
fmap ((False,) . GH.getUrl . GH.pullRequestUrl)
|
fmap ((False,) . GH.getUrl . GH.pullRequestUrl)
|
||||||
<$> ( liftIO $
|
<$> ( liftIO $
|
||||||
( GH.github
|
( GH.github
|
||||||
@ -78,23 +80,24 @@ prUpdate env title body prHead base = do
|
|||||||
runRequest = ExceptT . fmap (first (T.pack . show)) . liftIO . GH.github (authFrom env)
|
runRequest = ExceptT . fmap (first (T.pack . show)) . liftIO . GH.github (authFrom env)
|
||||||
let inNixpkgs f = f (N "nixos") (N "nixpkgs")
|
let inNixpkgs f = f (N "nixos") (N "nixpkgs")
|
||||||
|
|
||||||
prs <- runRequest $
|
prs <-
|
||||||
|
runRequest $
|
||||||
inNixpkgs GH.pullRequestsForR (GH.optionsHead prHead) GH.FetchAll
|
inNixpkgs GH.pullRequestsForR (GH.optionsHead prHead) GH.FetchAll
|
||||||
|
|
||||||
case V.toList prs of
|
case V.toList prs of
|
||||||
[] -> pr env title body prHead base
|
[] -> pr env title body prHead base
|
||||||
|
|
||||||
(_ : _ : _) -> throwE $ "Too many open PRs from " <> prHead
|
(_ : _ : _) -> throwE $ "Too many open PRs from " <> prHead
|
||||||
|
|
||||||
[thePR] -> do
|
[thePR] -> do
|
||||||
let withExistingPR :: (GH.Name GH.Owner -> GH.Name GH.Repo -> GH.IssueNumber -> a) -> a
|
let withExistingPR :: (GH.Name GH.Owner -> GH.Name GH.Repo -> GH.IssueNumber -> a) -> a
|
||||||
withExistingPR f = inNixpkgs f (GH.simplePullRequestNumber thePR)
|
withExistingPR f = inNixpkgs f (GH.simplePullRequestNumber thePR)
|
||||||
|
|
||||||
_ <- runRequest $
|
_ <-
|
||||||
|
runRequest $
|
||||||
withExistingPR GH.updatePullRequestR $
|
withExistingPR GH.updatePullRequestR $
|
||||||
GH.EditPullRequest (Just title) Nothing Nothing Nothing Nothing
|
GH.EditPullRequest (Just title) Nothing Nothing Nothing Nothing
|
||||||
|
|
||||||
_ <- runRequest $
|
_ <-
|
||||||
|
runRequest $
|
||||||
withExistingPR GH.createCommentR body
|
withExistingPR GH.createCommentR body
|
||||||
|
|
||||||
return (True, GH.getUrl $ GH.simplePullRequestUrl thePR)
|
return (True, GH.getUrl $ GH.simplePullRequestUrl thePR)
|
||||||
@ -129,12 +132,18 @@ parseURLMaybe url =
|
|||||||
extension = RE.string ".zip" <|> RE.string ".tar.gz"
|
extension = RE.string ".zip" <|> RE.string ".tar.gz"
|
||||||
toParts n o = URLParts (N n) (N o)
|
toParts n o = URLParts (N n) (N o)
|
||||||
regex =
|
regex =
|
||||||
( toParts <$> (domain *> pathSegment) <* slash <*> pathSegment
|
( toParts
|
||||||
|
<$> (domain *> pathSegment)
|
||||||
|
<* slash
|
||||||
|
<*> pathSegment
|
||||||
<*> (RE.string "/releases/download/" *> pathSegment)
|
<*> (RE.string "/releases/download/" *> pathSegment)
|
||||||
<* slash
|
<* slash
|
||||||
<* pathSegment
|
<* pathSegment
|
||||||
)
|
)
|
||||||
<|> ( toParts <$> (domain *> pathSegment) <* slash <*> pathSegment
|
<|> ( toParts
|
||||||
|
<$> (domain *> pathSegment)
|
||||||
|
<* slash
|
||||||
|
<*> pathSegment
|
||||||
<*> (RE.string "/archive/" *> pathSegment)
|
<*> (RE.string "/archive/" *> pathSegment)
|
||||||
<* extension
|
<* extension
|
||||||
)
|
)
|
||||||
@ -187,7 +196,8 @@ commitIsOldEnoughToDelete auth ghUser sha = do
|
|||||||
|
|
||||||
refShouldBeDeleted :: GH.Auth -> GH.Name GH.Owner -> (Text, GH.Name GH.GitCommit) -> IO Bool
|
refShouldBeDeleted :: GH.Auth -> GH.Name GH.Owner -> (Text, GH.Name GH.GitCommit) -> IO Bool
|
||||||
refShouldBeDeleted auth ghUser (ref, sha) =
|
refShouldBeDeleted auth ghUser (ref, sha) =
|
||||||
liftA2 (&&)
|
liftA2
|
||||||
|
(&&)
|
||||||
(either (const False) not <$> openPRWithAutoUpdateRefFrom auth ghUser ref)
|
(either (const False) not <$> openPRWithAutoUpdateRefFrom auth ghUser ref)
|
||||||
(commitIsOldEnoughToDelete auth ghUser sha)
|
(commitIsOldEnoughToDelete auth ghUser sha)
|
||||||
|
|
||||||
|
12
src/Git.hs
12
src/Git.hs
@ -18,7 +18,7 @@ module Git
|
|||||||
setupNixpkgs,
|
setupNixpkgs,
|
||||||
Git.show,
|
Git.show,
|
||||||
worktreeAdd,
|
worktreeAdd,
|
||||||
worktreeRemove
|
worktreeRemove,
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -33,7 +33,7 @@ import Data.Time.Clock (addUTCTime, getCurrentTime)
|
|||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import Language.Haskell.TH.Env (envQ)
|
import Language.Haskell.TH.Env (envQ)
|
||||||
import OurPrelude hiding (throw)
|
import OurPrelude hiding (throw)
|
||||||
import System.Directory (doesDirectoryExist, doesFileExist, getModificationTime, getCurrentDirectory, setCurrentDirectory)
|
import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, getModificationTime, setCurrentDirectory)
|
||||||
import System.Environment.XDG.BaseDir (getUserCacheDir)
|
import System.Environment.XDG.BaseDir (getUserCacheDir)
|
||||||
import System.Exit ()
|
import System.Exit ()
|
||||||
import System.IO.Error (tryIOError)
|
import System.IO.Error (tryIOError)
|
||||||
@ -98,7 +98,8 @@ diff :: MonadIO m => Text -> ExceptT Text m Text
|
|||||||
diff branch = readProcessInterleavedNoIndexIssue_ $ procGit ["diff", T.unpack branch]
|
diff branch = readProcessInterleavedNoIndexIssue_ $ procGit ["diff", T.unpack branch]
|
||||||
|
|
||||||
diffFileNames :: MonadIO m => Text -> ExceptT Text m [Text]
|
diffFileNames :: MonadIO m => Text -> ExceptT Text m [Text]
|
||||||
diffFileNames branch = readProcessInterleavedNoIndexIssue_ (procGit ["diff", T.unpack branch, "--name-only"])
|
diffFileNames branch =
|
||||||
|
readProcessInterleavedNoIndexIssue_ (procGit ["diff", T.unpack branch, "--name-only"])
|
||||||
& fmapRT T.lines
|
& fmapRT T.lines
|
||||||
|
|
||||||
staleFetchHead :: MonadIO m => m Bool
|
staleFetchHead :: MonadIO m => m Bool
|
||||||
@ -121,7 +122,8 @@ fetchIfStale = whenM staleFetchHead fetch
|
|||||||
fetch :: MonadIO m => ExceptT Text m ()
|
fetch :: MonadIO m => ExceptT Text m ()
|
||||||
fetch =
|
fetch =
|
||||||
runProcessNoIndexIssue_ $
|
runProcessNoIndexIssue_ $
|
||||||
silently $ procGit ["fetch", "-q", "--prune", "--multiple", "upstream", "origin"]
|
silently $
|
||||||
|
procGit ["fetch", "-q", "--prune", "--multiple", "upstream", "origin"]
|
||||||
|
|
||||||
push :: MonadIO m => UpdateEnv -> ExceptT Text m ()
|
push :: MonadIO m => UpdateEnv -> ExceptT Text m ()
|
||||||
push updateEnv =
|
push updateEnv =
|
||||||
@ -210,7 +212,6 @@ deleteBranchesEverywhere branches = do
|
|||||||
Left error2 -> T.putStrLn $ tshow error2
|
Left error2 -> T.putStrLn $ tshow error2
|
||||||
Right success2 -> T.putStrLn $ tshow success2
|
Right success2 -> T.putStrLn $ tshow success2
|
||||||
|
|
||||||
|
|
||||||
runProcessNoIndexIssue_IO ::
|
runProcessNoIndexIssue_IO ::
|
||||||
ProcessConfig () () () -> IO ()
|
ProcessConfig () () () -> IO ()
|
||||||
runProcessNoIndexIssue_IO config = go
|
runProcessNoIndexIssue_IO config = go
|
||||||
@ -253,7 +254,6 @@ readProcessInterleavedNoIndexIssue_ config = tryIOTextET go
|
|||||||
ExitSuccess -> return $ bytestringToText out
|
ExitSuccess -> return $ bytestringToText out
|
||||||
ExitFailure _ -> throw $ ExitCodeException code config out out
|
ExitFailure _ -> throw $ ExitCodeException code config out out
|
||||||
|
|
||||||
|
|
||||||
readProcessInterleavedNoIndexIssue_IO ::
|
readProcessInterleavedNoIndexIssue_IO ::
|
||||||
ProcessConfig () () () -> IO Text
|
ProcessConfig () () () -> IO Text
|
||||||
readProcessInterleavedNoIndexIssue_IO config = go
|
readProcessInterleavedNoIndexIssue_IO config = go
|
||||||
|
@ -15,14 +15,18 @@ filter _ cpeMatch "socat" v
|
|||||||
| cpeUpdatePresentAndNotPartOfVersion cpeMatch v = False -- TODO consider if this rule should be applied to all packages
|
| cpeUpdatePresentAndNotPartOfVersion cpeMatch v = False -- TODO consider if this rule should be applied to all packages
|
||||||
filter _ cpeMatch "uzbl" v
|
filter _ cpeMatch "uzbl" v
|
||||||
| isNothing (v =~ yearRegex)
|
| isNothing (v =~ yearRegex)
|
||||||
&& "2009.12.22" `anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch =
|
&& "2009.12.22"
|
||||||
|
`anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch =
|
||||||
False
|
False
|
||||||
| isNothing (v =~ yearRegex)
|
| isNothing (v =~ yearRegex)
|
||||||
&& "2010.04.03" `anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch =
|
&& "2010.04.03"
|
||||||
|
`anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch =
|
||||||
False
|
False
|
||||||
filter _ cpeMatch "go" v
|
filter _ cpeMatch "go" v
|
||||||
| "." `T.isInfixOf` v
|
| "."
|
||||||
&& "-" `anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch =
|
`T.isInfixOf` v
|
||||||
|
&& "-"
|
||||||
|
`anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch =
|
||||||
False
|
False
|
||||||
filter _ cpeMatch "terraform" _
|
filter _ cpeMatch "terraform" _
|
||||||
| cpeTargetSoftware (cpeMatchCPE cpeMatch) == Just "aws" = False
|
| cpeTargetSoftware (cpeMatchCPE cpeMatch) == Just "aws" = False
|
||||||
|
21
src/Nix.hs
21
src/Nix.hs
@ -40,8 +40,8 @@ import qualified Data.Text.Lazy.Encoding as TL
|
|||||||
import qualified Git
|
import qualified Git
|
||||||
import Language.Haskell.TH.Env (envQ)
|
import Language.Haskell.TH.Env (envQ)
|
||||||
import OurPrelude
|
import OurPrelude
|
||||||
import qualified System.Process.Typed as TP
|
|
||||||
import System.Exit ()
|
import System.Exit ()
|
||||||
|
import qualified System.Process.Typed as TP
|
||||||
import Utils (UpdateEnv (..), nixBuildOptions, nixCommonOptions, srcOrMain)
|
import Utils (UpdateEnv (..), nixBuildOptions, nixCommonOptions, srcOrMain)
|
||||||
import Prelude hiding (log)
|
import Prelude hiding (log)
|
||||||
|
|
||||||
@ -127,7 +127,8 @@ lookupAttrPath updateEnv =
|
|||||||
<> nixCommonOptions
|
<> nixCommonOptions
|
||||||
)
|
)
|
||||||
& ourReadProcess_
|
& ourReadProcess_
|
||||||
& fmapRT (fst >>> T.lines >>> head >>> T.words >>> head))
|
& fmapRT (fst >>> T.lines >>> head >>> T.words >>> head)
|
||||||
|
)
|
||||||
<|>
|
<|>
|
||||||
-- if that fails, check by attrpath
|
-- if that fails, check by attrpath
|
||||||
(getAttrString "name" (packageName updateEnv))
|
(getAttrString "name" (packageName updateEnv))
|
||||||
@ -178,7 +179,8 @@ getHomepage :: MonadIO m => Text -> ExceptT Text m Text
|
|||||||
getHomepage = nixEvalApplyRaw "p: p.meta.homepage or \"\""
|
getHomepage = nixEvalApplyRaw "p: p.meta.homepage or \"\""
|
||||||
|
|
||||||
getSrcUrl :: MonadIO m => Text -> ExceptT Text m Text
|
getSrcUrl :: MonadIO m => Text -> ExceptT Text m Text
|
||||||
getSrcUrl = srcOrMain
|
getSrcUrl =
|
||||||
|
srcOrMain
|
||||||
(nixEvalApplyRaw "p: builtins.elemAt p.drvAttrs.urls 0")
|
(nixEvalApplyRaw "p: builtins.elemAt p.drvAttrs.urls 0")
|
||||||
|
|
||||||
buildCmd :: Text -> ProcessConfig () () ()
|
buildCmd :: Text -> ProcessConfig () () ()
|
||||||
@ -245,10 +247,9 @@ resultLink =
|
|||||||
|
|
||||||
fakeHashMatching :: Text -> Text
|
fakeHashMatching :: Text -> Text
|
||||||
fakeHashMatching oldHash =
|
fakeHashMatching oldHash =
|
||||||
if "sha512-" `T.isPrefixOf` oldHash then
|
if "sha512-" `T.isPrefixOf` oldHash
|
||||||
"sha512-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA=="
|
then "sha512-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA=="
|
||||||
else
|
else "sha256-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA="
|
||||||
"sha256-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA="
|
|
||||||
|
|
||||||
-- fixed-output derivation produced path '/nix/store/fg2hz90z5bc773gpsx4gfxn3l6fl66nw-source' with sha256 hash '0q1lsgc1621czrg49nmabq6am9sgxa9syxrwzlksqqr4dyzw4nmf' instead of the expected hash '0bp22mzkjy48gncj5vm9b7whzrggcbs5pd4cnb6k8jpl9j02dhdv'
|
-- fixed-output derivation produced path '/nix/store/fg2hz90z5bc773gpsx4gfxn3l6fl66nw-source' with sha256 hash '0q1lsgc1621czrg49nmabq6am9sgxa9syxrwzlksqqr4dyzw4nmf' instead of the expected hash '0bp22mzkjy48gncj5vm9b7whzrggcbs5pd4cnb6k8jpl9j02dhdv'
|
||||||
getHashFromBuild :: MonadIO m => Text -> ExceptT Text m Text
|
getHashFromBuild :: MonadIO m => Text -> ExceptT Text m Text
|
||||||
@ -289,13 +290,15 @@ hasPatchNamed attrPath name = do
|
|||||||
hasUpdateScript :: MonadIO m => Text -> ExceptT Text m Bool
|
hasUpdateScript :: MonadIO m => Text -> ExceptT Text m Bool
|
||||||
hasUpdateScript attrPath = do
|
hasUpdateScript attrPath = do
|
||||||
nixEvalApply
|
nixEvalApply
|
||||||
"p: builtins.hasAttr \"updateScript\" p" attrPath
|
"p: builtins.hasAttr \"updateScript\" p"
|
||||||
|
attrPath
|
||||||
& readNixBool
|
& readNixBool
|
||||||
|
|
||||||
runUpdateScript :: MonadIO m => Text -> ExceptT Text m (ExitCode, Text)
|
runUpdateScript :: MonadIO m => Text -> ExceptT Text m (ExitCode, Text)
|
||||||
runUpdateScript attrPath = do
|
runUpdateScript attrPath = do
|
||||||
let timeout = "10m" :: Text
|
let timeout = "10m" :: Text
|
||||||
(exitCode, output) <- ourReadProcessInterleaved $
|
(exitCode, output) <-
|
||||||
|
ourReadProcessInterleaved $
|
||||||
TP.setStdin (TP.byteStringInput "\n") $
|
TP.setStdin (TP.byteStringInput "\n") $
|
||||||
proc "timeout" [T.unpack timeout, "nix-shell", "maintainers/scripts/update.nix", "--argstr", "package", T.unpack attrPath]
|
proc "timeout" [T.unpack timeout, "nix-shell", "maintainers/scripts/update.nix", "--argstr", "package", T.unpack attrPath]
|
||||||
case exitCode of
|
case exitCode of
|
||||||
|
@ -33,7 +33,9 @@ run ::
|
|||||||
FilePath ->
|
FilePath ->
|
||||||
Text ->
|
Text ->
|
||||||
Sem r Text
|
Sem r Text
|
||||||
run cache commit = let timeout = "45m" :: Text in do
|
run cache commit =
|
||||||
|
let timeout = "45m" :: Text
|
||||||
|
in do
|
||||||
-- TODO: probably just skip running nixpkgs-review if the directory
|
-- TODO: probably just skip running nixpkgs-review if the directory
|
||||||
-- already exists
|
-- already exists
|
||||||
void $
|
void $
|
||||||
|
@ -34,7 +34,6 @@ module OurPrelude
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import System.FilePath ((</>))
|
|
||||||
import Control.Applicative ((<|>))
|
import Control.Applicative ((<|>))
|
||||||
import Control.Category ((>>>))
|
import Control.Category ((>>>))
|
||||||
import Control.Error
|
import Control.Error
|
||||||
@ -57,6 +56,7 @@ import Polysemy
|
|||||||
import Polysemy.Error hiding (note, try, tryJust)
|
import Polysemy.Error hiding (note, try, tryJust)
|
||||||
import qualified Process as P
|
import qualified Process as P
|
||||||
import System.Exit
|
import System.Exit
|
||||||
|
import System.FilePath ((</>))
|
||||||
import System.Process.Typed
|
import System.Process.Typed
|
||||||
|
|
||||||
interpolate :: QuasiQuoter
|
interpolate :: QuasiQuoter
|
||||||
|
@ -17,14 +17,14 @@ import qualified Data.Set as S
|
|||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import qualified System.Posix.Files as F
|
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Utils
|
|
||||||
import qualified System.Directory
|
|
||||||
import OurPrelude
|
import OurPrelude
|
||||||
|
import qualified System.Directory
|
||||||
|
import qualified System.Posix.Files as F
|
||||||
import Text.Parsec (parse)
|
import Text.Parsec (parse)
|
||||||
import Text.Parser.Char
|
import Text.Parser.Char
|
||||||
import Text.Parser.Combinators
|
import Text.Parser.Combinators
|
||||||
|
import qualified Utils
|
||||||
|
|
||||||
outPathsExpr :: Text
|
outPathsExpr :: Text
|
||||||
outPathsExpr =
|
outPathsExpr =
|
||||||
@ -94,14 +94,23 @@ outPath = do
|
|||||||
liftIO $ T.writeFile outpathFile outPathsExpr
|
liftIO $ T.writeFile outpathFile outPathsExpr
|
||||||
liftIO $ putStrLn "[outpaths] eval start"
|
liftIO $ putStrLn "[outpaths] eval start"
|
||||||
currentDir <- liftIO $ System.Directory.getCurrentDirectory
|
currentDir <- liftIO $ System.Directory.getCurrentDirectory
|
||||||
result <- ourReadProcessInterleaved_ $ proc "nix-env" [
|
result <-
|
||||||
"-f", outpathFile,
|
ourReadProcessInterleaved_ $
|
||||||
|
proc
|
||||||
|
"nix-env"
|
||||||
|
[ "-f",
|
||||||
|
outpathFile,
|
||||||
"-qaP",
|
"-qaP",
|
||||||
"--no-name",
|
"--no-name",
|
||||||
"--out-path",
|
"--out-path",
|
||||||
"--arg", "path", currentDir,
|
"--arg",
|
||||||
"--arg", "checkMeta", "true",
|
"path",
|
||||||
"--show-trace"]
|
currentDir,
|
||||||
|
"--arg",
|
||||||
|
"checkMeta",
|
||||||
|
"true",
|
||||||
|
"--show-trace"
|
||||||
|
]
|
||||||
liftIO $ putStrLn "[outpaths] eval end"
|
liftIO $ putStrLn "[outpaths] eval end"
|
||||||
pure result
|
pure result
|
||||||
|
|
||||||
@ -163,7 +172,8 @@ parseResults = S.fromList <$> parseResultLine `sepEndBy` newline
|
|||||||
|
|
||||||
parseResultLine :: CharParsing m => m ResultLine
|
parseResultLine :: CharParsing m => m ResultLine
|
||||||
parseResultLine =
|
parseResultLine =
|
||||||
ResultLine <$> (T.dropWhileEnd (== '.') <$> parseAttrpath)
|
ResultLine
|
||||||
|
<$> (T.dropWhileEnd (== '.') <$> parseAttrpath)
|
||||||
<*> parseArchitecture
|
<*> parseArchitecture
|
||||||
<* spaces
|
<* spaces
|
||||||
<*> parseOutpaths
|
<*> parseOutpaths
|
||||||
@ -182,7 +192,8 @@ parseOutpaths = V.fromList <$> (parseOutpath `sepBy1` char ';')
|
|||||||
|
|
||||||
parseOutpath :: CharParsing m => m Outpath
|
parseOutpath :: CharParsing m => m Outpath
|
||||||
parseOutpath =
|
parseOutpath =
|
||||||
Outpath <$> optional (try (T.pack <$> (many (noneOf "=\n") <* char '=')))
|
Outpath
|
||||||
|
<$> optional (try (T.pack <$> (many (noneOf "=\n") <* char '=')))
|
||||||
<*> (T.pack <$> many (noneOf ";\n"))
|
<*> (T.pack <$> many (noneOf ";\n"))
|
||||||
|
|
||||||
packageRebuilds :: Set ResultLine -> Vector Text
|
packageRebuilds :: Set ResultLine -> Vector Text
|
||||||
|
@ -16,7 +16,7 @@ import GHC.Generics
|
|||||||
import Network.HTTP.Client.TLS (newTlsManager)
|
import Network.HTTP.Client.TLS (newTlsManager)
|
||||||
import OurPrelude
|
import OurPrelude
|
||||||
import Servant.API
|
import Servant.API
|
||||||
import Servant.Client (BaseUrl (..), mkClientEnv, ClientM, Scheme (..), client, runClientM)
|
import Servant.Client (BaseUrl (..), ClientM, Scheme (..), client, mkClientEnv, runClientM)
|
||||||
import System.IO
|
import System.IO
|
||||||
|
|
||||||
baseUrl :: BaseUrl
|
baseUrl :: BaseUrl
|
||||||
@ -35,9 +35,9 @@ type Project = Vector Package
|
|||||||
type Projects = HashMap Text Project
|
type Projects = HashMap Text Project
|
||||||
|
|
||||||
type API =
|
type API =
|
||||||
"project" :> Capture "project_name" Text :> Get '[JSON] Project :<|>
|
"project" :> Capture "project_name" Text :> Get '[JSON] Project
|
||||||
"projects" :> QueryParam "inrepo" Text :> QueryParam "outdated" Bool :> Get '[JSON] Projects :<|>
|
:<|> "projects" :> QueryParam "inrepo" Text :> QueryParam "outdated" Bool :> Get '[JSON] Projects
|
||||||
"projects" :> Capture "name" Text :> QueryParam "inrepo" Text :> QueryParam "outdated" Bool :> Get '[JSON] Projects
|
:<|> "projects" :> Capture "name" Text :> QueryParam "inrepo" Text :> QueryParam "outdated" Bool :> Get '[JSON] Projects
|
||||||
|
|
||||||
data Package = Package
|
data Package = Package
|
||||||
{ repo :: Text,
|
{ repo :: Text,
|
||||||
@ -56,12 +56,10 @@ api :: Proxy API
|
|||||||
api = Proxy
|
api = Proxy
|
||||||
|
|
||||||
project :: Text -> ClientM (Vector Package)
|
project :: Text -> ClientM (Vector Package)
|
||||||
|
|
||||||
projects ::
|
projects ::
|
||||||
Maybe Text ->
|
Maybe Text ->
|
||||||
Maybe Bool ->
|
Maybe Bool ->
|
||||||
ClientM Projects
|
ClientM Projects
|
||||||
|
|
||||||
projects' ::
|
projects' ::
|
||||||
Text ->
|
Text ->
|
||||||
Maybe Text ->
|
Maybe Text ->
|
||||||
|
@ -241,6 +241,7 @@ updateScript log Args {..} = do
|
|||||||
else do
|
else do
|
||||||
lift $ log "skipping because derivation has no updateScript"
|
lift $ log "skipping because derivation has no updateScript"
|
||||||
return Nothing
|
return Nothing
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- Common helper functions and utilities
|
-- Common helper functions and utilities
|
||||||
-- Helper to update version and src attributes, re-computing the sha256.
|
-- Helper to update version and src attributes, re-computing the sha256.
|
||||||
|
@ -197,8 +197,8 @@ checkResultList =
|
|||||||
|
|
||||||
skipOutpathCalcList :: Skiplist
|
skipOutpathCalcList :: Skiplist
|
||||||
skipOutpathCalcList =
|
skipOutpathCalcList =
|
||||||
[ eq "firefox-beta-bin-unwrapped" "master"
|
[ eq "firefox-beta-bin-unwrapped" "master",
|
||||||
, eq "firefox-devedition-bin-unwrapped" "master"
|
eq "firefox-devedition-bin-unwrapped" "master"
|
||||||
-- "firefox-release-bin-unwrapped" is unneeded here because firefox-bin is a dependency of other packages that Hydra doesn't ignore.
|
-- "firefox-release-bin-unwrapped" is unneeded here because firefox-bin is a dependency of other packages that Hydra doesn't ignore.
|
||||||
]
|
]
|
||||||
|
|
||||||
|
@ -30,7 +30,7 @@ import qualified Data.Set as S
|
|||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import Data.Time.Calendar (showGregorian)
|
import Data.Time.Calendar (showGregorian)
|
||||||
import Data.Time.Clock (getCurrentTime, utctDay, addUTCTime, UTCTime)
|
import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime, utctDay)
|
||||||
import qualified GH
|
import qualified GH
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import Language.Haskell.TH.Env (envQ)
|
import Language.Haskell.TH.Env (envQ)
|
||||||
@ -41,6 +41,8 @@ import OurPrelude
|
|||||||
import qualified Outpaths
|
import qualified Outpaths
|
||||||
import qualified Rewrite
|
import qualified Rewrite
|
||||||
import qualified Skiplist
|
import qualified Skiplist
|
||||||
|
import System.Directory (doesDirectoryExist, withCurrentDirectory)
|
||||||
|
import System.Posix.Directory (createDirectory)
|
||||||
import Utils
|
import Utils
|
||||||
( Boundary (..),
|
( Boundary (..),
|
||||||
Options (..),
|
Options (..),
|
||||||
@ -55,8 +57,6 @@ import Utils
|
|||||||
import qualified Utils as U
|
import qualified Utils as U
|
||||||
import qualified Version
|
import qualified Version
|
||||||
import Prelude hiding (log)
|
import Prelude hiding (log)
|
||||||
import System.Directory (doesDirectoryExist, withCurrentDirectory)
|
|
||||||
import System.Posix.Directory (createDirectory)
|
|
||||||
|
|
||||||
default (T.Text)
|
default (T.Text)
|
||||||
|
|
||||||
@ -181,7 +181,8 @@ updatePackageBatch simpleLog updateInfoLine updateEnv@UpdateEnv {..} = do
|
|||||||
Right foundAttrPath -> do
|
Right foundAttrPath -> do
|
||||||
log <- alsoLogToAttrPath foundAttrPath simpleLog
|
log <- alsoLogToAttrPath foundAttrPath simpleLog
|
||||||
log updateInfoLine
|
log updateInfoLine
|
||||||
mergeBase <- if batchUpdate options
|
mergeBase <-
|
||||||
|
if batchUpdate options
|
||||||
then Git.mergeBase
|
then Git.mergeBase
|
||||||
else pure "HEAD"
|
else pure "HEAD"
|
||||||
withWorktree mergeBase foundAttrPath updateEnv $
|
withWorktree mergeBase foundAttrPath updateEnv $
|
||||||
@ -198,11 +199,13 @@ checkExistingUpdate log updateEnv existingCommitMsg attrPath = do
|
|||||||
Nothing -> lift $ log "No auto update branch exists"
|
Nothing -> lift $ log "No auto update branch exists"
|
||||||
Just msg -> do
|
Just msg -> do
|
||||||
let nV = newVersion updateEnv
|
let nV = newVersion updateEnv
|
||||||
lift $ log
|
lift $
|
||||||
|
log
|
||||||
[interpolate|An auto update branch exists with message `$msg`. New version is $nV.|]
|
[interpolate|An auto update branch exists with message `$msg`. New version is $nV.|]
|
||||||
|
|
||||||
case U.titleVersion msg of
|
case U.titleVersion msg of
|
||||||
Just branchV | Version.matchVersion (RangeMatcher (Including nV) Unbounded) branchV ->
|
Just branchV
|
||||||
|
| Version.matchVersion (RangeMatcher (Including nV) Unbounded) branchV ->
|
||||||
throwError "An auto update branch exists with an equal or greater version"
|
throwError "An auto update branch exists with an equal or greater version"
|
||||||
_ ->
|
_ ->
|
||||||
lift $ log "The auto update branch does not match or exceed the new version."
|
lift $ log "The auto update branch does not match or exceed the new version."
|
||||||
@ -329,7 +332,7 @@ updateAttrPath log mergeBase updateEnv@UpdateEnv {..} attrPath = do
|
|||||||
|
|
||||||
when hasUpdateScript do
|
when hasUpdateScript do
|
||||||
changedFiles <- Git.diffFileNames mergeBase
|
changedFiles <- Git.diffFileNames mergeBase
|
||||||
let rewrittenFile = case changedFiles of { [f] -> f; _ -> derivationFile }
|
let rewrittenFile = case changedFiles of [f] -> f; _ -> derivationFile
|
||||||
assertNotUpdatedOn updateEnv' rewrittenFile "master"
|
assertNotUpdatedOn updateEnv' rewrittenFile "master"
|
||||||
assertNotUpdatedOn updateEnv' rewrittenFile "staging"
|
assertNotUpdatedOn updateEnv' rewrittenFile "staging"
|
||||||
assertNotUpdatedOn updateEnv' rewrittenFile "staging-next"
|
assertNotUpdatedOn updateEnv' rewrittenFile "staging-next"
|
||||||
@ -356,7 +359,9 @@ updateAttrPath log mergeBase updateEnv@UpdateEnv {..} attrPath = do
|
|||||||
then "Outpath calculations were skipped for this package; total number of rebuilds unknown."
|
then "Outpath calculations were skipped for this package; total number of rebuilds unknown."
|
||||||
else Outpaths.outpathReport opDiff
|
else Outpaths.outpathReport opDiff
|
||||||
let prBase =
|
let prBase =
|
||||||
flip fromMaybe skipOutpathBase
|
flip
|
||||||
|
fromMaybe
|
||||||
|
skipOutpathBase
|
||||||
if Outpaths.numPackageRebuilds opDiff <= 500
|
if Outpaths.numPackageRebuilds opDiff <= 500
|
||||||
then "master"
|
then "master"
|
||||||
else "staging"
|
else "staging"
|
||||||
@ -437,7 +442,9 @@ publishPackage log updateEnv oldSrcUrl newSrcUrl attrPath result opReport prBase
|
|||||||
let ghUser = GH.untagName . githubUser . options $ updateEnv
|
let ghUser = GH.untagName . githubUser . options $ updateEnv
|
||||||
let mkPR = if branchExists then GH.prUpdate else GH.pr
|
let mkPR = if branchExists then GH.prUpdate else GH.pr
|
||||||
(reusedPR, pullRequestUrl) <- mkPR updateEnv (prTitle updateEnv attrPath) prMsg (ghUser <> ":" <> (branchName updateEnv)) prBase
|
(reusedPR, pullRequestUrl) <- mkPR updateEnv (prTitle updateEnv attrPath) prMsg (ghUser <> ":" <> (branchName updateEnv)) prBase
|
||||||
when branchExists $ liftIO $ log
|
when branchExists $
|
||||||
|
liftIO $
|
||||||
|
log
|
||||||
if reusedPR
|
if reusedPR
|
||||||
then "Updated existing PR"
|
then "Updated existing PR"
|
||||||
else "Reused existing auto update branch, but no corresponding open PR was found, so created a new PR"
|
else "Reused existing auto update branch, but no corresponding open PR was found, so created a new PR"
|
||||||
@ -611,7 +618,8 @@ untilOfBorgFree log waitUntil = do
|
|||||||
stats <-
|
stats <-
|
||||||
shell "curl -s https://events.ofborg.org/stats.php" & readProcessInterleaved_
|
shell "curl -s https://events.ofborg.org/stats.php" & readProcessInterleaved_
|
||||||
waiting <-
|
waiting <-
|
||||||
shell (jqBin <> " .evaluator.messages.waiting") & setStdin (byteStringInput stats)
|
shell (jqBin <> " .evaluator.messages.waiting")
|
||||||
|
& setStdin (byteStringInput stats)
|
||||||
& readProcessInterleaved_
|
& readProcessInterleaved_
|
||||||
& fmap (BSL.readInt >>> fmap fst >>> fromMaybe 0)
|
& fmap (BSL.readInt >>> fmap fst >>> fromMaybe 0)
|
||||||
when (waiting > 2) $ do
|
when (waiting > 2) $ do
|
||||||
@ -695,8 +703,7 @@ cveReport updateEnv =
|
|||||||
doCachix :: MonadIO m => (Text -> m ()) -> UpdateEnv -> Text -> ExceptT Text m Text
|
doCachix :: MonadIO m => (Text -> m ()) -> UpdateEnv -> Text -> ExceptT Text m Text
|
||||||
doCachix log updateEnv resultPath =
|
doCachix log updateEnv resultPath =
|
||||||
let o = options updateEnv
|
let o = options updateEnv
|
||||||
in
|
in if batchUpdate o && "r-ryantm" == (GH.untagName $ githubUser o)
|
||||||
if batchUpdate o && "r-ryantm" == (GH.untagName $ githubUser o)
|
|
||||||
then do
|
then do
|
||||||
lift $ log ("cachix " <> (T.pack . show) resultPath)
|
lift $ log ("cachix " <> (T.pack . show) resultPath)
|
||||||
Nix.cachix resultPath
|
Nix.cachix resultPath
|
||||||
@ -737,7 +744,6 @@ updatePackage o updateInfo = do
|
|||||||
UpdatePackageSuccess -> do
|
UpdatePackageSuccess -> do
|
||||||
log $ "[result] Success updating " <> updateInfoLine
|
log $ "[result] Success updating " <> updateInfoLine
|
||||||
|
|
||||||
|
|
||||||
withWorktree :: Text -> Text -> UpdateEnv -> IO a -> IO a
|
withWorktree :: Text -> Text -> UpdateEnv -> IO a -> IO a
|
||||||
withWorktree branch attrpath updateEnv action = do
|
withWorktree branch attrpath updateEnv action = do
|
||||||
bracket
|
bracket
|
||||||
@ -747,8 +753,10 @@ withWorktree branch attrpath updateEnv action = do
|
|||||||
Git.worktreeRemove path
|
Git.worktreeRemove path
|
||||||
Git.delete1 (branchName updateEnv)
|
Git.delete1 (branchName updateEnv)
|
||||||
Git.worktreeAdd path branch updateEnv
|
Git.worktreeAdd path branch updateEnv
|
||||||
pure path)
|
pure path
|
||||||
|
)
|
||||||
( \path -> do
|
( \path -> do
|
||||||
Git.worktreeRemove path
|
Git.worktreeRemove path
|
||||||
Git.delete1 (branchName updateEnv))
|
Git.delete1 (branchName updateEnv)
|
||||||
|
)
|
||||||
(\path -> withCurrentDirectory path action)
|
(\path -> withCurrentDirectory path action)
|
||||||
|
15
src/Utils.hs
15
src/Utils.hs
@ -27,7 +27,7 @@ module Utils
|
|||||||
regDirMode,
|
regDirMode,
|
||||||
outpathCacheDir,
|
outpathCacheDir,
|
||||||
cacheDir,
|
cacheDir,
|
||||||
worktreeDir
|
worktreeDir,
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -48,10 +48,10 @@ import Database.SQLite.Simple.ToField (ToField, toField)
|
|||||||
import qualified GitHub as GH
|
import qualified GitHub as GH
|
||||||
import OurPrelude
|
import OurPrelude
|
||||||
import Polysemy.Output
|
import Polysemy.Output
|
||||||
import System.Directory (doesDirectoryExist, createDirectoryIfMissing)
|
import System.Directory (createDirectoryIfMissing, doesDirectoryExist)
|
||||||
|
import System.Environment (lookupEnv)
|
||||||
import System.Posix.Directory (createDirectory)
|
import System.Posix.Directory (createDirectory)
|
||||||
import System.Posix.Env (getEnv)
|
import System.Posix.Env (getEnv)
|
||||||
import System.Environment (lookupEnv)
|
|
||||||
import System.Posix.Files
|
import System.Posix.Files
|
||||||
( directoryMode,
|
( directoryMode,
|
||||||
fileExist,
|
fileExist,
|
||||||
@ -141,7 +141,10 @@ titleVersion title = if T.null prefix then Nothing else Just suffix
|
|||||||
|
|
||||||
regDirMode :: FileMode
|
regDirMode :: FileMode
|
||||||
regDirMode =
|
regDirMode =
|
||||||
directoryMode .|. ownerModes .|. groupModes .|. otherReadMode
|
directoryMode
|
||||||
|
.|. ownerModes
|
||||||
|
.|. groupModes
|
||||||
|
.|. otherReadMode
|
||||||
.|. otherExecuteMode
|
.|. otherExecuteMode
|
||||||
|
|
||||||
logsDirectory :: MonadIO m => ExceptT Text m FilePath
|
logsDirectory :: MonadIO m => ExceptT Text m FilePath
|
||||||
@ -214,7 +217,9 @@ logDir :: IO FilePath
|
|||||||
logDir = do
|
logDir = do
|
||||||
r <-
|
r <-
|
||||||
runExceptT
|
runExceptT
|
||||||
( logsDirectory <|> xdgRuntimeDir <|> tmpRuntimeDir
|
( logsDirectory
|
||||||
|
<|> xdgRuntimeDir
|
||||||
|
<|> tmpRuntimeDir
|
||||||
<|> throwE
|
<|> throwE
|
||||||
"Failed to create log directory."
|
"Failed to create log directory."
|
||||||
)
|
)
|
||||||
|
@ -8,8 +8,8 @@ module Version
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Data.Foldable (toList)
|
|
||||||
import Data.Char (isAlpha, isDigit)
|
import Data.Char (isAlpha, isDigit)
|
||||||
|
import Data.Foldable (toList)
|
||||||
import Data.Function (on)
|
import Data.Function (on)
|
||||||
import qualified Data.PartialOrd as PO
|
import qualified Data.PartialOrd as PO
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
@ -1,8 +1,8 @@
|
|||||||
module CheckSpec where
|
module CheckSpec where
|
||||||
|
|
||||||
|
import qualified Check
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import qualified Check
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = hspec spec
|
main = hspec spec
|
||||||
|
Loading…
Reference in New Issue
Block a user