Don't show spam packages

src/Data/WebsiteContent.hs

@@ -11,6 +11,7 @@ import Data.GhcLinks
 import Data.Aeson (withObject)
 import Data.Yaml
 import System.FilePath (takeFileName)
+import Types
 
 data WebsiteContent = WebsiteContent
     { wcHomepage :: !Html
@@ -19,6 +20,8 @@ data WebsiteContent = WebsiteContent
     , wcGhcLinks :: !GhcLinks
     , wcStackReleases :: ![StackRelease]
     , wcPosts :: !(Vector Post)
+    , wcSpamPackages :: !(Set PackageName)
+    -- ^ Packages considered spam which should not be displayed.
     }
 
 data Post = Post
@@ -42,6 +45,8 @@ loadWebsiteContent dir = do
     wcPosts <- loadPosts (dir </> "posts") `catchAny` \e -> do
       putStrLn $ "Error loading posts: " ++ tshow e
       return mempty
+    wcSpamPackages <- decodeFileEither (dir </> "spam-packages.yaml")
+                  >>= either throwIO (return . setFromList . map PackageName)
     return WebsiteContent {..}
   where
     readHtml fp = fmap (preEscapedToMarkup . decodeUtf8 :: ByteString -> Html)

src/Handler/Package.hs

@@ -21,6 +21,7 @@ import           Import
 import qualified Text.Blaze.Html.Renderer.Text as LT
 import           Text.Email.Validate
 import           Stackage.Database
+import           Yesod.GitRepo
 
 -- | Page metadata package.
 getPackageR :: PackageName -> Handler Html
@@ -57,10 +58,19 @@ renderStackageBadge style mLabel snapName = \case
     badgeSnapName (SNNightly _) = "nightly"
     badgeSnapName (SNLts x _)   = "lts-" <> tshow x
 
+checkSpam :: PackageName -> Handler Html -> Handler Html
+checkSpam name inner = do
+    wc <- getYesod >>= liftIO . grContent . appWebsiteContent
+    if name `member` wcSpamPackages wc
+      then defaultLayout $ do
+        setTitle $ "Spam package detected: " <> toHtml name
+        $(widgetFile "spam-package")
+      else inner
+
 packagePage :: Maybe (SnapName, Version)
             -> PackageName
             -> Handler Html
-packagePage mversion pname = track "Handler.Package.packagePage" $ do
+packagePage mversion pname = track "Handler.Package.packagePage" $ checkSpam pname $ do
     let pname' = toPathPiece pname
     (deprecated, inFavourOf) <- getDeprecated pname'
     latests <- getLatests pname'