-- 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.Routes.MultiTablePaging
  ( GetMultiTablePageRequest (..),
    MultiTablePage (..),
    LocalOrRemoteTable (..),
    MultiTablePagingState (..),
  )
where

import Control.Lens ((?~))
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Kind
import Data.OpenApi qualified as S
import Data.Proxy
import Data.Range
import Data.Schema
import Data.Text qualified as Text
import GHC.TypeLits
import Imports
import Wire.API.Routes.MultiTablePaging.State

-- | A request for a page of results from the database. Type arguments:
--
--  * @name@   Name of the resources being paginated through
--  * @tables@ A (usually finite) type that represent the table currently being
--             used (must be an instance of 'PagingTable')
--  * @max@    Maximum page size
--  * @def@    Default page size
--
-- See 'ConversationPagingState' for an example.
data GetMultiTablePageRequest (name :: Symbol) (tables :: Type) (max :: Nat) (def :: Nat) = GetMultiTablePageRequest
  { gmtprSize :: Range 1 max Int32,
    gmtprState :: Maybe (MultiTablePagingState name tables)
  }
  deriving stock (Show, Eq)

-- We can't use deriving via due to this error:
-- .../wire-server/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs:24:12: error:
--     • Couldn't match type ‘Data.Singletons.Prelude.Ord.Case_6989586621679792881
--                              1 max (CmpNat 1 max)’
--                      with ‘'True’
--         arising from the 'deriving' clause of a data type declaration
--     • When deriving the instance for (ToJSON
--                                         (GetMultiTablePageRequest name tables max def))
--    |
-- 24 |   deriving ToJSON via Schema (GetMultiTablePageRequest name tables max def)
--    |            ^^^^^^

type RequestSchemaConstraint name tables max def = (KnownNat max, KnownNat def, Within Int32 1 max, 1 <= def, def <= max, PagingTable tables, KnownSymbol name)

deriving via
  Schema (GetMultiTablePageRequest name tables max def)
  instance
    ( Typeable tables,
      RequestSchemaConstraint name tables max def
    ) =>
    ToJSON (GetMultiTablePageRequest name tables max def)

deriving via
  Schema (GetMultiTablePageRequest name tables max def)
  instance
    ( Typeable tables,
      RequestSchemaConstraint name tables max def
    ) =>
    FromJSON (GetMultiTablePageRequest name tables max def)

deriving via
  Schema (GetMultiTablePageRequest name tables max def)
  instance
    ( Typeable tables,
      RequestSchemaConstraint name tables max def
    ) =>
    S.ToSchema (GetMultiTablePageRequest name tables max def)

instance
  ( Typeable tables,
    RequestSchemaConstraint name tables max def
  ) =>
  ToSchema (GetMultiTablePageRequest name tables max def)
  where
  schema =
    let addPagingStateDoc =
          description
            ?~ "optional, when not specified, the first page will be returned.\
               \Every returned page contains a paging_state, this should be supplied to retrieve the next page."
        addSizeDoc = description ?~ ("optional, must be <= " <> textFromNat @max <> ", defaults to " <> textFromNat @def <> ".")
     in objectWithDocModifier
          (description ?~ "A request to list some or all of a user's " <> textFromSymbol @name <> ", including remote ones")
          $ GetMultiTablePageRequest
            <$> gmtprSize .= (fromMaybe (toRange (Proxy @def)) <$> optFieldWithDocModifier "size" addSizeDoc schema)
            <*> gmtprState .= maybe_ (optFieldWithDocModifier "paging_state" addPagingStateDoc schema)

textFromNat :: forall n. (KnownNat n) => Text
textFromNat = Text.pack . show . natVal $ Proxy @n

textFromSymbol :: forall s. (KnownSymbol s) => Text
textFromSymbol = Text.pack . symbolVal $ Proxy @s

-- | The result of a multi-table paginated query. Contains the list of results,
-- a flag indicating whether there are more, and the state to pass to the next
-- query.
data MultiTablePage (name :: Symbol) (resultsKey :: Symbol) (tables :: Type) a = MultiTablePage
  { mtpResults :: [a],
    mtpHasMore :: Bool,
    mtpPagingState :: MultiTablePagingState name tables
  }
  deriving stock (Eq, Show)

type PageSchemaConstraints name resultsKey tables a = (KnownSymbol resultsKey, KnownSymbol name, ToSchema a, PagingTable tables)

deriving via
  (Schema (MultiTablePage name resultsKey tables a))
  instance
    ( Typeable tables,
      Typeable a,
      PageSchemaConstraints name resultsKey tables a
    ) =>
    ToJSON (MultiTablePage name resultsKey tables a)

deriving via
  (Schema (MultiTablePage name resultsKey tables a))
  instance
    ( Typeable tables,
      Typeable a,
      PageSchemaConstraints name resultsKey tables a
    ) =>
    FromJSON (MultiTablePage name resultsKey tables a)

deriving via
  (Schema (MultiTablePage name resultsKey tables a))
  instance
    (Typeable tables, Typeable a, PageSchemaConstraints name resultsKey tables a) =>
    S.ToSchema (MultiTablePage name resultsKey tables a)

instance
  ( KnownSymbol resultsKey,
    KnownSymbol name,
    Typeable a,
    ToSchema a,
    Typeable tables,
    PagingTable tables
  ) =>
  ToSchema (MultiTablePage name resultsKey tables a)
  where
  schema =
    object $
      MultiTablePage
        <$> mtpResults .= field (textFromSymbol @resultsKey) (array schema)
        <*> mtpHasMore .= field "has_more" schema
        <*> mtpPagingState .= field "paging_state" schema

-- | A type to be used as the @tables@ argument of 'GetMultiTablePageRequest'
-- when the resources being paginated through are split into local and remote.
data LocalOrRemoteTable
  = PagingLocals
  | PagingRemotes
  deriving stock (Show, Eq)

instance PagingTable LocalOrRemoteTable where
  encodePagingTable PagingLocals = 0
  encodePagingTable PagingRemotes = 1

  decodePagingTable 0 = pure PagingLocals
  decodePagingTable 1 = pure PagingRemotes
  decodePagingTable x = fail $ "Expected 0 or 1 while parsing LocalOrRemoteTable, got: " <> show x
