This commit is contained in:
zowoq 2024-06-27 11:18:31 +00:00 committed by GitHub
commit e4439a2e35
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
20 changed files with 208 additions and 231 deletions

View File

@ -5,14 +5,14 @@
"nixpkgs": [ "nixpkgs": [
"nixpkgs" "nixpkgs"
], ],
"nixpkgs-for-manual": "nixpkgs-for-manual" "systems": "systems"
}, },
"locked": { "locked": {
"lastModified": 1669050835, "lastModified": 1710694589,
"narHash": "sha256-4ppYRBBY6lIqwMNYp0XA2mku1lSPyX4JaoTf+gt5NDg=", "narHash": "sha256-5wa+Jzxr+LygoxSZuZg0YU81jgdnx2IY/CqDIJMOgec=",
"owner": "ryantm", "owner": "ryantm",
"repo": "mmdoc", "repo": "mmdoc",
"rev": "cec02bafac9456bd1ed9b261b8d163a893885e5b", "rev": "b6ddf748b1d1c01ca582bb1b3dafd6bc3a4c83a6",
"type": "github" "type": "github"
}, },
"original": { "original": {
@ -23,11 +23,11 @@
}, },
"nixpkgs": { "nixpkgs": {
"locked": { "locked": {
"lastModified": 1672428209, "lastModified": 1714213793,
"narHash": "sha256-eejhqkDz2cb2vc5VeaWphJz8UXNuoNoM8/Op8eWv2tQ=", "narHash": "sha256-Yg5D5LhyAZvd3DZrQQfJAVK8K3TkUYKooFtH1ulM0mw=",
"owner": "NixOS", "owner": "NixOS",
"repo": "nixpkgs", "repo": "nixpkgs",
"rev": "293a28df6d7ff3dec1e61e37cc4ee6e6c0fb0847", "rev": "d6f6eb2a984f2ba9a366c31e4d36d65465683450",
"type": "github" "type": "github"
}, },
"original": { "original": {
@ -35,43 +35,25 @@
"type": "indirect" "type": "indirect"
} }
}, },
"nixpkgs-for-manual": {
"locked": {
"lastModified": 1663819393,
"narHash": "sha256-SMWfyAOKRPBC95M8dhZJTlb0kHyilr2lKEAfQSHlM7I=",
"owner": "ryantm",
"repo": "nixpkgs",
"rev": "6a6caacfdd079a0fa249046514480a1c4597d861",
"type": "github"
},
"original": {
"owner": "ryantm",
"ref": "minman",
"repo": "nixpkgs",
"type": "github"
}
},
"root": { "root": {
"inputs": { "inputs": {
"mmdoc": "mmdoc", "mmdoc": "mmdoc",
"nixpkgs": "nixpkgs", "nixpkgs": "nixpkgs",
"runtimeDeps": "runtimeDeps",
"treefmt-nix": "treefmt-nix" "treefmt-nix": "treefmt-nix"
} }
}, },
"runtimeDeps": { "systems": {
"locked": { "locked": {
"lastModified": 1714247354, "lastModified": 1681028828,
"narHash": "sha256-6dFKqP/aCKIdpOgqgIQUrRT0NOfVc14ftNcdELa4Pu4=", "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
"owner": "NixOS", "owner": "nix-systems",
"repo": "nixpkgs", "repo": "default",
"rev": "c8d7c8a78fb516c0842cc65346506a565c88014d", "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
"type": "github" "type": "github"
}, },
"original": { "original": {
"owner": "NixOS", "owner": "nix-systems",
"ref": "nixos-unstable-small", "repo": "default",
"repo": "nixpkgs",
"type": "github" "type": "github"
} }
}, },
@ -82,11 +64,11 @@
] ]
}, },
"locked": { "locked": {
"lastModified": 1711963903, "lastModified": 1714058656,
"narHash": "sha256-N3QDhoaX+paWXHbEXZapqd1r95mdshxToGowtjtYkGI=", "narHash": "sha256-Qv4RBm4LKuO4fNOfx9wl40W2rBbv5u5m+whxRYUMiaA=",
"owner": "numtide", "owner": "numtide",
"repo": "treefmt-nix", "repo": "treefmt-nix",
"rev": "49dc4a92b02b8e68798abd99184f228243b6e3ac", "rev": "c6aaf729f34a36c445618580a9f95a48f5e4e03f",
"type": "github" "type": "github"
}, },
"original": { "original": {

View File

@ -7,12 +7,10 @@
inputs.treefmt-nix.url = "github:numtide/treefmt-nix"; inputs.treefmt-nix.url = "github:numtide/treefmt-nix";
inputs.treefmt-nix.inputs.nixpkgs.follows = "nixpkgs"; inputs.treefmt-nix.inputs.nixpkgs.follows = "nixpkgs";
inputs.runtimeDeps.url = "github:NixOS/nixpkgs/nixos-unstable-small";
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, treefmt-nix, runtimeDeps } @ args: outputs = { self, nixpkgs, mmdoc, treefmt-nix } @ args:
let let
systems = [ "x86_64-linux" "aarch64-linux" "x86_64-darwin" "aarch64-darwin" ]; systems = [ "x86_64-linux" "aarch64-linux" "x86_64-darwin" "aarch64-darwin" ];
eachSystem = f: nixpkgs.lib.genAttrs systems (system: f nixpkgs.legacyPackages.${system}); eachSystem = f: nixpkgs.lib.genAttrs systems (system: f nixpkgs.legacyPackages.${system});

View File

@ -1,6 +1,5 @@
{ nixpkgs { nixpkgs
, mmdoc , mmdoc
, runtimeDeps
, system , system
, self , self
, ... , ...
@ -8,11 +7,9 @@
let let
runtimePkgs = import runtimeDeps { inherit system; };
pkgs = import nixpkgs { inherit system; config = { allowBroken = true; }; }; pkgs = import nixpkgs { inherit system; config = { allowBroken = true; }; };
drvAttrs = attrs: with runtimePkgs; { drvAttrs = attrs: with pkgs; {
NIX = nix; NIX = nix;
GIT = git; GIT = git;
JQ = jq; JQ = jq;
@ -33,7 +30,7 @@ let
pkgs.haskell.lib.failOnAllWarnings ( pkgs.haskell.lib.failOnAllWarnings (
pkgs.haskell.lib.disableExecutableProfiling ( pkgs.haskell.lib.disableExecutableProfiling (
pkgs.haskell.lib.disableLibraryProfiling ( pkgs.haskell.lib.disableLibraryProfiling (
pkgs.haskell.lib.generateOptparseApplicativeCompletion "nixpkgs-update" ( pkgs.haskellPackages.generateOptparseApplicativeCompletions [ "nixpkgs-update" ] (
(haskellPackages.callPackage ../nixpkgs-update.nix { }).overrideAttrs drvAttrs (haskellPackages.callPackage ../nixpkgs-update.nix { }).overrideAttrs drvAttrs
) )
) )

View File

@ -123,7 +123,7 @@ instance Show CPE where
] ]
<> "}" <> "}"
where where
cpeField :: Show a => String -> Maybe a -> [String] cpeField :: (Show a) => String -> Maybe a -> [String]
cpeField _ Nothing = [] cpeField _ Nothing = []
cpeField name (Just value) = [name <> " = " <> show value] cpeField name (Just value) = [name <> " = " <> show value]

View File

@ -176,7 +176,7 @@ duGist resultPath =
return $ "- du listing: " <> g <> "\n" return $ "- du listing: " <> g <> "\n"
) )
result :: MonadIO m => UpdateEnv -> String -> m Text result :: (MonadIO m) => UpdateEnv -> String -> m Text
result updateEnv resultPath = result updateEnv resultPath =
liftIO $ do liftIO $ do
let expectedVersion = newVersion updateEnv let expectedVersion = newVersion updateEnv

View File

@ -26,7 +26,7 @@ class Hex t where
hex :: t -> t hex :: t -> t
-- | Convert from hexadecimal and fail on invalid input. -- | Convert from hexadecimal and fail on invalid input.
unhex :: MonadFail m => t -> m t unhex :: (MonadFail m) => t -> m t
instance Hex String where instance Hex String where
hex = Prelude.concatMap w hex = Prelude.concatMap w
@ -42,7 +42,7 @@ instance Hex String where
liftM (toEnum ((x * 16) + y) :) $ unhex r liftM (toEnum ((x * 16) + y) :) $ unhex r
unhex [_] = fail "Non-even length" unhex [_] = fail "Non-even length"
c :: MonadFail m => Char -> m Int c :: (MonadFail m) => Char -> m Int
c '0' = return 0 c '0' = return 0
c '1' = return 1 c '1' = return 1
c '2' = return 2 c '2' = return 2

View File

@ -18,7 +18,7 @@ data File m a where
makeSem ''File makeSem ''File
runIO :: runIO ::
Member (Embed IO) r => (Member (Embed IO) r) =>
Sem (File ': r) a -> Sem (File ': r) a ->
Sem r a Sem r a
runIO = runIO =
@ -38,7 +38,7 @@ runPure contentList =
Write _file contents -> output contents Write _file contents -> output contents
replace :: replace ::
Member File r => (Member File r) =>
Text -> Text ->
Text -> Text ->
FilePath -> FilePath ->
@ -50,7 +50,7 @@ replace find replacement file = do
File.write file newContents File.write file newContents
return $ contents /= newContents return $ contents /= newContents
replaceIO :: MonadIO m => Text -> Text -> FilePath -> m Bool replaceIO :: (MonadIO m) => Text -> Text -> FilePath -> m Bool
replaceIO find replacement file = replaceIO find replacement file =
liftIO $ liftIO $
runFinal $ runFinal $

View File

@ -38,18 +38,18 @@ import qualified Utils as U
default (T.Text) default (T.Text)
gReleaseUrl :: MonadIO m => GH.Auth -> URLParts -> ExceptT Text m Text gReleaseUrl :: (MonadIO m) => GH.Auth -> URLParts -> ExceptT Text m Text
gReleaseUrl auth (URLParts o r t) = gReleaseUrl auth (URLParts o r t) =
ExceptT $ ExceptT $
bimap (T.pack . show) (GH.getUrl . GH.releaseHtmlUrl) bimap (T.pack . show) (GH.getUrl . GH.releaseHtmlUrl)
<$> liftIO (GH.github auth (GH.releaseByTagNameR o r t)) <$> liftIO (GH.github auth (GH.releaseByTagNameR o r t))
releaseUrl :: MonadIO m => UpdateEnv -> Text -> ExceptT Text m Text releaseUrl :: (MonadIO m) => UpdateEnv -> Text -> ExceptT Text m Text
releaseUrl env url = do releaseUrl env url = do
urlParts <- parseURL url urlParts <- parseURL url
gReleaseUrl (authFrom env) urlParts gReleaseUrl (authFrom env) urlParts
pr :: MonadIO m => UpdateEnv -> Text -> Text -> Text -> Text -> ExceptT Text m (Bool, Text) pr :: (MonadIO m) => UpdateEnv -> Text -> Text -> Text -> Text -> ExceptT Text m (Bool, Text)
pr env title body prHead base = do 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
@ -74,9 +74,9 @@ pr env title body prHead base = do
) )
) )
prUpdate :: forall m. MonadIO m => UpdateEnv -> Text -> Text -> Text -> Text -> ExceptT Text m (Bool, Text) prUpdate :: forall m. (MonadIO m) => UpdateEnv -> Text -> Text -> Text -> Text -> ExceptT Text m (Bool, Text)
prUpdate env title body prHead base = do prUpdate env title body prHead base = do
let runRequest :: FromJSON a => GH.Request k a -> ExceptT Text m a let runRequest :: (FromJSON a) => GH.Request k a -> ExceptT Text m a
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")
@ -149,11 +149,11 @@ parseURLMaybe url =
) )
in url =~ regex in url =~ regex
parseURL :: MonadIO m => Text -> ExceptT Text m URLParts parseURL :: (MonadIO m) => Text -> ExceptT Text m URLParts
parseURL url = parseURL url =
tryJust ("GitHub: " <> url <> " is not a GitHub URL.") (parseURLMaybe url) tryJust ("GitHub: " <> url <> " is not a GitHub URL.") (parseURLMaybe url)
compareUrl :: MonadIO m => Text -> Text -> ExceptT Text m Text compareUrl :: (MonadIO m) => Text -> Text -> ExceptT Text m Text
compareUrl urlOld urlNew = do compareUrl urlOld urlNew = do
oldParts <- parseURL urlOld oldParts <- parseURL urlOld
newParts <- parseURL urlNew newParts <- parseURL urlNew
@ -213,7 +213,7 @@ authFromToken = GH.OAuth . T.encodeUtf8
authFrom :: UpdateEnv -> GH.Auth authFrom :: UpdateEnv -> GH.Auth
authFrom = authFromToken . U.githubToken . options authFrom = authFromToken . U.githubToken . options
checkExistingUpdatePR :: MonadIO m => UpdateEnv -> Text -> ExceptT Text m () checkExistingUpdatePR :: (MonadIO m) => UpdateEnv -> Text -> ExceptT Text m ()
checkExistingUpdatePR env attrPath = do checkExistingUpdatePR env attrPath = do
searchResult <- searchResult <-
ExceptT $ ExceptT $
@ -239,7 +239,7 @@ checkExistingUpdatePR env attrPath = do
& T.unlines & T.unlines
report i = "- " <> GH.issueTitle i <> "\n " <> tshow (GH.issueUrl i) report i = "- " <> GH.issueTitle i <> "\n " <> tshow (GH.issueUrl i)
latestVersion :: MonadIO m => UpdateEnv -> Text -> ExceptT Text m Version latestVersion :: (MonadIO m) => UpdateEnv -> Text -> ExceptT Text m Version
latestVersion env url = do latestVersion env url = do
urlParts <- parseURL url urlParts <- parseURL url
r <- r <-

