{-# LANGUAGE DerivingVia #-}

module Security.Advisories.Core.Advisory
  ( Advisory(..)
    -- * Supporting types
  , Affected(..)
  , CAPEC(..)
  , CWE(..)
  , Architecture(..)
  , AffectedVersionRange(..)
  , OS(..)
  , Keyword(..)
  )
  where

import Data.Text (Text)
import Data.Time (ZonedTime)
import Distribution.Types.Version (Version)
import Distribution.Types.VersionRange (VersionRange)

import Text.Pandoc.Definition (Pandoc)

import Security.Advisories.Core.HsecId
import qualified Security.CVSS as CVSS
import Security.OSV (Reference)

data Advisory = Advisory
  { Advisory -> HsecId
advisoryId :: HsecId
  , Advisory -> ZonedTime
advisoryModified :: ZonedTime
  , Advisory -> ZonedTime
advisoryPublished :: ZonedTime
  , Advisory -> [CAPEC]
advisoryCAPECs :: [CAPEC]
  , Advisory -> [CWE]
advisoryCWEs :: [CWE]
  , Advisory -> [Keyword]
advisoryKeywords :: [Keyword]
  , Advisory -> [Text]
advisoryAliases :: [Text]
  , Advisory -> [Text]
advisoryRelated :: [Text]
  , Advisory -> [Affected]
advisoryAffected :: [Affected]
  , Advisory -> [Reference]
advisoryReferences :: [Reference]
  , Advisory -> Pandoc
advisoryPandoc :: Pandoc  -- ^ Parsed document, without TOML front matter
  , Advisory -> Text
advisoryHtml :: Text
  , Advisory -> Text
advisorySummary :: Text
    -- ^ A one-line, English textual summary of the vulnerability
  , Advisory -> Text
advisoryDetails :: Text
    -- ^ Details of the vulnerability (CommonMark), without TOML front matter
  }
  deriving stock (Int -> Advisory -> ShowS
[Advisory] -> ShowS
Advisory -> String
(Int -> Advisory -> ShowS)
-> (Advisory -> String) -> ([Advisory] -> ShowS) -> Show Advisory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Advisory -> ShowS
showsPrec :: Int -> Advisory -> ShowS
$cshow :: Advisory -> String
show :: Advisory -> String
$cshowList :: [Advisory] -> ShowS
showList :: [Advisory] -> ShowS
Show)

-- | An affected package (or package component).  An 'Advisory' must
-- mention one or more packages.
data Affected = Affected
  { Affected -> Text
affectedPackage :: Text
  , Affected -> CVSS
affectedCVSS :: CVSS.CVSS
  , Affected -> [AffectedVersionRange]
affectedVersions :: [AffectedVersionRange]
  , Affected -> Maybe [Architecture]
affectedArchitectures :: Maybe [Architecture]
  , Affected -> Maybe [OS]
affectedOS :: Maybe [OS]
  , Affected -> [(Text, VersionRange)]
affectedDeclarations :: [(Text, VersionRange)]
  }
  deriving stock (Int -> Affected -> ShowS
[Affected] -> ShowS
Affected -> String
(Int -> Affected -> ShowS)
-> (Affected -> String) -> ([Affected] -> ShowS) -> Show Affected
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Affected -> ShowS
showsPrec :: Int -> Affected -> ShowS
$cshow :: Affected -> String
show :: Affected -> String
$cshowList :: [Affected] -> ShowS
showList :: [Affected] -> ShowS
Show)

newtype CAPEC = CAPEC {CAPEC -> Integer
unCAPEC :: Integer}
  deriving stock (Int -> CAPEC -> ShowS
[CAPEC] -> ShowS
CAPEC -> String
(Int -> CAPEC -> ShowS)
-> (CAPEC -> String) -> ([CAPEC] -> ShowS) -> Show CAPEC
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CAPEC -> ShowS
showsPrec :: Int -> CAPEC -> ShowS
$cshow :: CAPEC -> String
show :: CAPEC -> String
$cshowList :: [CAPEC] -> ShowS
showList :: [CAPEC] -> ShowS
Show)

newtype CWE = CWE {CWE -> Integer
unCWE :: Integer}
  deriving stock (Int -> CWE -> ShowS
[CWE] -> ShowS
CWE -> String
(Int -> CWE -> ShowS)
-> (CWE -> String) -> ([CWE] -> ShowS) -> Show CWE
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CWE -> ShowS
showsPrec :: Int -> CWE -> ShowS
$cshow :: CWE -> String
show :: CWE -> String
$cshowList :: [CWE] -> ShowS
showList :: [CWE] -> ShowS
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 (Int -> Architecture -> ShowS
[Architecture] -> ShowS
Architecture -> String
(Int -> Architecture -> ShowS)
-> (Architecture -> String)
-> ([Architecture] -> ShowS)
-> Show Architecture
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Architecture -> ShowS
showsPrec :: Int -> Architecture -> ShowS
$cshow :: Architecture -> String
show :: Architecture -> String
$cshowList :: [Architecture] -> ShowS
showList :: [Architecture] -> ShowS
Show)

data OS
  = Windows
  | MacOS
  | Linux
  | FreeBSD
  | Android
  | NetBSD
  | OpenBSD
  deriving stock (Int -> OS -> ShowS
[OS] -> ShowS
OS -> String
(Int -> OS -> ShowS)
-> (OS -> String) -> ([OS] -> ShowS) -> Show OS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OS -> ShowS
showsPrec :: Int -> OS -> ShowS
$cshow :: OS -> String
show :: OS -> String
$cshowList :: [OS] -> ShowS
showList :: [OS] -> ShowS
Show)

newtype Keyword = Keyword Text
  deriving stock (Keyword -> Keyword -> Bool
(Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Bool) -> Eq Keyword
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Keyword -> Keyword -> Bool
== :: Keyword -> Keyword -> Bool
$c/= :: Keyword -> Keyword -> Bool
/= :: Keyword -> Keyword -> Bool
Eq, Eq Keyword
Eq Keyword =>
(Keyword -> Keyword -> Ordering)
-> (Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Keyword)
-> (Keyword -> Keyword -> Keyword)
-> Ord Keyword
Keyword -> Keyword -> Bool
Keyword -> Keyword -> Ordering
Keyword -> Keyword -> Keyword
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Keyword -> Keyword -> Ordering
compare :: Keyword -> Keyword -> Ordering
$c< :: Keyword -> Keyword -> Bool
< :: Keyword -> Keyword -> Bool
$c<= :: Keyword -> Keyword -> Bool
<= :: Keyword -> Keyword -> Bool
$c> :: Keyword -> Keyword -> Bool
> :: Keyword -> Keyword -> Bool
$c>= :: Keyword -> Keyword -> Bool
>= :: Keyword -> Keyword -> Bool
$cmax :: Keyword -> Keyword -> Keyword
max :: Keyword -> Keyword -> Keyword
$cmin :: Keyword -> Keyword -> Keyword
min :: Keyword -> Keyword -> Keyword
Ord)
  deriving (Int -> Keyword -> ShowS
[Keyword] -> ShowS
Keyword -> String
(Int -> Keyword -> ShowS)
-> (Keyword -> String) -> ([Keyword] -> ShowS) -> Show Keyword
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Keyword -> ShowS
showsPrec :: Int -> Keyword -> ShowS
$cshow :: Keyword -> String
show :: Keyword -> String
$cshowList :: [Keyword] -> ShowS
showList :: [Keyword] -> ShowS
Show) via Text

data AffectedVersionRange = AffectedVersionRange
  { AffectedVersionRange -> Version
affectedVersionRangeIntroduced :: Version,
    AffectedVersionRange -> Maybe Version
affectedVersionRangeFixed :: Maybe Version
  }
  deriving stock (Int -> AffectedVersionRange -> ShowS
[AffectedVersionRange] -> ShowS
AffectedVersionRange -> String
(Int -> AffectedVersionRange -> ShowS)
-> (AffectedVersionRange -> String)
-> ([AffectedVersionRange] -> ShowS)
-> Show AffectedVersionRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AffectedVersionRange -> ShowS
showsPrec :: Int -> AffectedVersionRange -> ShowS
$cshow :: AffectedVersionRange -> String
show :: AffectedVersionRange -> String
$cshowList :: [AffectedVersionRange] -> ShowS
showList :: [AffectedVersionRange] -> ShowS
Show)