{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

module Check
  ( result,
    -- exposed for testing:
    hasVersion
  )
where

import Control.Applicative (many)
import Data.Char (isDigit, isLetter)
import Data.Maybe (fromJust)
import qualified Data.Text as T
import Language.Haskell.TH.Env (envQ)
import OurPrelude
import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
import System.Exit
import System.IO.Temp (withSystemTempDirectory)
import Text.Regex.Applicative.Text (RE', (=~))
import qualified Text.Regex.Applicative.Text as RE
import Utils (UpdateEnv (..), Version, nixBuildOptions)

default (T.Text)

treeBin :: String
treeBin :: String
treeBin = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust ($$(envQ "TREE") :: Maybe String) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/bin/tree"

procTree :: [String] -> ProcessConfig () () ()
procTree :: [String] -> ProcessConfig () () ()
procTree = String -> [String] -> ProcessConfig () () ()
proc String
treeBin

gistBin :: String
gistBin :: String
gistBin = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust ($$(envQ "GIST") :: Maybe String) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/bin/gist"

procGist :: [String] -> ProcessConfig () () ()
procGist :: [String] -> ProcessConfig () () ()
procGist = String -> [String] -> ProcessConfig () () ()
proc String
gistBin

timeoutBin :: String
timeoutBin :: String
timeoutBin = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust ($$(envQ "TIMEOUT") :: Maybe String) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/bin/timeout"

data BinaryCheck = BinaryCheck
  { BinaryCheck -> String
filePath :: FilePath,
    BinaryCheck -> Bool
zeroExitCode :: Bool,
    BinaryCheck -> Bool
versionPresent :: Bool
  }

isWordCharacter :: Char -> Bool
isWordCharacter :: Char -> Bool
isWordCharacter Char
c = (Char -> Bool
isDigit Char
c) Bool -> Bool -> Bool
|| (Char -> Bool
isLetter Char
c)

isNonWordCharacter :: Char -> Bool
isNonWordCharacter :: Char -> Bool
isNonWordCharacter Char
c = Bool -> Bool
not (Char -> Bool
isWordCharacter Char
c)

-- | Construct regex: /.*\b${version}\b.*/s
versionRegex :: Text -> RE' ()
versionRegex :: Text -> RE' ()
versionRegex Text
version =
  (\Text
_ -> ()) (Text -> ()) -> RE Char Text -> RE' ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (
    (((RE Char Char -> RE Char String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many RE Char Char
RE.anySym) RE Char String -> RE Char Char -> RE Char String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ((Char -> Bool) -> RE Char Char
RE.psym Char -> Bool
isNonWordCharacter)) RE Char String -> RE Char String -> RE Char String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> RE Char String
forall (f :: * -> *) a. Applicative f => a -> f a
RE.pure String
""))
    RE Char String -> RE Char Text -> RE Char Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> RE Char Text
RE.string Text
version) RE Char Text -> RE Char String -> RE Char Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
    ((String -> RE Char String
forall (f :: * -> *) a. Applicative f => a -> f a
RE.pure String
"") RE Char String -> RE Char String -> RE Char String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (((Char -> Bool) -> RE Char Char
RE.psym Char -> Bool
isNonWordCharacter) RE Char Char -> RE Char String -> RE Char String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (RE Char Char -> RE Char String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many RE Char Char
RE.anySym)))
  )

hasVersion :: Text -> Text -> Bool
hasVersion :: Text -> Text -> Bool
hasVersion Text
contents Text
expectedVersion =
  Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool) -> Maybe () -> Bool
forall a b. (a -> b) -> a -> b
$ Text
contents Text -> RE' () -> Maybe ()
forall a. Text -> RE' a -> Maybe a
=~ Text -> RE' ()
versionRegex Text
expectedVersion

checkTestsBuild :: Text -> IO Bool
checkTestsBuild :: Text -> IO Bool
checkTestsBuild Text
attrPath =
  let args :: [String]
args =
        [String]
