{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Rewrite
( Args (..),
runAll,
golangModuleVersion,
quotedUrls,
quotedUrlsET,
rustCrateVersion,
version,
redirectedUrls,
)
where
import qualified Data.Text as T
import Data.Text.Encoding as T
import Data.Text.Encoding.Error as T
import Data.Text.IO as T
import qualified File
import qualified Network.HTTP.Client as HTTP
import Network.HTTP.Types.Status (statusCode)
import qualified Nix
import OurPrelude
import qualified Polysemy.Error as Error
import Polysemy.Output (Output, output)
import qualified Process
import System.Exit
import Utils (UpdateEnv (..))
import qualified Utils
( runLog,
stripQuotes,
)
import Prelude hiding (log)
data Args = Args
{ Args -> UpdateEnv
updateEnv :: Utils.UpdateEnv,
Args -> Text
attrPath :: Text,
Args -> FilePath
derivationFile :: FilePath,
Args -> Text
derivationContents :: Text,
Args -> Bool
hasUpdateScript :: Bool
}
type Rewriter = (Text -> IO ()) -> Args -> ExceptT Text IO (Maybe Text)
type Plan = [(Text, Rewriter)]
plan :: Plan
plan :: Plan
plan =
[ (Text
"version", (Text -> IO ()) -> Args -> ExceptT Text IO (Maybe Text)
forall (m :: * -> *).
MonadIO m =>
(Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
version),
(Text
"rustCrateVersion", (Text -> IO ()) -> Args -> ExceptT Text IO (Maybe Text)
forall (m :: * -> *).
MonadIO m =>
(Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
rustCrateVersion),
(Text
"golangModuleVersion", (Text -> IO ()) -> Args -> ExceptT Text IO (Maybe Text)
forall (m :: * -> *).
MonadIO m =>
(Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
golangModuleVersion),
(Text
"updateScript", (Text -> IO ()) -> Args -> ExceptT Text IO (Maybe Text)
forall (m :: * -> *).
MonadIO m =>
(Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
updateScript),
(Text
"", (Text -> IO ()) -> Args -> ExceptT Text IO (Maybe Text)
forall (m :: * -> *).
MonadIO m =>
(Text -> IO ()) -> Args -> ExceptT Text m (Maybe Text)
quotedUrlsET)
]
runAll :: (Text -> IO ()) -> Args -> ExceptT Text IO [Text]
runAll :: (Text -> IO ()) -> Args -> ExceptT Text IO [Text]
runAll Text -> IO ()
log Args
args = do
[Maybe Text]
msgs <- Plan
-> ((Text, (Text -> IO ()) -> Args -> ExceptT Text IO (Maybe Text))
-> ExceptT Text IO (Maybe Text))
-> ExceptT Text IO [Maybe Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Plan
plan (((Text, (Text -> IO ()) -> Args -> ExceptT Text IO (Maybe Text))
-> ExceptT Text IO (Maybe Text))
-> ExceptT Text IO [Maybe Text])
-> ((Text, (Text -> IO ()) -> Args -> ExceptT Text IO (Maybe Text))
-> ExceptT Text IO (Maybe Text))
-> ExceptT Text IO [Maybe Text]
forall a b. (a -> b) -> a -> b
$ \(Text
name, (Text -> IO ()) -> Args -> ExceptT Text IO (Maybe Text)
f) -> do
let log' :: Text -> IO ()
log' Text
msg =
if Text -> Bool
T.null Text
name
then Text -> IO ()
log Text
msg
else Text -> IO ()
log (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ (Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"] ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
IO () -> ExceptT Text IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ExceptT Text IO ()) -> IO () -> ExceptT Text IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
log' Text
""
(Text -> IO ()) -> Args -> ExceptT Text IO (Maybe Text)
f Text -> IO ()
log' Args
args
[Text] -> ExceptT Text IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> ExceptT Text IO [Text])
-> [Text] -> ExceptT Text IO [Text]
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Text]
msgs
version :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
version :: (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
version Text -> m ()
log args :: Args
args@Args {Bool
FilePath
Text
UpdateEnv
hasUpdateScript :: Bool
derivationContents :: Text
derivationFile :: FilePath
attrPath :: Text
updateEnv :: UpdateEnv
hasUpdateScript :: Args -> Bool
derivationContents :: Args -> Text
derivationFile :: Args -> FilePath
attrPath :: Args -> Text
updateEnv :: Args -> UpdateEnv
..} = do
if
| Text -> Int
Nix.numberOfFetchers Text
derivationContents Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
|| Text -> Int
Nix.numberOfHashes Text
derivationContents Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 -> do
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ()) -> m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
log Text
"generic version rewriter does not support multiple hashes"
Maybe Text -> ExceptT Text m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
| Bool
hasUpdateScript -> do
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ()) -> m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
log Text
"skipping because derivation has updateScript"
Maybe Text -> ExceptT Text m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
| Bool
otherwise -> do
Args -> ExceptT Text m ()
forall (m :: * -> *). MonadIO m => Args -> ExceptT Text m ()
srcVersionFix Args
args
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ()) -> m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
log Text
"updated version and sha256"
Maybe Text -> ExceptT Text m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ExceptT Text m (Maybe Text))
-> Maybe Text -> ExceptT Text m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Version update"
quotedUrls ::
Members '[Process.Process, File.File, Error Text, Output Text] r =>
Args ->
Sem r (Maybe Text)
quotedUrls :: Args -> Sem r (Maybe Text)
quotedUrls Args {Bool
FilePath
Text
UpdateEnv
hasUpdateScript :: Bool
derivationContents :: Text
derivationFile :: FilePath
attrPath :: Text
updateEnv :: UpdateEnv
hasUpdateScript :: Args -> Bool
derivationContents :: Args -> Text
derivationFile :: Args -> FilePath
attrPath :: Args -> Text
updateEnv :: Args -> UpdateEnv
..} = do
Text -> Sem r ()
forall o (r :: [(* -> *) -> * -> *]).
MemberWithError (Output o) r =>
o -> Sem r ()
output Text
"[quotedUrls]"
Text
homepage <- Text -> Sem r Text
forall (r :: [(* -> *) -> * -> *]).
Members '[Process, Error Text] r =>
Text -> Sem r Text
Nix.getHomepage Text
attrPath
Text
stripped <- case Text -> Maybe Text
Utils.stripQuotes Text
homepage of
Maybe Text
Nothing -> Text -> Sem r Text
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw Text
"Could not strip url! This should never happen!"
Just Text
x -> Text -> Sem r Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
x
let goodHomepage :: Text
goodHomepage = Text
"homepage = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
homepage Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";"
let replacer :: Text -> Sem r Bool
replacer = \Text
target -> Text -> Text -> FilePath -> Sem r Bool
forall (r :: [(* -> *) -> * -> *]).
Member File r =>
Text -> Text -> FilePath -> Sem r Bool
File.replace Text
target Text
goodHomepage FilePath
derivationFile
Bool
urlReplaced1 <- Text -> Sem r Bool
replacer (Text
"homepage = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
stripped Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";")
Bool
urlReplaced2 <- Text -> Sem r Bool
replacer (Text
"homepage = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
stripped Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ;")
Bool
urlReplaced3 <- Text -> Sem r Bool
replacer (Text
"homepage =" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
stripped Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";")
Bool
urlReplaced4 <- Text -> Sem r Bool
replacer (Text
"homepage =" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
stripped Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"; ")
if Bool
urlReplaced1 Bool -> Bool -> Bool
|| Bool
urlReplaced2 Bool -> Bool -> Bool
|| Bool
urlReplaced3 Bool -> Bool -> Bool
|| Bool
urlReplaced4
then do
Text -> Sem r ()
forall o (r :: [(* -> *) -> * -> *]).
MemberWithError (Output o) r =>
o -> Sem r ()
output Text
"[quotedUrls]: added quotes to meta.homepage"
Maybe Text -> Sem r (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> Sem r (Maybe Text))
-> Maybe Text -> Sem r (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Quoted meta.homepage for [RFC 45](https://github.com/NixOS/rfcs/pull/45)"
else do
Text -> Sem r ()
forall o (r :: [(* -> *) -> * -> *]).
MemberWithError (Output o) r =>
o -> Sem r ()
output Text
"[quotedUrls] nothing found to replace"
Maybe Text -> Sem r (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
quotedUrlsET :: MonadIO m => (Text -> IO ()) -> Args -> ExceptT Text m (Maybe Text)
quotedUrlsET :: (Text -> IO ()) -> Args -> ExceptT Text m (Maybe Text)
quotedUrlsET Text -> IO ()
log Args
rwArgs =
m (Either Text (Maybe Text)) -> ExceptT Text m (Maybe Text)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Text (Maybe Text)) -> ExceptT Text m (Maybe Text))
-> m (Either Text (Maybe Text)) -> ExceptT Text m (Maybe Text)
forall a b. (a -> b) -> a -> b
$
IO (Either Text (Maybe Text)) -> m (Either Text (Maybe Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO (Either Text (Maybe Text)) -> m (Either Text (Maybe Text)))
-> (Sem
'[Output Text, File, Process, Error Text, Embed IO, Final IO]
(Maybe Text)
-> IO (Either Text (Maybe Text)))
-> Sem
'[Output Text, File, Process, Error Text, Embed IO, Final IO]
(Maybe Text)
-> m (Either Text (Maybe Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem '[Final IO] (Either Text (Maybe Text))
-> IO (Either Text (Maybe Text))
forall (m :: * -> *) a. Monad m => Sem '[Final m] a -> m a
runFinal
(Sem '[Final IO] (Either Text (Maybe Text))
-> IO (Either Text (Maybe Text)))
-> (Sem
'[Output Text, File, Process, Error Text, Embed IO, Final IO]
(Maybe Text)
-> Sem '[Final IO] (Either Text (Maybe Text)))
-> Sem
'[Output Text, File, Process, Error Text, Embed IO, Final IO]
(Maybe Text)
-> IO (Either Text (Maybe Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem '[Embed IO, Final IO] (Either Text (Maybe Text))
-> Sem '[Final IO] (Either Text (Maybe Text))
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
Sem (Embed m : r) a -> Sem r a
embedToFinal
(Sem '[Embed IO, Final IO] (Either Text (Maybe Text))
-> Sem '[Final IO] (Either Text (Maybe Text)))
-> (Sem
'[Output Text, File, Process, Error Text, Embed IO, Final IO]
(Maybe Text)
-> Sem '[Embed IO, Final IO] (Either Text (Maybe Text)))
-> Sem
'[Output Text, File, Process, Error Text, Embed IO, Final IO]
(Maybe Text)
-> Sem '[Final IO] (Either Text (Maybe Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem '[Error Text, Embed IO, Final IO] (Maybe Text)
-> Sem '[Embed IO, Final IO] (Either Text (Maybe Text))
forall e (r :: [(* -> *) -> * -> *]) a.
Sem (Error e : r) a -> Sem r (Either e a)
Error.runError
(Sem '[Error Text, Embed IO, Final IO] (Maybe Text)
-> Sem '[Embed IO, Final IO] (Either Text (Maybe Text)))
-> (Sem
'[Output Text, File, Process, Error Text, Embed IO, Final IO]
(Maybe Text)
-> Sem '[Error Text, Embed IO, Final IO] (Maybe Text))
-> Sem
'[Output Text, File, Process, Error Text, Embed IO, Final IO]
(Maybe Text)
-> Sem '[Embed IO, Final IO] (Either Text (Maybe Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem '[Process, Error Text, Embed IO, Final IO] (Maybe Text)
-> Sem '[Error Text, Embed IO, Final IO] (Maybe Text)
forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
Sem (Process : r) a -> Sem r a
Process.runIO
(Sem '[Process, Error Text, Embed IO, Final IO] (Maybe Text)
-> Sem '[Error Text, Embed IO, Final IO] (Maybe Text))
-> (Sem
'[Output Text, File, Process, Error Text, Embed IO, Final IO]
(Maybe Text)
-> Sem '[Process, Error Text, Embed IO, Final IO] (Maybe Text))
-> Sem
'[Output Text, File, Process, Error Text, Embed IO, Final IO]
(Maybe Text)
-> Sem '[Error Text, Embed IO, Final IO] (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem '[File, Process, Error Text, Embed IO, Final IO] (Maybe Text)
-> Sem '[Process, Error Text, Embed IO, Final IO] (Maybe Text)
forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
Sem (File : r) a -> Sem r a
File.runIO
(Sem '[File, Process, Error Text, Embed IO, Final IO] (Maybe Text)
-> Sem '[Process, Error Text, Embed IO, Final IO] (Maybe Text))
-> (Sem
'[Output Text, File, Process, Error Text, Embed IO, Final IO]
(Maybe Text)
-> Sem
'[File, Process, Error Text, Embed IO, Final IO] (Maybe Text))
-> Sem
'[Output Text, File, Process, Error Text, Embed IO, Final IO]
(Maybe Text)
-> Sem '[Process, Error Text, Embed IO, Final IO] (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> IO ())
-> Sem
'[Output Text, File, Process, Error Text, Embed IO, Final IO]
(Maybe Text)
-> Sem
'[File, Process, Error Text, Embed IO, Final IO] (Maybe Text)
forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
(Text -> IO ()) -> Sem (Output Text : r) a -> Sem r a
Utils.runLog Text -> IO ()
log
(Sem
'[Output Text, File, Process, Error Text, Embed IO, Final IO]
(Maybe Text)
-> m (Either Text (Maybe Text)))
-> Sem
'[Output Text, File, Process, Error Text, Embed IO, Final IO]
(Maybe Text)
-> m (Either Text (Maybe Text))
forall a b. (a -> b) -> a -> b
$ Args
-> Sem
'[Output Text, File, Process, Error Text, Embed IO, Final IO]
(Maybe Text)
forall (r :: [(* -> *) -> * -> *]).
Members '[Process, File, Error Text, Output Text] r =>
Args -> Sem r (Maybe Text)
quotedUrls Args
rwArgs
redirectedUrls :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
redirectedUrls :: (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
redirectedUrls Text -> m ()
log Args {Bool
FilePath
Text
UpdateEnv
hasUpdateScript :: Bool
derivationContents :: Text
derivationFile :: FilePath
attrPath :: Text
updateEnv :: UpdateEnv
hasUpdateScript :: Args -> Bool
derivationContents :: Args -> Text
derivationFile :: Args -> FilePath
attrPath :: Args -> Text
updateEnv :: Args -> UpdateEnv
..} = do
Text
unstripped <- Text -> ExceptT Text m Text
forall (m :: * -> *). MonadIO m => Text -> ExceptT Text m Text
Nix.getHomepageET Text
attrPath
Text
homepage <- case Text -> Maybe Text
Utils.stripQuotes Text
unstripped of
Maybe Text
Nothing -> Text -> ExceptT Text m Text
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Text
"Could not strip homepage! This should never happen!"
Just Text
x -> Text -> ExceptT Text m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
x
Response ByteString
response <- IO (Response ByteString) -> ExceptT Text m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> ExceptT Text m (Response ByteString))
-> IO (Response ByteString) -> ExceptT Text m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ do
Manager
manager <- ManagerSettings -> IO Manager
HTTP.newManager ManagerSettings
HTTP.defaultManagerSettings
Request
request <- FilePath -> IO Request
forall (m :: * -> *). MonadThrow m => FilePath -> m Request
HTTP.parseRequest (Text -> FilePath
T.unpack Text
homepage)
Request -> Manager -> IO (Response ByteString)
HTTP.httpLbs Request
request Manager
manager
let status :: Int
status = Status -> Int
statusCode (Status -> Int) -> Status -> Int
forall a b. (a -> b) -> a -> b
$ Response ByteString -> Status
forall body. Response body -> Status
HTTP.responseStatus Response ByteString
response
if Int
status Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
301, Int
308]
then do
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ()) -> m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
log Text
"Redirecting URL"
let headers :: ResponseHeaders
headers = Response ByteString -> ResponseHeaders
forall body. Response body -> ResponseHeaders
HTTP.responseHeaders Response ByteString
response
location :: Maybe ByteString
location = HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"Location" ResponseHeaders
headers
case Maybe ByteString
location of
Maybe ByteString
Nothing -> do
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ()) -> m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
log Text
"Server did not return a location"
Maybe Text -> ExceptT Text m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
Just ((OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
T.lenientDecode) -> Text
newHomepage) -> do
Bool
_ <- Text -> Text -> FilePath -> ExceptT Text m Bool
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> FilePath -> m Bool
File.replaceIO Text
homepage Text
newHomepage FilePath
derivationFile
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ()) -> m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
log Text
"Replaced homepage"
Maybe Text -> ExceptT Text m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ExceptT Text m (Maybe Text))
-> Maybe Text -> ExceptT Text m (Maybe Text)
forall a b. (a -> b) -> a -> b
$
Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
Text
"Replaced homepage by "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newHomepage
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" due http "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (FilePath -> Text
T.pack (FilePath -> Text) -> (Int -> FilePath) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show) Int
status
else do
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ()) -> m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
log Text
"URL not redirected"
Maybe Text -> ExceptT Text m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
rustCrateVersion :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
rustCrateVersion :: (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
rustCrateVersion Text -> m ()
log args :: Args
args@Args {Bool
FilePath
Text
UpdateEnv
hasUpdateScript :: Bool
derivationContents :: Text
derivationFile :: FilePath
attrPath :: Text
updateEnv :: UpdateEnv
hasUpdateScript :: Args -> Bool
derivationContents :: Args -> Text
derivationFile :: Args -> FilePath
attrPath :: Args -> Text
updateEnv :: Args -> UpdateEnv
..} = do
if
| Bool -> Bool
not (Text -> Text -> Bool
T.isInfixOf Text
"cargoSha256" Text
derivationContents) -> do
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ()) -> m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
log Text
"No cargoSha256 found"
Maybe Text -> ExceptT Text m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
| Bool
hasUpdateScript -> do
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ()) -> m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
log Text
"skipping because derivation has updateScript"
Maybe Text -> ExceptT Text m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
| Bool
otherwise -> do
Args -> ExceptT Text m ()
forall (m :: * -> *). MonadIO m => Args -> ExceptT Text m ()
srcVersionFix Args
args
Text
oldCargoSha256 <- Raw -> Text -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
Raw -> Text -> Text -> ExceptT Text m Text
Nix.getAttr Raw
Nix.Raw Text
"cargoSha256" Text
attrPath
Bool
_ <- m Bool -> ExceptT Text m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Text m Bool) -> m Bool -> ExceptT Text m Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> FilePath -> m Bool
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> FilePath -> m Bool
File.replaceIO Text
oldCargoSha256 Text
Nix.sha256Zero FilePath
derivationFile
Text
newCargoSha256 <- Text -> ExceptT Text m Text
forall (m :: * -> *). MonadIO m => Text -> ExceptT Text m Text
Nix.getHashFromBuild Text
attrPath
Bool -> ExceptT Text m () -> ExceptT Text m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
oldCargoSha256 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
newCargoSha256) (ExceptT Text m () -> ExceptT Text m ())
-> ExceptT Text m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> ExceptT Text m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Text
"cargoSha256 hashes equal; no update necessary"
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ())
-> (Text -> m ()) -> Text -> ExceptT Text m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
log (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text
"Replacing cargoSha256 with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newCargoSha256
Bool
_ <- m Bool -> ExceptT Text m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Text m Bool) -> m Bool -> ExceptT Text m Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> FilePath -> m Bool
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> FilePath -> m Bool
File.replaceIO Text
Nix.sha256Zero Text
newCargoSha256 FilePath
derivationFile
Text -> ExceptT Text m ()
forall (m :: * -> *). MonadIO m => Text -> ExceptT Text m ()
Nix.build Text
attrPath
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ()) -> m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
log Text
"Finished updating Crate version and replacing hashes"
Maybe Text -> ExceptT Text m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ExceptT Text m (Maybe Text))
-> Maybe Text -> ExceptT Text m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Rust version update"
golangModuleVersion :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
golangModuleVersion :: (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
golangModuleVersion Text -> m ()
log args :: Args
args@Args {Bool
FilePath
Text
UpdateEnv
hasUpdateScript :: Bool
derivationContents :: Text
derivationFile :: FilePath
attrPath :: Text
updateEnv :: UpdateEnv
hasUpdateScript :: Args -> Bool
derivationContents :: Args -> Text
derivationFile :: Args -> FilePath
attrPath :: Args -> Text
updateEnv :: Args -> UpdateEnv
..} = do
if
| Bool -> Bool
not (Text -> Text -> Bool
T.isInfixOf Text
"buildGoModule" Text
derivationContents Bool -> Bool -> Bool
&& Text -> Text -> Bool
T.isInfixOf Text
"vendorSha256" Text
derivationContents) -> do
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ()) -> m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
log Text
"Not a buildGoModule package with vendorSha256"
Maybe Text -> ExceptT Text m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
| Bool
hasUpdateScript -> do
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ()) -> m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
log Text
"skipping because derivation has updateScript"
Maybe Text -> ExceptT Text m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
| Bool
otherwise -> do
Args -> ExceptT Text m ()
forall (m :: * -> *). MonadIO m => Args -> ExceptT Text m ()
srcVersionFix Args
args
Text
oldVendorSha256 <- (Raw -> Text -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
Raw -> Text -> Text -> ExceptT Text m Text
Nix.getAttr Raw
Nix.Raw Text
"vendorSha256" Text
attrPath ExceptT Text m Text -> ExceptT Text m Text -> ExceptT Text m Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Raw -> Text -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
Raw -> Text -> Text -> ExceptT Text m Text
Nix.getAttr Raw
Nix.NoRaw Text
"vendorSha256" Text
attrPath)
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ())
-> (Text -> m ()) -> Text -> ExceptT Text m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
log (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text
"Found old vendorSha256 = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
oldVendorSha256
Text
original <- IO Text -> ExceptT Text m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> ExceptT Text m Text) -> IO Text -> ExceptT Text m Text
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Text
T.readFile FilePath
derivationFile
Bool
_ <- m Bool -> ExceptT Text m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Text m Bool) -> m Bool -> ExceptT Text m Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> FilePath -> m Bool
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> FilePath -> m Bool
File.replaceIO (Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
oldVendorSha256 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"") Text
"null" FilePath
derivationFile
Either Text ()
ok <- ExceptT Text (ExceptT Text m) () -> ExceptT Text m (Either Text ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text (ExceptT Text m) ()
-> ExceptT Text m (Either Text ()))
-> ExceptT Text (ExceptT Text m) ()
-> ExceptT Text m (Either Text ())
forall a b. (a -> b) -> a -> b
$ Text -> ExceptT Text (ExceptT Text m) ()
forall (m :: * -> *). MonadIO m => Text -> ExceptT Text m ()
Nix.build Text
attrPath
()
_ <-
if Either Text () -> Bool
forall a b. Either a b -> Bool
isLeft Either Text ()
ok
then do
()
_ <- IO () -> ExceptT Text m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Text m ()) -> IO () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
T.writeFile FilePath
derivationFile Text
original
Bool
_ <- m Bool -> ExceptT Text m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Text m Bool) -> m Bool -> ExceptT Text m Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> FilePath -> m Bool
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> FilePath -> m Bool
File.replaceIO Text
oldVendorSha256 Text
Nix.sha256Zero FilePath
derivationFile
Text
newVendorSha256 <- Text -> ExceptT Text m Text
forall (m :: * -> *). MonadIO m => Text -> ExceptT Text m Text
Nix.getHashFromBuild Text
attrPath
Bool
_ <- m Bool -> ExceptT Text m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Text m Bool) -> m Bool -> ExceptT Text m Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> FilePath -> m Bool
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> FilePath -> m Bool
File.replaceIO Text
Nix.sha256Zero Text
newVendorSha256 FilePath
derivationFile
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ())
-> (Text -> m ()) -> Text -> ExceptT Text m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
log (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text
"Replaced vendorSha256 with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newVendorSha256
else do
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ())
-> (Text -> m ()) -> Text -> ExceptT Text m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
log (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text
"Set vendorSha256 to null"
Text -> ExceptT Text m ()
forall (m :: * -> *). MonadIO m => Text -> ExceptT Text m ()
Nix.build Text
attrPath
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ()) -> m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
log Text
"Finished updating vendorSha256"
Maybe Text -> ExceptT Text m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ExceptT Text m (Maybe Text))
-> Maybe Text -> ExceptT Text m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Golang update"
updateScript :: MonadIO m => (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
updateScript :: (Text -> m ()) -> Args -> ExceptT Text m (Maybe Text)
updateScript Text -> m ()
log Args {Bool
FilePath
Text
UpdateEnv
hasUpdateScript :: Bool
derivationContents :: Text
derivationFile :: FilePath
attrPath :: Text
updateEnv :: UpdateEnv
hasUpdateScript :: Args -> Bool
derivationContents :: Args -> Text
derivationFile :: Args -> FilePath
attrPath :: Args -> Text
updateEnv :: Args -> UpdateEnv
..} = do
if Bool
hasUpdateScript
then do
(ExitCode
exitCode, Text
msg) <- Text -> ExceptT Text m (ExitCode, Text)
forall (m :: * -> *).
MonadIO m =>
Text -> ExceptT Text m (ExitCode, Text)
Nix.runUpdateScript Text
attrPath
case ExitCode
exitCode of
ExitCode
ExitSuccess -> do
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ()) -> m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
log Text
"Success"
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ()) -> m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
log Text
msg
Maybe Text -> ExceptT Text m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ExceptT Text m (Maybe Text))
-> Maybe Text -> ExceptT Text m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Ran passthru.UpdateScript"
ExitFailure Int
num -> do
Text -> ExceptT Text m (Maybe Text)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Text -> ExceptT Text m (Maybe Text))
-> Text -> ExceptT Text m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text
"[updateScript] Failed with exit code " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
num Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
else do
m () -> ExceptT Text m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Text m ()) -> m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
log Text
"skipping because derivation has no updateScript"
Maybe Text -> ExceptT Text m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
srcVersionFix :: MonadIO m => Args -> ExceptT Text m ()
srcVersionFix :: Args -> ExceptT Text m ()
srcVersionFix Args {Bool
FilePath
Text
UpdateEnv
hasUpdateScript :: Bool
derivationContents :: Text
derivationFile :: FilePath
attrPath :: Text
updateEnv :: UpdateEnv
hasUpdateScript :: Args -> Bool
derivationContents :: Args -> Text
derivationFile :: Args -> FilePath
attrPath :: Args -> Text
updateEnv :: Args -> UpdateEnv
..} = do
let UpdateEnv {Maybe Text
Text
Options
options :: UpdateEnv -> Options
sourceURL :: UpdateEnv -> Maybe Text
newVersion :: UpdateEnv -> Text
oldVersion :: UpdateEnv -> Text
packageName :: UpdateEnv -> Text
options :: Options
sourceURL :: Maybe Text
newVersion :: Text
oldVersion :: Text
packageName :: Text
..} = UpdateEnv
updateEnv
Text
oldHash <- Text -> ExceptT Text m Text
forall (m :: * -> *). MonadIO m => Text -> ExceptT Text m Text
Nix.getOldHash Text
attrPath
Bool
_ <- m Bool -> ExceptT Text m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Text m Bool) -> m Bool -> ExceptT Text m Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> FilePath -> m Bool
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> FilePath -> m Bool
File.replaceIO Text
oldVersion Text
newVersion FilePath
derivationFile
Bool
_ <- m Bool -> ExceptT Text m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Text m Bool) -> m Bool -> ExceptT Text m Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> FilePath -> m Bool
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> FilePath -> m Bool
File.replaceIO Text
oldHash Text
Nix.sha256Zero FilePath
derivationFile
Text
newHash <- Text -> ExceptT Text m Text
forall (m :: * -> *). MonadIO m => Text -> ExceptT Text m Text
Nix.getHashFromBuild Text
attrPath
Bool -> ExceptT Text m () -> ExceptT Text m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
oldHash Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
newHash) (ExceptT Text m () -> ExceptT Text m ())
-> ExceptT Text m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> ExceptT Text m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Text
"Hashes equal; no update necessary"
Bool
_ <- m Bool -> ExceptT Text m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Text m Bool) -> m Bool -> ExceptT Text m Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> FilePath -> m Bool
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> FilePath -> m Bool
File.replaceIO Text
Nix.sha256Zero Text
newHash FilePath
derivationFile
() -> ExceptT Text m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()