-- 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.Sem.Paging.Cassandra
  ( CassandraPaging,
    LegacyPaging,
    InternalPaging,
    InternalPage (..),
    InternalPagingState (..),
    mkInternalPage,
    ipNext,
    ResultSet,
    mkResultSet,
    resultSetResult,
    resultSetType,
    ResultSetType (..),
  )
where

import Cassandra
import Data.Id
import Data.Qualified
import Data.Range
import Imports
import Wire.API.Connection (UserConnection)
import Wire.API.Team.Member (HardTruncationLimit, TeamMember)
import qualified Wire.Sem.Paging as E

-- | This paging system uses Cassandra's 'PagingState' to keep track of state,
-- and does not rely on ordering. This is the preferred way of paging across
-- multiple tables, as in  'MultiTablePaging'.
data CassandraPaging

type instance E.PagingState CassandraPaging a = PagingState

type instance E.Page CassandraPaging a = PageWithState a

type instance E.PagingBounds CassandraPaging ConvId = Range 1 1000 Int32

type instance E.PagingBounds CassandraPaging (Remote ConvId) = Range 1 1000 Int32

type instance E.PagingBounds CassandraPaging TeamId = Range 1 100 Int32

-- | This paging system is based on ordering, and keeps track of state using
-- the id of the next item to fetch. Implementations of this paging system also
-- contain extra logic to detect if the last page has been fetched.
data LegacyPaging

type instance E.PagingState LegacyPaging a = a

type instance E.Page LegacyPaging a = ResultSet a

type instance E.PagingBounds LegacyPaging ConvId = Range 1 1000 Int32

type instance E.PagingBounds LegacyPaging TeamId = Range 1 100 Int32

data InternalPaging

data InternalPagingState a = forall s. InternalPagingState (Page s, s -> Client a)

deriving instance (Functor InternalPagingState)

data InternalPage a = forall s. InternalPage (Page s, s -> Client a, [a])

deriving instance (Functor InternalPage)

mkInternalPage :: Page s -> (s -> Client a) -> Client (InternalPage a)
mkInternalPage :: forall s a. Page s -> (s -> Client a) -> Client (InternalPage a)
mkInternalPage Page s
p s -> Client a
f = do
  [a]
items <- (s -> Client a) -> [s] -> Client [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse s -> Client a
f (Page s -> [s]
forall a. Page a -> [a]
result Page s
p)
  InternalPage a -> Client (InternalPage a)
forall a. a -> Client a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InternalPage a -> Client (InternalPage a))
-> InternalPage a -> Client (InternalPage a)
forall a b. (a -> b) -> a -> b
$ (Page s, s -> Client a, [a]) -> InternalPage a
forall a s. (Page s, s -> Client a, [a]) -> InternalPage a
InternalPage (Page s
p, s -> Client a
f, [a]
items)

ipNext :: InternalPagingState a -> Client (InternalPage a)
ipNext :: forall a. InternalPagingState a -> Client (InternalPage a)
ipNext (InternalPagingState (Page s
p, s -> Client a
f)) = do
  Page s
p' <- Page s -> Client (Page s)
forall a. Page a -> Client (Page a)
nextPage Page s
p
  Page s -> (s -> Client a) -> Client (InternalPage a)
forall s a. Page s -> (s -> Client a) -> Client (InternalPage a)
mkInternalPage Page s
p' s -> Client a
f

type instance E.PagingState InternalPaging a = InternalPagingState a

type instance E.Page InternalPaging a = InternalPage a

type instance E.PagingBounds InternalPaging TeamMember = Range 1 HardTruncationLimit Int32

type instance E.PagingBounds CassandraPaging TeamMember = Range 1 HardTruncationLimit Int32

type instance E.PagingBounds InternalPaging TeamId = Range 1 100 Int32

type instance E.PagingBounds InternalPaging (Remote UserConnection) = Range 1 1000 Int32

instance E.Paging InternalPaging where
  pageItems :: forall a. Page InternalPaging a -> [a]
pageItems (InternalPage (Page s
_, s -> Client a
_, [a]
items)) = [a]
items
  pageHasMore :: forall a. Page InternalPaging a -> Bool
