module SlackBuilder.Download ( cloneAndArchive , commit , download , hostedSources , remoteFileExists , updateSlackBuildVersion ) where import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString 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(..) , GET(..) , reqBr ) import Data.Functor ((<&>)) import Network.HTTP.Client (BodyReader, Response(..), brRead) import Conduit ( ConduitT , yield , runConduitRes , sinkFile , (.|) , ZipSink(..) , await ) import Crypto.Hash (Digest, MD5, hashInit, hashFinalize, hashUpdate) import Data.Void (Void) 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'] responseBodySource :: MonadIO m => Response BodyReader -> ConduitT i ByteString m () responseBodySource = bodyReaderSource . responseBody where bodyReaderSource br = liftIO (brRead br) >>= go br go br bs = unless (ByteString.null bs) $ yield bs >> bodyReaderSource br sinkHash :: Monad m => ConduitT ByteString Void m (Digest MD5) sinkHash = sink hashInit where sink ctx = await >>= maybe (pure $ hashFinalize ctx) (sink . hashUpdate ctx) download :: Text -> FilePath -> SlackBuilderT (Maybe (Digest MD5)) download uri target = SlackBuilderT (liftIO $ mkURI uri) >>= traverse (runReq defaultHttpConfig . go . fst) . useHttpsURI where go uri' = reqBr GET uri' NoReqBody mempty readResponse readResponse :: Response BodyReader -> IO (Digest MD5) readResponse response = runConduitRes $ responseBodySource response .| getZipSink (ZipSink (sinkFile target) *> ZipSink sinkHash)