diff --git a/config/routes b/config/routes index d71d4f4..e9f892e 100644 --- a/config/routes +++ b/config/routes @@ -18,8 +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/upload PkgUploadR POST !admin -- ?id= /admin/v0/eos-upload EosUploadR POST !admin /admin/v0/index PkgIndexR POST !admin /admin/v0/deindex PkgDeindexR GET POST !admin diff --git a/src/Application.hs b/src/Application.hs index 620e5be..9df0c49 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -184,7 +184,6 @@ 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 9e45495..8ab24de 100644 --- a/src/Cli/Cli.hs +++ b/src/Cli/Cli.hs @@ -90,7 +90,7 @@ import Network.HTTP.Simple ( setRequestBody, setRequestBodyJSON, setRequestHeaders, - setRequestResponseTimeout, + setRequestResponseTimeout, setRequestQueryString, ) import Network.HTTP.Types (status200) import Network.URI ( @@ -179,7 +179,7 @@ import Startlude ( ($>), (&), (.), - (<&>), + (<&>), encodeUtf8, ) import System.Directory ( createDirectoryIfMissing, @@ -529,20 +529,10 @@ upload (Upload name mpkg shouldIndex arches) = do 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") + <&> setRequestQueryString [("id", Just $ encodeUtf8 pkgId_)] <&> setRequestHeaders [("accept", "text/plain")] <&> setRequestResponseTimeout (responseTimeoutMicro (5_400_000_000)) -- 90 minutes <&> applyBasicAuth (B8.pack publishCfgRepoUser) (B8.pack publishCfgRepoPass) diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index a3521b7..bca1746 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -58,7 +58,7 @@ import Handler.Util ( getHashFromQuery, getVersionFromQuery, orThrow, - sendResponseText, checkAdminAllowedPkgs, checkAdminAuth, + sendResponseText, checkAdminAuth, checkAdminAuthUpload, getPkgIdParam, ) import Lib.PkgRepository ( PkgRepo (PkgRepo, pkgRepoFileRoot), @@ -79,7 +79,7 @@ import Model ( Unique (UniqueName, UniquePkgCategory), Upload (..), VersionRecord (versionRecordNumber, versionRecordPkgId), - unPkgRecordKey, AdminPkgs (AdminPkgs), + unPkgRecordKey, ) import Network.HTTP.Types ( status400, @@ -116,10 +116,8 @@ import Startlude ( (<$>), (<<$>>), (<>), - (>), - (&&), - (||), - (<=), + (/=), + FilePath ) import System.FilePath ( (<.>), @@ -145,68 +143,50 @@ import Yesod ( runDB, sendResponseStatus, ) -import Yesod.Auth (YesodAuth (maybeAuthId)) 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 resourcesTemp <- getsYesod $ ( "temp") . resourcesDir . appSettings - whitelist <- getsYesod $ whitelist . appSettings createDirectoryIfMissing True resourcesTemp + pkgId_ <- getPkgIdParam withTempDirectory resourcesTemp "newpkg" $ \dir -> do let path = dir "temp" <.> "s9pk" - runConduit $ rawRequestBody .| sinkFile path - pool <- getsYesod appConnPool - PkgRepo{..} <- ask - res <- retry $ extractPkg pool path - when (isNothing res) $ do - $logError "Failed to extract package" - sendResponseText status500 "Failed to extract package" - PackageManifest{..} <- do - liftIO (decodeFileStrict (dir "manifest.json")) - `orThrow` sendResponseText status500 "Failed to parse manifest.json" - if ((length whitelist > 0 && (packageManifestId `elem` whitelist)) || length whitelist <= 0) - then do + case pkgId_ of + Nothing -> do + PackageManifest{..} <- extractPackageManifest dir path + name <- checkAdminAuthUpload packageManifestId + finishUpload dir path name PackageManifest{..} + Just pkgId -> do + name <- checkAdminAuthUpload pkgId + PackageManifest{..} <- extractPackageManifest dir path + if packageManifestId /= pkgId + then sendResponseText status401 [i|Package id #{packageManifestId} does not match request id of #{pkgId}|] + else finishUpload dir path name PackageManifest{..} + where + retry m = runMaybeT . asum $ replicate 3 (MaybeT $ hush <$> try @_ @SomeException m) + extractPackageManifest :: FilePath -> FilePath -> Handler PackageManifest + extractPackageManifest dir path = do + runConduit $ rawRequestBody .| sinkFile path + pool <- getsYesod appConnPool + res <- retry $ extractPkg pool path + when (isNothing res) $ do + $logError "Failed to extract package" + sendResponseText status500 "Failed to extract package" + liftIO (decodeFileStrict (dir "manifest.json")) `orThrow` sendResponseText status500 "Failed to parse manifest.json" + finishUpload :: FilePath -> FilePath -> Text -> PackageManifest -> Handler () + finishUpload dir path admin PackageManifest{..} = do + PkgRepo{..} <- ask renameFile path (dir (toS . unPkgId) packageManifestId <.> "s9pk") let targetPath = pkgRepoFileRoot show packageManifestId show packageManifestVersion removePathForcibly targetPath createDirectoryIfMissing True targetPath renameDirectory dir targetPath - (authorized, name) <- checkAdminAuth packageManifestId - if authorized - then do - now <- liftIO getCurrentTime - 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) - + now <- liftIO getCurrentTime + runDB $ insert_ (Upload (AdminKey admin) (PkgRecordKey packageManifestId)packageManifestVersion now) postEosUploadR :: Handler () postEosUploadR = do diff --git a/src/Handler/Util.hs b/src/Handler/Util.hs index 1caf38c..21a2016 100644 --- a/src/Handler/Util.hs +++ b/src/Handler/Util.hs @@ -32,7 +32,7 @@ import Lib.Types.Emver ( ) import Model ( UserActivity (..), - VersionRecord (versionRecordOsVersion, versionRecordDeprecatedAt, versionRecordPkgId), VersionPlatform (versionPlatformDevice), AdminId, Key (PkgRecordKey, AdminKey), + VersionRecord (versionRecordOsVersion, versionRecordDeprecatedAt, versionRecordPkgId), VersionPlatform (versionPlatformDevice), AdminId, Key (PkgRecordKey, AdminKey), AdminPkgs (AdminPkgs), ) import Network.HTTP.Types ( Status, @@ -63,6 +63,9 @@ import Startlude ( (.), (>), (<$>), + (&&), + (||), + (<=), (>>=), note, (=<<), catMaybes, all, encodeUtf8, toS, fmap, traceM, show, trace, any, or, (++), IO, putStrLn, map ) import UnliftIO (MonadUnliftIO) @@ -89,9 +92,15 @@ import Data.Aeson (eitherDecodeStrict) import Data.Bifunctor (Bifunctor(first)) import qualified Data.MultiMap as MM import Startlude (bimap) -import Data.List (length) +import Data.List (elem, length) import Control.Monad.Logger (logError) import Yesod.Auth (YesodAuth(maybeAuthId)) +import Network.HTTP.Types.Status (status401) +import Yesod (getsYesod) +import Settings (AppSettings(whitelist)) +import Network.HTTP.Types (status200) +import Database.Persist (insert_) +import Yesod (lookupPostParam) orThrow :: MonadHandler m => m (Maybe a) -> m a -> m a orThrow action other = @@ -277,4 +286,33 @@ checkAdminAuth pkgId = do pure (False, "") Just name -> do (authorized, _) <- checkAdminAllowedPkgs pkgId name - pure (authorized, name) \ No newline at end of file + pure (authorized, name) + +checkAdminAuthUpload :: PkgId -> Handler Text +checkAdminAuthUpload 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 pure name + 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) + pure name + else sendResponseText status401 "User not authorized to upload this package." + else sendResponseText status401 "Package does not belong on this registry." + +getPkgIdParam :: MonadHandler m => m (Maybe PkgId) +getPkgIdParam = do + id <- lookupPostParam "id" + case id of + Nothing -> pure Nothing + Just v -> case readMaybe v of + Nothing -> sendResponseStatus status400 ("Invalid PkgId" :: Text) + Just t -> pure (Just t) \ No newline at end of file