module SlackBuilder.Download ( cloneAndArchive , commit , hostedSources , remoteFileExists , updateSlackBuildVersion ) where import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO import SlackBuilder.Config import SlackBuilder.Trans import Control.Monad.Trans.Reader (asks) import Control.Monad.IO.Class (MonadIO(liftIO)) import System.IO (IOMode(..), withFile) import System.FilePath ((), (<.>)) import System.Process (CreateProcess(..), StdStream(..), proc, readCreateProcessWithExitCode, callProcess) import System.Exit (ExitCode(..)) import Control.Monad (unless) import Text.URI (URI(..), mkURI) import Network.HTTP.Req ( useHttpsURI , HEAD(..) , NoReqBody(..) , req , runReq , defaultHttpConfig , ignoreResponse , responseStatusCode, HttpConfig (..) ) import Data.Maybe (fromMaybe) import Data.Functor ((<&>)) updateSlackBuildVersion :: Text -> Text -> SlackBuilderT () updateSlackBuildVersion packagePath version = do repository' <- SlackBuilderT $ asks repository let name = Text.unpack $ snd $ Text.breakOnEnd "/" packagePath slackbuildFilename = repository' Text.unpack packagePath (name <.> "SlackBuild") slackbuildContents <- liftIO $ Text.IO.readFile slackbuildFilename let (contentsHead, contentsTail) = Text.dropWhile (/= '\n') <$> Text.breakOn "VERSION=${VERSION:-" slackbuildContents liftIO $ Text.IO.writeFile slackbuildFilename $ contentsHead <> "VERSION=${VERSION:-" <> version <> "}" <> contentsTail commit :: Text -> Text -> SlackBuilderT () commit packagePath version = do branch' <- SlackBuilderT $ Text.unpack <$> asks branch repository' <- SlackBuilderT $ asks repository let message = Text.unpack $ packagePath <> ": Updated for version " <> version (checkoutExitCode, _, _) <- liftIO $ withFile "/dev/null" WriteMode $ testCheckout repository' branch' unless (checkoutExitCode == ExitSuccess) $ liftIO $ callProcess "git" ["-C", repository', "checkout", "-b", branch', "master"] liftIO $ callProcess "git" ["-C", repository', "add", Text.unpack packagePath] >> callProcess "git" ["-C", repository', "commit", "-S", "-m", message] where testCheckout repository' branch' nullHandle = let createCheckoutProcess = (proc "git" ["-C", repository', "checkout", branch']) { std_in = NoStream , std_err = UseHandle nullHandle } in readCreateProcessWithExitCode createCheckoutProcess "" hostedSources :: Text -> SlackBuilderT URI hostedSources absoluteURL = SlackBuilderT (asks downloadURL) >>= liftIO . mkURI . (<> absoluteURL) remoteFileExists :: Text -> SlackBuilderT Bool remoteFileExists url = hostedSources url >>= traverse (runReq httpConfig . go . fst) . useHttpsURI <&> maybe False ((== 200) . responseStatusCode) where httpConfig = defaultHttpConfig { httpConfigCheckResponse = const $ const $ const Nothing } go uri = req HEAD uri NoReqBody ignoreResponse mempty uploadCommand :: Text -> Text -> SlackBuilderT () uploadCommand localPath remotePath' = do remoteRoot <- SlackBuilderT $ asks remotePath liftIO $ callProcess "scp" $ Text.unpack <$> [ "slackbuilds/" <> localPath , remoteRoot <> remotePath' ] cloneAndArchive :: Text -> Text -> FilePath -> Text -> SlackBuilderT () cloneAndArchive repo nameVersion tarball tagPrefix = do let (_, version) = Text.breakOnEnd "-" nameVersion nameVersion' = Text.unpack nameVersion repository' <- SlackBuilderT $ asks repository liftIO $ callProcess "rm" ["-rf", nameVersion'] liftIO $ callProcess "git" ["clone", Text.unpack repo, nameVersion'] liftIO $ callProcess "git" [ "-C" , nameVersion' , "checkout" , Text.unpack $ tagPrefix <> version ] liftIO $ callProcess "git" [ "-C" , nameVersion' , "submodule" , "update" , "--init" , "--recursive" ] liftIO $ callProcess "tar" [ "Jcvf" , repository' tarball , nameVersion' ] liftIO $ callProcess "rm" ["-rf", nameVersion']