diff --git a/config/routes b/config/routes index fa71767..d71d4f4 100644 --- a/config/routes +++ b/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 diff --git a/src/Application.hs b/src/Application.hs index 9df0c49..620e5be 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -184,6 +184,7 @@ import Handler.Admin ( postPkgDeindexR, postPkgIndexR, postPkgUploadR, + postCheckPkgAuthR ) import Handler.Eos (getEosR, getEosVersionR) import Handler.Root(getRootR, getMarketplaceR) diff --git a/src/Cli/Cli.hs b/src/Cli/Cli.hs index dfdc1bb..698ea22 100644 --- a/src/Cli/Cli.hs +++ b/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 diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index b3b71c9..a71fcfd 100644 --- a/src/Handler/Admin.hs +++ b/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." \ No newline at end of file