View File

@ -80,7 +80,7 @@ deleteOrigin :: [Text] -> ProcessConfig () () ()
deleteOrigin branches = deleteOrigin branches =
silently $ procGit (["push", "origin", "--delete"] ++ fmap T.unpack branches) silently $ procGit (["push", "origin", "--delete"] ++ fmap T.unpack branches)
cleanAndResetTo :: MonadIO m => Text -> ExceptT Text m () cleanAndResetTo :: (MonadIO m) => Text -> ExceptT Text m ()
cleanAndResetTo branch = cleanAndResetTo branch =
let target = "upstream/" <> branch let target = "upstream/" <> branch
in do in do
@ -90,19 +90,19 @@ cleanAndResetTo branch =
runProcessNoIndexIssue_ $ reset target runProcessNoIndexIssue_ $ reset target
runProcessNoIndexIssue_ clean runProcessNoIndexIssue_ clean
show :: MonadIO m => Text -> Text -> ExceptT Text m Text show :: (MonadIO m) => Text -> Text -> ExceptT Text m Text
show branch file = show branch file =
readProcessInterleavedNoIndexIssue_ $ silently $ procGit ["show", T.unpack ("remotes/upstream/" <> branch <> ":" <> file)] readProcessInterleavedNoIndexIssue_ $ silently $ procGit ["show", T.unpack ("remotes/upstream/" <> branch <> ":" <> file)]
diff :: MonadIO m => Text -> ExceptT Text m Text 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 = diffFileNames branch =
readProcessInterleavedNoIndexIssue_ (procGit ["diff", T.unpack branch, "--name-only"]) readProcessInterleavedNoIndexIssue_ (procGit ["diff", T.unpack branch, "--name-only"])
& fmapRT T.lines & fmapRT T.lines
staleFetchHead :: MonadIO m => m Bool staleFetchHead :: (MonadIO m) => m Bool
staleFetchHead = staleFetchHead =
liftIO $ do liftIO $ do
nixpkgsGit <- getUserCacheDir "nixpkgs" nixpkgsGit <- getUserCacheDir "nixpkgs"
@ -116,16 +116,16 @@ staleFetchHead =
fetchedLast <- getModificationTime fetchHead fetchedLast <- getModificationTime fetchHead
return (fetchedLast < oneHourAgo) return (fetchedLast < oneHourAgo)
fetchIfStale :: MonadIO m => ExceptT Text m () fetchIfStale :: (MonadIO m) => ExceptT Text m ()
fetchIfStale = whenM staleFetchHead fetch fetchIfStale = whenM staleFetchHead fetch
fetch :: MonadIO m => ExceptT Text m () fetch :: (MonadIO m) => ExceptT Text m ()
fetch = fetch =
runProcessNoIndexIssue_ $ runProcessNoIndexIssue_ $
silently $ silently $
procGit ["fetch", "-q", "--prune", "--multiple", "upstream", "origin"] 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 =
runProcessNoIndexIssue_ runProcessNoIndexIssue_
( procGit ( procGit
@ -176,7 +176,7 @@ mergeBase = do
-- Return Nothing if a remote branch for this package doesn't exist. If a -- Return Nothing if a remote branch for this package doesn't exist. If a
-- branch does exist, return a Just of its last commit message. -- branch does exist, return a Just of its last commit message.
findAutoUpdateBranchMessage :: MonadIO m => Text -> ExceptT Text m (Maybe Text) findAutoUpdateBranchMessage :: (MonadIO m) => Text -> ExceptT Text m (Maybe Text)
findAutoUpdateBranchMessage pName = do findAutoUpdateBranchMessage pName = do
remoteBranches <- remoteBranches <-
readProcessInterleavedNoIndexIssue_ (procGit ["branch", "--remote", "--format=%(refname:short) %(subject)"]) readProcessInterleavedNoIndexIssue_ (procGit ["branch", "--remote", "--format=%(refname:short) %(subject)"])
@ -190,11 +190,11 @@ inNixpkgsRepo = do
currentDir <- getCurrentDirectory currentDir <- getCurrentDirectory
doesFileExist (currentDir <> "/nixos/release.nix") doesFileExist (currentDir <> "/nixos/release.nix")
commit :: MonadIO m => Text -> ExceptT Text m () commit :: (MonadIO m) => Text -> ExceptT Text m ()
commit ref = commit ref =
runProcessNoIndexIssue_ (procGit ["commit", "-am", T.unpack ref]) runProcessNoIndexIssue_ (procGit ["commit", "-am", T.unpack ref])
headRev :: MonadIO m => ExceptT Text m Text headRev :: (MonadIO m) => ExceptT Text m Text
headRev = T.strip <$> readProcessInterleavedNoIndexIssue_ (procGit ["rev-parse", "HEAD"]) headRev = T.strip <$> readProcessInterleavedNoIndexIssue_ (procGit ["rev-parse", "HEAD"])
deleteBranchesEverywhere :: Vector Text -> IO () deleteBranchesEverywhere :: Vector Text -> IO ()
@ -227,7 +227,7 @@ runProcessNoIndexIssue_IO config = go
ExitFailure _ -> throw $ ExitCodeException code config out e ExitFailure _ -> throw $ ExitCodeException code config out e
runProcessNoIndexIssue_ :: runProcessNoIndexIssue_ ::
MonadIO m => ProcessConfig () () () -> ExceptT Text m () (MonadIO m) => ProcessConfig () () () -> ExceptT Text m ()
runProcessNoIndexIssue_ config = tryIOTextET go runProcessNoIndexIssue_ config = tryIOTextET go
where where
go = do go = do
@ -241,7 +241,7 @@ runProcessNoIndexIssue_ config = tryIOTextET go
ExitFailure _ -> throw $ ExitCodeException code config out e ExitFailure _ -> throw $ ExitCodeException code config out e
readProcessInterleavedNoIndexIssue_ :: readProcessInterleavedNoIndexIssue_ ::
MonadIO m => ProcessConfig () () () -> ExceptT Text m Text (MonadIO m) => ProcessConfig () () () -> ExceptT Text m Text
readProcessInterleavedNoIndexIssue_ config = tryIOTextET go readProcessInterleavedNoIndexIssue_ config = tryIOTextET go
where where
go = do go = do

View File

@ -16,17 +16,17 @@ filter _ cpeMatch "socat" v
filter _ cpeMatch "uzbl" v filter _ cpeMatch "uzbl" v
| isNothing (v =~ yearRegex) | isNothing (v =~ yearRegex)
&& "2009.12.22" && "2009.12.22"
`anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch = `anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch =
False False
| isNothing (v =~ yearRegex) | isNothing (v =~ yearRegex)
&& "2010.04.03" && "2010.04.03"
`anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch = `anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch =
False False
filter _ cpeMatch "go" v filter _ cpeMatch "go" v
| "." | "."
`T.isInfixOf` v `T.isInfixOf` v
&& "-" && "-"
`anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch = `anyVersionInfixOf` cpeMatchVersionMatcher cpeMatch =
False False
filter _ cpeMatch "terraform" _ filter _ cpeMatch "terraform" _
| cpeTargetSoftware (cpeMatchCPE cpeMatch) == Just "aws" = False | cpeTargetSoftware (cpeMatchCPE cpeMatch) == Just "aws" = False

View File

@ -61,7 +61,7 @@ rawOpt Raw = ["--raw"]
rawOpt NoRaw = [] rawOpt NoRaw = []
nixEvalApply :: nixEvalApply ::
MonadIO m => (MonadIO m) =>
Text -> Text ->
Text -> Text ->
ExceptT Text m Text ExceptT Text m Text
@ -71,7 +71,7 @@ nixEvalApply applyFunc attrPath =
& fmapRT (fst >>> T.strip) & fmapRT (fst >>> T.strip)
nixEvalApplyRaw :: nixEvalApplyRaw ::
MonadIO m => (MonadIO m) =>
Text -> Text ->
Text -> Text ->
ExceptT Text m Text ExceptT Text m Text
@ -81,7 +81,7 @@ nixEvalApplyRaw applyFunc attrPath =
& fmapRT (fst >>> T.strip) & fmapRT (fst >>> T.strip)
nixEvalExpr :: nixEvalExpr ::
MonadIO m => (MonadIO m) =>
Text -> Text ->
ExceptT Text m Text ExceptT Text m Text
nixEvalExpr expr = nixEvalExpr expr =
@ -90,7 +90,7 @@ nixEvalExpr expr =
& fmapRT (fst >>> T.strip) & fmapRT (fst >>> T.strip)
-- Error if the "new version" is actually newer according to nix -- Error if the "new version" is actually newer according to nix
assertNewerVersion :: MonadIO m => UpdateEnv -> ExceptT Text m () assertNewerVersion :: (MonadIO m) => UpdateEnv -> ExceptT Text m ()
assertNewerVersion updateEnv = do assertNewerVersion updateEnv = do
versionComparison <- versionComparison <-
nixEvalExpr nixEvalExpr
@ -113,7 +113,7 @@ assertNewerVersion updateEnv = do
) )
-- This is extremely slow but gives us the best results we know of -- This is extremely slow but gives us the best results we know of
lookupAttrPath :: MonadIO m => UpdateEnv -> ExceptT Text m Text lookupAttrPath :: (MonadIO m) => UpdateEnv -> ExceptT Text m Text
lookupAttrPath updateEnv = lookupAttrPath updateEnv =
-- lookup attrpath by nix-env -- lookup attrpath by nix-env
( proc ( proc
@ -134,7 +134,7 @@ lookupAttrPath updateEnv =
(getAttrString "name" (packageName updateEnv)) (getAttrString "name" (packageName updateEnv))
& fmapRT (const (packageName updateEnv)) & fmapRT (const (packageName updateEnv))
getDerivationFile :: MonadIO m => Text -> ExceptT Text m Text getDerivationFile :: (MonadIO m) => Text -> ExceptT Text m Text
getDerivationFile attrPath = do getDerivationFile attrPath = do
npDir <- liftIO $ Git.nixpkgsDir npDir <- liftIO $ Git.nixpkgsDir
proc "env" ["EDITOR=echo", (binPath <> "/nix"), "--extra-experimental-features", "nix-command", "edit", attrPath & T.unpack, "-f", "."] proc "env" ["EDITOR=echo", (binPath <> "/nix"), "--extra-experimental-features", "nix-command", "edit", attrPath & T.unpack, "-f", "."]
@ -143,20 +143,20 @@ getDerivationFile attrPath = do
-- Get an attribute that can be evaluated off a derivation, as in: -- Get an attribute that can be evaluated off a derivation, as in:
-- getAttr "cargoSha256" "ripgrep" -> 0lwz661rbm7kwkd6mallxym1pz8ynda5f03ynjfd16vrazy2dj21 -- getAttr "cargoSha256" "ripgrep" -> 0lwz661rbm7kwkd6mallxym1pz8ynda5f03ynjfd16vrazy2dj21
getAttr :: MonadIO m => Text -> Text -> ExceptT Text m Text getAttr :: (MonadIO m) => Text -> Text -> ExceptT Text m Text
getAttr attr = srcOrMain (nixEvalApply ("p: p." <> attr)) getAttr attr = srcOrMain (nixEvalApply ("p: p." <> attr))
getAttrString :: MonadIO m => Text -> Text -> ExceptT Text m Text getAttrString :: (MonadIO m) => Text -> Text -> ExceptT Text m Text
getAttrString attr = srcOrMain (nixEvalApplyRaw ("p: p." <> attr)) getAttrString attr = srcOrMain (nixEvalApplyRaw ("p: p." <> attr))
getHash :: MonadIO m => Text -> ExceptT Text m Text getHash :: (MonadIO m) => Text -> ExceptT Text m Text
getHash = getAttrString "drvAttrs.outputHash" getHash = getAttrString "drvAttrs.outputHash"
getMaintainers :: MonadIO m => Text -> ExceptT Text m Text getMaintainers :: (MonadIO m) => Text -> ExceptT Text m Text
getMaintainers = getMaintainers =
nixEvalApplyRaw "p: let gh = m : m.github or \"\"; nonempty = s: s != \"\"; addAt = s: \"@\"+s; in builtins.concatStringsSep \" \" (map addAt (builtins.filter nonempty (map gh p.meta.maintainers or [])))" nixEvalApplyRaw "p: let gh = m : m.github or \"\"; nonempty = s: s != \"\"; addAt = s: \"@\"+s; in builtins.concatStringsSep \" \" (map addAt (builtins.filter nonempty (map gh p.meta.maintainers or [])))"
readNixBool :: MonadIO m => ExceptT Text m Text -> ExceptT Text m Bool readNixBool :: (MonadIO m) => ExceptT Text m Text -> ExceptT Text m Bool
readNixBool t = do readNixBool t = do
text <- t text <- t
case text of case text of
@ -164,21 +164,21 @@ readNixBool t = do
"false" -> return False "false" -> return False
a -> throwE ("Failed to read expected nix boolean " <> a <> " ") a -> throwE ("Failed to read expected nix boolean " <> a <> " ")
getIsBroken :: MonadIO m => Text -> ExceptT Text m Bool getIsBroken :: (MonadIO m) => Text -> ExceptT Text m Bool
getIsBroken attrPath = getIsBroken attrPath =
getAttr "meta.broken" attrPath getAttr "meta.broken" attrPath
& readNixBool & readNixBool
getChangelog :: MonadIO m => Text -> ExceptT Text m Text getChangelog :: (MonadIO m) => Text -> ExceptT Text m Text
getChangelog = nixEvalApplyRaw "p: p.meta.changelog or \"\"" getChangelog = nixEvalApplyRaw "p: p.meta.changelog or \"\""
getDescription :: MonadIO m => Text -> ExceptT Text m Text getDescription :: (MonadIO m) => Text -> ExceptT Text m Text
getDescription = nixEvalApplyRaw "p: p.meta.description or \"\"" getDescription = nixEvalApplyRaw "p: p.meta.description or \"\""
getHomepage :: MonadIO m => Text -> ExceptT Text m Text 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 = getSrcUrl =
srcOrMain srcOrMain
(nixEvalApplyRaw "p: builtins.elemAt p.drvAttrs.urls 0") (nixEvalApplyRaw "p: builtins.elemAt p.drvAttrs.urls 0")
@ -190,7 +190,7 @@ buildCmd attrPath =
log :: Text -> ProcessConfig () () () log :: Text -> ProcessConfig () () ()
log attrPath = proc (binPath <> "/nix") ["--extra-experimental-features", "nix-command", "log", "-f", ".", attrPath & T.unpack] log attrPath = proc (binPath <> "/nix") ["--extra-experimental-features", "nix-command", "log", "-f", ".", attrPath & T.unpack]
build :: MonadIO m => Text -> ExceptT Text m () build :: (MonadIO m) => Text -> ExceptT Text m ()
build attrPath = build attrPath =
(buildCmd attrPath & runProcess_ & tryIOTextET) (buildCmd attrPath & runProcess_ & tryIOTextET)
<|> ( do <|> ( do
@ -204,7 +204,7 @@ build attrPath =
& fmap (T.lines >>> reverse >>> take 30 >>> reverse >>> T.unlines) & fmap (T.lines >>> reverse >>> take 30 >>> reverse >>> T.unlines)
throwE ("nix build failed.\n" <> buildLog <> " ") throwE ("nix build failed.\n" <> buildLog <> " ")
cachix :: MonadIO m => Text -> ExceptT Text m () cachix :: (MonadIO m) => Text -> ExceptT Text m ()
cachix resultPath = cachix resultPath =
( setStdin ( setStdin
(byteStringInput (TL.encodeUtf8 (TL.fromStrict resultPath))) (byteStringInput (TL.encodeUtf8 (TL.fromStrict resultPath)))
@ -228,7 +228,7 @@ numberOfHashes derivationContents =
countUp x = T.count x derivationContents countUp x = T.count x derivationContents
assertOldVersionOn :: assertOldVersionOn ::
MonadIO m => UpdateEnv -> Text -> Text -> ExceptT Text m () (MonadIO m) => UpdateEnv -> Text -> Text -> ExceptT Text m ()
assertOldVersionOn updateEnv branchName contents = assertOldVersionOn updateEnv branchName contents =
tryAssert tryAssert
("Old version " <> oldVersionPattern <> " not present in " <> branchName <> " derivation file with contents: " <> contents) ("Old version " <> oldVersionPattern <> " not present in " <> branchName <> " derivation file with contents: " <> contents)
@ -236,7 +236,7 @@ assertOldVersionOn updateEnv branchName contents =
where where
oldVersionPattern = oldVersion updateEnv <> "\"" oldVersionPattern = oldVersion updateEnv <> "\""
resultLink :: MonadIO m => ExceptT Text m Text resultLink :: (MonadIO m) => ExceptT Text m Text
resultLink = resultLink =
T.strip T.strip
<$> ( ourReadProcessInterleaved_ "readlink ./result" <$> ( ourReadProcessInterleaved_ "readlink ./result"
@ -252,7 +252,7 @@ fakeHashMatching oldHash =
else "sha256-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA=" else "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
getHashFromBuild = getHashFromBuild =
srcOrMain srcOrMain
( \attrPath -> do ( \attrPath -> do
@ -275,26 +275,26 @@ getHashFromBuild =
secondSplit secondSplit
) )
version :: MonadIO m => ExceptT Text m Text version :: (MonadIO m) => ExceptT Text m Text
version = ourReadProcessInterleaved_ (proc (binPath <> "/nix") ["--version"]) version = ourReadProcessInterleaved_ (proc (binPath <> "/nix") ["--version"])
getPatches :: MonadIO m => Text -> ExceptT Text m Text getPatches :: (MonadIO m) => Text -> ExceptT Text m Text
getPatches = getPatches =
nixEvalApply "p: map (patch: patch.name) p.patches" nixEvalApply "p: map (patch: patch.name) p.patches"
hasPatchNamed :: MonadIO m => Text -> Text -> ExceptT Text m Bool hasPatchNamed :: (MonadIO m) => Text -> Text -> ExceptT Text m Bool
hasPatchNamed attrPath name = do hasPatchNamed attrPath name = do
ps <- getPatches attrPath ps <- getPatches attrPath
return $ name `T.isInfixOf` ps return $ name `T.isInfixOf` ps
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" "p: builtins.hasAttr \"updateScript\" p"
attrPath 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) <- (exitCode, output) <-

View File

@ -29,7 +29,7 @@ revDir :: FilePath -> Text -> FilePath
revDir cache commit = cache <> "/rev-" <> T.unpack commit revDir cache commit = cache <> "/rev-" <> T.unpack commit
run :: run ::
Members '[F.File, P.Process, Output Text] r => (Members '[F.File, P.Process, Output Text] r) =>
FilePath -> FilePath ->
Text -> Text ->
Sem r Text Sem r Text

View File

@ -62,46 +62,46 @@ import System.Process.Typed
interpolate :: QuasiQuoter interpolate :: QuasiQuoter
interpolate = NeatInterpolation.text interpolate = NeatInterpolation.text
tshow :: Show a => a -> Text tshow :: (Show a) => a -> Text
tshow = show >>> pack tshow = show >>> pack
tryIOTextET :: MonadIO m => IO a -> ExceptT Text m a tryIOTextET :: (MonadIO m) => IO a -> ExceptT Text m a
tryIOTextET = syncIO >>> fmapLT tshow tryIOTextET = syncIO >>> fmapLT tshow
whenM :: Monad m => m Bool -> m () -> m () whenM :: (Monad m) => m Bool -> m () -> m ()
whenM c a = c >>= \res -> when res a whenM c a = c >>= \res -> when res a
bytestringToText :: BSL.ByteString -> Text bytestringToText :: BSL.ByteString -> Text
bytestringToText = BSL.toStrict >>> (T.decodeUtf8With T.lenientDecode) bytestringToText = BSL.toStrict >>> (T.decodeUtf8With T.lenientDecode)
ourReadProcessInterleavedBS_ :: ourReadProcessInterleavedBS_ ::
MonadIO m => (MonadIO m) =>
ProcessConfig stdin stdoutIgnored stderrIgnored -> ProcessConfig stdin stdoutIgnored stderrIgnored ->
ExceptT Text m BSL.ByteString ExceptT Text m BSL.ByteString
ourReadProcessInterleavedBS_ = readProcessInterleaved_ >>> tryIOTextET ourReadProcessInterleavedBS_ = readProcessInterleaved_ >>> tryIOTextET
ourReadProcess_ :: ourReadProcess_ ::
MonadIO m => (MonadIO m) =>
ProcessConfig stdin stdout stderr -> ProcessConfig stdin stdout stderr ->
ExceptT Text m (Text, Text) ExceptT Text m (Text, Text)
ourReadProcess_ = readProcess_ >>> tryIOTextET >>> fmapRT (\(stdout, stderr) -> (bytestringToText stdout, bytestringToText stderr)) ourReadProcess_ = readProcess_ >>> tryIOTextET >>> fmapRT (\(stdout, stderr) -> (bytestringToText stdout, bytestringToText stderr))
ourReadProcess_Sem :: ourReadProcess_Sem ::
Members '[P.Process] r => (Members '[P.Process] r) =>
ProcessConfig stdin stdoutIgnored stderrIgnored -> ProcessConfig stdin stdoutIgnored stderrIgnored ->
Sem r (Text, Text) Sem r (Text, Text)
ourReadProcess_Sem = ourReadProcess_Sem =
P.read_ >>> fmap (\(stdout, stderr) -> (bytestringToText stdout, bytestringToText stderr)) P.read_ >>> fmap (\(stdout, stderr) -> (bytestringToText stdout, bytestringToText stderr))
ourReadProcessInterleaved_ :: ourReadProcessInterleaved_ ::
MonadIO m => (MonadIO m) =>
ProcessConfig stdin stdoutIgnored stderrIgnored -> ProcessConfig stdin stdoutIgnored stderrIgnored ->
ExceptT Text m Text ExceptT Text m Text
ourReadProcessInterleaved_ = ourReadProcessInterleaved_ =
readProcessInterleaved_ >>> tryIOTextET >>> fmapRT bytestringToText readProcessInterleaved_ >>> tryIOTextET >>> fmapRT bytestringToText
ourReadProcessInterleaved :: ourReadProcessInterleaved ::
MonadIO m => (MonadIO m) =>
ProcessConfig stdin stdoutIgnored stderrIgnored -> ProcessConfig stdin stdoutIgnored stderrIgnored ->
ExceptT Text m (ExitCode, Text) ExceptT Text m (ExitCode, Text)
ourReadProcessInterleaved = ourReadProcessInterleaved =
@ -110,7 +110,7 @@ ourReadProcessInterleaved =
>>> fmapRT (\(a, b) -> (a, bytestringToText b)) >>> fmapRT (\(a, b) -> (a, bytestringToText b))
ourReadProcessInterleavedSem :: ourReadProcessInterleavedSem ::
Members '[P.Process] r => (Members '[P.Process] r) =>
ProcessConfig stdin stdoutIgnored stderrIgnored -> ProcessConfig stdin stdoutIgnored stderrIgnored ->
Sem r (ExitCode, Text) Sem r (ExitCode, Text)
ourReadProcessInterleavedSem = ourReadProcessInterleavedSem =

View File

@ -87,7 +87,7 @@ in
tweak (builtins.removeAttrs hydraJobs blacklist) tweak (builtins.removeAttrs hydraJobs blacklist)
|] |]
outPath :: MonadIO m => ExceptT Text m Text outPath :: (MonadIO m) => ExceptT Text m Text
outPath = do outPath = do
cacheDir <- liftIO $ Utils.outpathCacheDir cacheDir <- liftIO $ Utils.outpathCacheDir
let outpathFile = (cacheDir </> "outpaths.nix") let outpathFile = (cacheDir </> "outpaths.nix")
@ -131,7 +131,7 @@ data ResultLine = ResultLine
-- testInput :: Text -- testInput :: Text
-- testInput = -- testInput =
-- "haskellPackages.amazonka-dynamodb-streams.x86_64-linux doc=/nix/store/m4rpsc9nx0qcflh9ni6qdlg6hbkwpicc-amazonka-dynamodb-streams-1.6.0-doc;/nix/store/rvd4zydr22a7j5kgnmg5x6695c7bgqbk-amazonka-dynamodb-streams-1.6.0\nhaskellPackages.agum.x86_64-darwin doc=/nix/store/n526rc0pa5h0krdzsdni5agcpvcd3cb9-agum-2.7-doc;/nix/store/s59r75svbjm724q5iaprq4mln5k6wcr9-agum-2.7" -- "haskellPackages.amazonka-dynamodb-streams.x86_64-linux doc=/nix/store/m4rpsc9nx0qcflh9ni6qdlg6hbkwpicc-amazonka-dynamodb-streams-1.6.0-doc;/nix/store/rvd4zydr22a7j5kgnmg5x6695c7bgqbk-amazonka-dynamodb-streams-1.6.0\nhaskellPackages.agum.x86_64-darwin doc=/nix/store/n526rc0pa5h0krdzsdni5agcpvcd3cb9-agum-2.7-doc;/nix/store/s59r75svbjm724q5iaprq4mln5k6wcr9-agum-2.7"
currentOutpathSet :: MonadIO m => ExceptT Text m (Set ResultLine) currentOutpathSet :: (MonadIO m) => ExceptT Text m (Set ResultLine)
currentOutpathSet = do currentOutpathSet = do
rev <- Git.headRev rev <- Git.headRev
mayOp <- lift $ lookupOutPathByRev rev mayOp <- lift $ lookupOutPathByRev rev
@ -145,12 +145,12 @@ currentOutpathSet = do
pure paths pure paths
parse parseResults "outpath" op & fmapL tshow & hoistEither parse parseResults "outpath" op & fmapL tshow & hoistEither
currentOutpathSetUncached :: MonadIO m => ExceptT Text m (Set ResultLine) currentOutpathSetUncached :: (MonadIO m) => ExceptT Text m (Set ResultLine)
currentOutpathSetUncached = do currentOutpathSetUncached = do
op <- outPath op <- outPath
parse parseResults "outpath" op & fmapL tshow & hoistEither parse parseResults "outpath" op & fmapL tshow & hoistEither
lookupOutPathByRev :: MonadIO m => Text -> m (Maybe Text) lookupOutPathByRev :: (MonadIO m) => Text -> m (Maybe Text)
lookupOutPathByRev rev = do lookupOutPathByRev rev = do
dir <- Utils.outpathCacheDir dir <- Utils.outpathCacheDir
let file = dir <> "/" <> T.unpack rev let file = dir <> "/" <> T.unpack rev
@ -167,10 +167,10 @@ dummyOutpathSetBefore attrPath = S.singleton (ResultLine attrPath "x86-64" (V.si
dummyOutpathSetAfter :: Text -> Set ResultLine dummyOutpathSetAfter :: Text -> Set ResultLine
dummyOutpathSetAfter attrPath = S.singleton (ResultLine attrPath "x86-64" (V.singleton (Outpath (Just "attrPath") "fakepath-edited"))) dummyOutpathSetAfter attrPath = S.singleton (ResultLine attrPath "x86-64" (V.singleton (Outpath (Just "attrPath") "fakepath-edited")))
parseResults :: CharParsing m => m (Set ResultLine) parseResults :: (CharParsing m) => m (Set ResultLine)
parseResults = S.fromList <$> parseResultLine `sepEndBy` newline parseResults = S.fromList <$> parseResultLine `sepEndBy` newline
parseResultLine :: CharParsing m => m ResultLine parseResultLine :: (CharParsing m) => m ResultLine
parseResultLine = parseResultLine =
ResultLine ResultLine
<$> (T.dropWhileEnd (== '.') <$> parseAttrpath) <$> (T.dropWhileEnd (== '.') <$> parseAttrpath)
@ -178,19 +178,19 @@ parseResultLine =
<* spaces <* spaces
<*> parseOutpaths <*> parseOutpaths
parseAttrpath :: CharParsing m => m Text parseAttrpath :: (CharParsing m) => m Text
parseAttrpath = T.concat <$> many (try parseAttrpathPart) parseAttrpath = T.concat <$> many (try parseAttrpathPart)
parseAttrpathPart :: CharParsing m => m Text parseAttrpathPart :: (CharParsing m) => m Text
parseAttrpathPart = T.snoc <$> (T.pack <$> many (noneOf ". ")) <*> char '.' parseAttrpathPart = T.snoc <$> (T.pack <$> many (noneOf ". ")) <*> char '.'
parseArchitecture :: CharParsing m => m Text parseArchitecture :: (CharParsing m) => m Text
parseArchitecture = T.pack <$> many (noneOf " ") parseArchitecture = T.pack <$> many (noneOf " ")
parseOutpaths :: CharParsing m => m (Vector Outpath) parseOutpaths :: (CharParsing m) => m (Vector Outpath)
parseOutpaths = V.fromList <$> (parseOutpath `sepBy1` char ';') parseOutpaths = V.fromList <$> (parseOutpath `sepBy1` char ';')
parseOutpath :: CharParsing m => m Outpath parseOutpath :: (CharParsing m) => m Outpath
parseOutpath = parseOutpath =
Outpath Outpath
<$> optional (try (T.pack <$> (many (noneOf "=\n") <* char '='))) <$> optional (try (T.pack <$> (many (noneOf "=\n") <* char '=')))

View File

@ -17,7 +17,7 @@ data Process m a where
makeSem ''Process makeSem ''Process
runIO :: runIO ::
Member (Embed IO) r => (Member (Embed IO) r) =>
Sem (Process ': r) a -> Sem (Process ': r) a ->
Sem r a Sem r a
runIO = runIO =

View File

@ -77,23 +77,23 @@ runAll log args = do
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- The canonical updater: updates the src attribute and recomputes the sha256 -- The canonical updater: updates the src attribute and recomputes the sha256
version :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text) version :: (MonadIO m) => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
version log args@Args {..} = do version log args@Args {..} = do
if if
| Nix.numberOfFetchers derivationContents > 1 || Nix.numberOfHashes derivationContents > 1 -> do | Nix.numberOfFetchers derivationContents > 1 || Nix.numberOfHashes derivationContents > 1 -> do
lift $ log "generic version rewriter does not support multiple hashes" lift $ log "generic version rewriter does not support multiple hashes"
return Nothing return Nothing
| hasUpdateScript -> do | hasUpdateScript -> do
lift $ log "skipping because derivation has updateScript" lift $ log "skipping because derivation has updateScript"
return Nothing return Nothing
| otherwise -> do | otherwise -> do
srcVersionFix args srcVersionFix args
lift $ log "updated version and sha256" lift $ log "updated version and sha256"
return $ Just "Version update" return $ Just "Version update"
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Redirect homepage when moved. -- Redirect homepage when moved.
redirectedUrls :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text) redirectedUrls :: (MonadIO m) => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
redirectedUrls log Args {..} = do redirectedUrls log Args {..} = do
homepage <- Nix.getHomepage attrPath homepage <- Nix.getHomepage attrPath
response <- liftIO $ do response <- liftIO $ do
@ -127,106 +127,106 @@ redirectedUrls log Args {..} = do
-- Rewrite Rust on rustPlatform.buildRustPackage -- Rewrite Rust on rustPlatform.buildRustPackage
-- This is basically `version` above, but with a second pass to also update the -- This is basically `version` above, but with a second pass to also update the
-- cargoSha256 vendor hash. -- cargoSha256 vendor hash.
rustCrateVersion :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text) rustCrateVersion :: (MonadIO m) => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
rustCrateVersion log args@Args {..} = do rustCrateVersion log args@Args {..} = do
if if
| and [(not (T.isInfixOf "cargoSha256" derivationContents)), (not (T.isInfixOf "cargoHash" derivationContents))] -> do | and [(not (T.isInfixOf "cargoSha256" derivationContents)), (not (T.isInfixOf "cargoHash" derivationContents))] -> do
lift $ log "No cargoSha256 or cargoHash found" lift $ log "No cargoSha256 or cargoHash found"
return Nothing return Nothing
| hasUpdateScript -> do | hasUpdateScript -> do
lift $ log "skipping because derivation has updateScript" lift $ log "skipping because derivation has updateScript"
return Nothing return Nothing
| otherwise -> do | otherwise -> do
_ <- lift $ File.replaceIO "cargoSha256 =" "cargoHash =" derivationFile _ <- lift $ File.replaceIO "cargoSha256 =" "cargoHash =" derivationFile
-- This starts the same way `version` does, minus the assert -- This starts the same way `version` does, minus the assert
srcVersionFix args srcVersionFix args
-- But then from there we need to do this a second time for the cargoHash! -- But then from there we need to do this a second time for the cargoHash!
oldCargoHash <- Nix.getAttrString "cargoHash" attrPath oldCargoHash <- Nix.getAttrString "cargoHash" attrPath
let fakeHash = Nix.fakeHashMatching oldCargoHash let fakeHash = Nix.fakeHashMatching oldCargoHash
_ <- lift $ File.replaceIO oldCargoHash fakeHash derivationFile _ <- lift $ File.replaceIO oldCargoHash fakeHash derivationFile
newCargoHash <- Nix.getHashFromBuild attrPath newCargoHash <- Nix.getHashFromBuild attrPath
when (oldCargoHash == newCargoHash) $ throwE ("cargo hashes equal; no update necessary: " <> oldCargoHash) when (oldCargoHash == newCargoHash) $ throwE ("cargo hashes equal; no update necessary: " <> oldCargoHash)
lift . log $ "Replacing cargoHash with " <> newCargoHash lift . log $ "Replacing cargoHash with " <> newCargoHash
_ <- lift $ File.replaceIO fakeHash newCargoHash derivationFile _ <- lift $ File.replaceIO fakeHash newCargoHash derivationFile
-- Ensure the package actually builds and passes its tests -- Ensure the package actually builds and passes its tests
Nix.build attrPath Nix.build attrPath
lift $ log "Finished updating Crate version and replacing hashes" lift $ log "Finished updating Crate version and replacing hashes"
return $ Just "Rust version update" return $ Just "Rust version update"
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Rewrite Golang packages with buildGoModule -- Rewrite Golang packages with buildGoModule
-- This is basically `version` above, but with a second pass to also update the -- This is basically `version` above, but with a second pass to also update the
-- vendorHash go vendor hash. -- vendorHash go vendor hash.
golangModuleVersion :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text) golangModuleVersion :: (MonadIO m) => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
golangModuleVersion log args@Args {..} = do golangModuleVersion log args@Args {..} = do
if if
| and [not (T.isInfixOf "buildGoModule" derivationContents && T.isInfixOf "vendorSha256" derivationContents), not (T.isInfixOf "buildGoModule" derivationContents && T.isInfixOf "vendorHash" derivationContents)] -> do | and [not (T.isInfixOf "buildGoModule" derivationContents && T.isInfixOf "vendorSha256" derivationContents), not (T.isInfixOf "buildGoModule" derivationContents && T.isInfixOf "vendorHash" derivationContents)] -> do
lift $ log "Not a buildGoModule package with vendorSha256 or vendorHash" lift $ log "Not a buildGoModule package with vendorSha256 or vendorHash"
return Nothing return Nothing
| hasUpdateScript -> do | hasUpdateScript -> do
lift $ log "skipping because derivation has updateScript" lift $ log "skipping because derivation has updateScript"
return Nothing return Nothing
| otherwise -> do | otherwise -> do
_ <- lift $ File.replaceIO "vendorSha256 =" "vendorHash =" derivationFile _ <- lift $ File.replaceIO "vendorSha256 =" "vendorHash =" derivationFile
-- This starts the same way `version` does, minus the assert -- This starts the same way `version` does, minus the assert
srcVersionFix args srcVersionFix args
-- But then from there we need to do this a second time for the vendorHash! -- But then from there we need to do this a second time for the vendorHash!
-- Note that explicit `null` cannot be coerced to a string by nix eval --raw -- Note that explicit `null` cannot be coerced to a string by nix eval --raw
oldVendorHash <- Nix.getAttr "vendorHash" attrPath oldVendorHash <- Nix.getAttr "vendorHash" attrPath
lift . log $ "Found old vendorHash = " <> oldVendorHash lift . log $ "Found old vendorHash = " <> oldVendorHash
original <- liftIO $ T.readFile derivationFile original <- liftIO $ T.readFile derivationFile
_ <- lift $ File.replaceIO oldVendorHash "null" derivationFile _ <- lift $ File.replaceIO oldVendorHash "null" derivationFile
ok <- runExceptT $ Nix.build attrPath ok <- runExceptT $ Nix.build attrPath
_ <- _ <-
if isLeft ok if isLeft ok
then do then do
_ <- liftIO $ T.writeFile derivationFile original _ <- liftIO $ T.writeFile derivationFile original
let fakeHash = Nix.fakeHashMatching oldVendorHash let fakeHash = Nix.fakeHashMatching oldVendorHash
_ <- lift $ File.replaceIO oldVendorHash ("\"" <> fakeHash <> "\"") derivationFile _ <- lift $ File.replaceIO oldVendorHash ("\"" <> fakeHash <> "\"") derivationFile
newVendorHash <- Nix.getHashFromBuild attrPath newVendorHash <- Nix.getHashFromBuild attrPath
_ <- lift $ File.replaceIO fakeHash newVendorHash derivationFile _ <- lift $ File.replaceIO fakeHash newVendorHash derivationFile
-- Note that on some small bumps, this may not actually change if go.sum did not -- Note that on some small bumps, this may not actually change if go.sum did not
lift . log $ "Replaced vendorHash with " <> newVendorHash lift . log $ "Replaced vendorHash with " <> newVendorHash
else do else do
lift . log $ "Set vendorHash to null" lift . log $ "Set vendorHash to null"
-- Ensure the package actually builds and passes its tests -- Ensure the package actually builds and passes its tests
Nix.build attrPath Nix.build attrPath
lift $ log "Finished updating vendorHash" lift $ log "Finished updating vendorHash"
return $ Just "Golang update" return $ Just "Golang update"
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Rewrite NPM packages with buildNpmPackage -- Rewrite NPM packages with buildNpmPackage
-- This is basically `version` above, but with a second pass to also update the -- This is basically `version` above, but with a second pass to also update the
-- cargoSha256 vendor hash. -- cargoSha256 vendor hash.
npmDepsVersion :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text) npmDepsVersion :: (MonadIO m) => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
npmDepsVersion log args@Args {..} = do npmDepsVersion log args@Args {..} = do
if if
| not (T.isInfixOf "npmDepsHash" derivationContents) -> do | not (T.isInfixOf "npmDepsHash" derivationContents) -> do
lift $ log "No npmDepsHash" lift $ log "No npmDepsHash"
return Nothing return Nothing
| hasUpdateScript -> do | hasUpdateScript -> do
lift $ log "skipping because derivation has updateScript" lift $ log "skipping because derivation has updateScript"
return Nothing return Nothing
| otherwise -> do | otherwise -> do
-- This starts the same way `version` does, minus the assert -- This starts the same way `version` does, minus the assert
srcVersionFix args srcVersionFix args
-- But then from there we need to do this a second time for the cargoHash! -- But then from there we need to do this a second time for the cargoHash!
oldDepsHash <- Nix.getAttrString "npmDepsHash" attrPath oldDepsHash <- Nix.getAttrString "npmDepsHash" attrPath
let fakeHash = Nix.fakeHashMatching oldDepsHash let fakeHash = Nix.fakeHashMatching oldDepsHash
_ <- lift $ File.replaceIO oldDepsHash fakeHash derivationFile _ <- lift $ File.replaceIO oldDepsHash fakeHash derivationFile
newDepsHash <- Nix.getHashFromBuild attrPath newDepsHash <- Nix.getHashFromBuild attrPath
when (oldDepsHash == newDepsHash) $ throwE ("deps hashes equal; no update necessary: " <> oldDepsHash) when (oldDepsHash == newDepsHash) $ throwE ("deps hashes equal; no update necessary: " <> oldDepsHash)
lift . log $ "Replacing npmDepsHash with " <> newDepsHash lift . log $ "Replacing npmDepsHash with " <> newDepsHash
_ <- lift $ File.replaceIO fakeHash newDepsHash derivationFile _ <- lift $ File.replaceIO fakeHash newDepsHash derivationFile
-- Ensure the package actually builds and passes its tests -- Ensure the package actually builds and passes its tests
Nix.build attrPath Nix.build attrPath
lift $ log "Finished updating NPM deps version and replacing hashes" lift $ log "Finished updating NPM deps version and replacing hashes"
return $ Just "NPM version update" return $ Just "NPM version update"
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Calls passthru.updateScript -- Calls passthru.updateScript
updateScript :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text) updateScript :: (MonadIO m) => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
updateScript log Args {..} = do updateScript log Args {..} = do
if hasUpdateScript if hasUpdateScript
then do then do
@ -246,7 +246,7 @@ updateScript log Args {..} = do
-- 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.
-- This is done by the generic version upgrader, but is also a sub-component of some of the others. -- This is done by the generic version upgrader, but is also a sub-component of some of the others.
srcVersionFix :: MonadIO m => Args -> ExceptT Text m () srcVersionFix :: (MonadIO m) => Args -> ExceptT Text m ()
srcVersionFix Args {..} = do srcVersionFix Args {..} = do
let UpdateEnv {..} = updateEnv let UpdateEnv {..} = updateEnv
oldHash <- Nix.getHash attrPath oldHash <- Nix.getHash attrPath

View File

@ -223,7 +223,7 @@ eq part reason = ((part ==), reason)
regex :: RE' a -> Text -> (Text -> Bool, Text) regex :: RE' a -> Text -> (Text -> Bool, Text)
regex pat reason = (isJust . (=~ pat), reason) regex pat reason = (isJust . (=~ pat), reason)
python :: Monad m => Int -> Text -> ExceptT Text m () python :: (Monad m) => Int -> Text -> ExceptT Text m ()
python numPackageRebuilds derivationContents = python numPackageRebuilds derivationContents =
tryAssert tryAssert
( "Python package with too many package rebuilds " ( "Python package with too many package rebuilds "

View File

@ -68,7 +68,7 @@ alsoLogToAttrPath attrPath topLevelLog = do
topLevelLog text topLevelLog text
attrPathLog text attrPathLog text
log' :: MonadIO m => FilePath -> Text -> m () log' :: (MonadIO m) => FilePath -> Text -> m ()
log' logFile msg = liftIO $ T.appendFile logFile (msg <> "\n") log' logFile msg = liftIO $ T.appendFile logFile (msg <> "\n")
attrPathLogFilePath :: Text -> IO String attrPathLogFilePath :: Text -> IO String
@ -628,7 +628,7 @@ untilOfBorgFree log waitUntil = do
untilOfBorgFree log waitUntil untilOfBorgFree log waitUntil
assertNotUpdatedOn :: assertNotUpdatedOn ::
MonadIO m => UpdateEnv -> Text -> Text -> ExceptT Text m () (MonadIO m) => UpdateEnv -> Text -> Text -> ExceptT Text m ()
assertNotUpdatedOn updateEnv derivationFile branch = do assertNotUpdatedOn updateEnv derivationFile branch = do
derivationContents <- Git.show branch derivationFile derivationContents <- Git.show branch derivationFile
Nix.assertOldVersionOn updateEnv branch derivationContents Nix.assertOldVersionOn updateEnv branch derivationContents
@ -700,7 +700,7 @@ cveReport updateEnv =
<br/> <br/>
|] |]
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 if batchUpdate o && "r-ryantm" == (GH.untagName $ githubUser o) in if batchUpdate o && "r-ryantm" == (GH.untagName $ githubUser o)

View File

@ -96,7 +96,7 @@ readField f@(Field (SQLText t) _) =
Left e -> returnError ConversionFailed f $ "read error: " <> e Left e -> returnError ConversionFailed f $ "read error: " <> e
readField f = returnError ConversionFailed f "expecting SQLText column type" readField f = returnError ConversionFailed f "expecting SQLText column type"
showField :: Show a => a -> SQLData showField :: (Show a) => a -> SQLData
showField = toField . show showField = toField . show
instance FromField VersionMatcher where instance FromField VersionMatcher where
@ -125,7 +125,7 @@ data UpdateEnv = UpdateEnv
options :: Options options :: Options
} }
whenBatch :: Applicative f => UpdateEnv -> f () -> f () whenBatch :: (Applicative f) => UpdateEnv -> f () -> f ()
whenBatch updateEnv = when (batchUpdate . options $ updateEnv) whenBatch updateEnv = when (batchUpdate . options $ updateEnv)
prTitle :: UpdateEnv -> Text -> Text prTitle :: UpdateEnv -> Text -> Text
@ -147,7 +147,7 @@ regDirMode =
.|. otherReadMode .|. otherReadMode
.|. otherExecuteMode .|. otherExecuteMode
logsDirectory :: MonadIO m => ExceptT Text m FilePath logsDirectory :: (MonadIO m) => ExceptT Text m FilePath
logsDirectory = do logsDirectory = do
dir <- dir <-
noteT "Could not get environment variable LOGS_DIRECTORY" $ noteT "Could not get environment variable LOGS_DIRECTORY" $
@ -163,7 +163,7 @@ logsDirectory = do
) )
return dir return dir
cacheDir :: MonadIO m => m FilePath cacheDir :: (MonadIO m) => m FilePath
cacheDir = do cacheDir = do
cacheDirectory <- liftIO $ lookupEnv "CACHE_DIRECTORY" cacheDirectory <- liftIO $ lookupEnv "CACHE_DIRECTORY"
xdgCacheHome <- liftIO $ fmap (fmap (\dir -> dir </> "nixpkgs-update")) $ lookupEnv "XDG_CACHE_HOME" xdgCacheHome <- liftIO $ fmap (fmap (\dir -> dir </> "nixpkgs-update")) $ lookupEnv "XDG_CACHE_HOME"
@ -172,7 +172,7 @@ cacheDir = do
liftIO $ createDirectoryIfMissing True dir liftIO $ createDirectoryIfMissing True dir
return dir return dir
outpathCacheDir :: MonadIO m => m FilePath outpathCacheDir :: (MonadIO m) => m FilePath
outpathCacheDir = do outpathCacheDir = do
cache <- cacheDir cache <- cacheDir
let dir = cache </> "outpath" let dir = cache </> "outpath"
@ -186,7 +186,7 @@ worktreeDir = do
createDirectoryIfMissing False dir createDirectoryIfMissing False dir
return dir return dir
xdgRuntimeDir :: MonadIO m => ExceptT Text m FilePath xdgRuntimeDir :: (MonadIO m) => ExceptT Text m FilePath
xdgRuntimeDir = do xdgRuntimeDir = do
xDir <- xDir <-
noteT "Could not get environment variable XDG_RUNTIME_DIR" $ noteT "Could not get environment variable XDG_RUNTIME_DIR" $
@ -204,7 +204,7 @@ xdgRuntimeDir = do
) )
return dir return dir
tmpRuntimeDir :: MonadIO m => ExceptT Text m FilePath tmpRuntimeDir :: (MonadIO m) => ExceptT Text m FilePath
tmpRuntimeDir = do tmpRuntimeDir = do
dir <- liftIO $ mkdtemp "nixpkgs-update" dir <- liftIO $ mkdtemp "nixpkgs-update"
dirExists <- liftIO $ doesDirectoryExist dir dirExists <- liftIO $ doesDirectoryExist dir
@ -241,7 +241,7 @@ parseUpdates = map (toTriple . T.words) . T.lines
toTriple [package, oldVer, newVer, url] = Right (package, oldVer, newVer, Just url) toTriple [package, oldVer, newVer, url] = Right (package, oldVer, newVer, Just url)
toTriple line = Left $ "Unable to parse update: " <> T.unwords line toTriple line = Left $ "Unable to parse update: " <> T.unwords line
srcOrMain :: MonadIO m => (Text -> ExceptT Text m a) -> Text -> ExceptT Text m a srcOrMain :: (MonadIO m) => (Text -> ExceptT Text m a) -> Text -> ExceptT Text m a
srcOrMain et attrPath = et (attrPath <> ".src") <|> et (attrPath <> ".originalSrc") <|> et attrPath srcOrMain et attrPath = et (attrPath <> ".src") <|> et (attrPath <> ".originalSrc") <|> et attrPath
nixCommonOptions :: [String] nixCommonOptions :: [String]
@ -263,7 +263,7 @@ nixBuildOptions =
<> nixCommonOptions <> nixCommonOptions
runLog :: runLog ::
Member (Embed IO) r => (Member (Embed IO) r) =>
(Text -> IO ()) -> (Text -> IO ()) ->
Sem ((Output Text) ': r) a -> Sem ((Output Text) ': r) a ->
Sem r a Sem r a

View File

@ -91,7 +91,7 @@ versionIncompatibleWithPathPin :: Text -> Version -> Bool
versionIncompatibleWithPathPin path version = versionIncompatibleWithPathPin path version =
not (versionCompatibleWithPathPin path version) not (versionCompatibleWithPathPin path version)
assertCompatibleWithPathPin :: Monad m => UpdateEnv -> Text -> ExceptT Text m () assertCompatibleWithPathPin :: (Monad m) => UpdateEnv -> Text -> ExceptT Text m ()
assertCompatibleWithPathPin ue attrPath = assertCompatibleWithPathPin ue attrPath =
tryAssert tryAssert
( "Version in attr path " ( "Version in attr path "