nixBuildOptions
          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"-E",
               String
"{ config }: (import ./. { inherit config; })."
                 String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Text -> String
T.unpack Text
attrPath)
                 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".tests or {}"
             ]
   in do
        Either Text (ExitCode, Text)
r <- ExceptT Text IO (ExitCode, Text)
-> IO (Either Text (ExitCode, Text))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text IO (ExitCode, Text)
 -> IO (Either Text (ExitCode, Text)))
-> ExceptT Text IO (ExitCode, Text)
-> IO (Either Text (ExitCode, Text))
forall a b. (a -> b) -> a -> b
$ ProcessConfig () () () -> ExceptT Text IO (ExitCode, Text)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> ExceptT Text m (ExitCode, Text)
ourReadProcessInterleaved (ProcessConfig () () () -> ExceptT Text IO (ExitCode, Text))
-> ProcessConfig () () () -> ExceptT Text IO (ExitCode, Text)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> ProcessConfig () () ()
proc String
"nix-build" [String]
args
        case Either Text (ExitCode, Text)
r of
          Right (ExitCode
ExitSuccess, Text
_) -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          Either Text (ExitCode, Text)
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Run a program with provided argument and report whether the output
-- mentions the expected version
checkBinary :: Text -> Version -> FilePath -> IO BinaryCheck
checkBinary :: Text -> Text -> String -> IO BinaryCheck
checkBinary Text
argument Text
expectedVersion String
program = do
  Either Text (ExitCode, Text)
eResult <-
    ExceptT Text IO (ExitCode, Text)
-> IO (Either Text (ExitCode, Text))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text IO (ExitCode, Text)
 -> IO (Either Text (ExitCode, Text)))
-> ExceptT Text IO (ExitCode, Text)
-> IO (Either Text (ExitCode, Text))
forall a b. (a -> b) -> a -> b
$
      String
-> (String -> ExceptT Text IO (ExitCode, Text))
-> ExceptT Text IO (ExitCode, Text)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory
        String
"nixpkgs-update"
        ( ProcessConfig () () ()
-> String -> ExceptT Text IO (ExitCode, Text)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> String -> ExceptT Text m (ExitCode, Text)
ourLockedDownReadProcessInterleaved (ProcessConfig () () ()
 -> String -> ExceptT Text IO (ExitCode, Text))
-> ProcessConfig () () ()
-> String
-> ExceptT Text IO (ExitCode, Text)
forall a b. (a -> b) -> a -> b
$
            String -> ProcessConfig () () ()
shell (String
timeoutBin String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" -k 2 1 " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
program String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
argument)
        )
  case Either Text (ExitCode, Text)
eResult of
    Left (Text
_ :: Text) -> BinaryCheck -> IO BinaryCheck
forall (m :: * -> *) a. Monad m => a -> m a
return (BinaryCheck -> IO BinaryCheck) -> BinaryCheck -> IO BinaryCheck
forall a b. (a -> b) -> a -> b
$ String -> Bool -> Bool -> BinaryCheck
BinaryCheck String
program Bool
False Bool
False
    Right (ExitCode
exitCode, Text
contents) ->
      BinaryCheck -> IO BinaryCheck
forall (m :: * -> *) a. Monad m => a -> m a
return (BinaryCheck -> IO BinaryCheck) -> BinaryCheck -> IO BinaryCheck
forall a b. (a -> b) -> a -> b
$ String -> Bool -> Bool -> BinaryCheck
BinaryCheck String
program (ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess) (Text -> Text -> Bool
hasVersion Text
contents Text
expectedVersion)

