hsec-core-0.5.0.0: src/Security/Advisories/Core/Advisory.hs

{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

module Security.Advisories.Core.Advisory
  ( Advisory (..),

    -- * Supporting types
    Affected (..),
    CAPEC (..),
    CWE (..),
    Architecture (..),
    AffectedVersionRange (..),
    OS (..),
    Keyword (..),
    AffectedApi (..),
    ComponentIdentifier (..),
    GHCComponent (..),
    RepositoryURL (..),
    RepositoryName (..),
    PackageName,
    mkPackageName,
    unPackageName,
    ghcComponentToText,
    ghcComponentFromText,
    hackage,

    -- * Queries
    isVersionAffectedBy,
    isVersionRangeAffectedBy,
  )
where

import Data.Text (Text)
import Data.Time (UTCTime)
import Distribution.Types.PackageName (PackageName, mkPackageName, unPackageName)
import Distribution.Types.Version (Version)
import Distribution.Types.VersionInterval (asVersionIntervals)
import Distribution.Types.VersionRange (VersionRange, anyVersion, earlierVersion, intersectVersionRanges, noVersion, orLaterVersion, unionVersionRanges, withinRange)
import Network.URI (URI)
import Network.URI.Static (uri)
import Security.Advisories.Core.HsecId (HsecId)
import Security.Advisories.Core.OsvId (OsvId)
import qualified Security.CVSS as CVSS
import Security.OSV (Reference)
import Text.Pandoc.Definition (Pandoc)

data Advisory = Advisory
  { advisoryId :: HsecId,
    advisoryModified :: UTCTime,
    advisoryPublished :: UTCTime,
    advisoryCAPECs :: [CAPEC],
    advisoryCWEs :: [CWE],
    advisoryKeywords :: [Keyword],
    advisoryAliases :: [OsvId],
    advisoryRelated :: [OsvId],
    advisoryAffected :: [Affected],
    advisoryReferences :: [Reference],
    -- | Parsed document, without TOML front matter
    advisoryPandoc :: Pandoc,
    advisoryHtml :: Text,
    -- | A one-line, English textual summary of the vulnerability
    advisorySummary :: Text,
    -- | Details of the vulnerability (CommonMark), without TOML front matter
    advisoryDetails :: Text
  }
  deriving stock (Show)

data ComponentIdentifier
  = Repository RepositoryURL RepositoryName PackageName
  | GHC GHCComponent
  deriving stock (Show, Eq)

hackage :: PackageName -> ComponentIdentifier
hackage =
  Repository
    (RepositoryURL [uri|https://hackage.haskell.org|])
    (RepositoryName "hackage")

newtype RepositoryURL
  = RepositoryURL {unRepositoryURL :: URI}
  deriving stock (Eq, Ord, Show)

newtype RepositoryName
  = RepositoryName {unRepositoryName :: Text}
  deriving stock (Eq, Ord, Show)

-- Keep this list in sync with the 'ghcComponentFromText' below
data GHCComponent = GHCCompiler | GHCi | GHCRTS | GHCPkg | RunGHC | IServ | HP2PS | HPC | HSC2HS | Haddock
  deriving stock (Show, Eq, Ord, Enum, Bounded)

ghcComponentToText :: GHCComponent -> Text
ghcComponentToText c = case c of
  GHCCompiler -> "ghc"
  GHCi -> "ghci"
  GHCRTS -> "rts"
  GHCPkg -> "ghc-pkg"
  RunGHC -> "runghc"
  IServ -> "ghc-iserv"
  HP2PS -> "hp2ps"
  HPC -> "hpc"
  HSC2HS -> "hsc2hs"
  Haddock -> "haddock"

ghcComponentFromText :: Text -> Maybe GHCComponent
ghcComponentFromText c = case c of
  "ghc" -> Just GHCCompiler
  "ghci" -> Just GHCi
  "rts" -> Just GHCRTS
  "ghc-pkg" -> Just GHCPkg
  "runghc" -> Just RunGHC
  "ghc-iserv" -> Just IServ
  "hp2ps" -> Just HP2PS
  "hpc" -> Just HPC
  "hsc2hs" -> Just HSC2HS
  "haddock" -> Just Haddock
  _ -> Nothing

-- | An affected package (or package component).  An 'Advisory' must
-- mention one or more packages.
data Affected = Affected
  { affectedComponentIdentifier :: ComponentIdentifier,
    affectedCVSS :: CVSS.CVSS,
    affectedVersions :: [AffectedVersionRange],
    affectedArchitectures :: Maybe [Architecture],
    affectedOS :: Maybe [OS],
    affectedDeclarations :: [(Text, VersionRange)],
    affectedApi :: [AffectedApi]
  }
  deriving stock (Eq, Show)

newtype CAPEC = CAPEC {unCAPEC :: Integer}
  deriving stock (Eq, Show)

newtype CWE = CWE {unCWE :: Integer}
  deriving stock (Eq, Show)

data Architecture
  = AArch64
  | Alpha
  | Arm
  | HPPA
  | HPPA1_1
  | I386
  | IA64
  | M68K
  | MIPS
  | MIPSEB
  | MIPSEL
  | NIOS2
  | PowerPC
  | PowerPC64
  | PowerPC64LE
  | RISCV32
  | RISCV64
  | RS6000
  | S390
  | S390X
  | SH4
  | SPARC
  | SPARC64
  | VAX
  | X86_64
  deriving stock (Eq, Show, Enum, Bounded)

data OS
  = Windows
  | MacOS
  | Linux
  | FreeBSD
  | Android
  | NetBSD
  | OpenBSD
  deriving stock (Eq, Show, Enum, Bounded)

newtype Keyword = Keyword {unKeyword :: Text}
  deriving stock (Eq, Ord)
  deriving (Show) via Text

data AffectedApi = AffectedApi
  { affectedApiModule :: Text,
    affectedApiName :: Text
  }
  deriving stock (Eq, Show)

data AffectedVersionRange = AffectedVersionRange
  { affectedVersionRangeIntroduced :: Version,
    affectedVersionRangeFixed :: Maybe Version
  }
  deriving stock (Eq, Show)

-- * Queries

-- | Check whether a component and a version is concerned by an advisory
--
-- Since @0.2.1.0@
isVersionAffectedBy :: ComponentIdentifier -> Version -> Advisory -> Bool
isVersionAffectedBy = isAffectedByHelper withinRange

-- | Check whether a component and a version range is concerned by an advisory
--
-- Since @0.2.1.0@
isVersionRangeAffectedBy :: ComponentIdentifier -> VersionRange -> Advisory -> Bool
isVersionRangeAffectedBy = isAffectedByHelper $
  \queryVersionRange affectedVersionRange ->
    isSomeVersion (affectedVersionRange `intersectVersionRanges` queryVersionRange)
  where
    isSomeVersion :: VersionRange -> Bool
    isSomeVersion range
      | [] <- asVersionIntervals range = False
      | otherwise = True

-- | Helper function for 'isVersionAffectedBy' and 'isVersionRangeAffectedBy'
isAffectedByHelper :: (a -> VersionRange -> Bool) -> ComponentIdentifier -> a -> Advisory -> Bool
isAffectedByHelper checkWithRange queryComponent queryVersionish =
  any checkAffected . advisoryAffected
  where
    checkAffected :: Affected -> Bool
    checkAffected affected =
      affectedComponentIdentifier affected == queryComponent && checkWithRange queryVersionish (fromAffected affected)

    fromAffected :: Affected -> VersionRange
    fromAffected = foldr (unionVersionRanges . fromAffectedVersionRange) noVersion . affectedVersions

    fromAffectedVersionRange :: AffectedVersionRange -> VersionRange
    fromAffectedVersionRange avr =
      intersectVersionRanges
        (orLaterVersion (affectedVersionRangeIntroduced avr))
        (maybe anyVersion earlierVersion (affectedVersionRangeFixed avr))