From d599a90e8b2780e30120fc9a458286784f1e40b7 Mon Sep 17 00:00:00 2001
From: Lucy Cifferello <12953208+elvece@users.noreply.github.com>
Date: Tue, 11 Apr 2023 20:22:14 -0600
Subject: [PATCH] add config setting to allow protections around package
 uploads to specific registries

---
 config/settings.yml             |  1 +
 src/Handler/Admin.hs            | 33 +++++++++++++++++++--------------
 src/Handler/Package/V1/Index.hs |  2 +-
 src/Settings.hs                 |  9 ++++++---
 4 files changed, 27 insertions(+), 18 deletions(-)

diff --git a/config/settings.yml b/config/settings.yml
index b90f685..647478f 100644
--- a/config/settings.yml
+++ b/config/settings.yml
@@ -39,6 +39,7 @@ marketplace-name: "_env:MARKETPLACE_NAME:CHANGE ME"
 max-eos-version: "_env:MAX_VERSION:0.3.4.0"
 min-eos-version: "_env:MIN_VERSION:0.3.4.0"
 run-migration: "_env:RUN_MIGRATION:false"
+blacklist: "_env:BLACKLIST:ADD ME"
 
 database:
   database: "_env:PG_DATABASE:start9_registry"
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 0eb4256..81ccf55 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -144,11 +144,13 @@ import Yesod (
 import Yesod.Auth (YesodAuth (maybeAuthId))
 import Yesod.Core.Types (JSONResponse (JSONResponse))
 import Database.Persist.Sql (runSqlPool)
+import Data.List (elem)
 
 
 postPkgUploadR :: Handler ()
 postPkgUploadR = do
     resourcesTemp <- getsYesod $ (</> "temp") . resourcesDir . appSettings
+    blacklist <- getsYesod $ blacklist . appSettings
     createDirectoryIfMissing True resourcesTemp
     withTempDirectory resourcesTemp "newpkg" $ \dir -> do
         let path = dir </> "temp" <.> "s9pk"
@@ -159,22 +161,25 @@ postPkgUploadR = do
         when (isNothing res) $ do
             $logError "Failed to extract package"
             sendResponseText status500 "Failed to extract package"
-        PackageManifest{..} <-
+        PackageManifest{..} <- do
             liftIO (decodeFileStrict (dir </> "manifest.json"))
                 `orThrow` sendResponseText status500 "Failed to parse manifest.json"
-        renameFile path (dir </> (toS . unPkgId) packageManifestId <.> "s9pk")
-        let targetPath = pkgRepoFileRoot </> show packageManifestId </> show packageManifestVersion
-        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
-                now <- liftIO getCurrentTime
-                runDB $ insert_ (Upload (AdminKey name) (PkgRecordKey packageManifestId) packageManifestVersion now)
+        if (elem packageManifestId blacklist)
+         then sendResponseText status500 "Package does not belong on this registry."
+         else do
+            renameFile path (dir </> (toS . unPkgId) packageManifestId <.> "s9pk")
+            let targetPath = pkgRepoFileRoot </> show packageManifestId </> show packageManifestVersion
+            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
+                    now <- liftIO getCurrentTime
+                    runDB $ insert_ (Upload (AdminKey name) (PkgRecordKey packageManifestId) packageManifestVersion now)
     where
         retry m = runMaybeT . asum $ replicate 3 (MaybeT $ hush <$> try @_ @SomeException m)
 
diff --git a/src/Handler/Package/V1/Index.hs b/src/Handler/Package/V1/Index.hs
index 8d2a92a..3dda683 100644
--- a/src/Handler/Package/V1/Index.hs
+++ b/src/Handler/Package/V1/Index.hs
@@ -23,7 +23,7 @@ import Database.Queries (
     getDependencyVersions,
     getPkgDataSource,
     getPkgDependencyData,
-    serviceQuerySource, fetchLatestApp,
+    serviceQuerySource,
  )
 import Foundation (Handler, Route (InstructionsR, LicenseR), RegistryCtx (appSettings))
 import Handler.Package.Api (DependencyRes (..), PackageListRes (..), PackageRes (..))
diff --git a/src/Settings.hs b/src/Settings.hs
index decf434..6a9881c 100644
--- a/src/Settings.hs
+++ b/src/Settings.hs
@@ -56,6 +56,7 @@ import           Lib.PkgRepository              ( EosRepo(EosRepo, eosRepoFileRo
                                                 )
 import           Lib.Types.Emver                ( Version )
 import           Orphans.Emver                  ( )
+import Lib.Types.Core (PkgId)
 -- | Runtime settings to configure this application. These settings can be
 -- loaded from various sources: defaults, environment variables, config files,
 -- theoretically even a database.
@@ -75,12 +76,12 @@ data AppSettings = AppSettings
     -- ^ Should all log messages be displayed?
     , errorLogRoot              :: !FilePath
     , marketplaceName           :: !Text
-    , maxOsVersion             :: !Version
-    , minOsVersion             :: !Version
+    , maxOsVersion              :: !Version
+    , minOsVersion              :: !Version
     , registryHostname          :: !Text
     , registryVersion           :: !Version
     , resourcesDir              :: !FilePath
-    , needsMigration              :: !Bool
+    , needsMigration            :: !Bool
     , sslAuto                   :: !Bool
     , sslCertLocation           :: !FilePath
     , sslCsrLocation            :: !FilePath
@@ -88,6 +89,7 @@ data AppSettings = AppSettings
     , sslPath                   :: !FilePath
     , staticBinDir              :: !FilePath
     , torPort                   :: !AppPort
+    , blacklist                 :: ![PkgId]
     }
 instance Has PkgRepo AppSettings where
     extract = liftA2 PkgRepo ((</> "apps") . resourcesDir) staticBinDir
@@ -120,6 +122,7 @@ instance FromJSON AppSettings where
         sslPath                   <- o .: "ssl-path"
         staticBinDir              <- o .: "static-bin-dir"
         torPort                   <- o .: "tor-port"
+        blacklist                 <- o .: "blacklist"
 
         let sslKeyLocation  = sslPath </> "key.pem"
         let sslCsrLocation  = sslPath </> "certificate.csr"