{-# LANGUAGE DerivingVia #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- 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.Public.Util where

import Control.Comonad
import Data.Maybe
import Data.SOP (I (..), NS (..))
import Servant
import Servant.OpenApi.Internal.Orphans ()
import Wire.API.Routes.MultiVerb

instance
  (ResponseType r1 ~ a, ResponseType r2 ~ a) =>
  AsUnion '[r1, r2] (ResponseForExistedCreated a)
  where
  toUnion :: ResponseForExistedCreated a -> Union (ResponseTypes '[r1, r2])
toUnion (Existed a
x) = I a -> NS I '[a, a]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (a -> I a
forall a. a -> I a
I a
x)
  toUnion (Created a
x) = NS I '[a] -> NS I '[a, a]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (I a -> NS I '[a]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (a -> I a
forall a. a -> I a
I a
x))

  fromUnion :: Union (ResponseTypes '[r1, r2]) -> ResponseForExistedCreated a
fromUnion (Z (I x
x)) = a -> ResponseForExistedCreated a
forall a. a -> ResponseForExistedCreated a
Existed a
x
x
  fromUnion (S (Z (I x
x))) = a -> ResponseForExistedCreated a
forall a. a -> ResponseForExistedCreated a
Created a
x
x
  fromUnion (S (S NS I xs
x)) = case NS I xs
x of {}

-- Note: order is important here; if you swap Existed with Created, the wrong
-- status codes will be returned. Keep the Order in ResponseForExistedCreated
-- and the corresponding type the same.
data ResponseForExistedCreated a
  = Existed !a
  | Created !a
  deriving ((forall a b.
 (a -> b)
 -> ResponseForExistedCreated a -> ResponseForExistedCreated b)
-> (forall a b.
    a -> ResponseForExistedCreated b -> ResponseForExistedCreated a)
-> Functor ResponseForExistedCreated
forall a b.
a -> ResponseForExistedCreated b -> ResponseForExistedCreated a
forall a b.
(a -> b)
-> ResponseForExistedCreated a -> ResponseForExistedCreated 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)
-> ResponseForExistedCreated a -> ResponseForExistedCreated b
fmap :: forall a b.
(a -> b)
-> ResponseForExistedCreated a -> ResponseForExistedCreated b
$c<$ :: forall a b.
a -> ResponseForExistedCreated b -> ResponseForExistedCreated a
<$ :: forall a b.
a -> ResponseForExistedCreated b -> ResponseForExistedCreated a
Functor)

instance Comonad ResponseForExistedCreated where
  extract :: forall a. ResponseForExistedCreated a -> a
extract (Existed a
x) = a
x
  extract (Created a
x) = a
x

  duplicate :: forall a.
ResponseForExistedCreated a
-> ResponseForExistedCreated (ResponseForExistedCreated a)
duplicate r :: ResponseForExistedCreated a
r@(Existed a
_) = ResponseForExistedCreated a
-> ResponseForExistedCreated (ResponseForExistedCreated a)
forall a. a -> ResponseForExistedCreated a
Existed ResponseForExistedCreated a
r
  duplicate r :: ResponseForExistedCreated a
r@(Created a
_) = ResponseForExistedCreated a
-> ResponseForExistedCreated (ResponseForExistedCreated a)
forall a. a -> ResponseForExistedCreated a
Created ResponseForExistedCreated a
r

type ResponsesForExistedCreated eDesc cDesc a =
  '[ Respond 200 eDesc a,
     Respond 201 cDesc a
   ]

data UpdateResult a
  = Unchanged
  | Updated !a
  deriving ((forall a b. (a -> b) -> UpdateResult a -> UpdateResult b)
-> (forall a b. a -> UpdateResult b -> UpdateResult a)
-> Functor UpdateResult
forall a b. a -> UpdateResult b -> UpdateResult a
forall a b. (a -> b) -> UpdateResult a -> UpdateResult 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) -> UpdateResult a -> UpdateResult b
fmap :: forall a b. (a -> b) -> UpdateResult a -> UpdateResult b
$c<$ :: forall a b. a -> UpdateResult b -> UpdateResult a
<$ :: forall a b. a -> UpdateResult b -> UpdateResult a
Functor)

mkUpdateResult :: Maybe a -> UpdateResult a
mkUpdateResult :: forall a. Maybe a -> UpdateResult a
mkUpdateResult = UpdateResult a
-> (a -> UpdateResult a) -> Maybe a -> UpdateResult a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UpdateResult a
forall a. UpdateResult a
Unchanged a -> UpdateResult a
forall a. a -> UpdateResult a
Updated

type UpdateResponses unchangedDesc updatedDesc a =
  '[ RespondEmpty 204 unchangedDesc,
     Respond 200 updatedDesc a
   ]

instance
  (ResponseType r1 ~ (), ResponseType r2 ~ a) =>
  AsUnion '[r1, r2] (UpdateResult a)
  where
  toUnion :: UpdateResult a -> Union (ResponseTypes '[r1, r2])
toUnion UpdateResult a
Unchanged = I () -> NS I '[(), a]
forall {k} (x :: k) (xs :: [k]) (f :: k -> *).
UElem x xs =>
f x -> NS f xs
forall (f :: * -> *). f () -> NS f '[(), a]
inject (() -> I ()
forall a. a -> I a
I ())
  toUnion (Updated a
a) = I a -> NS I '[(), a]
forall {k} (x :: k) (xs :: [k]) (f :: k -> *).
UElem x xs =>
f x -> NS f xs
forall (f :: * -> *). f a -> NS f '[(), a]
inject (a -> I a
forall a. a -> I a
I a
a)

  fromUnion :: Union (ResponseTypes '[r1, r2]) -> UpdateResult a
fromUnion (Z (I ())) = UpdateResult a
forall a. UpdateResult a
Unchanged
  fromUnion (S (Z (I x
a))) = a -> UpdateResult a
forall a. a -> UpdateResult a
Updated a
x
a
  fromUnion (S (S NS I xs
x)) = case NS I xs
x of {}

type PaginationDocs =
  "The IDs returned by this endpoint are paginated. To get the first page, make\
  \ a call with the `paging_state` field set to `null` (or omitted). Whenever the\
  \ `has_more` field of the response is set to `true`, more results are available,\
  \ and they can be obtained by calling the endpoint again, but this time passing\
  \ the value of `paging_state` returned by the previous call. One can continue in\
  \ this fashion until all results are returned, which is indicated by `has_more`\
  \ being `false`. Note that `paging_state` should be considered an opaque token.\
  \ It should not be inspected, or stored, or reused across multiple unrelated\
  \ invocations of the endpoint."