checks :: [Version -> FilePath -> IO BinaryCheck]
checks :: [Text -> String -> IO BinaryCheck]
checks =
  [ Text -> Text -> String -> IO BinaryCheck
checkBinary Text
"",
    Text -> Text -> String -> IO BinaryCheck
checkBinary Text
"-V",
    Text -> Text -> String -> IO BinaryCheck
checkBinary Text
"-v",
    Text -> Text -> String -> IO BinaryCheck
checkBinary Text
"--version",
    Text -> Text -> String -> IO BinaryCheck
checkBinary Text
"version",
    Text -> Text -> String -> IO BinaryCheck
checkBinary Text
"-h",
    Text -> Text -> String -> IO BinaryCheck
checkBinary Text
"--help",
    Text -> Text -> String -> IO BinaryCheck
checkBinary Text
"help"
  ]

someChecks :: BinaryCheck -> [IO BinaryCheck] -> IO BinaryCheck
someChecks :: BinaryCheck -> [IO BinaryCheck] -> IO BinaryCheck
someChecks BinaryCheck
best [] = BinaryCheck -> IO BinaryCheck
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryCheck
best
someChecks BinaryCheck
best (IO BinaryCheck
c : [IO BinaryCheck]
rest) = do
  BinaryCheck
current <- IO BinaryCheck
c
  let nb :: BinaryCheck
nb = BinaryCheck -> BinaryCheck
newBest BinaryCheck
current
  case BinaryCheck
nb of
    BinaryCheck String
_ Bool
True Bool
True -> BinaryCheck -> IO BinaryCheck
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryCheck
nb
    BinaryCheck
_ -> BinaryCheck -> [IO BinaryCheck] -> IO BinaryCheck
someChecks BinaryCheck
nb [IO BinaryCheck]
rest
  where
    newBest :: BinaryCheck -> BinaryCheck
    newBest :: BinaryCheck -> BinaryCheck
newBest (BinaryCheck String
_ Bool
currentExit Bool
currentVersionPresent) =
      String -> Bool -> Bool -> BinaryCheck
BinaryCheck
        (BinaryCheck -> String
filePath BinaryCheck
best)
        (BinaryCheck -> Bool
zeroExitCode BinaryCheck
best Bool -> Bool -> Bool
|| Bool
currentExit)
        (BinaryCheck -> Bool
versionPresent BinaryCheck
best Bool -> Bool -> Bool
|| Bool
currentVersionPresent)

-- | Run a program with various version or help flags and report
-- when they succeded
runChecks :: Version -> FilePath -> IO BinaryCheck
runChecks :: Text -> String -> IO BinaryCheck
runChecks Text
expectedVersion String
program =
  BinaryCheck -> [IO BinaryCheck] -> IO BinaryCheck
someChecks (String -> Bool -> Bool -> BinaryCheck
BinaryCheck String
program Bool
False Bool
False) [IO BinaryCheck]
checks'
  where
    checks' :: [IO BinaryCheck]
checks' = ((Text -> String -> IO BinaryCheck) -> IO BinaryCheck)
-> [Text -> String -> IO BinaryCheck] -> [IO BinaryCheck]
forall a b. (a -> b) -> [a] -> [b]
map (\Text -> String -> IO BinaryCheck
c -> Text -> String -> IO BinaryCheck
c Text
expectedVersion String
program) [Text -> String -> IO BinaryCheck]
checks

checkTestsBuildReport :: Bool -> Text
checkTestsBuildReport :: Bool -> Text
checkTestsBuildReport Bool
False =
  Text
"- Warning: a test defined in `passthru.tests` did not pass"
checkTestsBuildReport Bool
True =
  Text
"- The tests defined in `passthru.tests`, if any, passed"

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

ourLockedDownReadProcessInterleaved ::
  MonadIO m =>
  ProcessConfig stdin stdoutIgnored stderrIgnored ->
  FilePath ->
  ExceptT Text m (ExitCode, Text)
ourLockedDownReadProcessInterleaved :: ProcessConfig stdin stdoutIgnored stderrIgnored
-> String -> ExceptT Text m (ExitCode, Text)
ourLockedDownReadProcessInterleaved ProcessConfig stdin stdoutIgnored stderrIgnored
processConfig String
tempDir =
  ProcessConfig stdin stdoutIgnored stderrIgnored
