diff --git a/src/Data/WebsiteContent.hs b/src/Data/WebsiteContent.hs index 9012429..7e2b98f 100644 --- a/src/Data/WebsiteContent.hs +++ b/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) diff --git a/src/Handler/Package.hs b/src/Handler/Package.hs index 84a0bdc..674530f 100644 --- a/src/Handler/Package.hs +++ b/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'