From 8834dd1d2839bbb76f32782ed8eb5b9511a35145 Mon Sep 17 00:00:00 2001 From: Lucy <12953208+elvece@users.noreply.github.com> Date: Tue, 16 Apr 2024 15:26:46 -0400 Subject: [PATCH] Feature/admin allowed pkgs (#139) * update admin endpoints to check if authorized to upload pkg * add auth route for package to check in cli prior to upload * fix param parsing * remove uneeded log * add case for when package is new * move insert auth admin to pkg check * send 200 response on successful insert * invert logic * retype AdminPkgs since PkgRecord id as key will not yet exist * cleanup --- config/routes | 1 + src/Application.hs | 1 + src/Cli/Cli.hs | 18 ++++++- src/Database/Queries.hs | 21 +++++++- src/Handler/Admin.hs | 106 +++++++++++++++++++++++++++------------- src/Handler/Util.hs | 31 ++++++++++-- src/Model.hs | 5 ++ 7 files changed, 141 insertions(+), 42 deletions(-) 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..9e45495 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, unpack) 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,19 @@ 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 + pkgAuthBody <- + parseRequest ("POST " <> show publishCfgRepoLocation <> "/admin/v0/auth/" <> unpack 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 +550,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/Database/Queries.hs b/src/Database/Queries.hs index 7d47c13..aaf5200 100644 --- a/src/Database/Queries.hs +++ b/src/Database/Queries.hs @@ -19,7 +19,7 @@ import Model ( Metric (Metric), PkgDependency (..), PkgRecord (PkgRecord), - VersionRecord (VersionRecord), VersionPlatform (VersionPlatform), EntityField (VersionPlatformPkgId, VersionPlatformVersionNumber, VersionPlatformArch), PkgRecordId, + VersionRecord (VersionRecord), VersionPlatform (VersionPlatform), EntityField (VersionPlatformPkgId, VersionPlatformVersionNumber, VersionPlatformArch, AdminPkgsPkgId, AdminPkgsAdmin), PkgRecordId, AdminPkgs, AdminId, ) import Orphans.Emver () import Startlude ( @@ -327,4 +327,21 @@ getVersionPlatform pkgId arches = do where_ $ v ^. VersionPlatformPkgId ==. val pkgId where_ (v ^. VersionPlatformArch `in_` (valList arches)) pure v - pure $ entityVal <$> vps \ No newline at end of file + pure $ entityVal <$> vps + +getAllowedPkgs :: (Monad m, MonadIO m) => PkgId -> AdminId -> ReaderT SqlBackend m [AdminPkgs] +getAllowedPkgs pkgId adminId = do + pkgs <- select $ do + p <- from $ table @AdminPkgs + where_ $ p ^. AdminPkgsPkgId ==. val pkgId + where_ $ p ^. AdminPkgsAdmin ==. val adminId + pure p + pure $ entityVal <$> pkgs + +getPkg:: (Monad m, MonadIO m) => PkgRecordId -> ReaderT SqlBackend m [PkgRecord] +getPkg pkgId = do + pkg <- select $ do + p <- from $ table @PkgRecord + where_ $ p ^. PkgRecordId ==. val pkgId + pure p + pure $ entityVal <$> pkg \ No newline at end of file diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 8c2003a..a3521b7 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -58,7 +58,7 @@ import Handler.Util ( getHashFromQuery, getVersionFromQuery, orThrow, - sendResponseText, + sendResponseText, checkAdminAllowedPkgs, checkAdminAuth, ) import Lib.PkgRepository ( PkgRepo (PkgRepo, pkgRepoFileRoot), @@ -79,7 +79,7 @@ import Model ( Unique (UniqueName, UniquePkgCategory), Upload (..), VersionRecord (versionRecordNumber, versionRecordPkgId), - unPkgRecordKey, + unPkgRecordKey, AdminPkgs (AdminPkgs), ) import Network.HTTP.Types ( status400, @@ -150,6 +150,28 @@ import Yesod.Core.Types (JSONResponse (JSONResponse)) 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, newPkg) <- checkAdminAllowedPkgs pkgId name + if authorized && not newPkg + then sendResponseText status200 "User authorized to upload this package." + else if authorized && newPkg + -- if pkg is whitelisted and a new upload, add as authorized for this admin user + then do + runDB $ insert_ (AdminPkgs (AdminKey name) pkgId) + 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 @@ -175,14 +197,12 @@ postPkgUploadR = do removePathForcibly targetPath createDirectoryIfMissing True targetPath renameDirectory dir targetPath - maybeAuthId >>= \case - Nothing -> do - $logError - "The Impossible has happened, an unauthenticated user has managed to upload a pacakge to this registry" - pure () - Just name -> do + (authorized, name) <- checkAdminAuth packageManifestId + if authorized + then do now <- liftIO getCurrentTime - runDB $ insert_ (Upload (AdminKey name) (PkgRecordKey packageManifestId) packageManifestVersion now) + runDB $ insert_ (Upload (AdminKey name) (PkgRecordKey packageManifestId)packageManifestVersion now) + else sendResponseText status401 "User not authorized to upload this package." else sendResponseText status500 "Package does not belong on this registry." where retry m = runMaybeT . asum $ replicate 3 (MaybeT $ hush <$> try @_ @SomeException m) @@ -230,24 +250,32 @@ instance ToJSON IndexPkgReq where postPkgIndexR :: Handler () postPkgIndexR = do IndexPkgReq{..} <- requireCheckJsonBody - manifest <- getManifestLocation indexPkgReqId indexPkgReqVersion - man <- - liftIO (decodeFileStrict manifest) - `orThrow` sendResponseText - status404 - [i|Could not decode manifest for #{indexPkgReqId}@#{indexPkgReqVersion}|] - pool <- getsYesod appConnPool - runSqlPoolNoTransaction (upsertPackageVersion man) pool Nothing - runSqlPool (upsertPackageVersionPlatform indexPkgReqArches man) pool + (admin, _) <- checkAdminAuth indexPkgReqId + if admin + then do + manifest <- getManifestLocation indexPkgReqId indexPkgReqVersion + man <- + liftIO (decodeFileStrict manifest) + `orThrow` sendResponseText + status404 + [i|Could not decode manifest for #{indexPkgReqId}@#{indexPkgReqVersion}|] + pool <- getsYesod appConnPool + runSqlPoolNoTransaction (upsertPackageVersion man) pool Nothing + runSqlPool (upsertPackageVersionPlatform indexPkgReqArches man) pool + else sendResponseText status401 "User not authorized to index this package." postPkgDeindexR :: Handler () postPkgDeindexR = do IndexPkgReq{..} <- requireCheckJsonBody - case indexPkgReqArches of - Nothing -> runDB $ delete (VersionRecordKey (PkgRecordKey indexPkgReqId) indexPkgReqVersion) - Just a -> do - _ <- traverse (deleteArch indexPkgReqId indexPkgReqVersion) a - pure () + (admin, _) <- checkAdminAuth indexPkgReqId + if admin + then do + case indexPkgReqArches of + Nothing -> runDB $ delete (VersionRecordKey (PkgRecordKey indexPkgReqId) indexPkgReqVersion) + Just a -> do + _ <- traverse (deleteArch indexPkgReqId indexPkgReqVersion) a + pure () + else sendResponseText status401 "User not authorized to deindex this package." where deleteArch :: PkgId -> Version -> OsArch -> Handler () deleteArch id v a = runDB $ deleteWhere [VersionPlatformArch ==. a, VersionPlatformVersionNumber ==. v, VersionPlatformPkgId ==. PkgRecordKey id] @@ -298,18 +326,26 @@ deleteCategoryR cat = runDB $ deleteBy (UniqueName cat) postPkgCategorizeR :: Text -> PkgId -> Handler () -postPkgCategorizeR cat pkg = runDB $ do - catEnt <- getBy (UniqueName cat) `orThrow` sendResponseText status404 [i|Category "#{cat}" does not exist|] - _pkgEnt <- get (PkgRecordKey pkg) `orThrow` sendResponseText status404 [i|Package "#{pkg}" does not exist|] - now <- liftIO getCurrentTime - void $ - insertUnique (PkgCategory now (PkgRecordKey pkg) (entityKey catEnt)) - `orThrow` sendResponseText - status403 - [i|Package "#{pkg}" is already assigned to category "#{cat}"|] +postPkgCategorizeR cat pkg = do + (admin, _) <- checkAdminAuth pkg + if admin + then runDB $ do + catEnt <- getBy (UniqueName cat) `orThrow` sendResponseText status404 [i|Category "#{cat}" does not exist|] + _pkgEnt <- get (PkgRecordKey pkg) `orThrow` sendResponseText status404 [i|Package "#{pkg}" does not exist|] + now <- liftIO getCurrentTime + void $ + insertUnique (PkgCategory now (PkgRecordKey pkg) (entityKey catEnt)) + `orThrow` sendResponseText + status403 + [i|Package "#{pkg}" is already assigned to category "#{cat}"|] + 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 + (admin, _) <- checkAdminAuth pkg + if admin + 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 diff --git a/src/Handler/Util.hs b/src/Handler/Util.hs index 36687b3..1caf38c 100644 --- a/src/Handler/Util.hs +++ b/src/Handler/Util.hs @@ -18,7 +18,7 @@ import Data.String.Interpolate.IsString ( import Data.Text qualified as T import Data.Text.Lazy qualified as TL import Data.Text.Lazy.Builder qualified as TB -import Database.Queries (fetchAllPkgVersions, getVersionPlatform) +import Database.Queries (fetchAllPkgVersions, getVersionPlatform, getAllowedPkgs, getPkg) import Foundation import Lib.PkgRepository ( PkgRepo, @@ -32,7 +32,7 @@ import Lib.Types.Emver ( ) import Model ( UserActivity (..), - VersionRecord (versionRecordOsVersion, versionRecordDeprecatedAt, versionRecordPkgId), VersionPlatform (versionPlatformDevice), + VersionRecord (versionRecordOsVersion, versionRecordDeprecatedAt, versionRecordPkgId), VersionPlatform (versionPlatformDevice), AdminId, Key (PkgRecordKey, AdminKey), ) import Network.HTTP.Types ( Status, @@ -61,6 +61,7 @@ import Startlude ( void, ($), (.), + (>), (<$>), (>>=), note, (=<<), catMaybes, all, encodeUtf8, toS, fmap, traceM, show, trace, any, or, (++), IO, putStrLn, map ) @@ -88,6 +89,9 @@ import Data.Aeson (eitherDecodeStrict) import Data.Bifunctor (Bifunctor(first)) import qualified Data.MultiMap as MM import Startlude (bimap) +import Data.List (length) +import Control.Monad.Logger (logError) +import Yesod.Auth (YesodAuth(maybeAuthId)) orThrow :: MonadHandler m => m (Maybe a) -> m a -> m a orThrow action other = @@ -252,4 +256,25 @@ areRegexMatchesEqual textMap (PackageDevice regexMap) = checkMatch :: (Text, RegexPattern) -> Bool checkMatch (key, regexPattern) = case MM.lookup key textMap of - val -> or $ regexMatch regexPattern <$> val \ No newline at end of file + val -> or $ regexMatch regexPattern <$> val + +checkAdminAllowedPkgs :: PkgId -> Text -> Handler (Bool, Bool) -- (authorized, newPkg) +checkAdminAllowedPkgs pkgId adminId = do + -- if pkg does not exist yet, allow, because authorized by whitelist + pkg <- runDB $ getPkg (PkgRecordKey pkgId) + if length pkg > 0 + then do + res <- runDB $ getAllowedPkgs pkgId (AdminKey adminId) + pure $ if length res > 0 then (True, False) else (False, False) + else pure (True, True) + +checkAdminAuth :: PkgId -> Handler (Bool, Text) +checkAdminAuth pkgId = do + maybeAuthId >>= \case + Nothing -> do + $logError + "Impossible: an unauthenticated user has accessed an authenticated endpoint." + pure (False, "") + Just name -> do + (authorized, _) <- checkAdminAllowedPkgs pkgId name + pure (authorized, name) \ No newline at end of file diff --git a/src/Model.hs b/src/Model.hs index a7b1566..5813bdc 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -153,6 +153,11 @@ Admin passHash (Digest SHA256) deletedAt UTCTime Maybe +AdminPkgs + admin AdminId + pkgId PkgId + UniqueAdminPkg pkgId admin + Upload uploader AdminId pkgId PkgRecordId