processConfig ProcessConfig stdin stdoutIgnored stderrIgnored
-> (ProcessConfig stdin stdoutIgnored stderrIgnored
    -> ProcessConfig stdin stdoutIgnored stderrIgnored)
-> ProcessConfig stdin stdoutIgnored stderrIgnored
forall a b. a -> (a -> b) -> b
& String
-> ProcessConfig stdin stdoutIgnored stderrIgnored
-> ProcessConfig stdin stdoutIgnored stderrIgnored
forall stdin stdout stderr.
String
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setWorkingDir String
tempDir
    ProcessConfig stdin stdoutIgnored stderrIgnored
-> (ProcessConfig stdin stdoutIgnored stderrIgnored
    -> ProcessConfig stdin stdoutIgnored stderrIgnored)
-> ProcessConfig stdin stdoutIgnored stderrIgnored
forall a b. a -> (a -> b) -> b
& [(String, String)]
-> ProcessConfig stdin stdoutIgnored stderrIgnored
-> ProcessConfig stdin stdoutIgnored stderrIgnored
forall stdin stdout stderr.
[(String, String)]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setEnv [(String
"EDITOR", String
"echo"), (String
"HOME", String
"/we-dont-write-to-home")]
    ProcessConfig stdin stdoutIgnored stderrIgnored
-> (ProcessConfig stdin stdoutIgnored stderrIgnored
    -> ExceptT Text m (ExitCode, Text))
-> ExceptT Text m (ExitCode, Text)
forall a b. a -> (a -> b) -> b
& ProcessConfig stdin stdoutIgnored stderrIgnored
-> ExceptT Text m (ExitCode, Text)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> ExceptT Text m (ExitCode, Text)
ourReadProcessInterleaved

foundVersionInOutputs :: Text -> String -> IO (Maybe Text)
foundVersionInOutputs :: Text -> String -> IO (Maybe Text)
foundVersionInOutputs Text
expectedVersion String
resultPath =
  Either Text Text -> Maybe Text
forall a b. Either a b -> Maybe b
hush
    (Either Text Text -> Maybe Text)
-> IO (Either Text Text) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT Text IO Text -> IO (Either Text Text)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
      ( do
          (ExitCode
exitCode, Text
_) <-
            String -> [String] -> ProcessConfig () () ()
proc String
"grep" [String
"-r", Text -> String
T.unpack Text
expectedVersion, String
resultPath]
              ProcessConfig () () ()
-> (ProcessConfig () () () -> ExceptT Text IO (ExitCode, Text))
-> ExceptT Text IO (ExitCode, Text)
forall a b. a -> (a -> b) -> b
& ProcessConfig () () () -> ExceptT Text IO (ExitCode, Text)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> ExceptT Text m (ExitCode, Text)
ourReadProcessInterleaved
          case ExitCode
exitCode of
            ExitCode
ExitSuccess ->
              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
$
                Text
"- found "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
expectedVersion
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with grep in "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
resultPath
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            ExitCode
_ -> Text -> ExceptT Text IO Text
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Text
"grep did not find version in file names"
      )

foundVersionInFileNames :: Text -> String -> IO (Maybe Text)
foundVersionInFileNames :: Text -> String -> IO (Maybe Text)
foundVersionInFileNames Text
expectedVersion String
resultPath =
  Either Text Text -> Maybe Text
forall a b. Either a b -> Maybe b
hush
    (Either Text Text -> Maybe Text)
