mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-26 10:21:51 +00:00
adds list-unindexed
This commit is contained in:
Keagan McClelland
@@ -4,6 +4,8 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Cli.Cli
|
||||
( cliMain
|
||||
@@ -23,7 +25,9 @@ import Control.Monad.Logger ( LogLevel(..)
|
||||
import Crypto.Hash ( SHA256(SHA256)
|
||||
, hashWith
|
||||
)
|
||||
import Data.Aeson ( eitherDecodeStrict )
|
||||
import Data.Aeson ( FromJSON
|
||||
, eitherDecodeStrict
|
||||
)
|
||||
import Data.ByteArray.Encoding ( Base(..)
|
||||
, convertToBase
|
||||
)
|
||||
@@ -40,7 +44,9 @@ import Data.HashMap.Internal.Strict ( HashMap
|
||||
)
|
||||
import Dhall hiding ( void )
|
||||
import Dhall.Core ( pretty )
|
||||
import Handler.Admin ( IndexPkgReq(IndexPkgReq) )
|
||||
import Handler.Admin ( IndexPkgReq(IndexPkgReq)
|
||||
, PackageList(..)
|
||||
)
|
||||
import Lib.External.AppMgr ( sourceManifest )
|
||||
import Lib.Types.AppIndex ( PackageManifest
|
||||
( PackageManifest
|
||||
@@ -58,6 +64,7 @@ import Network.HTTP.Client.Conduit ( StreamFileStatus(StreamFileSta
|
||||
)
|
||||
import Network.HTTP.Client.TLS ( newTlsManager )
|
||||
import Network.HTTP.Simple ( getResponseBody
|
||||
, httpJSON
|
||||
, httpLBS
|
||||
, setRequestBody
|
||||
, setRequestBodyJSON
|
||||
@@ -105,6 +112,8 @@ import Startlude ( ($)
|
||||
, decodeUtf8
|
||||
, exitWith
|
||||
, filter
|
||||
, flip
|
||||
, fmap
|
||||
, for_
|
||||
, fromIntegral
|
||||
, fromMaybe
|
||||
@@ -135,6 +144,7 @@ import System.ProgressBar ( Progress(..)
|
||||
import Yesod ( logError
|
||||
, logWarn
|
||||
)
|
||||
import Yesod.Core ( FromJSON(parseJSON) )
|
||||
|
||||
data Upload = Upload
|
||||
{ publishRepoName :: String
|
||||
@@ -178,6 +188,7 @@ data Command
|
||||
| CmdRegList
|
||||
| CmdUpload Upload
|
||||
| CmdIndex String String Version Bool
|
||||
| CmdListUnindexed String
|
||||
deriving Show
|
||||
|
||||
cfgLocation :: IO FilePath
|
||||
@@ -251,6 +262,13 @@ parseIndexHelper b =
|
||||
<*> strArgument (metavar "VERSION")
|
||||
<*> pure b
|
||||
|
||||
parseListUnindexed :: Parser String
|
||||
parseListUnindexed = subparser $ command
|
||||
"list-unindexed"
|
||||
( info (strOption (short 't' <> long "target" <> metavar "REGISTRY_NAME"))
|
||||
$ progDesc "Lists unindexed package versions on target registry"
|
||||
)
|
||||
|
||||
parseCommand :: Parser Command
|
||||
parseCommand =
|
||||
(parseInit $> CmdInit)
|
||||
@@ -258,6 +276,7 @@ parseCommand =
|
||||
<|> subparser (command "reg" (info reg $ progDesc "Manage configured registries") <> metavar "reg")
|
||||
<|> parseIndex
|
||||
<|> parseDeindex
|
||||
<|> (CmdListUnindexed <$> parseListUnindexed)
|
||||
where reg = parseRepoAdd <|> (CmdRegDel <$> parseRepoDel) <|> (parseRepoList $> CmdRegList)
|
||||
|
||||
opts :: ParserInfo Command
|
||||
@@ -273,6 +292,7 @@ cliMain =
|
||||
CmdRegList -> regLs
|
||||
CmdUpload up -> upload up
|
||||
CmdIndex name pkg v shouldIndex -> if shouldIndex then index name pkg v else deindex name pkg v
|
||||
CmdListUnindexed name -> listUnindexed name
|
||||
)
|
||||
|
||||
init :: IO ()
|
||||
@@ -388,6 +408,19 @@ deindex name pkg v = do
|
||||
res <- getResponseBody <$> httpLBS withBody
|
||||
if LB.null res then pure () else $logError (decodeUtf8 $ LB.toStrict res) *> exitWith (ExitFailure 1)
|
||||
|
||||
|
||||
listUnindexed :: String -> IO ()
|
||||
listUnindexed name = do
|
||||
PublishCfgRepo {..} <- findNameInCfg name
|
||||
noBody <-
|
||||
parseRequest (show publishCfgRepoLocation <> "/admin/v0/deindex")
|
||||
<&> setRequestHeaders [("accept", "application/json")]
|
||||
<&> applyBasicAuth (B8.pack publishCfgRepoUser) (B8.pack publishCfgRepoPass)
|
||||
PackageList {..} <- getResponseBody <$> httpJSON noBody
|
||||
void $ flip traverseWithKey unPackageList $ \k v -> do
|
||||
putChunk (chunk (unPkgId k <> ": ") & fore blue)
|
||||
putChunkLn $ chunk (show v) & fore yellow
|
||||
|
||||
findNameInCfg :: String -> IO PublishCfgRepo
|
||||
findNameInCfg name = do
|
||||
loc <- cfgLocation
|
||||
|
||||
@@ -19,15 +19,29 @@ import Data.Aeson ( (.:)
|
||||
, object
|
||||
, withObject
|
||||
)
|
||||
import Data.HashMap.Internal.Strict ( HashMap
|
||||
, differenceWith
|
||||
, filter
|
||||
, fromListWith
|
||||
)
|
||||
import Data.List ( (\\)
|
||||
, null
|
||||
)
|
||||
import Data.String.Interpolate.IsString
|
||||
( i )
|
||||
import Database.Persist ( insert_ )
|
||||
import Database.Persist ( entityKey
|
||||
, entityVal
|
||||
, insert_
|
||||
, selectList
|
||||
)
|
||||
import Database.Persist.Postgresql ( runSqlPoolNoTransaction )
|
||||
import Database.Queries ( upsertPackageVersion )
|
||||
import Foundation
|
||||
import Lib.PkgRepository ( PkgRepo(PkgRepo, pkgRepoFileRoot)
|
||||
, extractPkg
|
||||
, getManifestLocation
|
||||
, getPackages
|
||||
, getVersionsFor
|
||||
)
|
||||
import Lib.Types.AppIndex ( PackageManifest(..)
|
||||
, PkgId(unPkgId)
|
||||
@@ -35,13 +49,18 @@ import Lib.Types.AppIndex ( PackageManifest(..)
|
||||
import Lib.Types.Emver ( Version(..) )
|
||||
import Model ( Key(AdminKey, PkgRecordKey, VersionRecordKey)
|
||||
, Upload(..)
|
||||
, VersionRecord(versionRecordNumber, versionRecordPkgId)
|
||||
, unPkgRecordKey
|
||||
)
|
||||
import Network.HTTP.Types ( status404
|
||||
, status500
|
||||
)
|
||||
import Startlude ( ($)
|
||||
, (&&&)
|
||||
, (.)
|
||||
, (<$>)
|
||||
, (<<$>>)
|
||||
, (<>)
|
||||
, Applicative(pure)
|
||||
, Bool(..)
|
||||
, Eq
|
||||
@@ -50,15 +69,22 @@ import Startlude ( ($)
|
||||
, Show
|
||||
, SomeException(..)
|
||||
, asum
|
||||
, fmap
|
||||
, getCurrentTime
|
||||
, guard
|
||||
, guarded
|
||||
, hush
|
||||
, isNothing
|
||||
, liftIO
|
||||
, not
|
||||
, panic
|
||||
, replicate
|
||||
, show
|
||||
, throwIO
|
||||
, toS
|
||||
, traverse
|
||||
, when
|
||||
, zip
|
||||
)
|
||||
import System.FilePath ( (<.>)
|
||||
, (</>)
|
||||
@@ -83,6 +109,7 @@ import Yesod ( ToJSON(..)
|
||||
, runDB
|
||||
)
|
||||
import Yesod.Auth ( YesodAuth(maybeAuthId) )
|
||||
import Yesod.Core.Types ( JSONResponse(JSONResponse) )
|
||||
|
||||
postPkgUploadR :: Handler ()
|
||||
postPkgUploadR = do
|
||||
@@ -141,3 +168,24 @@ postPkgDeindexR :: Handler ()
|
||||
postPkgDeindexR = do
|
||||
IndexPkgReq {..} <- requireCheckJsonBody
|
||||
runDB $ delete (VersionRecordKey (PkgRecordKey indexPkgReqId) indexPkgReqVersion)
|
||||
|
||||
newtype PackageList = PackageList { unPackageList :: HashMap PkgId [Version] }
|
||||
instance FromJSON PackageList where
|
||||
parseJSON = fmap PackageList . parseJSON
|
||||
instance ToJSON PackageList where
|
||||
toJSON = toJSON . unPackageList
|
||||
|
||||
getPkgDeindexR :: Handler (JSONResponse PackageList)
|
||||
getPkgDeindexR = do
|
||||
dbList <-
|
||||
runDB
|
||||
$ (unPkgRecordKey . versionRecordPkgId &&& (: []) . versionRecordNumber)
|
||||
. entityVal
|
||||
<<$>> selectList [] []
|
||||
let inDb = fromListWith (<>) dbList
|
||||
pkgsOnDisk <- getPackages
|
||||
onDisk <- fromListWith (<>) . zip pkgsOnDisk <$> traverse getVersionsFor pkgsOnDisk
|
||||
pure . JSONResponse . PackageList $ filter (not . null) $ differenceWith (guarded null .* (\\)) onDisk inDb
|
||||
|
||||
(.*) :: (b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
|
||||
(.*) = (.) . (.)
|
||||
|
||||
@@ -108,6 +108,7 @@ import Startlude ( ($)
|
||||
, snd
|
||||
, sortBy
|
||||
, throwIO
|
||||
, toS
|
||||
, void
|
||||
)
|
||||
import System.FSNotify ( ActionPredicate
|
||||
@@ -163,6 +164,12 @@ newtype EosRepo = EosRepo
|
||||
{ eosRepoFileRoot :: FilePath
|
||||
}
|
||||
|
||||
getPackages :: (MonadIO m, MonadReader r m, Has PkgRepo r) => m [PkgId]
|
||||
getPackages = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
paths <- listDirectory root
|
||||
pure $ PkgId . toS <$> paths
|
||||
|
||||
getVersionsFor :: (MonadIO m, MonadReader r m, Has PkgRepo r, MonadLogger m) => PkgId -> m [Version]
|
||||
getVersionsFor pkg = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
|
||||
Reference in New Issue
Block a user