{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# 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/>.
{-# OPTIONS_GHC -Wno-unused-top-binds #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 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.Routes.Version
  ( -- * API version endpoint
    VersionAPI,
    VersionAPITag,
    VersionInfo (..),
    versionHeader,
    VersionHeader,

    -- * Version
    Version (..),
    versionInt,
    versionText,
    versionedName,
    VersionNumber (..),
    VersionExp (..),
    supportedVersions,
    isDevelopmentVersion,
    developmentVersions,
    expandVersionExp,
    maxAvailableVersion,

    -- * Servant combinators
    Until,
    From,

    -- * Versioned schema-profunctor things.
    versionedObject,
    versionedObjectWithDocModifier,

    -- * Swagger
    module Wire.API.Routes.SpecialiseToVersion,
  )
where

import Control.Error (note)
import Control.Lens (makePrisms, (?~))
import Data.Aeson (FromJSON, ToJSON (..))
import Data.Aeson qualified as Aeson
import Data.Aeson.Types qualified as Aeson
import Data.Bifunctor
import Data.Binary.Builder qualified as Builder
import Data.ByteString.Conversion (ToByteString (builder), toByteString')
import Data.ByteString.Lazy qualified as LBS
import Data.Domain
import Data.OpenApi qualified as S
import Data.Schema
import Data.Set ((\\))
import Data.Set qualified as Set
import Data.Singletons.Base.TH
import Data.Text qualified as Text
import Data.Text.Encoding as Text
import Imports hiding ((\\))
import Servant
import Wire.API.Routes.Named hiding (unnamed)
import Wire.API.Routes.SpecialiseToVersion
import Wire.API.VersionInfo
import Wire.Arbitrary (Arbitrary, GenericUniform (GenericUniform))

-- | Version of the public API.  Serializes to `"v<n>"`.  See 'VersionNumber' below for one
-- that serializes to `<n>`.  See `/libs/wire-api/test/unit/Test/Wire/API/Routes/Version.hs`
-- for serialization rules.
--
-- If you add or remove versions from this type, make sure 'versionInt', 'supportedVersions',
-- and 'developmentVersions' stay in sync; everything else here should keep working without
-- change.  See also documentation in the *docs* directory.
-- https://docs.wire.com/developer/developer/api-versioning.html#version-bump-checklist
data Version = V0 | V1 | V2 | V3 | V4 | V5 | V6 | V7 | V8 | V9 | V10 | V11 | V12 | V13 | V14 | V15 | V16 | V17
  deriving stock (Eq, Ord, Bounded, Enum, Show, Generic)
  deriving (FromJSON, ToJSON) via (Schema Version)
  deriving (Arbitrary) via (GenericUniform Version)

instance RenderableSymbol V1 where renderSymbol = "V1"

instance RenderableSymbol V2 where renderSymbol = "V2"

instance RenderableSymbol V3 where renderSymbol = "V3"

instance RenderableSymbol V4 where renderSymbol = "V4"

instance RenderableSymbol V5 where renderSymbol = "V5"

instance RenderableSymbol V6 where renderSymbol = "V6"

instance RenderableSymbol V7 where renderSymbol = "V7"

instance RenderableSymbol V8 where renderSymbol = "V8"

instance RenderableSymbol V9 where renderSymbol = "V9"

instance RenderableSymbol V10 where renderSymbol = "V10"

instance RenderableSymbol V11 where renderSymbol = "V11"

instance RenderableSymbol V12 where renderSymbol = "V12"

instance RenderableSymbol V13 where renderSymbol = "V13"

instance RenderableSymbol V14 where renderSymbol = "V14"

instance RenderableSymbol V15 where renderSymbol = "V15"

instance RenderableSymbol V16 where renderSymbol = "V16"

instance RenderableSymbol V17 where renderSymbol = "V17"

-- | Manual enumeration of version integrals (the `<n>` in the constructor `V<n>`).
--
-- This is not the same as 'fromEnum': we will remove unsupported versions in the future,
-- which will cause `<n>` and `fromEnum V<n>` to diverge.  `Enum` should not be understood as
-- a bijection between meaningful integers and versions, but merely as a convenient way to say
-- `allVersions = [minBound..]`.
versionInt :: (Integral i) => Version -> i
versionInt V0 = 0
versionInt V1 = 1
versionInt V2 = 2
versionInt V3 = 3
versionInt V4 = 4
versionInt V5 = 5
versionInt V6 = 6
versionInt V7 = 7
versionInt V8 = 8
versionInt V9 = 9
versionInt V10 = 10
versionInt V11 = 11
versionInt V12 = 12
versionInt V13 = 13
versionInt V14 = 14
versionInt V15 = 15
versionInt V16 = 16
versionInt V17 = 17

supportedVersions :: [Version]
supportedVersions = [minBound .. maxBound]

maxAvailableVersion :: Set Version -> Maybe Version
maxAvailableVersion disabled = Set.lookupMax $ Set.fromList supportedVersions \\ disabled

versionedName :: Maybe Version -> Text -> Text
versionedName Nothing unversionedName = unversionedName
versionedName (Just v) unversionedName = unversionedName <> Text.pack (show v)

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

versionText :: Version -> Text
versionText = ("v" <>) . toUrlPiece . versionInt @Int

versionByteString :: Version -> ByteString
versionByteString = ("v" <>) . toByteString' . versionInt @Int

instance ToSchema Version where
  schema = enum @Text . mconcat $ (\v -> element (versionText v) v) <$> [minBound ..]

instance FromHttpApiData Version where
  parseQueryParam v = note ("Unknown version: " <> v) $
    getAlt $
      flip foldMap [minBound ..] $
        \s ->
          guard (versionText s == v) $> s

instance ToHttpApiData Version where
  toHeader = versionByteString
  toUrlPiece = versionText

instance ToByteString Version where
  builder = Builder.fromByteString . versionByteString

-- | Wrapper around 'Version' that serializes to integers `<n>`, as needed in
-- eg. `VersionInfo`.  See `/libs/wire-api/test/unit/Test/Wire/API/Routes/Version.hs` for
-- serialization rules.
newtype VersionNumber = VersionNumber {fromVersionNumber :: Version}
  deriving stock (Eq, Ord, Show, Generic)
  deriving newtype (Bounded, Enum)
  deriving (FromJSON, ToJSON) via (Schema VersionNumber)
  deriving (Arbitrary) via (GenericUniform Version)

instance ToSchema VersionNumber where
  schema =
    enum @Integer . mconcat $ (\v -> element (versionInt v) (VersionNumber v)) <$> [minBound ..]

instance FromHttpApiData VersionNumber where
  parseHeader = first Text.pack . Aeson.eitherDecode . LBS.fromStrict
  parseUrlPiece = parseHeader . Text.encodeUtf8

instance ToHttpApiData VersionNumber where
  toHeader = LBS.toStrict . Aeson.encode
  toUrlPiece = Text.decodeUtf8 . toHeader

instance ToByteString VersionNumber where
  builder = toEncodedUrlPiece

-- | Information related to the public API version.
--
-- This record also contains whether federation is enabled and the federation
-- domain. Clients should fetch this information early when connecting to a
-- backend, in order to decide how to form request paths, and how to deal with
-- federated backends and qualified user IDs.
data VersionInfo = VersionInfo
  { vinfoSupported :: [VersionNumber],
    vinfoDevelopment :: [VersionNumber],
    vinfoFederation :: Bool,
    vinfoDomain :: Domain
  }
  deriving (FromJSON, ToJSON, S.ToSchema) via (Schema VersionInfo)

instance ToSchema VersionInfo where
  schema =
    objectWithDocModifier (S.schema . S.example ?~ toJSON example) $
      VersionInfo
        <$> vinfoSupported
          .= vinfoObjectSchema schema
        <*> vinfoDevelopment .= field "development" (array schema)
        <*> vinfoFederation .= field "federation" schema
        <*> vinfoDomain .= field "domain" schema
    where
      example :: VersionInfo
      example =
        VersionInfo
          { vinfoSupported = VersionNumber <$> supportedVersions,
            vinfoDevelopment = [maxBound],
            vinfoFederation = False,
            vinfoDomain = Domain "example.com"
          }

type VersionAPI =
  Named
    "get-version"
    ( "api-version"
        :> Get '[JSON] VersionInfo
    )

data VersionAPITag

-- Development versions

$(genSingletons [''Version])

isDevelopmentVersion :: Version -> Bool
isDevelopmentVersion V0 = False
isDevelopmentVersion V1 = False
isDevelopmentVersion V2 = False
isDevelopmentVersion V3 = False
isDevelopmentVersion V4 = False
isDevelopmentVersion V5 = False
isDevelopmentVersion V6 = False
isDevelopmentVersion V7 = False
isDevelopmentVersion V8 = False
isDevelopmentVersion V9 = False
isDevelopmentVersion V10 = False
isDevelopmentVersion V11 = False
isDevelopmentVersion V12 = False
isDevelopmentVersion V13 = False
isDevelopmentVersion V14 = False
isDevelopmentVersion V15 = False
isDevelopmentVersion V16 = False
isDevelopmentVersion V17 = True

developmentVersions :: [Version]
developmentVersions = filter isDevelopmentVersion supportedVersions

-- Version keywords

-- | A version "expression" which can be used when disabling versions in a
-- configuration file.
data VersionExp
  = -- | A fixed version.
    VersionExpConst Version
  | -- | All development versions.
    VersionExpDevelopment
  deriving (Show, Eq, Ord, Generic)

$(makePrisms ''VersionExp)

instance ToSchema VersionExp where
  schema =
    named "VersionExp" $
      tag _VersionExpConst (unnamed schema)
        <> tag
          _VersionExpDevelopment
          ( unnamed
              (enum @Text (element "development" ()))
          )

deriving via Schema VersionExp instance (FromJSON VersionExp)

deriving via Schema VersionExp instance (ToJSON VersionExp)

-- | Expand a version expression into a set of versions.
expandVersionExp :: VersionExp -> Set Version
expandVersionExp (VersionExpConst v) = Set.singleton v
expandVersionExp VersionExpDevelopment = Set.fromList developmentVersions

$(promoteOrdInstances [''Version])

versionedObject ::
  forall doc doc' a b.
  (Typeable a, HasObject doc doc') =>
  Maybe Version ->
  SchemaP doc Aeson.Object [Aeson.Pair] a b ->
  SchemaP doc' Aeson.Value Aeson.Value a b
versionedObject version = namedObject (mkVersionedSchemaName @a version)

versionedObjectWithDocModifier ::
  forall doc doc' a.
  (Typeable a, HasObject doc doc') =>
  Maybe Version ->
  (doc' -> doc') ->
  ObjectSchema doc a ->
  ValueSchema doc' a
versionedObjectWithDocModifier v = namedObjectWithDocModifier (mkVersionedSchemaName @a v)

mkVersionedSchemaName :: forall a. (Typeable a) => Maybe Version -> Text
mkVersionedSchemaName (Just v) = mkSchemaNameWith @a (versionText v)
mkVersionedSchemaName Nothing = mkSchemaName @a
