purge most of Shelly.FilePath; use XDG Base Directory Specification for working dir

2024-12-15 13:52:49 +03:00 · 2019-02-04 21:30:59 -08:00 · 2019-02-04 21:30:59 -08:00 · a7564d04ab
commit a7564d04ab
parent 2cf009e98a
10 changed files with 172 additions and 158 deletions
--- a/src/Check.hs
+++ b/src/Check.hs
@ -11,12 +11,11 @@ import OurPrelude
 import Control.Applicative (many)
 import Data.Char (isSpace)
 import qualified Data.Text as T
-import Prelude hiding (FilePath)
 import qualified Shell
-import Shelly
+import Shelly hiding (FilePath)
 import qualified Text.Regex.Applicative.Text as RE
 import Text.Regex.Applicative.Text (RE', (=~))
-import Utils (Options(..), UpdateEnv(..), Version)
+import Utils (UpdateEnv(..), Version, runtimeDir)

 default (T.Text)

@ -38,7 +37,8 @@ versionRegex version =
 checkBinary :: Text -> Version -> FilePath -> Sh BinaryCheck
 checkBinary argument expectedVersion program =
  catchany_sh
-    (do stdout <- Shell.canFail $ cmd "timeout" "-k" "2" "1" program argument
+    (do stdout <-
+          Shell.canFail $ cmd "timeout" "-k" "2" "1" (T.pack program) argument
        code <- lastExitCode
        stderr <- lastStderr
        let hasVersion =
@ -86,72 +86,81 @@ runChecks expectedVersion program =

 checkReport :: BinaryCheck -> Text
 checkReport (BinaryCheck p False False) =
-  "- Warning: no invocation of " <> toTextIgnore p <>
+  "- Warning: no invocation of " <> T.pack p <>
  " had a zero exit code or showed the expected version"
 checkReport (BinaryCheck p _ _) =
-  "- " <> toTextIgnore p <> " passed the binary check."
+  "- " <> T.pack p <> " passed the binary check."

-result :: UpdateEnv -> FilePath -> Sh Text
-result updateEnv resultPath = do
-  let expectedVersion = newVersion updateEnv
-  home <- get_env_text "HOME"
-  let logFile = workingDir (options updateEnv) </> "check-result-log.tmp"
-  setenv "EDITOR" "echo"
-  setenv "HOME" "/homeless-shelter"
-  let addToReport input = appendfile logFile (input <> "\n")
-  tempdir <- fromText . T.strip <$> cmd "mktemp" "-d"
-  chdir tempdir $ do
-    rm_f logFile
-    let binaryDir = resultPath </> "bin"
-    binExists <- test_d binaryDir
-    binaries <-
-      if binExists
-        then findWhen test_f (resultPath </> "bin")
-        else return []
-    checks' <- forM binaries $ \binary -> runChecks expectedVersion binary
-    addToReport (T.intercalate "\n" (map checkReport checks'))
-    let passedZeroExitCode =
-          (T.pack . show)
-            (foldl
-               (\acc c ->
-                  if zeroExitCode c
-                    then acc + 1
-                    else acc)
-               0
-               checks' :: Int)
-        passedVersionPresent =
-          (T.pack . show)
-            (foldl
-               (\acc c ->
-                  if versionPresent c
-                    then acc + 1
-                    else acc)
-               0
-               checks' :: Int)
-        numBinaries = (T.pack . show) (length binaries)
-    addToReport
-      ("- " <> passedZeroExitCode <> " of " <> numBinaries <>
-       " passed binary check by having a zero exit code.")
-    addToReport
-      ("- " <> passedVersionPresent <> " of " <> numBinaries <>
-       " passed binary check by having the new version present in output.")
-    _ <- Shell.canFail $ cmd "grep" "-r" expectedVersion resultPath
-    whenM ((== 0) <$> lastExitCode) $
-      addToReport $
-      "- found " <> expectedVersion <> " with grep in " <>
-      toTextIgnore resultPath
-    whenM
-      (null <$>
-       findWhen
-         (\p -> ((expectedVersion `T.isInfixOf` toTextIgnore p) &&) <$> test_f p)
-         resultPath) $
-      addToReport $
-      "- found " <> expectedVersion <> " in filename of file in " <>
-      toTextIgnore resultPath
-    setenv "HOME" home
-    gist1 <- cmd "tree" resultPath -|- cmd "gist"
-    unless (T.null gist1) $
-      addToReport $ "- directory tree listing: " <> T.strip gist1
-    gist2 <- cmd "du" "-h" resultPath -|- cmd "gist"
-    unless (T.null gist2) $ addToReport $ "- du listing: " <> T.strip gist2
-  Shell.canFail $ readfile logFile
+result :: MonadIO m => UpdateEnv -> FilePath -> m Text
+result updateEnv resultPath =
+  let shellyResultPath = fromText . T.pack $ resultPath
+   in Shell.ourShell (options updateEnv) $ do
+        let expectedVersion = newVersion updateEnv
+        home <- get_env_text "HOME"
+        rDir <- liftIO runtimeDir
+        let logFile = rDir <> "/check-result-log.tmp"
+        let shellyLogFile = logFile & T.pack & fromText
+        setenv "EDITOR" "echo"
+        setenv "HOME" "/homeless-shelter"
+        let addToReport input = appendfile shellyLogFile (input <> "\n")
+        tempdir <- fromText . T.strip <$> cmd "mktemp" "-d"
+        chdir tempdir $ do
+          rm_f (shellyLogFile)
+          let binaryDir = shellyResultPath </> "/bin"
+          binExists <- test_d binaryDir
+          binaries <-
+            if binExists
+              then findWhen test_f binaryDir
+              else return []
+          checks' <-
+            forM binaries $ \binary ->
+              runChecks expectedVersion (T.unpack $ toTextIgnore binary)
+          addToReport (T.intercalate "\n" (map checkReport checks'))
+          let passedZeroExitCode =
+                (T.pack . show)
+                  (foldl
+                     (\acc c ->
+                        if zeroExitCode c
+                          then acc + 1
+                          else acc)
+                     0
+                     checks' :: Int)
+              passedVersionPresent =
+                (T.pack . show)
+                  (foldl
+                     (\acc c ->
+                        if versionPresent c
+                          then acc + 1
+                          else acc)
+                     0
+                     checks' :: Int)
+              numBinaries = (T.pack . show) (length binaries)
+          addToReport
+            ("- " <> passedZeroExitCode <> " of " <> numBinaries <>
+             " passed binary check by having a zero exit code.")
+          addToReport
+            ("- " <> passedVersionPresent <> " of " <> numBinaries <>
+             " passed binary check by having the new version present in output.")
+          _ <- Shell.canFail $ cmd "grep" "-r" expectedVersion shellyResultPath
+          whenM ((== 0) <$> lastExitCode) $
+            addToReport $
+            "- found " <> expectedVersion <> " with grep in " <>
+            T.pack resultPath
+          whenM
+            (null <$>
+             findWhen
+               (\p ->
+                  ((expectedVersion `T.isInfixOf` toTextIgnore p) &&) <$>
+                  test_f p)
+               (fromText $ T.pack resultPath)) $
+            addToReport $
+            "- found " <> expectedVersion <> " in filename of file in " <>
+            toTextIgnore shellyResultPath
+          setenv "HOME" home
+          gist1 <- cmd "tree" shellyResultPath -|- cmd "gist"
+          unless (T.null gist1) $
+            addToReport $ "- directory tree listing: " <> T.strip gist1
+          gist2 <- cmd "du" "-h" shellyResultPath -|- cmd "gist"
+          unless (T.null gist2) $
+            addToReport $ "- du listing: " <> T.strip gist2
+        Shell.canFail (readfile shellyLogFile)
--- a/src/Clean.hs
+++ b/src/Clean.hs
@ -11,9 +11,8 @@ import OurPrelude
 import Control.Applicative (some)
 import qualified Data.Text as T
 import qualified File
-import Prelude hiding (FilePath)
 import qualified Shell
-import Shelly
+import Shelly hiding (FilePath)
 import qualified Text.Regex.Applicative.Text as RE
 import Text.Regex.Applicative.Text (RE', (=~))
 import Utils (UpdateEnv(..), Version)
@ -47,12 +46,17 @@ fixSrcUrl updateEnv derivationFile attrPath oldSrcUrl = do
       ".name).name)")
  whenM
    (Shell.succeeded $
-     cmd "grep" "-q" ("name = \"" <> newDerivationName <> "\"") derivationFile) $
+     cmd
+       "grep"
+       "-q"
+       ("name = \"" <> newDerivationName <> "\"")
+       (T.pack derivationFile)) $
    -- Separate name and version
   do
    let newName = name <> "-${version}"
    File.replace newDerivationName newName derivationFile
-    _ <- cmd "grep" "-q" ("name = \"" <> newName <> "\"") derivationFile
+    _ <-
+      cmd "grep" "-q" ("name = \"" <> newName <> "\"") (T.pack derivationFile)
    _ <-
      cmd
        "sed"
@ -61,12 +65,12 @@ fixSrcUrl updateEnv derivationFile attrPath oldSrcUrl = do
         "-${version}\";\\)|\\1\\2\\n\\1version = \"" <>
         newVersion updateEnv <>
         "\";|")
-        derivationFile
+        (T.pack derivationFile)
    cmd
      "grep"
      "-q"
      ("version = \"" <> newVersion updateEnv <> "\";")
-      derivationFile
+      (T.pack derivationFile)
  -- Obtain download URLs from repology
  -- TODO: use repology-api package
  downloads <-
@ -97,11 +101,13 @@ fixSrcUrl updateEnv derivationFile attrPath oldSrcUrl = do
              "${version}"
              (T.replace newDerivationName "${name}" downloadUrl)
      lift $ File.replace oldUrl newUrl derivationFile
-      _ <- lift $ cmd "grep" "-q" ("url = \"" <> newUrl <> "\";") derivationFile
+      _ <-
+        lift $
+        cmd "grep" "-q" ("url = \"" <> newUrl <> "\";") (T.pack derivationFile)
      whenM
        (lift $
         Shell.succeeded $
-         cmd "grep" "-q" ("url = \"" <> newUrl <> "\";") derivationFile) $ do
+         cmd "grep" "-q" ("url = \"" <> newUrl <> "\";") (T.pack derivationFile)) $ do
        hash <-
          lift $
          Shell.canFail $ cmd "nix-prefetch-url" "-A" (attrPath <> ".src")
--- a/src/File.hs
+++ b/src/File.hs
@ -6,15 +6,9 @@ import OurPrelude

 import qualified Data.Text as T
 import Data.Text.IO as T
-import qualified Shelly
-import Shelly (Sh, liftIO, toTextIgnore)

-replaceIO :: Text -> Text -> FilePath -> IO ()
-replaceIO find r file = do
-  contents <- T.readFile file
-  T.writeFile file (T.replace find r contents)
-
-replace :: Text -> Text -> Shelly.FilePath -> Sh ()
-replace find r file = liftIO $ replaceIO find r f
-  where
-    f = (T.unpack . toTextIgnore) file
+replace :: MonadIO m => Text -> Text -> FilePath -> m ()
+replace find r file =
+  liftIO $ do
+    contents <- T.readFile file
+    T.writeFile file (T.replace find r contents)
--- a/src/GH.hs
+++ b/src/GH.hs
@ -40,8 +40,8 @@ releaseUrl url = do
  urlParts <- parseURL url
  gReleaseUrl urlParts

-pr :: Text -> Text -> Sh ()
-pr base = cmd "hub" "pull-request" "-b" base "-m"
+pr :: MonadIO m => Text -> Text -> m ()
+pr base msg = shelly $ cmd "hub" "pull-request" "-b" base "-m" msg

 data URLParts = URLParts
  { owner :: Name Owner
--- a/src/Main.hs
+++ b/src/Main.hs
@ -12,7 +12,6 @@ import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import DeleteMerged (deleteDone)
 import qualified Options.Applicative as Opt
-import System.Directory (getHomeDirectory)
 import Update (updateAll)
 import Utils (Options(..), setupNixpkgs)

@ -59,9 +58,8 @@ programInfo =

 makeOptions :: Arguments -> IO Options
 makeOptions Arguments {dry} = do
-  homeDir <- T.pack <$> getHomeDirectory
  token <- T.strip <$> T.readFile "github_token.txt"
-  return $ Options dry (homeDir <> "/.nixpkgs-update") token
+  return $ Options dry token

 main :: IO ()
 main = do
--- a/src/Nix.hs
+++ b/src/Nix.hs
@ -27,9 +27,8 @@ import OurPrelude

 import Control.Monad (void)
 import qualified Data.Text as T
-import Prelude hiding (FilePath)
 import qualified Shell
-import Shelly (FilePath, Sh, cmd, fromText, run, setStdin, shelly, toTextIgnore)
+import Shelly (cmd, run, setStdin, shelly)
 import Utils (UpdateEnv(..), overwriteErrorT)

 data Raw
@ -83,7 +82,7 @@ lookupAttrPath updateEnv =
 getDerivationFile :: MonadIO m => Text -> ExceptT Text m FilePath
 getDerivationFile attrPath =
  cmd "env" "EDITOR=echo" "nix" "edit" attrPath "-f" "." & fmap T.strip &
-  fmap fromText &
+  fmap T.unpack &
  Shell.shellyET &
  overwriteErrorT "Couldn't find derivation file."

@ -152,8 +151,9 @@ getSrcAttr attr attrPath =
 getSrcUrls :: MonadIO m => Text -> ExceptT Text m Text
 getSrcUrls = getSrcAttr "urls"

-buildCmd :: Text -> Sh ()
-buildCmd =
+buildCmd :: MonadIO m => Text -> m ()
+buildCmd attrPath =
+  shelly $
  cmd
    "nix-build"
    "--option"
@ -163,6 +163,7 @@ buildCmd =
    "restrict-eval"
    "true"
    "-A"
+    attrPath

 build :: MonadIO m => Text -> ExceptT Text m ()
 build attrPath =
@ -179,7 +180,7 @@ build attrPath =
 cachix :: MonadIO m => FilePath -> m ()
 cachix resultPath =
  shelly $ do
-    setStdin (toTextIgnore resultPath)
+    setStdin (T.pack resultPath)
    void $ Shell.shE $ cmd "cachix" "push" "r-ryantm"

 numberOfFetchers :: Text -> Int
@ -191,7 +192,7 @@ numberOfFetchers derivationContents =
 assertOneOrFewerFetcher :: MonadIO m => Text -> FilePath -> ExceptT Text m ()
 assertOneOrFewerFetcher derivationContents derivationFile =
  tryAssert
-    ("More than one fetcher in " <> toTextIgnore derivationFile)
+    ("More than one fetcher in " <> T.pack derivationFile)
    (numberOfFetchers derivationContents <= 1)

 assertOldVersionOn ::
@ -205,7 +206,7 @@ assertOldVersionOn updateEnv branchName contents =

 resultLink :: MonadIO m => ExceptT Text m FilePath
 resultLink =
-  (T.strip >>> fromText) <$> do
+  (T.strip >>> T.unpack) <$> do
    Shell.shellyET (cmd "readlink" "./result") <|>
      Shell.shellyET (cmd "readlink" "./result-bin") <|>
      throwE "Could not find result link."
@ -214,7 +215,7 @@ sha256Zero :: Text
 sha256Zero = "0000000000000000000000000000000000000000000000000000"

 -- fixed-output derivation produced path '/nix/store/fg2hz90z5bc773gpsx4gfxn3l6fl66nw-source' with sha256 hash '0q1lsgc1621czrg49nmabq6am9sgxa9syxrwzlksqqr4dyzw4nmf' instead of the expected hash '0bp22mzkjy48gncj5vm9b7whzrggcbs5pd4cnb6k8jpl9j02dhdv'
-getHashFromBuild :: Text -> ExceptT Text Sh Text
+getHashFromBuild :: MonadIO m => Text -> ExceptT Text m Text
 getHashFromBuild attrPath = do
  stderr <-
    (ExceptT $ Shell.shRE (buildCmd attrPath)) <|>
--- a/src/Outpaths.hs
+++ b/src/Outpaths.hs
@ -75,8 +75,10 @@ in
  tweak (builtins.removeAttrs hydraJobs blacklist))
 |]

-outPath :: Sh Text
+outPath :: MonadIO m => m Text
 outPath =
+  shelly $
+  silently $
  sub $ do
    _ <-
      cmd
@ -112,9 +114,9 @@ testInput :: Text
 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"

-currentOutpathSet :: Sh (Either Text (Set ResultLine))
+currentOutpathSet :: MonadIO m => m (Either Text (Set ResultLine))
 currentOutpathSet =
-  first (show >>> T.pack) . parse parseResults "outpath" <$> silently outPath
+  first (show >>> T.pack) . parse parseResults "outpath" <$> outPath

 parseResults :: CharParsing m => m (Set ResultLine)
 parseResults = S.fromList <$> parseResultLine `sepEndBy` newline
--- a/src/Shell.hs
+++ b/src/Shell.hs
@ -29,7 +29,7 @@ ourSilentShell o s =
    setUpEnvironment o
    s

-ourShell :: Options -> Sh a -> IO a
+ourShell :: MonadIO m => Options -> Sh a -> m a
 ourShell o s =
  shelly $
  verbosely $ do
@ -46,14 +46,15 @@ shE s = do

 -- A shell cmd we are expecting to fail and want to look at the output
 -- of it.
-shRE :: Sh a -> Sh (Either Text Text)
-shRE s = do
-  _ <- canFail s
-  stderr <- lastStderr
-  status <- lastExitCode
-  case status of
-    0 -> return $ Left ""
-    _ -> return $ Right stderr
+shRE :: MonadIO m => Sh a -> m (Either Text Text)
+shRE s =
+  shelly $ do
+    _ <- canFail s
+    stderr <- lastStderr
+    status <- lastExitCode
+    case status of
+      0 -> return $ Left ""
+      _ -> return $ Right stderr

 shellyET :: MonadIO m => Sh a -> ExceptT Text m a
 shellyET = shE >>> shelly >>> ExceptT
--- a/src/Update.hs
+++ b/src/Update.hs
@ -13,20 +13,20 @@ import OurPrelude

 import qualified Blacklist
 import qualified Check
-import Control.Exception (SomeException)
-import Control.Exception.Lifted
 import Data.IORef
 import qualified Data.Set as S
 import qualified Data.Text as T
+import qualified Data.Text.IO as T
 import Data.Time.Clock (UTCTime, getCurrentTime)
 import qualified File
 import qualified GH
 import qualified Git
 import qualified Nix
 import Outpaths
-import Prelude hiding (FilePath, log)
+import Prelude hiding (log)
 import qualified Shell
-import Shelly.Lifted
+import Shelly ((-|-), cmd, shelly, sleep)
+import System.Posix.Files (touchFile)
 import qualified Time
 import Utils
  ( Options(..)
@ -34,6 +34,7 @@ import Utils
  , Version
  , branchName
  , parseUpdates
+  , runtimeDir
  , tRead
  )
 import qualified Version
@ -45,31 +46,31 @@ data MergeBaseOutpathsInfo = MergeBaseOutpathsInfo
  , mergeBaseOutpaths :: Set ResultLine
  }

-log' :: (MonadIO m, MonadSh m) => FilePath -> Text -> m ()
+log' :: MonadIO m => FilePath -> Text -> m ()
 log' logFile msg = do
  runDate <- Time.runDate
-  appendfile logFile (runDate <> " " <> msg <> "\n")
+  liftIO $ T.appendFile logFile (runDate <> " " <> msg <> "\n")

 updateAll :: Options -> Text -> IO ()
-updateAll o updates =
-  Shell.ourShell o $ do
-    let logFile = fromText (workingDir o) </> "ups.log"
-    mkdir_p (fromText (workingDir o))
-    touchfile logFile
-    let log = log' logFile
-    appendfile logFile "\n\n"
-    log "New run of ups.sh"
-    twoHoursAgo <- Time.twoHoursAgo
-    mergeBaseOutpathSet <-
-      liftIO $ newIORef (MergeBaseOutpathsInfo twoHoursAgo S.empty)
-    updateLoop o log (parseUpdates updates) mergeBaseOutpathSet
+updateAll o updates = do
+  rDir <- runtimeDir
+  let logFile = rDir <> "/ups.log"
+  touchFile logFile
+  let log = log' logFile
+  T.appendFile logFile "\n\n"
+  log "New run of ups.sh"
+  twoHoursAgo <- Time.twoHoursAgo
+  mergeBaseOutpathSet <-
+    liftIO $ newIORef (MergeBaseOutpathsInfo twoHoursAgo S.empty)
+  updateLoop o log (parseUpdates updates) mergeBaseOutpathSet

 updateLoop ::
-     Options
-  -> (Text -> Sh ())
+     MonadIO m
+  => Options
+  -> (Text -> m ())
  -> [Either Text (Text, Version, Version)]
  -> IORef MergeBaseOutpathsInfo
-  -> Sh ()
+  -> m ()
 updateLoop _ log [] _ = log "ups.sh finished"
 updateLoop o log (Left e:moreUpdates) mergeBaseOutpathsContext = do
  log e
@ -99,13 +100,13 @@ updateLoop o log (Right (pName, oldVer, newVer):moreUpdates) mergeBaseOutpathsCo
 -- * the merge base context should be updated externally to this function
 -- * the commit for branches: master, staging, staging-next, python-unstable
 updatePackage ::
-     (Text -> Sh ())
+     MonadIO m
+  => (Text -> m ())
  -> UpdateEnv
  -> IORef MergeBaseOutpathsInfo
-  -> Sh (Either Text ())
+  -> m (Either Text ())
 updatePackage log updateEnv mergeBaseOutpathsContext =
-  runExceptT $
-  flip catches [Handler (\(ex :: SomeException) -> throwE (T.pack (show ex)))] $ do
+  runExceptT $ do
    Blacklist.packageName (packageName updateEnv)
    Nix.assertNewerVersion updateEnv
    Git.fetchIfStale
@ -133,7 +134,7 @@ updatePackage log updateEnv mergeBaseOutpathsContext =
            writeIORef mergeBaseOutpathsContext (MergeBaseOutpathsInfo now mbos)
          return mbos
        else return $ mergeBaseOutpaths mergeBaseOutpathsInfo
-    derivationContents <- lift $ readfile derivationFile
+    derivationContents <- liftIO $ T.readFile derivationFile
    Nix.assertOneOrFewerFetcher derivationContents derivationFile
    Blacklist.content derivationContents
    oldHash <- Nix.getOldHash attrPath
@ -159,20 +160,21 @@ updatePackage log updateEnv mergeBaseOutpathsContext =
    publishPackage log updateEnv oldSrcUrl newSrcUrl attrPath result opDiff

 publishPackage ::
-     (Text -> Sh ())
+     MonadIO m
+  => (Text -> m ())
  -> UpdateEnv
  -> Text
  -> Text
  -> Text
  -> FilePath
  -> Set ResultLine
-  -> ExceptT Text Sh ()
+  -> ExceptT Text m ()
 publishPackage log updateEnv oldSrcUrl newSrcUrl attrPath result opDiff = do
  lift $ log ("cachix " <> (T.pack . show) result)
  lift $ Nix.cachix result
  resultCheckReport <-
    case Blacklist.checkResult (packageName updateEnv) of
-      Right () -> lift $ sub (Check.result updateEnv result)
+      Right () -> lift $ Check.result updateEnv result
      Left msg -> pure msg
  d <- Nix.getDescription attrPath
  let metaDescription =
@ -261,7 +263,7 @@ prMessage updateEnv isBroken metaDescription releaseUrlMessage compareUrlMessage
      oV = oldVersion updateEnv
      nV = newVersion updateEnv
      repologyLink = repologyUrl updateEnv
-      result = toTextIgnore resultPath
+      result = T.pack resultPath
   in [interpolate|
       $attrPath: $oV -> $nV

@ -321,19 +323,21 @@ prMessage updateEnv isBroken metaDescription releaseUrlMessage compareUrlMessage
       $maintainersCc
    |]

-untilOfBorgFree :: Sh ()
-untilOfBorgFree = do
-  waiting :: Int <-
-    tRead <$>
-    Shell.canFail
-      (cmd "curl" "-s" "https://events.nix.ci/stats.php" -|-
-       cmd "jq" ".evaluator.messages.waiting")
-  when (waiting > 2) $ do
-    sleep 60
-    untilOfBorgFree
+untilOfBorgFree :: MonadIO m => m ()
+untilOfBorgFree =
+  shelly $ do
+    waiting :: Int <-
+      tRead <$>
+      Shell.canFail
+        (cmd "curl" "-s" "https://events.nix.ci/stats.php" -|-
+         cmd "jq" ".evaluator.messages.waiting")
+    when (waiting > 2) $ do
+      sleep 60
+      untilOfBorgFree

-assertNotUpdatedOn :: UpdateEnv -> FilePath -> Text -> ExceptT Text Sh ()
+assertNotUpdatedOn ::
+     MonadIO m => UpdateEnv -> FilePath -> Text -> ExceptT Text m ()
 assertNotUpdatedOn updateEnv derivationFile branch = do
  Git.cleanAndResetTo branch
-  derivationContents <- lift $ readfile derivationFile
+  derivationContents <- liftIO $ T.readFile derivationFile
  Nix.assertOldVersionOn updateEnv branch derivationContents
--- a/src/Utils.hs
+++ b/src/Utils.hs
@ -31,7 +31,6 @@ type Version = Text

 data Options = Options
  { dryRun :: Bool
-  , workingDir :: Text
  , githubToken :: Text
  } deriving (Show)