{-# LANGUAGE RecordWildCards #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2020 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 Web.Scim.Schema.ListResponse
  ( ListResponse (..),
    fromList,
  )
where

import Data.Aeson
import GHC.Generics (Generic)
import Web.Scim.Schema.Common
import Web.Scim.Schema.Schema

-- | A "pagination" type used as a wrapper whenever a SCIM endpoint has to
-- return a list.
--
-- Pagination is not actually supported anywhere in the code yet; whenever
-- there are several results we always return them all as one page, and we
-- don't support different values of 'startIndex'.
--
-- FUTUREWORK: Support for pagination might be added once we have to handle
-- organizations with lots of users.
data ListResponse a = ListResponse
  { ListResponse a -> [Schema]
schemas :: [Schema],
    ListResponse a -> Int
totalResults :: Int,
    ListResponse a -> Int
itemsPerPage :: Int,
    ListResponse a -> Int
startIndex :: Int,
    ListResponse a -> [a]
resources :: [a]
  }
  deriving (Int -> ListResponse a -> ShowS
[ListResponse a] -> ShowS
ListResponse a -> String
(Int -> ListResponse a -> ShowS)
-> (ListResponse a -> String)
-> ([ListResponse a] -> ShowS)
-> Show (ListResponse a)
forall a. Show a => Int -> ListResponse a -> ShowS
forall a. Show a => [ListResponse a] -> ShowS
forall a. Show a => ListResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListResponse a] -> ShowS
$cshowList :: forall a. Show a => [ListResponse a] -> ShowS
show :: ListResponse a -> String
$cshow :: forall a. Show a => ListResponse a -> String
showsPrec :: Int -> ListResponse a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ListResponse a -> ShowS
Show, ListResponse a -> ListResponse a -> Bool
(ListResponse a -> ListResponse a -> Bool)
-> (ListResponse a -> ListResponse a -> Bool)
-> Eq (ListResponse a)
forall a. Eq a => ListResponse a -> ListResponse a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListResponse a -> ListResponse a -> Bool
$c/= :: forall a. Eq a => ListResponse a -> ListResponse a -> Bool
== :: ListResponse a -> ListResponse a -> Bool
$c== :: forall a. Eq a => ListResponse a -> ListResponse a -> Bool
Eq, (forall x. ListResponse a -> Rep (ListResponse a) x)
-> (forall x. Rep (ListResponse a) x -> ListResponse a)
-> Generic (ListResponse a)
forall x. Rep (ListResponse a) x -> ListResponse a
forall x. ListResponse a -> Rep (ListResponse a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ListResponse a) x -> ListResponse a
forall a x. ListResponse a -> Rep (ListResponse a) x
$cto :: forall a x. Rep (ListResponse a) x -> ListResponse a
$cfrom :: forall a x. ListResponse a -> Rep (ListResponse a) x
Generic)

fromList :: [a] -> ListResponse a
fromList :: [a] -> ListResponse a
fromList [a]
list =
  ListResponse :: forall a. [Schema] -> Int -> Int -> Int -> [a] -> ListResponse a
ListResponse
    { schemas :: [Schema]
schemas = [Schema
ListResponse20],
      totalResults :: Int
totalResults = Int
len,
      itemsPerPage :: Int
itemsPerPage = Int
len,
      startIndex :: Int
startIndex = Int
1, -- NOTE: lists are 1-indexed in SCIM
      resources :: [a]
resources = [a]
list
    }
  where
    len :: Int
len = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
list

instance FromJSON a => FromJSON (ListResponse a) where
  parseJSON :: Value -> Parser (ListResponse a)
parseJSON = Options -> Value -> Parser (ListResponse a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
parseOptions (Value -> Parser (ListResponse a))
-> (Value -> Value) -> Value -> Parser (ListResponse a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value
jsonLower

instance ToJSON a => ToJSON (ListResponse a) where
  toJSON :: ListResponse a -> Value
toJSON ListResponse {Int
[a]
[Schema]
resources :: [a]
startIndex :: Int
itemsPerPage :: Int
totalResults :: Int
schemas :: [Schema]
resources :: forall a. ListResponse a -> [a]
startIndex :: forall a. ListResponse a -> Int
itemsPerPage :: forall a. ListResponse a -> Int
totalResults :: forall a. ListResponse a -> Int
schemas :: forall a. ListResponse a -> [Schema]
..} =
    [Pair] -> Value
object
      [ Text
"Resources" Text -> [a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [a]
resources,
        Text
"schemas" Text -> [Schema] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Schema]
schemas,
        Text
"totalResults" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
totalResults,
        Text
"itemsPerPage" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
itemsPerPage,
        Text
"startIndex" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
startIndex
      ]