add auth route for package to check in cli prior to upload

config/routes

@@ -18,6 +18,7 @@
 /package/#ApiVersion/version/#PkgId                 PkgVersionR        GET -- get most recent appId version
 
 -- ADMIN API V0
+/admin/v0/auth/#PkgId               					CheckPkgAuthR      POST !admin
 /admin/v0/upload                           					PkgUploadR         POST !admin
 /admin/v0/eos-upload                       					EosUploadR         POST !admin
 /admin/v0/index                            					PkgIndexR          POST !admin

src/Application.hs

@@ -184,6 +184,7 @@ import Handler.Admin (
     postPkgDeindexR,
     postPkgIndexR,
     postPkgUploadR,
+    postCheckPkgAuthR
  )
 import Handler.Eos (getEosR, getEosVersionR)
 import Handler.Root(getRootR, getMarketplaceR)

src/Cli/Cli.hs

@@ -53,7 +53,7 @@ import Data.HashMap.Internal.Strict (
 import Data.String.Interpolate.IsString (
     i,
  )
-import Data.Text (toLower)
+import Data.Text (toLower, splitOn)
 import Dhall (
     Encoder (embed),
     FromDhall (..),
@@ -207,6 +207,8 @@ import Yesod (
 import Prelude (read)
 import Options.Applicative (some)
 import Control.Applicative.HT (lift4)
+import Data.List (last)
+import Data.List (head)
 
 
 data Upload = Upload
@@ -526,6 +528,20 @@ upload (Upload name mpkg shouldIndex arches) = do
                     for_ pkgs $ \f -> $logWarn (fromString f)
                     exitWith $ ExitFailure 1
         Just s -> pure s
+    let pkgId_ = head $ splitOn "." $ last $ splitOn "/" $ show pkg
+    putChunkLn $ fromString ("Checking permissions...") & fore green
+    pkgAuthBody <-
+        parseRequest ("POST " <> show publishCfgRepoLocation <> "/admin/v0/auth/" <> show pkgId_)
+            <&> setRequestHeaders [("accept", "text/plain")]
+            <&> setRequestResponseTimeout (responseTimeoutMicro (90_000_000))
+            <&> applyBasicAuth (B8.pack publishCfgRepoUser) (B8.pack publishCfgRepoPass)
+    manager <- newTlsManager
+    pkgAuthRes <- runReaderT (httpLbs pkgAuthBody) manager
+    if getResponseStatus pkgAuthRes == status200
+        then pure () -- no output is successful
+        else do
+            $logError (decodeUtf8 . LB.toStrict $ getResponseBody pkgAuthRes)
+            exitWith $ ExitFailure 1
     noBody <-
         parseRequest ("POST " <> show publishCfgRepoLocation <> "/admin/v0/upload")
             <&> setRequestHeaders [("accept", "text/plain")]
@@ -535,7 +551,6 @@ upload (Upload name mpkg shouldIndex arches) = do
     bar <- newProgressBar defStyle 30 (Progress 0 (fromIntegral size) ())
     body <- observedStreamFile (updateProgress bar . const . sfs2prog) pkg
     let withBody = setRequestBody body noBody
-    manager <- newTlsManager
     res <- runReaderT (httpLbs withBody) manager
     if getResponseStatus res == status200
         then -- no output is successful

src/Handler/Admin.hs

@@ -151,6 +151,22 @@ import Database.Persist.Sql (runSqlPool)
 import Data.List (elem, length)
 import Database.Persist ((==.))
 import Network.HTTP.Types.Status (status401)
+import Network.HTTP.Types (status200)
+
+postCheckPkgAuthR :: PkgId -> Handler ()
+postCheckPkgAuthR pkgId = do
+    whitelist <- getsYesod $ whitelist . appSettings
+    maybeAuthId >>= \case
+        Nothing -> do
+            sendResponseText status401 "User not an authorized admin."
+        Just name -> do
+            if ((length whitelist > 0 && (pkgId `elem` whitelist)) || length whitelist <= 0)
+                then do
+                    authorized <- checkAdminAllowedPkgs pkgId name
+                    if authorized
+                        then sendResponseText status200 "User authorized to upload this package."
+                        else sendResponseText status401 "User not authorized to upload this package."
+                else sendResponseText status500 "Package does not belong on this registry."
 
 postPkgUploadR :: Handler ()
 postPkgUploadR = do
@@ -179,7 +195,7 @@ postPkgUploadR = do
             maybeAuthId >>= \case
                 Nothing -> do
                     $logError
-                        "The Impossible has happened, an unauthenticated user has managed to upload a pacakge to this registry"
+                        "Impossible: an unauthenticated user has managed to upload a pacakge to this registry."
                     pure ()
                 Just name -> do
                     authorized <- checkAdminAllowedPkgs packageManifestId name
@@ -238,7 +254,7 @@ postPkgIndexR = do
     maybeAuthId >>= \case
         Nothing -> do
             $logError
-                "An unauthenticated user has accessed the index endpoint."
+                "Impossible: an unauthenticated user has accessed the index endpoint."
             pure ()
         Just name -> do
             authorized <- checkAdminAllowedPkgs indexPkgReqId name
@@ -261,7 +277,7 @@ postPkgDeindexR = do
     maybeAuthId >>= \case
         Nothing -> do
             $logError
-                "An unauthenticated user has accessed the deindex endpoint."
+                "Impossible: an unauthenticated user has accessed the deindex endpoint."
             pure ()
         Just name -> do
             authorized <- checkAdminAllowedPkgs indexPkgReqId name
@@ -327,7 +343,7 @@ postPkgCategorizeR cat pkg = do
     maybeAuthId >>= \case
         Nothing -> do
             $logError
-                "An unauthenticated user has accessed the categorize endpoint."
+                "Impossible: an unauthenticated user has accessed the categorize endpoint."
             pure ()
         Just name -> do
             authorized <- checkAdminAllowedPkgs pkg name
@@ -345,6 +361,16 @@ postPkgCategorizeR cat pkg = do
                 else sendResponseText status401 "User not authorized to categorize this package."
 
 deletePkgCategorizeR :: Text -> PkgId -> Handler ()
-deletePkgCategorizeR cat pkg = runDB $ do
-    catEnt <- getBy (UniqueName cat) `orThrow` sendResponseText status404 [i|Category "#{cat}" does not exist|]
-    deleteBy (UniquePkgCategory (PkgRecordKey pkg) (entityKey catEnt))
+deletePkgCategorizeR cat pkg = do
+    maybeAuthId >>= \case
+        Nothing -> do
+            $logError
+                "Impossible: an unauthenticated user has accessed the uncategorize endpoint."
+            pure ()
+        Just name -> do
+            authorized <- checkAdminAllowedPkgs pkg name
+            if authorized
+                then runDB $ do
+                    catEnt <- getBy (UniqueName cat) `orThrow` sendResponseText status404 [i|Category "#{cat}" does not exist|]
+                    deleteBy (UniquePkgCategory (PkgRecordKey pkg) (entityKey catEnt))
+                else sendResponseText status401 "User not authorized to uncategorize this package."