diff --git a/src/Database/Queries.hs b/src/Database/Queries.hs index 91195db..685423b 100644 --- a/src/Database/Queries.hs +++ b/src/Database/Queries.hs @@ -338,16 +338,16 @@ getAllowedPkgs pkgId adminId = do pure p pure $ entityVal <$> pkgs -getPkg:: (Monad m, MonadIO m) => PkgRecordId -> ReaderT SqlBackend m [PkgRecord] -getPkg pkgId = do +getPkgById:: (Monad m, MonadIO m) => PkgRecordId -> ReaderT SqlBackend m [PkgRecord] +getPkgById pkgId = do pkg <- select $ do p <- from $ table @PkgRecord where_ $ p ^. PkgRecordId ==. val pkgId pure p pure $ entityVal <$> pkg -getPkgNew:: (Monad m, MonadIO m) => PkgRecordId -> ReaderT SqlBackend m [PkgRecord] -getPkgNew pkgId = do +getPkgOnlyCreated:: (Monad m, MonadIO m) => PkgRecordId -> ReaderT SqlBackend m [PkgRecord] +getPkgOnlyCreated pkgId = do pkg <- select $ do p <- from $ table @PkgRecord where_ $ p ^. PkgRecordId ==. val pkgId diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 672ee53..215b638 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -147,14 +147,12 @@ import Yesod.Core.Types (JSONResponse (JSONResponse)) import Database.Persist.Sql (runSqlPool) import Database.Persist ((==.)) import Network.HTTP.Types.Status (status401) -import Control.Monad.Logger (logInfo) postPkgUploadR :: Handler () postPkgUploadR = do resourcesTemp <- getsYesod $ ( "temp") . resourcesDir . appSettings createDirectoryIfMissing True resourcesTemp pkgId_ <- getPkgIdParam - $logInfo $ "PARAM: " <> show pkgId_ withTempDirectory resourcesTemp "newpkg" $ \dir -> do let path = dir "temp" <.> "s9pk" case pkgId_ of @@ -163,11 +161,10 @@ postPkgUploadR = do name <- checkAdminAuthUpload packageManifestId finishUpload dir path name PackageManifest{..} Just pkgId -> do - $logInfo $ "VALID: " <> show pkgId name <- checkAdminAuthUpload pkgId PackageManifest{..} <- extractPackageManifest dir path if packageManifestId /= pkgId - then sendResponseText status401 [i|Package id #{packageManifestId} does not match request id of #{pkgId}|] + then sendResponseText status401 [i|Package id #{packageManifestId} does not match requested id #{pkgId}|] else finishUpload dir path name PackageManifest{..} where retry m = runMaybeT . asum $ replicate 3 (MaybeT $ hush <$> try @_ @SomeException m) diff --git a/src/Handler/Util.hs b/src/Handler/Util.hs index 91164a6..80f077b 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, getAllowedPkgs, getPkg, getPkgNew) +import Database.Queries (fetchAllPkgVersions, getVersionPlatform, getAllowedPkgs, getPkgById, getPkgOnlyCreated) import Foundation import Lib.PkgRepository ( PkgRepo, @@ -270,13 +270,13 @@ areRegexMatchesEqual textMap (PackageDevice regexMap) = 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) - pkgCreated <- runDB $ getPkgNew (PkgRecordKey pkgId) + pkg <- runDB $ getPkgById (PkgRecordKey pkgId) + pkgExtracted <- runDB $ getPkgOnlyCreated (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 if length pkgCreated > 0 + else if length pkgExtracted > 0 then pure (True, True) else pure (True, True) @@ -311,10 +311,5 @@ checkAdminAuthUpload pkgId = do 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 - lookupGetParam "id" >>= \case - 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 +getPkgIdParam :: Handler (Maybe PkgId) +getPkgIdParam = parseQueryParam "id" ((flip $ note . mappend "Invalid 'id': ") =<< readMaybe) \ No newline at end of file