From 1fe7da23c940149e694709bbcf108084c6395039 Mon Sep 17 00:00:00 2001 From: Keagan McClelland Date: Tue, 24 May 2022 15:49:20 -0600 Subject: [PATCH] implements multi registry management --- cli/Main.hs | 7 +- hie.yaml | 14 ++-- package.yaml | 4 + src/Cli/Cli.hs | 216 +++++++++++++++++++++++++++++++++++++++++++++++++ stack.yaml | 1 + 5 files changed, 231 insertions(+), 11 deletions(-) create mode 100644 src/Cli/Cli.hs diff --git a/cli/Main.hs b/cli/Main.hs index 8fae644..7ea664a 100644 --- a/cli/Main.hs +++ b/cli/Main.hs @@ -1,7 +1,4 @@ module Main where -import Startlude ( IO - , pure - ) +import Cli.Cli (cliMain) -main :: IO () -main = pure () +main = cliMain diff --git a/hie.yaml b/hie.yaml index 3e092b8..0704f37 100644 --- a/hie.yaml +++ b/hie.yaml @@ -1,8 +1,10 @@ cradle: stack: - - path: "./" - component: "start9-registry:lib" - - path: "./app" - component: "start9-registry:exe:start9-registry" - - path: "./test" - component: "start9-registry:test:start9-registry-test" \ No newline at end of file + - path: "./" + component: "start9-registry:lib" + - path: "./app" + component: "start9-registry:exe:start9-registry" + - path: "./test" + component: "start9-registry:test:start9-registry-test" + - path: "./cli" + component: "start9-registry:exe:embassy-publish" diff --git a/package.yaml b/package.yaml index 77496a6..8967fc6 100644 --- a/package.yaml +++ b/package.yaml @@ -27,6 +27,7 @@ dependencies: - cryptonite - cryptonite-conduit - data-default + - dhall - directory - errors - esqueleto @@ -44,6 +45,8 @@ dependencies: - monad-logger - monad-logger-extras - monad-loops + - network-uri + - optparse-applicative - parallel - persistent - persistent-migration @@ -51,6 +54,7 @@ dependencies: - persistent-template - process - protolude + - rainbow - shakespeare - template-haskell - text diff --git a/src/Cli/Cli.hs b/src/Cli/Cli.hs new file mode 100644 index 0000000..39087da --- /dev/null +++ b/src/Cli/Cli.hs @@ -0,0 +1,216 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE RecordWildCards #-} + +module Cli.Cli + ( cliMain + ) where + +import Data.Default +import Data.Functor.Contravariant ( contramap ) +import Data.HashMap.Internal.Strict ( HashMap + , delete + , empty + , insert + , traverseWithKey + ) +import Data.String ( IsString(fromString) ) +import Dhall hiding ( void ) +import Dhall.Core ( pretty ) +import Network.URI ( URI + , parseURI + ) +import Options.Applicative hiding ( auto + , empty + ) +import Rainbow ( fore + , magenta + , putChunk + , putChunkLn + , yellow + ) +import Startlude ( ($) + , ($>) + , (&) + , (.) + , (<$>) + , (<&>) + , (>>=) + , Bool(..) + , FilePath + , IO + , IsString + , Maybe + , Monad(return) + , Semigroup((<>)) + , Show + , String + , fromMaybe + , panic + , print + , pure + , show + , unlessM + , void + , writeFile + ) +import System.Directory ( createDirectory + , createDirectoryIfMissing + , doesPathExist + , getHomeDirectory + ) +import System.FilePath ( () + , takeBaseName + , takeDirectory + ) + +data Upload = Upload + { publishRepoName :: String + , publishPkg :: Maybe FilePath + , publishIndex :: Bool + } + deriving Show + +data PublishCfg = PublishCfg + { publishCfgRepos :: HashMap String PublishCfgRepo + } + deriving Generic +instance FromDhall PublishCfg +instance ToDhall PublishCfg +instance Default PublishCfg where + def = PublishCfg empty + + +data PublishCfgRepo = PublishCfgRepo + { publishCfgRepoLocation :: URI + , publishCfgRepoUser :: String + , publishCfgRepoPass :: String + } + deriving (Show, Generic) +instance FromDhall PublishCfgRepo +instance ToDhall PublishCfgRepo + +instance FromDhall URI where + autoWith norm = fromMaybe (panic "Invalid URI for publish target") . parseURI <$> autoWith norm + +instance ToDhall URI where + injectWith norm = contramap (show @_ @String) (injectWith norm) + +instance IsString URI where + fromString = fromMaybe (panic "Invalid URI for publish target") . parseURI + +data RegAdd = RegAdd + deriving Show +data RegDel = RegDel + deriving Show + +data Command + = CmdInit + | CmdRegAdd String PublishCfgRepo + | CmdRegDel String + | CmdRegList + | CmdUpload Upload + deriving Show + +cfgLocation :: IO FilePath +cfgLocation = getHomeDirectory <&> \d -> d ".embassy/publish.dhall" + +parseInit :: Parser () +parseInit = subparser $ command "init" (info (pure ()) $ progDesc "Initializes embassy-publish config") + +parsePublish :: Parser Upload +parsePublish = subparser $ command "upload" (info go $ progDesc "Publishes a .s9pk to a remote registry") + where + go = liftA3 + Upload + (strOption (short 't' <> long "target" <> metavar "NAME" <> help "Name of registry in publish.dhall")) + (optional $ strOption + (short 'p' <> long "package" <> metavar "S9PK" <> help "File path of the package to publish") + ) + (switch (short 'i' <> long "index" <> help "Index the package after uploading")) + +parseRepoAdd :: Parser Command +parseRepoAdd = subparser $ command "add" (info go $ progDesc "Add a registry to your config") <> metavar "add" + where + go :: Parser Command + go = + let + publishCfgRepoLocation = + strOption (short 'l' <> long "location" <> metavar "REGISTRY_URL" <> help "Registry URL") + publishCfgRepoUser = strOption + (short 'u' <> long "username" <> metavar "USERNAME" <> help "Admin username for this registry") + publishCfgRepoPass = strOption + (short 'p' <> long "password" <> metavar "PASSWORD" <> help "Admin password for this registry") + name = + strOption + (short 'n' <> long "name" <> metavar "REGISTRY_NAME" <> help + "Name to reference this registry in the future" + ) + r = PublishCfgRepo <$> publishCfgRepoLocation <*> publishCfgRepoUser <*> publishCfgRepoPass + in + liftA2 CmdRegAdd name r + +parseRepoDel :: Parser String +parseRepoDel = subparser $ command "rm" (info go $ progDesc "Remove a registry from your config") <> metavar "rm" + where + go = strOption + (short 'n' <> long "name" <> metavar "REGISTRY_NAME" <> help + "Registry name chosen when this was originally configured" + ) + +parseRepoList :: Parser () +parseRepoList = subparser $ command "ls" (info (pure ()) $ progDesc "List registries in your config") <> metavar "ls" + +parseCommand :: Parser Command +parseCommand = (parseInit $> CmdInit) <|> (CmdUpload <$> parsePublish) <|> subparser + (command "reg" (info reg $ progDesc "Manage configured registries")) + where reg = parseRepoAdd <|> (CmdRegDel <$> parseRepoDel) <|> (parseRepoList $> CmdRegList) + +opts :: ParserInfo Command +opts = info (parseCommand <**> helper) (fullDesc <> progDesc "Publish tool for Embassy Packages") + +cliMain :: IO () +cliMain = + execParser opts + >>= (\case + CmdInit -> init + CmdRegAdd s pcr -> regAdd s pcr + CmdRegDel s -> regRm s + CmdRegList -> regLs + CmdUpload up -> regUpload up + ) + +init :: IO () +init = do + loc <- cfgLocation + createDirectoryIfMissing True (takeDirectory loc) + unlessM (doesPathExist loc) $ writeFile loc (pretty $ embed inject (def @PublishCfg)) + +regAdd :: String -> PublishCfgRepo -> IO () +regAdd name val = do + loc <- cfgLocation + PublishCfg cfg <- inputFile auto loc + let cfg' = insert name val cfg + writeFile loc (pretty $ embed inject $ PublishCfg cfg') + +regRm :: String -> IO () +regRm name = do + loc <- cfgLocation + PublishCfg cfg <- inputFile auto loc + let cfg' = delete name cfg + writeFile loc (pretty $ embed inject $ PublishCfg cfg') + +regLs :: IO () +regLs = do + loc <- cfgLocation + PublishCfg cfg <- inputFile auto loc + void $ traverseWithKey f cfg + where + f k v = do + putChunk $ fromString (k <> ": ") & fore yellow + putChunkLn $ fromString (show $ publishCfgRepoLocation v) & fore magenta + +regUpload :: Upload -> IO () +regUpload = panic "unimplemented" diff --git a/stack.yaml b/stack.yaml index 731ea1b..4481b7a 100644 --- a/stack.yaml +++ b/stack.yaml @@ -44,6 +44,7 @@ extra-deps: - esqueleto-3.5.1.0 - monad-logger-extras-0.1.1.1 - persistent-migration-0.3.0 + - rainbow-0.34.2.2 - wai-request-spec-0.10.2.4 - warp-3.3.19 - yesod-auth-basic-0.1.0.3