diff --git a/src/Cli/Cli.hs b/src/Cli/Cli.hs index b14ceee..a0ee4de 100644 --- a/src/Cli/Cli.hs +++ b/src/Cli/Cli.hs @@ -13,15 +13,8 @@ module Cli.Cli ( ) where import Conduit ( - ConduitT, - MonadIO, - awaitForever, foldC, runConduit, - runConduitRes, - sinkFileCautious, - sourceFile, - yield, (.|), ) import Control.Monad.Logger ( @@ -36,7 +29,6 @@ import Crypto.Hash ( SHA256 (SHA256), hashWith, ) -import Crypto.Hash.Conduit (hashFile, sinkHash) import Data.Aeson ( ToJSON, eitherDecodeStrict, @@ -48,7 +40,6 @@ import Data.ByteArray.Encoding ( import Data.ByteString.Char8 qualified as B8 import Data.ByteString.Lazy qualified as LB import Data.Conduit.Process (readProcess) -import Data.Conduit.Zlib (gzip) import Data.Default import Data.Functor.Contravariant (contramap) import Data.HashMap.Internal.Strict ( @@ -99,7 +90,6 @@ import Network.HTTP.Simple ( setRequestBody, setRequestBodyJSON, setRequestHeaders, - setRequestQueryString, setRequestResponseTimeout, ) import Network.HTTP.Types (status200) @@ -163,7 +153,6 @@ import Startlude ( ReaderT (runReaderT), Semigroup ((<>)), Show, - SomeException, String, appendFile, const, @@ -178,12 +167,10 @@ import Startlude ( fromMaybe, fst, headMay, - liftIO, not, panic, show, snd, - throwIO, unlessM, void, when, @@ -202,7 +189,6 @@ import System.Directory ( getFileSize, getHomeDirectory, listDirectory, - removeFile, ) import System.FilePath ( takeDirectory, @@ -211,15 +197,10 @@ import System.FilePath ( ) import System.ProgressBar ( Progress (..), - ProgressBar, - Style (stylePrefix), defStyle, - incProgress, - msg, newProgressBar, updateProgress, ) -import UnliftIO.Exception (handle) import Yesod ( logError, logWarn, @@ -233,15 +214,6 @@ data Upload = Upload } deriving (Show) - -data EosUpload = EosUpload - { eosRepoName :: !String - , eosPath :: !FilePath - , eosVersion :: !Version - } - deriving (Show) - - newtype PublishCfg = PublishCfg { publishCfgRepos :: HashMap String PublishCfgRepo } @@ -287,7 +259,6 @@ data Command | CmdCatDel !String !String | CmdPkgCatAdd !String !PkgId !String | CmdPkgCatDel !String !PkgId !String - | CmdEosUpload !EosUpload deriving (Show) @@ -401,7 +372,6 @@ parseCommand = <|> (CmdListUnindexed <$> parseListUnindexed) <|> parseCat <|> parsePkgCat - <|> (CmdEosUpload <$> parseEosPublish) where reg = parseRepoAdd <|> (CmdRegDel <$> parseRepoDel) <|> (parseRepoList $> CmdRegList) @@ -448,22 +418,6 @@ parsePkgCat = subparser $ command "categorize" (info cat $ progDesc "Add or remo <*> strArgument (metavar "PACKAGE_ID") <*> strArgument (metavar "CATEGORY") - -parseEosPublish :: Parser EosUpload -parseEosPublish = - subparser $ - command "eos-upload" (info go $ progDesc "Publishes a .img to a remote registry") - <> metavar - "eos-upload" - where - go = - liftA3 - EosUpload - (strOption (short 't' <> long "target" <> metavar "NAME" <> help "Name of registry in publish.dhall")) - (strOption (short 'i' <> long "image" <> metavar "EOS_IMG" <> help "File path of the image to publish")) - (strOption (short 'v' <> long "version" <> help "Version of the image")) - - opts :: ParserInfo Command opts = info (parseCommand <**> helper) (fullDesc <> progDesc "Publish tool for Embassy Packages") @@ -482,8 +436,6 @@ cliMain = CmdCatDel target cat -> catDel target cat CmdPkgCatAdd target pkg cat -> pkgCatAdd target pkg cat CmdPkgCatDel target pkg cat -> pkgCatDel target pkg cat - CmdEosUpload up -> eosUpload up - init :: Maybe Shell -> IO () init sh = do @@ -593,59 +545,6 @@ upload (Upload name mpkg shouldIndex) = do sfs2prog :: StreamFileStatus -> Progress () sfs2prog StreamFileStatus{..} = Progress (fromIntegral readSoFar) (fromIntegral fileSize) () - -eosUpload :: EosUpload -> IO () -eosUpload (EosUpload name img version) = handle @_ @SomeException cleanup $ do - PublishCfgRepo{..} <- findNameInCfg name - noBody <- - parseRequest ("POST " <> show publishCfgRepoLocation <> "/admin/v0/eos-upload") - <&> setRequestHeaders [("accept", "text/plain")] - <&> setRequestResponseTimeout (responseTimeoutMicro (180_000_000)) -- 3 minutes - <&> setRequestHeaders [("Content-Encoding", "gzip")] - <&> applyBasicAuth (B8.pack publishCfgRepoUser) (B8.pack publishCfgRepoPass) - size <- getFileSize img - hashBar <- newProgressBar defStyle{stylePrefix = msg "Hashing"} 30 (Progress 0 (fromIntegral size) ()) - runConduitRes $ sourceFile img .| transByteCounter hashBar .| sinkHash @_ @SHA256 - hash <- hashFile @_ @SHA256 img - let compressedFilePath = "/tmp/eos.img.gz" - zipBar <- newProgressBar defStyle{stylePrefix = msg "Gzipping"} 30 (Progress 0 (fromIntegral size) ()) - runConduitRes $ - sourceFile img - .| transByteCounter zipBar - .| gzip - .| sinkFileCautious compressedFilePath - compressedSize <- getFileSize compressedFilePath - fileBar <- newProgressBar defStyle{stylePrefix = msg "Uploading"} 30 (Progress 0 (fromIntegral compressedSize) ()) - body <- observedStreamFile (updateProgress fileBar . const . sfs2prog) $ compressedFilePath - let withBody = setRequestBody body noBody - let withQParams = - setRequestQueryString - [("version", Just $ show version), ("hash", Just $ convertToBase Base16 hash)] - withBody - manager <- newTlsManager - res <- runReaderT (httpLbs withQParams) manager - removeFile compressedFilePath - if getResponseStatus res == status200 - then -- no output is successful - pure () - else do - $logError (decodeUtf8 . LB.toStrict $ getResponseBody res) - exitWith $ ExitFailure 1 - putChunkLn $ fromString ("Successfully uploaded " <> img) & fore green - where - sfs2prog :: StreamFileStatus -> Progress () - sfs2prog StreamFileStatus{..} = Progress (fromIntegral readSoFar) (fromIntegral fileSize) () - transByteCounter :: MonadIO m => ProgressBar a -> ConduitT B8.ByteString B8.ByteString m () - transByteCounter bar = awaitForever $ \bs -> do - let len = B8.length bs - liftIO $ incProgress bar len - yield bs - cleanup e = do - $logError $ show e - removeFile "/tmp/eos.img.gz" - throwIO e - - index :: String -> String -> Version -> IO () index name pkg v = performHttp name "POST" [i|/admin/v0/index|] (IndexPkgReq (PkgId $ toS pkg) v)