{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.
module Wire.API.Federation.Version
  ( -- * Version, VersionInfo
    Version (..),
    V0Sym0,
    V1Sym0,
    V2Sym0,
    intToVersion,
    versionInt,
    versionText,
    supportedVersions,
    VersionInfo (..),
    versionInfo,

    -- * VersionRange
    VersionUpperBound (..),
    VersionRange (..),
    allVersions,
    latestCommonVersion,
    rangeFromVersion,
    rangeUntilVersion,
  )
where

import Control.Lens ((?~))
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.OpenApi qualified as S
import Data.Schema
import Data.Set qualified as Set
import Data.Singletons.Base.TH
import Data.Text qualified as Text
import Imports

data Version = V0 | V1 | V2
  deriving stock (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
/= :: Version -> Version -> Bool
Eq, Eq Version
Eq Version =>
(Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
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 :: Version -> Version -> Ordering
compare :: Version -> Version -> Ordering
$c< :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
>= :: Version -> Version -> Bool
$cmax :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
min :: Version -> Version -> Version
Ord, Version
Version -> Version -> Bounded Version
forall a. a -> a -> Bounded a
$cminBound :: Version
minBound :: Version
$cmaxBound :: Version
maxBound :: Version
Bounded, Int -> Version
Version -> Int
Version -> [Version]
Version -> Version
Version -> Version -> [Version]
Version -> Version -> Version -> [Version]
(Version -> Version)
-> (Version -> Version)
-> (Int -> Version)
-> (Version -> Int)
-> (Version -> [Version])
-> (Version -> Version -> [Version])
-> (Version -> Version -> [Version])
-> (Version -> Version -> Version -> [Version])
-> Enum Version
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Version -> Version
succ :: Version -> Version
$cpred :: Version -> Version
pred :: Version -> Version
$ctoEnum :: Int -> Version
toEnum :: Int -> Version
$cfromEnum :: Version -> Int
fromEnum :: Version -> Int
$cenumFrom :: Version -> [Version]
enumFrom :: Version -> [Version]
$cenumFromThen :: Version -> Version -> [Version]
enumFromThen :: Version -> Version -> [Version]
$cenumFromTo :: Version -> Version -> [Version]
enumFromTo :: Version -> Version -> [Version]
$cenumFromThenTo :: Version -> Version -> Version -> [Version]
enumFromThenTo :: Version -> Version -> Version -> [Version]
Enum, Int -> Version -> ShowS
[Version] -> ShowS
Version -> [Char]
(Int -> Version -> ShowS)
-> (Version -> [Char]) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Version -> ShowS
showsPrec :: Int -> Version -> ShowS
$cshow :: Version -> [Char]
show :: Version -> [Char]
$cshowList :: [Version] -> ShowS
showList :: [Version] -> ShowS
Show, (forall x. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Version -> Rep Version x
from :: forall x. Version -> Rep Version x
$cto :: forall x. Rep Version x -> Version
to :: forall x. Rep Version x -> Version
Generic)
  deriving (Value -> Parser [Version]
Value -> Parser Version
(Value -> Parser Version)
-> (Value -> Parser [Version]) -> FromJSON Version
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Version
parseJSON :: Value -> Parser Version
$cparseJSONList :: Value -> Parser [Version]
parseJSONList :: Value -> Parser [Version]
FromJSON, [Version] -> Value
[Version] -> Encoding
Version -> Value
Version -> Encoding
(Version -> Value)
-> (Version -> Encoding)
-> ([Version] -> Value)
-> ([Version] -> Encoding)
-> ToJSON Version
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Version -> Value
toJSON :: Version -> Value
$ctoEncoding :: Version -> Encoding
toEncoding :: Version -> Encoding
$ctoJSONList :: [Version] -> Value
toJSONList :: [Version] -> Value
$ctoEncodingList :: [Version] -> Encoding
toEncodingList :: [Version] -> Encoding
ToJSON) via (Schema Version)

versionInt :: Version -> Int
versionInt :: Version -> Int
versionInt Version
V0 = Int
0
versionInt Version
V1 = Int
1
versionInt Version
V2 = Int
2

versionText :: Version -> Text
versionText :: Version -> Text
versionText = (Text
"v" <>) (Text -> Text) -> (Version -> Text) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack ([Char] -> Text) -> (Version -> [Char]) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> (Version -> Int) -> Version -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Int
versionInt

intToVersion :: Int -> Maybe Version
intToVersion :: Int -> Maybe Version
intToVersion Int
intV = (Version -> Bool) -> [Version] -> Maybe Version
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Version
v -> Version -> Int
versionInt Version
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
intV) [Version
forall a. Bounded a => a
minBound ..]

instance ToSchema Version where
  schema :: ValueSchema NamedSwaggerDoc Version
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Integer Text
"Version" (SchemaP [Value] Integer (Alt Maybe Integer) Version Version
 -> ValueSchema NamedSwaggerDoc Version)
-> ([SchemaP [Value] Integer (Alt Maybe Integer) Version Version]
    -> SchemaP [Value] Integer (Alt Maybe Integer) Version Version)
-> [SchemaP [Value] Integer (Alt Maybe Integer) Version Version]
-> ValueSchema NamedSwaggerDoc Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SchemaP [Value] Integer (Alt Maybe Integer) Version Version]
-> SchemaP [Value] Integer (Alt Maybe Integer) Version Version
forall a. Monoid a => [a] -> a
mconcat ([SchemaP [Value] Integer (Alt Maybe Integer) Version Version]
 -> ValueSchema NamedSwaggerDoc Version)
-> [SchemaP [Value] Integer (Alt Maybe Integer) Version Version]
-> ValueSchema NamedSwaggerDoc Version
forall a b. (a -> b) -> a -> b
$
      [ Integer
-> Version
-> SchemaP [Value] Integer (Alt Maybe Integer) Version Version
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Integer
0 Version
V0,
        Integer
-> Version
-> SchemaP [Value] Integer (Alt Maybe Integer) Version Version
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Integer
1 Version
V1,
        Integer
-> Version
-> SchemaP [Value] Integer (Alt Maybe Integer) Version Version
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Integer
2 Version
V2
      ]

supportedVersions :: Set Version
supportedVersions :: Set Version
supportedVersions = [Version] -> Set Version
forall a. Ord a => [a] -> Set a
Set.fromList [Version
forall a. Bounded a => a
minBound .. Version
forall a. Bounded a => a
maxBound]

data VersionInfo = VersionInfo
  { VersionInfo -> [Int]
vinfoSupported :: [Int]
  }
  deriving (Value -> Parser [VersionInfo]
Value -> Parser VersionInfo
(Value -> Parser VersionInfo)
-> (Value -> Parser [VersionInfo]) -> FromJSON VersionInfo
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser VersionInfo
parseJSON :: Value -> Parser VersionInfo
$cparseJSONList :: Value -> Parser [VersionInfo]
parseJSONList :: Value -> Parser [VersionInfo]
FromJSON, [VersionInfo] -> Value
[VersionInfo] -> Encoding
VersionInfo -> Value
VersionInfo -> Encoding
(VersionInfo -> Value)
-> (VersionInfo -> Encoding)
-> ([VersionInfo] -> Value)
-> ([VersionInfo] -> Encoding)
-> ToJSON VersionInfo
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: VersionInfo -> Value
toJSON :: VersionInfo -> Value
$ctoEncoding :: VersionInfo -> Encoding
toEncoding :: VersionInfo -> Encoding
$ctoJSONList :: [VersionInfo] -> Value
toJSONList :: [VersionInfo] -> Value
$ctoEncodingList :: [VersionInfo] -> Encoding
toEncodingList :: [VersionInfo] -> Encoding
ToJSON, Typeable VersionInfo
Typeable VersionInfo =>
(Proxy VersionInfo -> Declare (Definitions Schema) NamedSchema)
-> ToSchema VersionInfo
Proxy VersionInfo -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy VersionInfo -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy VersionInfo -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema VersionInfo)

instance ToSchema VersionInfo where
  schema :: ValueSchema NamedSwaggerDoc VersionInfo
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc VersionInfo
-> ValueSchema NamedSwaggerDoc VersionInfo
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier Text
"VersionInfo" ((Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasSchema s a => Lens' s a
Lens' NamedSwaggerDoc Schema
S.schema ((Schema -> Identity Schema)
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> ((Maybe Value -> Identity (Maybe Value))
    -> Schema -> Identity Schema)
-> (Maybe Value -> Identity (Maybe Value))
-> NamedSwaggerDoc
-> Identity NamedSwaggerDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
S.example ((Maybe Value -> Identity (Maybe Value))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Value -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ VersionInfo -> Value
forall a. ToJSON a => a -> Value
toJSON VersionInfo
example) (ObjectSchema SwaggerDoc VersionInfo
 -> ValueSchema NamedSwaggerDoc VersionInfo)
-> ObjectSchema SwaggerDoc VersionInfo
-> ValueSchema NamedSwaggerDoc VersionInfo
forall a b. (a -> b) -> a -> b
$
      [Int] -> VersionInfo
VersionInfo
        -- if the supported_versions field does not exist, assume an old backend
        -- that only supports V0
        ([Int] -> VersionInfo)
-> SchemaP SwaggerDoc Object [Pair] VersionInfo [Int]
-> ObjectSchema SwaggerDoc VersionInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VersionInfo -> [Int]
vinfoSupported
          (VersionInfo -> [Int])
-> SchemaP SwaggerDoc Object [Pair] [Int] [Int]
-> SchemaP SwaggerDoc Object [Pair] VersionInfo [Int]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Maybe [Int] -> [Int])
-> SchemaP SwaggerDoc Object [Pair] [Int] (Maybe [Int])
-> SchemaP SwaggerDoc Object [Pair] [Int] [Int]
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Object [Pair] [Int] a
-> SchemaP SwaggerDoc Object [Pair] [Int] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ([Int] -> Maybe [Int] -> [Int]
forall a. a -> Maybe a -> a
fromMaybe [Int
0])
            (Text
-> SchemaP SwaggerDoc Value Value [Int] [Int]
-> SchemaP SwaggerDoc Object [Pair] [Int] (Maybe [Int])
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"supported_versions" (ValueSchema NamedSwaggerDoc Int
-> SchemaP SwaggerDoc Value Value [Int] [Int]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Int
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
        -- legacy field to support older versions of the backend with broken
        -- version negotiation
        ObjectSchema SwaggerDoc VersionInfo
-> SchemaP SwaggerDoc Object [Pair] VersionInfo [Int]
-> ObjectSchema SwaggerDoc VersionInfo
forall a b.
SchemaP SwaggerDoc Object [Pair] VersionInfo a
-> SchemaP SwaggerDoc Object [Pair] VersionInfo b
-> SchemaP SwaggerDoc Object [Pair] VersionInfo a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Int] -> VersionInfo -> [Int]
forall a b. a -> b -> a
const [Int
0 :: Int, Int
1] (VersionInfo -> [Int])
-> SchemaP SwaggerDoc Object [Pair] [Int] [Int]
-> SchemaP SwaggerDoc Object [Pair] VersionInfo [Int]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [Int] [Int]
-> SchemaP SwaggerDoc Object [Pair] [Int] [Int]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"supported" (ValueSchema NamedSwaggerDoc Int
-> SchemaP SwaggerDoc Value Value [Int] [Int]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Int
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    where
      example :: VersionInfo
      example :: VersionInfo
example =
        VersionInfo
          { $sel:vinfoSupported:VersionInfo :: [Int]
vinfoSupported = (Version -> Int) -> [Version] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Version -> Int
versionInt (Set Version -> [Version]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Version
supportedVersions)
          }

versionInfo :: VersionInfo
versionInfo :: VersionInfo
versionInfo = [Int] -> VersionInfo
VersionInfo ((Version -> Int) -> [Version] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Version -> Int
versionInt (Set Version -> [Version]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Version
supportedVersions))

----------------------------------------------------------------------

-- | The upper bound of a version range.
--
-- The order of constructors here makes the 'Unbounded' value maximum in the
-- generated lexicographic ordering.
data VersionUpperBound = VersionUpperBound Version | Unbounded
  deriving (VersionUpperBound -> VersionUpperBound -> Bool
(VersionUpperBound -> VersionUpperBound -> Bool)
-> (VersionUpperBound -> VersionUpperBound -> Bool)
-> Eq VersionUpperBound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionUpperBound -> VersionUpperBound -> Bool
== :: VersionUpperBound -> VersionUpperBound -> Bool
$c/= :: VersionUpperBound -> VersionUpperBound -> Bool
/= :: VersionUpperBound -> VersionUpperBound -> Bool
Eq, Eq VersionUpperBound
Eq VersionUpperBound =>
(VersionUpperBound -> VersionUpperBound -> Ordering)
-> (VersionUpperBound -> VersionUpperBound -> Bool)
-> (VersionUpperBound -> VersionUpperBound -> Bool)
-> (VersionUpperBound -> VersionUpperBound -> Bool)
-> (VersionUpperBound -> VersionUpperBound -> Bool)
-> (VersionUpperBound -> VersionUpperBound -> VersionUpperBound)
-> (VersionUpperBound -> VersionUpperBound -> VersionUpperBound)
-> Ord VersionUpperBound
VersionUpperBound -> VersionUpperBound -> Bool
VersionUpperBound -> VersionUpperBound -> Ordering
VersionUpperBound -> VersionUpperBound -> VersionUpperBound
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 :: VersionUpperBound -> VersionUpperBound -> Ordering
compare :: VersionUpperBound -> VersionUpperBound -> Ordering
$c< :: VersionUpperBound -> VersionUpperBound -> Bool
< :: VersionUpperBound -> VersionUpperBound -> Bool
$c<= :: VersionUpperBound -> VersionUpperBound -> Bool
<= :: VersionUpperBound -> VersionUpperBound -> Bool
$c> :: VersionUpperBound -> VersionUpperBound -> Bool
> :: VersionUpperBound -> VersionUpperBound -> Bool
$c>= :: VersionUpperBound -> VersionUpperBound -> Bool
>= :: VersionUpperBound -> VersionUpperBound -> Bool
$cmax :: VersionUpperBound -> VersionUpperBound -> VersionUpperBound
max :: VersionUpperBound -> VersionUpperBound -> VersionUpperBound
$cmin :: VersionUpperBound -> VersionUpperBound -> VersionUpperBound
min :: VersionUpperBound -> VersionUpperBound -> VersionUpperBound
Ord, Int -> VersionUpperBound -> ShowS
[VersionUpperBound] -> ShowS
VersionUpperBound -> [Char]
(Int -> VersionUpperBound -> ShowS)
-> (VersionUpperBound -> [Char])
-> ([VersionUpperBound] -> ShowS)
-> Show VersionUpperBound
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionUpperBound -> ShowS
showsPrec :: Int -> VersionUpperBound -> ShowS
$cshow :: VersionUpperBound -> [Char]
show :: VersionUpperBound -> [Char]
$cshowList :: [VersionUpperBound] -> ShowS
showList :: [VersionUpperBound] -> ShowS
Show)

versionFromUpperBound :: VersionUpperBound -> Maybe Version
versionFromUpperBound :: VersionUpperBound -> Maybe Version
versionFromUpperBound (VersionUpperBound Version
v) = Version -> Maybe Version
forall a. a -> Maybe a
Just Version
v
versionFromUpperBound VersionUpperBound
Unbounded = Maybe Version
forall a. Maybe a
Nothing

versionToUpperBound :: Maybe Version -> VersionUpperBound
versionToUpperBound :: Maybe Version -> VersionUpperBound
versionToUpperBound (Just Version
v) = Version -> VersionUpperBound
VersionUpperBound Version
v
versionToUpperBound Maybe Version
Nothing = VersionUpperBound
Unbounded

data VersionRange = VersionRange
  { VersionRange -> Version
_fromVersion :: Version,
    VersionRange -> VersionUpperBound
_toVersionExcl :: VersionUpperBound
  }

deriving instance Eq VersionRange

deriving instance Show VersionRange

deriving instance Ord VersionRange

instance ToSchema VersionRange where
  schema :: ValueSchema NamedSwaggerDoc VersionRange
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] VersionRange VersionRange
-> ValueSchema NamedSwaggerDoc VersionRange
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"VersionRange" (SchemaP SwaggerDoc Object [Pair] VersionRange VersionRange
 -> ValueSchema NamedSwaggerDoc VersionRange)
-> SchemaP SwaggerDoc Object [Pair] VersionRange VersionRange
-> ValueSchema NamedSwaggerDoc VersionRange
forall a b. (a -> b) -> a -> b
$
      Version -> VersionUpperBound -> VersionRange
VersionRange
        (Version -> VersionUpperBound -> VersionRange)
-> SchemaP SwaggerDoc Object [Pair] VersionRange Version
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     VersionRange
     (VersionUpperBound -> VersionRange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VersionRange -> Version
_fromVersion (VersionRange -> Version)
-> SchemaP SwaggerDoc Object [Pair] Version Version
-> SchemaP SwaggerDoc Object [Pair] VersionRange Version
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc Version
-> SchemaP SwaggerDoc Object [Pair] Version Version
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"from" ValueSchema NamedSwaggerDoc Version
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  VersionRange
  (VersionUpperBound -> VersionRange)
-> SchemaP SwaggerDoc Object [Pair] VersionRange VersionUpperBound
-> SchemaP SwaggerDoc Object [Pair] VersionRange VersionRange
forall a b.
SchemaP SwaggerDoc Object [Pair] VersionRange (a -> b)
-> SchemaP SwaggerDoc Object [Pair] VersionRange a
-> SchemaP SwaggerDoc Object [Pair] VersionRange b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (VersionUpperBound -> Maybe Version
versionFromUpperBound (VersionUpperBound -> Maybe Version)
-> (VersionRange -> VersionUpperBound)
-> VersionRange
-> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> VersionUpperBound
_toVersionExcl)
          (VersionRange -> Maybe Version)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe Version) VersionUpperBound
-> SchemaP SwaggerDoc Object [Pair] VersionRange VersionUpperBound
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Version VersionUpperBound
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe Version) VersionUpperBound
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Maybe Version -> VersionUpperBound
versionToUpperBound (Maybe Version -> VersionUpperBound)
-> SchemaP SwaggerDoc Object [Pair] Version (Maybe Version)
-> SchemaP SwaggerDoc Object [Pair] Version VersionUpperBound
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc Version
-> SchemaP SwaggerDoc Object [Pair] Version (Maybe Version)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier Text
"until_excl" NamedSwaggerDoc -> NamedSwaggerDoc
desc ValueSchema NamedSwaggerDoc Version
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    where
      desc :: NamedSwaggerDoc -> NamedSwaggerDoc
desc = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"exlusive upper version bound"

deriving via Schema VersionRange instance ToJSON VersionRange

deriving via Schema VersionRange instance FromJSON VersionRange

allVersions :: VersionRange
allVersions :: VersionRange
allVersions = Version -> VersionUpperBound -> VersionRange
VersionRange Version
forall a. Bounded a => a
minBound VersionUpperBound
Unbounded

-- | The semigroup instance of VersionRange is intersection.
instance Semigroup VersionRange where
  VersionRange Version
from1 VersionUpperBound
to1 <> :: VersionRange -> VersionRange -> VersionRange
<> VersionRange Version
from2 VersionUpperBound
to2 =
    Version -> VersionUpperBound -> VersionRange
VersionRange (Version -> Version -> Version
forall a. Ord a => a -> a -> a
max Version
from1 Version
from2) (VersionUpperBound -> VersionUpperBound -> VersionUpperBound
forall a. Ord a => a -> a -> a
min VersionUpperBound
to1 VersionUpperBound
to2)

inVersionRange :: VersionRange -> Version -> Bool
inVersionRange :: VersionRange -> Version -> Bool
inVersionRange (VersionRange Version
a VersionUpperBound
b) Version
v =
  Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
a Bool -> Bool -> Bool
&& Version -> VersionUpperBound
VersionUpperBound Version
v VersionUpperBound -> VersionUpperBound -> Bool
forall a. Ord a => a -> a -> Bool
< VersionUpperBound
b

rangeFromVersion :: Version -> VersionRange
rangeFromVersion :: Version -> VersionRange
rangeFromVersion Version
v = Version -> VersionUpperBound -> VersionRange
VersionRange Version
v VersionUpperBound
Unbounded

rangeUntilVersion :: Version -> VersionRange
rangeUntilVersion :: Version -> VersionRange
rangeUntilVersion Version
v = Version -> VersionUpperBound -> VersionRange
VersionRange Version
forall a. Bounded a => a
minBound (Version -> VersionUpperBound
VersionUpperBound Version
v)

-- | For a version range of a local backend and for a set of versions that a
-- remote backend supports, compute the newest version supported by both. The
-- remote versions are given as integers as the range of versions supported by
-- the remote backend can include a version unknown to the local backend. If
-- there is no version in common, the return value is 'Nothing'.
latestCommonVersion :: (Foldable f) => VersionRange -> f Int -> Maybe Version
latestCommonVersion :: forall (f :: * -> *).
Foldable f =>
VersionRange -> f Int -> Maybe Version
latestCommonVersion VersionRange
localVersions =
  [Version] -> Maybe Version
forall a. Ord a => [a] -> Maybe a
safeMaximum
    ([Version] -> Maybe Version)
-> (f Int -> [Version]) -> f Int -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> Bool) -> [Version] -> [Version]
forall a. (a -> Bool) -> [a] -> [a]
filter (VersionRange -> Version -> Bool
inVersionRange VersionRange
localVersions)
    ([Version] -> [Version])
-> (f Int -> [Version]) -> f Int -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Maybe Version) -> [Int] -> [Version]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Int -> Maybe Version
intToVersion
    ([Int] -> [Version]) -> (f Int -> [Int]) -> f Int -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f Int -> [Int]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

safeMaximum :: (Ord a) => [a] -> Maybe a
safeMaximum :: forall a. Ord a => [a] -> Maybe a
safeMaximum [] = Maybe a
forall a. Maybe a
Nothing
safeMaximum [a]
as = a -> Maybe a
forall a. a -> Maybe a
Just ([a] -> a
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [a]
as)

$(genSingletons [''Version])

$(promoteOrdInstances [''Version])