diff --git a/code/hsec-tools/assets/css/default.css b/code/hsec-tools/assets/css/default.css new file mode 100644 index 00000000..17973558 --- /dev/null +++ b/code/hsec-tools/assets/css/default.css @@ -0,0 +1,152 @@ +:root{ + --bg-color:#FFFFFF; + --text-color:#333; + --outline-color:#DB83ED; + --header-color:#5E5184; + --anchor-color:#9E358F; + --anchor-visited-color:#6F5F9C; + --code-bg-color:#FAFAFA; + --filename-bg:#EAEAEA; + --code-color:#383a42; + --code-bg-color:#fafafa; + --code-comment-color:#a0a1a7; + --code-kw-color:#af005f; + --code-name-color:#e45649; + --code-literal-color:#268bd2; + --code-string-color:#cb4b16; + --code-attr-color:#986801; + --code-constructor-color:#5f5faf; + --code-symbol-color:#4078f2; + --code-record-field-color:#c18401; + --code-pragma-color:#2aa198 +} +@media (prefers-color-scheme:dark){ + :root{ + --bg-color:#333; + --text-color:#C9D1D9; + --header-color:#BBA1FF; + --anchor-color:#EB82DC; + --anchor-visited-color:#D5C5FF; + --code-bg-color:transparent; + --filename-bg:#2C2C2C; + --code-color:#C9D1D9; + --code-bg-color:#333; + --code-comment-color:#a0a1a7; + --code-kw-color:#BBA1FF; + --code-name-color:#e45649; + --code-literal-color:#268bd2; + --code-string-color:#cb4b16; + --code-attr-color:#986801; + --code-constructor-color:#d079c9; + --code-symbol-color:var(--code-color); + --code-record-field-color:#c18401; + --code-pragma-color:#2aa198 + } +} +*:focus-visible{ + outline-color:var(--outline-color) +} +body{ + color:var(--text-color); + background-color:var(--bg-color) +} +a{ + color:var(--anchor-color) +} +a:visited{ + color:var(--anchor-visited-color) +} +h1,h2,h3,h4,h5,h6{ + color:var(--header-color) +} +input{ + background-color:rgba(255,255,255,0.06); + color:var(--text-color) +} +.nav-bar{ + text-align: right; +} +.nav-bar ul{ + display: inline-block; + list-style: none; + margin: 0; + padding: 0; +} +.nav-bar li{ + display: inline-block; + vertical-align: middle; + padding: 0; + margin: 0; + height: 100%; + position: relative; +} + *:focus-visible{ + outline-offset:4px; + outline-width:1px +} +body{ + font-size:1.6rem; + margin:0 auto; + max-width:120rem +} +footer{ + margin-top:3rem; + padding:1.2rem 0; + border-top:0.2rem solid #000; + font-size:1.2rem; + color:#555 +} +h1{ + font-size:2.4rem +} +h2{ + font-size:2rem +} +html{ + font-size:62.5%; + font-family:Helvetica,sans-serif +} +table tbody td{ + padding:5px +} +footer{ + padding: 0 2%; + text-align: center; +} +footer .HF{ + height:50px; + line-height:50px; + display:inline-block; + background-repeat:no-repeat; + background-image:url('../images/hf-logo.png'); + background-size:50px; + background-position:left center; + padding-left:60px +} +@media (max-width:319px){ + .nav-bar{ + margin:0 1.5rem 0 0; + } + .nav-bar a{ + display:block; + line-height:1.6 + } +} +@media (min-width:320px){ + .nav-bar{ + margin:0 2rem 0 0; + } + .nav-bar a{ + display:inline; + margin:0 0.6rem + } +} +@media (min-width:640px){ + .nav-bar{ + margin:0 3rem 0 0; + } + .nav-bar a{ + margin:0 0 0 1.2rem; + display:inline + } +} diff --git a/code/hsec-tools/assets/images/hf-logo.png b/code/hsec-tools/assets/images/hf-logo.png new file mode 100644 index 00000000..5a79f4c1 Binary files /dev/null and b/code/hsec-tools/assets/images/hf-logo.png differ diff --git a/code/hsec-tools/hsec-tools.cabal b/code/hsec-tools/hsec-tools.cabal index fede7e80..3ea5ee8d 100644 --- a/code/hsec-tools/hsec-tools.cabal +++ b/code/hsec-tools/hsec-tools.cabal @@ -23,6 +23,7 @@ maintainer: security-advisories@haskell.org category: Data extra-doc-files: CHANGELOG.md extra-source-files: + assets/* test/golden/*.golden test/golden/*.md @@ -35,6 +36,7 @@ library Security.Advisories.Convert.OSV Security.Advisories.Filesystem Security.Advisories.Generate.HTML + Security.Advisories.Generate.TH Security.Advisories.Git Security.Advisories.Parse Security.Advisories.Queries @@ -42,6 +44,7 @@ library build-depends: , aeson >=2.0.1.0 && <3 , base >=4.14 && <4.20 + , bytestring >=0.10 && <0.13 , Cabal-syntax >=3.8.1.0 && <3.11 , commonmark ^>=0.2.2 , commonmark-pandoc >=0.2 && <0.3 @@ -52,6 +55,7 @@ library , filepath >=1.4 && <1.5 , hsec-core >= 0.1 && < 0.2 , feed ==1.3.* + , file-embed >=0.0.13.0 && <0.0.17 , lucid >=2.9.0 && < 3 , mtl >=2.2 && <2.4 , osv >= 0.1 && < 0.2 @@ -61,6 +65,7 @@ library , process >=1.6 && <1.7 , safe >=0.3 && < 0.4 , text >=1.2 && <3 + , template-haskell >=2.16.0.0 && <2.23 , time >=1.9 && <1.14 , toml-parser ^>=2.0.0.0 , validation-selective >=0.1 && <1 diff --git a/code/hsec-tools/src/Security/Advisories/Generate/HTML.hs b/code/hsec-tools/src/Security/Advisories/Generate/HTML.hs index 9a564414..7eb30c8a 100644 --- a/code/hsec-tools/src/Security/Advisories/Generate/HTML.hs +++ b/code/hsec-tools/src/Security/Advisories/Generate/HTML.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module Security.Advisories.Generate.HTML ( renderAdvisoriesIndex, @@ -8,6 +9,7 @@ module Security.Advisories.Generate.HTML where import Control.Monad (forM_) +import qualified Data.ByteString.Char8 as BS8 import Data.List (sortOn) import Data.List.Extra (groupSort) import qualified Data.Map.Strict as Map @@ -20,7 +22,7 @@ import Data.Time (ZonedTime, zonedTimeToUTC) import Data.Time.Format.ISO8601 import System.Directory (createDirectoryIfMissing) import System.Exit (exitFailure) -import System.FilePath (()) +import System.FilePath ((), takeDirectory) import System.IO (hPrint, stderr) import Distribution.Pretty (prettyShow) @@ -32,6 +34,7 @@ import Validation (Validation (..)) import qualified Security.Advisories as Advisories import Security.Advisories.Filesystem (listAdvisories) +import Security.Advisories.Generate.TH (readDirFilesTH) -- * Actions @@ -61,12 +64,18 @@ renderAdvisoriesIndex src dst = do forM_ advisories $ \advisory -> renderHTMLToFile (advisoriesDir advisoryHtmlFilename (Advisories.advisoryId advisory)) $ inPage PageAdvisory $ - div_ [class_ "pure-u-1"] $ - toHtmlRaw (Advisories.advisoryHtml advisory) + toHtmlRaw (Advisories.advisoryHtml advisory) putStrLn $ "Rendering " <> (dst "atom.xml") writeFile (dst "atom.xml") $ T.unpack $ renderFeed advisories + putStrLn "Copying assets" + let assetsDir = dst "assets" + forM_ $(readDirFilesTH "assets") $ \(path, content) -> do + createDirectoryIfMissing True $ assetsDir takeDirectory path + putStrLn $ "Copying " <> (assetsDir path) + BS8.writeFile (assetsDir path) content + -- * Rendering types data AdvisoryR = AdvisoryR @@ -89,61 +98,56 @@ data AffectedPackageR = AffectedPackageR listByDates :: [AdvisoryR] -> Html () listByDates advisories = inPage PageListByDates $ - div_ [class_ "pure-u-1"] $ do + div_ [class_ "advisories"] $ do + table_ [class_ "pure-table pure-table-horizontal"] $ do + thead_ $ do + tr_ $ do + th_ "#" + th_ "Package(s)" + th_ "Summary" + + tbody_ $ do + let sortedAdvisories = + zip + (sortOn (Down . advisoryId) advisories) + (cycle [[], [class_ "pure-table-odd"]]) + forM_ sortedAdvisories $ \(advisory, trClasses) -> + tr_ trClasses $ do + td_ [class_ "advisory-id"] $ a_ [href_ $ advisoryLink (advisoryId advisory)] $ toHtml (Advisories.printHsecId (advisoryId advisory)) + td_ [class_ "advisory-packages"] $ toHtml $ T.intercalate "," $ packageName <$> advisoryAffected advisory + td_ [class_ "advisory-summary"] $ toHtml $ advisorySummary advisory + +listByPackages :: [AdvisoryR] -> Html () +listByPackages advisories = + inPage PageListByPackages $ do + let byPackage :: Map.Map Text [(AdvisoryR, AffectedPackageR)] + byPackage = + Map.fromList $ + groupSort + [ (packageName package, (advisory, package)) + | advisory <- advisories, + package <- advisoryAffected advisory + ] + + forM_ (Map.toList byPackage) $ \(currentPackageName, perPackageAdvisory) -> do + h2_ $ toHtml currentPackageName div_ [class_ "advisories"] $ do - table_ [class_ "pure-table pure-table-horizontal"] $ do + table_ [] $ do thead_ $ do tr_ $ do th_ "#" - th_ "Package(s)" + th_ "Introduced" + th_ "Fixed" th_ "Summary" tbody_ $ do let sortedAdvisories = - zip - (sortOn (Down . advisoryId) advisories) - (cycle [[], [class_ "pure-table-odd"]]) - forM_ sortedAdvisories $ \(advisory, trClasses) -> - tr_ trClasses $ do - td_ [class_ "advisory-id"] $ a_ [href_ $ advisoryLink (advisoryId advisory)] $ toHtml (Advisories.printHsecId (advisoryId advisory)) - td_ [class_ "advisory-packages"] $ toHtml $ T.intercalate "," $ packageName <$> advisoryAffected advisory - td_ [class_ "advisory-summary"] $ toHtml $ advisorySummary advisory - -listByPackages :: [AdvisoryR] -> Html () -listByPackages advisories = - inPage PageListByPackages $ - div_ [class_ "pure-u-1"] $ do - let byPackage :: Map.Map Text [(AdvisoryR, AffectedPackageR)] - byPackage = - Map.fromList $ - groupSort - [ (packageName package, (advisory, package)) - | advisory <- advisories, - package <- advisoryAffected advisory - ] - - forM_ (Map.toList byPackage) $ \(currentPackageName, perPackageAdvisory) -> do - h2_ $ toHtml currentPackageName - div_ [class_ "advisories"] $ do - table_ [class_ "pure-table pure-table-horizontal"] $ do - thead_ $ do - tr_ $ do - th_ "#" - th_ "Introduced" - th_ "Fixed" - th_ "Summary" - - tbody_ $ do - let sortedAdvisories = - zip - (sortOn (Down . advisoryId . fst) perPackageAdvisory) - (cycle [[], [class_ "pure-table-odd"]]) - forM_ sortedAdvisories $ \((advisory, package), trClasses) -> - tr_ trClasses $ do - td_ [class_ "advisory-id"] $ a_ [href_ $ advisoryLink $ advisoryId advisory] $ toHtml (Advisories.printHsecId $ advisoryId advisory) - td_ [class_ "advisory-introduced"] $ toHtml $ introduced package - td_ [class_ "advisory-fixed"] $ maybe (return ()) toHtml $ fixed package - td_ [class_ "advisory-summary"] $ toHtml $ advisorySummary advisory + sortOn (Down . advisoryId . fst) perPackageAdvisory + forM_ sortedAdvisories $ \(advisory, package) -> do + td_ [class_ "advisory-id"] $ a_ [href_ $ advisoryLink $ advisoryId advisory] $ toHtml (Advisories.printHsecId $ advisoryId advisory) + td_ [class_ "advisory-introduced"] $ toHtml $ introduced package + td_ [class_ "advisory-fixed"] $ maybe (return ()) toHtml $ fixed package + td_ [class_ "advisory-summary"] $ toHtml $ advisorySummary advisory -- * Utils @@ -162,45 +166,33 @@ baseUrlForPage = \case inPage :: NavigationPage -> Html () -> Html () inPage page content = doctypehtml_ $ - html_ $ do + html_ [lang_ "en"] $ do head_ $ do meta_ [charset_ "UTF-8"] base_ [href_ $ baseUrlForPage page] link_ [rel_ "alternate", type_ "application/atom+xml", href_ atomFeedUrl] - link_ [rel_ "stylesheet", href_ "https://cdn.jsdelivr.net/npm/purecss@3.0.0/build/pure-min.css", integrity_ "sha384-X38yfunGUhNzHpBaEBsWLO+A0HDYOQi8ufWDkZ0k9e0eXz/tH3II7uKZ9msv++Ls", crossorigin_ "anonymous"] + link_ [rel_ "stylesheet", href_ "assets/css/default.css"] meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1"] - title_ "Haskell Security.Advisories.Core" - style_ $ - T.intercalate - "\n" - [ ".advisories, .content {", - " margin: 1em;", - "}", - "a {", - " text-decoration: none;", - "}", - "a:visited {", - " text-decoration: none;", - " color: darkblue;", - "}", - "pre {", - " background: lightgrey;", - "}" - ] + meta_ [name_ "description", content_ "Haskell Security advisories"] + title_ "Haskell Security advisories" body_ $ do - div_ [class_ "pure-u-1"] $ do - div_ [class_ "pure-menu pure-menu-horizontal"] $ do - let selectedOn p cls = - if page == p - then cls <> " pure-menu-selected" - else cls - span_ [class_ "pure-menu-heading pure-menu-link"] "Advisories list" - ul_ [class_ "pure-menu-list"] $ do - li_ [class_ $ selectedOn PageListByDates "pure-menu-item"] $ - a_ [href_ "by-dates.html", class_ "pure-menu-link"] "by date" - li_ [class_ $ selectedOn PageListByPackages "pure-menu-item"] $ - a_ [href_ "by-packages.html", class_ "pure-menu-link"] "by package" + div_ [class_ "nav-bar"] $ do + let selectedOn p = + if page == p + then "selected" + else "" + ul_ [class_ "items"] $ do + li_ [class_ $ selectedOn PageListByDates] $ + a_ [href_ "by-dates.html"] "by date" + li_ [class_ $ selectedOn PageListByPackages] $ + a_ [href_ "by-packages.html"] "by package" + h1_ [] "Advisories list" div_ [class_ "content"] content + footer_ [] $ do + div_ [class_ "HF"] $ do + "This site is a project of " + a_ [href_ "https://haskell.foundation", target_ "_blank", rel_ "noopener noreferrer"] "The Haskell Foundation" + "." advisoryHtmlFilename :: Advisories.HsecId -> FilePath advisoryHtmlFilename advisoryId' = Advisories.printHsecId advisoryId' <> ".html" diff --git a/code/hsec-tools/src/Security/Advisories/Generate/TH.hs b/code/hsec-tools/src/Security/Advisories/Generate/TH.hs new file mode 100644 index 00000000..700a3a36 --- /dev/null +++ b/code/hsec-tools/src/Security/Advisories/Generate/TH.hs @@ -0,0 +1,22 @@ +module Security.Advisories.Generate.TH ( + readFileTH, + readDirFilesTH, + fileLocation, + ) where + +import Control.Monad.IO.Class (liftIO) +import Data.ByteString.Char8 as BS8 +import Data.FileEmbed (embedDir, makeRelativeToLocationPredicate) +import Language.Haskell.TH (Exp (LitE), Lit (StringL), Q) + +-- | Read file at compile-time. +readFileTH :: FilePath -> Q Exp +readFileTH p = fileLocation p $ \p' -> LitE . StringL . BS8.unpack <$> liftIO (BS8.readFile p') + +-- | Read files in (sub-)directory at compile-time. +-- Gives a [(FilePath, ByteString)] +readDirFilesTH :: FilePath -> Q Exp +readDirFilesTH p = fileLocation p embedDir + +fileLocation :: FilePath -> (FilePath -> Q Exp) -> Q Exp +fileLocation fp act = makeRelativeToLocationPredicate (== "hsec-tools.cabal") fp >>= act