{- | The semver grammar and ordering (npm).

Backed by the [@versions@](https://hackage.haskell.org/package/versions) library:
a 'SemverKey' wraps its 'Data.Versions.SemVer', so parsing and precedence are the
library's. A semver version is a numeric @major.minor.patch@ core followed by an
optional @-prerelease@, with @+build@ metadata ignored (semver §10 -- build
metadata does not affect precedence). Ordering follows semver §11: the numeric
core compares field-by-field, a prerelease ranks below the corresponding final
release, and among prerelease identifiers numeric ones rank below alphanumeric
ones (the opposite of the RubyGems\/PEP 440-local rule in
"Ecluse.Core.Version.Token").

A semver version is __stable__ iff it carries no prerelease.
-}
module Ecluse.Core.Version.Semver (
    SemverKey (..),
    parseSemver,
    isSemverStable,
) where

import Data.Char (isDigit)
import Data.Text qualified as T
import Data.Versions (SemVer (..))
import Data.Versions qualified as V

import Ecluse.Core.Version.Token (maxVersionLength)

{- | A parsed semver version, wrapping the @versions@ library's
'Data.Versions.SemVer'. Its 'Ord' is the library's semver §11 precedence
(build metadata excluded), derived through the newtype.
-}
newtype SemverKey = SemverKey SemVer
    deriving stock (Int -> SemverKey -> ShowS
[SemverKey] -> ShowS
SemverKey -> String
(Int -> SemverKey -> ShowS)
-> (SemverKey -> String)
-> ([SemverKey] -> ShowS)
-> Show SemverKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SemverKey -> ShowS
showsPrec :: Int -> SemverKey -> ShowS
$cshow :: SemverKey -> String
show :: SemverKey -> String
$cshowList :: [SemverKey] -> ShowS
showList :: [SemverKey] -> ShowS
Show)
    deriving newtype (SemverKey -> SemverKey -> Bool
(SemverKey -> SemverKey -> Bool)
-> (SemverKey -> SemverKey -> Bool) -> Eq SemverKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SemverKey -> SemverKey -> Bool
== :: SemverKey -> SemverKey -> Bool
$c/= :: SemverKey -> SemverKey -> Bool
/= :: SemverKey -> SemverKey -> Bool
Eq, Eq SemverKey
Eq SemverKey =>
(SemverKey -> SemverKey -> Ordering)
-> (SemverKey -> SemverKey -> Bool)
-> (SemverKey -> SemverKey -> Bool)
-> (SemverKey -> SemverKey -> Bool)
-> (SemverKey -> SemverKey -> Bool)
-> (SemverKey -> SemverKey -> SemverKey)
-> (SemverKey -> SemverKey -> SemverKey)
-> Ord SemverKey
SemverKey -> SemverKey -> Bool
SemverKey -> SemverKey -> Ordering
SemverKey -> SemverKey -> SemverKey
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 :: SemverKey -> SemverKey -> Ordering
compare :: SemverKey -> SemverKey -> Ordering
$c< :: SemverKey -> SemverKey -> Bool
< :: SemverKey -> SemverKey -> Bool
$c<= :: SemverKey -> SemverKey -> Bool
<= :: SemverKey -> SemverKey -> Bool
$c> :: SemverKey -> SemverKey -> Bool
> :: SemverKey -> SemverKey -> Bool
$c>= :: SemverKey -> SemverKey -> Bool
>= :: SemverKey -> SemverKey -> Bool
$cmax :: SemverKey -> SemverKey -> SemverKey
max :: SemverKey -> SemverKey -> SemverKey
$cmin :: SemverKey -> SemverKey -> SemverKey
min :: SemverKey -> SemverKey -> SemverKey
Ord)

{- | Parse a semver version via @versions@' 'Data.Versions.semver' (numeric
@major.minor.patch@ core, optional @-prerelease@, ignoring @+build@ metadata).
A parse failure becomes 'Nothing' -- no key, so an ordering rule abstains rather
than dropping a version over a parser gap.

The raw text is bounded first, as the PEP 440 ("Ecluse.Core.Version.Pep440") and
Gem ("Ecluse.Core.Version.Gem") grammars bound it, so hostile registry metadata
cannot inflict an algorithmic-complexity DoS through an unbounded version string.
Semver carries a second hazard those grammars do not: they read numeric segments
into an unbounded 'Integer', whereas @versions@ stores 'Data.Versions.SemVer''s
numeric components in fixed-width machine words that overflow __silently__
(wrapping, never failing). A numeric run long enough to overflow would key a huge
version as a small one -- corrupting 'Ecluse.Core.Version.compareVersions' and so
@dist-tags.latest@ selection -- so a run too long to fit is refused here as well.
A refused version is served raw without an ordering key, exactly as any other
unparseable one.
-}
parseSemver :: Text -> Maybe SemverKey
parseSemver :: Text -> Maybe SemverKey
parseSemver Text
raw = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Int -> Ordering
T.compareLength Text
raw Int
maxVersionLength Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT)
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Text -> Bool
hasOverlongNumericRun Text
raw))
    SemVer -> SemverKey
SemverKey (SemVer -> SemverKey) -> Maybe SemVer -> Maybe SemverKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ParsingError SemVer -> Maybe SemVer
forall l r. Either l r -> Maybe r
rightToMaybe (Text -> Either ParsingError SemVer
V.semver Text
raw)

{- The largest run of consecutive decimal digits guaranteed to fit the
@versions@ library's fixed-width numeric components: an 18-digit run is at most
@10^18 - 1 < 2^63@, so it fits any 64-bit signed or unsigned word and never
overflows. A run of 19+ digits might, and is refused. Real semver numbers are
tiny -- node-semver itself caps a component at @2^53 - 1@ (16 digits) -- so this
bound only ever rejects adversarial input. -}
maxNumericRun :: Int
maxNumericRun :: Int
maxNumericRun = Int
18

{- Whether @raw@ contains a maximal run of decimal digits long enough that the
@versions@ library's fixed-width numeric components could overflow on it. Total:
'T.groupBy' partitions the text into maximal same-class runs, and a digit run
longer than 'maxNumericRun' fails the bound. -}
hasOverlongNumericRun :: Text -> Bool
hasOverlongNumericRun :: Text -> Bool
hasOverlongNumericRun = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
overlong ([Text] -> Bool) -> (Text -> [Text]) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy Char -> Char -> Bool
sameClass
  where
    sameClass :: Char -> Char -> Bool
sameClass Char
a Char
b = Char -> Bool
isDigit Char
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Bool
isDigit Char
b
    -- A run is homogeneous by 'sameClass', so 'T.all' 'isDigit' identifies a
    -- digit run; an over-long one fails the bound.
    overlong :: Text -> Bool
overlong Text
run = (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
run Bool -> Bool -> Bool
&& Text -> Int -> Ordering
T.compareLength Text
run Int
maxNumericRun Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT

{- | Whether a semver version is stable: a final release with no prerelease
component. So @1.0.0@ is stable; @1.0.0-rc.1@ and @2.0.0-beta@ are not.
-}
isSemverStable :: SemverKey -> Bool
isSemverStable :: SemverKey -> Bool
isSemverStable (SemverKey SemVer
sv) = Maybe Release -> Bool
forall a. Maybe a -> Bool
isNothing (SemVer -> Maybe Release
_svPreRel SemVer
sv)