-> IO (Either Text Text) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT Text IO Text -> IO (Either Text Text)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
      ( do
          (ExitCode
_, Text
contents) <-
            String -> ProcessConfig () () ()
shell (String
"find " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
resultPath) ProcessConfig () () ()
-> (ProcessConfig () () () -> ExceptT Text IO (ExitCode, Text))
-> ExceptT Text IO (ExitCode, Text)
forall a b. a -> (a -> b) -> b
& ProcessConfig () () () -> ExceptT Text IO (ExitCode, Text)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> ExceptT Text m (ExitCode, Text)
ourReadProcessInterleaved
          (Text
contents Text -> RE' () -> Maybe ()
forall a. Text -> RE' a -> Maybe a
=~ Text -> RE' ()
versionRegex Text
expectedVersion) Maybe () -> (Maybe () -> MaybeT IO ()) -> MaybeT IO ()
forall a b. a -> (a -> b) -> b
& Maybe () -> MaybeT IO ()
forall (m :: * -> *) b. Monad m => Maybe b -> MaybeT m b
hoistMaybe
            MaybeT IO ()
-> (MaybeT IO () -> ExceptT Text IO ()) -> ExceptT Text IO ()
forall a b. a -> (a -> b) -> b
& Text -> MaybeT IO () -> ExceptT Text IO ()
forall (m :: * -> *) a b.
Monad m =>
a -> MaybeT m b -> ExceptT a m b
noteT (String -> Text
T.pack String
"Expected version not found")
          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
$
            Text
"- found "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
expectedVersion
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in filename of file in "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
resultPath
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
      )

treeGist :: String -> IO (Maybe Text)
treeGist :: String -> IO (Maybe Text)
treeGist String
resultPath =
  Either Text Text -> Maybe Text
forall a b. Either a b -> Maybe b
hush
    (Either Text Text -> Maybe Text)
-> IO (Either Text Text) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT Text IO Text -> IO (Either Text Text)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
      ( do
          ByteString
contents <- [String] -> ProcessConfig () () ()
procTree [String
resultPath] ProcessConfig () () ()
-> (ProcessConfig () () () -> ExceptT Text IO ByteString)
-> ExceptT Text IO ByteString
forall a b. a -> (a -> b) -> b
& ProcessConfig () () () -> ExceptT Text IO ByteString
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> ExceptT Text m ByteString
ourReadProcessInterleavedBS_
          Text
g <-
            String -> ProcessConfig () () ()
shell String
gistBin ProcessConfig () () ()
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
forall a b. a -> (a -> b) -> b
& StreamSpec 'STInput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin (ByteString -> StreamSpec 'STInput ()
byteStringInput ByteString
contents)
              ProcessConfig () () ()
-> (ProcessConfig () () () -> ExceptT Text IO Text)
-> ExceptT Text IO Text
forall a b. a -> (a -> b) -> b
& ProcessConfig () () () -> ExceptT Text IO Text
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> ExceptT Text m Text
ourReadProcessInterleaved_
          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
$ Text
"- directory tree listing: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
g Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
      )

duGist :: String -> IO (Maybe Text)
duGist :: String -> IO (Maybe Text)
duGist String
resultPath =
  Either Text Text -> Maybe Text
forall a b. Either a b -> Maybe b
hush
    (Either Text Text -> Maybe Text)
-> IO (Either Text Text) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT Text IO Text -> IO (Either Text Text)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
      ( do
          ByteString
contents <- String -> [String] -> ProcessConfig () () ()
proc String
"du" [String
resultPath] ProcessConfig () () ()
-> (ProcessConfig () () () -> ExceptT Text IO ByteString)
-> ExceptT Text IO ByteString
forall a b. a -> (a -> b) -> b
& ProcessConfig () () () -> ExceptT Text IO ByteString
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> ExceptT Text m ByteString
ourReadProcessInterleavedBS_
          Text
g <-
            String -> ProcessConfig () () ()
shell String
gistBin ProcessConfig () () ()
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
forall a b. a -> (a -> b) -> b
& StreamSpec 'STInput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin (ByteString -> StreamSpec 'STInput ()
byteStringInput ByteString
contents)
              ProcessConfig () () ()
-> (ProcessConfig () () () -> ExceptT Text IO Text)
-> ExceptT Text IO Text
forall a b. a -> (a -> b) -> b
& ProcessConfig () () () -> ExceptT Text IO Text
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> ExceptT Text m Text
ourReadProcessInterleaved_
          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