pageHasMore (InternalPage (Page s
p, s -> Client a
_, [a]
_)) = Page s -> Bool
forall a. Page a -> Bool
hasMore Page s
p
  pageState :: forall a. Page InternalPaging a -> PagingState InternalPaging a
pageState (InternalPage (Page s
p, s -> Client a
f, [a]
_)) = (Page s, s -> Client a) -> InternalPagingState a
forall a s. (Page s, s -> Client a) -> InternalPagingState a
InternalPagingState (Page s
p, s -> Client a
f)

-- We use this newtype to highlight the fact that the 'Page' wrapped in here
-- can not reliably used for paging.
--
-- The reason for this is that Cassandra returns 'hasMore' as true if the
-- page size requested is equal to result size. To work around this we
-- actually request for one additional element and drop the last value if
-- necessary. This means however that 'nextPage' does not work properly as
-- we would miss a value on every page size.
-- Thus, and since we don't want to expose the ResultSet constructor
-- because it gives access to `nextPage`, we give accessors to the results
-- and a more typed `hasMore` (ResultSetComplete | ResultSetTruncated)
data ResultSet a = ResultSet
  { forall a. ResultSet a -> [a]
resultSetResult :: [a],
    forall a. ResultSet a -> ResultSetType
resultSetType :: ResultSetType
  }
  deriving stock (Int -> ResultSet a -> ShowS
[ResultSet a] -> ShowS
ResultSet a -> String
(Int -> ResultSet a -> ShowS)
-> (ResultSet a -> String)
-> ([ResultSet a] -> ShowS)
-> Show (ResultSet a)
forall a. Show a => Int -> ResultSet a -> ShowS
forall a. Show a => [ResultSet a] -> ShowS
forall a. Show a => ResultSet a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ResultSet a -> ShowS
showsPrec :: Int -> ResultSet a -> ShowS
$cshow :: forall a. Show a => ResultSet a -> String
show :: ResultSet a -> String
$cshowList :: forall a. Show a => [ResultSet a] -> ShowS
showList :: [ResultSet a] -> ShowS
Show, (forall a b. (a -> b) -> ResultSet a -> ResultSet b)
-> (forall a b. a -> ResultSet b -> ResultSet a)
-> Functor ResultSet
forall a b. a -> ResultSet b -> ResultSet a
forall a b. (a -> b) -> ResultSet a -> ResultSet b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ResultSet a -> ResultSet b
fmap :: forall a b. (a -> b) -> ResultSet a -> ResultSet b
$c<$ :: forall a b. a -> ResultSet b -> ResultSet a
<$ :: forall a b. a -> ResultSet b -> ResultSet a
Functor, (forall m. Monoid m => ResultSet m -> m)
-> (forall m a. Monoid m => (a -> m) -> ResultSet a -> m)
-> (forall m a. Monoid m => (a -> m) -> ResultSet a -> m)
-> (forall a b. (a -> b -> b) -> b -> ResultSet a -> b)
-> (forall a b. (a -> b -> b) -> b -> ResultSet a -> b)
-> (forall b a. (b -> a -> b) -> b -> ResultSet a -> b)
-> (forall b a. (b -> a -> b) -> b -> ResultSet a -> b)
-> (forall a. (a -> a -> a) -> ResultSet a -> a)
-> (forall a. (a -> a -> a) -> ResultSet a -> a)
-> (forall a. ResultSet a -> [a])
-> (forall a. ResultSet a -> Bool)
-> (forall a. ResultSet a -> Int)
-> (forall a. Eq a => a -> ResultSet a -> Bool)
-> (forall a. Ord a => ResultSet a -> a)
-> (forall a. Ord a => ResultSet a -> a)
-> (forall a. Num a => ResultSet a -> a)
-> (forall a. Num a => ResultSet a -> a)
-> Foldable ResultSet
forall a. Eq a => a -> ResultSet a -> Bool
forall a. Num a => ResultSet a -> a
forall a. Ord a => ResultSet a -> a
forall m. Monoid m => ResultSet m -> m
forall a. ResultSet a -> Bool
forall a. ResultSet a -> Int
forall a. ResultSet a -> [a]
forall a. (a -> a -> a) -> ResultSet a -> a
forall m a. Monoid m => (a -> m) -> ResultSet a -> m
forall b a. (b -> a -> b) -> b -> ResultSet a -> b
forall a b. (a -> b -> b) -> b -> ResultSet a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => ResultSet m -> m
fold :: forall m. Monoid m => ResultSet m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ResultSet a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ResultSet a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ResultSet a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ResultSet a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ResultSet a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ResultSet a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ResultSet a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ResultSet a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ResultSet a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ResultSet a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ResultSet a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ResultSet a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ResultSet a -> a
foldr1 :: forall a. (a -> a -> a) -> ResultSet a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ResultSet a -> a
foldl1 :: forall a. (a -> a -> a) -> ResultSet a -> a
$ctoList :: forall a. ResultSet a -> [a]
toList :: forall a. ResultSet a -> [a]
$cnull :: forall a. ResultSet a -> Bool
null :: forall a. ResultSet a -> Bool
$clength :: forall a. ResultSet a -> Int
length :: forall a. ResultSet a -> Int
$celem :: forall a. Eq a => a -> ResultSet a -> Bool
elem :: forall a. Eq a => a -> ResultSet a -> Bool
$cmaximum :: forall a. Ord a => ResultSet a -> a
maximum :: forall a. Ord a => ResultSet a -> a
$cminimum :: forall a. Ord a => ResultSet a -> a
minimum :: forall a. Ord a => ResultSet a -> a
$csum :: forall a. Num a => ResultSet a -> a
sum :: forall a. Num a => ResultSet a -> a
$cproduct :: forall a. Num a => ResultSet a -> a
product :: forall a. Num a => ResultSet a -> a
Foldable, Functor ResultSet
Foldable ResultSet
(Functor ResultSet, Foldable ResultSet) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> ResultSet a -> f (ResultSet b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ResultSet (f a) -> f (ResultSet a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ResultSet a -> m (ResultSet b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ResultSet (m a) -> m (ResultSet a))
-> Traversable ResultSet
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ResultSet (m a) -> m (ResultSet a)
forall (f :: * -> *) a.
Applicative f =>
ResultSet (f a) -> f (ResultSet a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ResultSet a -> m (ResultSet b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ResultSet a -> f (ResultSet b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ResultSet a -> f (ResultSet b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ResultSet a -> f (ResultSet b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ResultSet (f a) -> f (ResultSet a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ResultSet (f a) -> f (ResultSet a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ResultSet a -> m (ResultSet b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ResultSet a -> m (ResultSet b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ResultSet (m a) -> m (ResultSet a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ResultSet (m a) -> m (ResultSet a)
Traversable)

-- | A more descriptive type than using a simple bool to represent `hasMore`
data ResultSetType
  = ResultSetComplete
  | ResultSetTruncated
  deriving stock (ResultSetType -> ResultSetType -> Bool
(ResultSetType -> ResultSetType -> Bool)
-> (ResultSetType -> ResultSetType -> Bool) -> Eq ResultSetType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResultSetType -> ResultSetType -> Bool
== :: ResultSetType -> ResultSetType -> Bool
$c/= :: ResultSetType -> ResultSetType -> Bool
/= :: ResultSetType -> ResultSetType -> Bool
Eq, Int -> ResultSetType -> ShowS
[ResultSetType] -> ShowS
ResultSetType -> String
(Int -> ResultSetType -> ShowS)
-> (ResultSetType -> String)
-> ([ResultSetType] -> ShowS)
-> Show ResultSetType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResultSetType -> ShowS
showsPrec :: Int -> ResultSetType -> ShowS
$cshow :: ResultSetType -> String
show :: ResultSetType -> String
$cshowList :: [ResultSetType] -> ShowS
showList :: [ResultSetType] -> ShowS
Show)

mkResultSet :: Page a -> ResultSet a
mkResultSet :: forall a. Page a -> ResultSet a
mkResultSet Page a
page = [a] -> ResultSetType -> ResultSet a
forall a. [a] -> ResultSetType -> ResultSet a
ResultSet (Page a -> [a]
forall a. Page a -> [a]
result Page a
page) ResultSetType
typ
  where
    typ :: ResultSetType
typ
      | Page a -> Bool
forall a. Page a -> Bool
hasMore Page a
page = ResultSetType
ResultSetTruncated
      | Bool
otherwise = ResultSetType
ResultSetComplete