$ Text
"- du listing: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
g Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
      )

result :: MonadIO m => UpdateEnv -> String -> m Text
result :: UpdateEnv -> String -> m Text
result UpdateEnv
updateEnv String
resultPath =
  IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    let expectedVersion :: Text
expectedVersion = UpdateEnv -> Text
newVersion UpdateEnv
updateEnv
        binaryDir :: String
binaryDir = String
resultPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/bin"
    Bool
testsBuild <- Text -> IO Bool
checkTestsBuild (UpdateEnv -> Text
packageName UpdateEnv
updateEnv)
    Bool
binExists <- String -> IO Bool
doesDirectoryExist String
binaryDir
    [String]
binaries <-
      if Bool
binExists
        then
          ( do
              [String]
fs <- String -> IO [String]
listDirectory String
binaryDir
              (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
f -> String
binaryDir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f) [String]
fs)
          )
        else [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [BinaryCheck]
checks' <- [String] -> (String -> IO BinaryCheck) -> IO [BinaryCheck]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
binaries ((String -> IO BinaryCheck) -> IO [BinaryCheck])
-> (String -> IO BinaryCheck) -> IO [BinaryCheck]
forall a b. (a -> b) -> a -> b
$ \String
binary -> Text -> String -> IO BinaryCheck
runChecks Text
expectedVersion String
binary
    let passedZeroExitCode :: Text
passedZeroExitCode =
          (String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show)
            ( (Int -> BinaryCheck -> Int) -> Int -> [BinaryCheck] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
                ( \Int
acc BinaryCheck
c ->
                    if BinaryCheck -> Bool
zeroExitCode BinaryCheck
c
                      then Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                      else Int
acc
                )
                Int
0
                [BinaryCheck]
checks' ::
                Int
            )
        passedVersionPresent :: Text
passedVersionPresent =
          (String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show)
            ( (Int -> BinaryCheck -> Int) -> Int -> [BinaryCheck] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
                ( \Int
acc BinaryCheck
c ->
                    if BinaryCheck -> Bool
versionPresent BinaryCheck
c
                      then Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                      else Int
acc
                )
                Int
0
                [BinaryCheck]
checks' ::
                Int
            )
        numBinaries :: Text
numBinaries = (String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
binaries)
    Text
someReports <-
      Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
""
        (Maybe Text -> Text) -> IO (Maybe Text) -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> String -> IO (Maybe Text)
foundVersionInOutputs Text
expectedVersion String
resultPath
        IO (Maybe Text) -> IO (Maybe Text) -> IO (Maybe Text)
forall a. Semigroup a => a -> a -> a
<> Text -> String -> IO (Maybe Text)
foundVersionInFileNames Text
expectedVersion String
resultPath
        IO (Maybe Text) -> IO (Maybe Text) -> IO (Maybe Text)
forall a. Semigroup a => a -> a -> a
<> String -> IO (Maybe Text)
treeGist String
resultPath
        IO (Maybe Text) -> IO (Maybe Text) -> IO (Maybe Text)
forall a. Semigroup a => a -> a -> a
<> String -> IO (Maybe Text)
duGist String
resultPath
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$
      let testsBuildSummary :: Text
testsBuildSummary = Bool -> Text
checkTestsBuildReport Bool
testsBuild
          c :: Text
c = Text -> [Text] -> Text
T.intercalate Text
"\n" ((BinaryCheck -> Text) -> [BinaryCheck] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map BinaryCheck -> Text
checkReport [BinaryCheck]
checks')
          binaryCheckSummary :: Text
binaryCheckSummary =
            Text
"- "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
passedZeroExitCode
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
numBinaries
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" passed binary check by having a zero exit code."
          versionPresentSummary :: Text
versionPresentSummary =
            Text
"- "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
passedVersionPresent
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
numBinaries
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" passed binary check by having the new version present in output."
       in [interpolate|
              $testsBuildSummary
              $c
              $binaryCheckSummary
              $versionPresentSummary
              $someReports
            |]