-- 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.Error.Empty where

import Control.Lens ((.~))
import Data.OpenApi qualified as S
import Data.Text qualified as Text
import GHC.TypeLits
import Imports
import Network.HTTP.Types as HTTP
import Servant
import Servant.API.Status
import Servant.Client.Core
import Wire.API.Routes.MultiVerb

data EmptyErrorForLegacyReasons s desc

type instance ResponseType (EmptyErrorForLegacyReasons s desc) = ()

instance
  (KnownStatus s) =>
  IsResponse cs (EmptyErrorForLegacyReasons s desc)
  where
  type ResponseStatus (EmptyErrorForLegacyReasons s desc) = s
  type ResponseBody (EmptyErrorForLegacyReasons s desc) = ()

  responseRender :: AcceptHeader
-> ResponseType (EmptyErrorForLegacyReasons s desc)
-> Maybe
     (ResponseF (ResponseBody (EmptyErrorForLegacyReasons s desc)))
responseRender AcceptHeader
_ () =
    ResponseF (ResponseBody (EmptyErrorForLegacyReasons s desc))
-> Maybe
     (ResponseF (ResponseBody (EmptyErrorForLegacyReasons s desc)))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResponseF (ResponseBody (EmptyErrorForLegacyReasons s desc))
 -> Maybe
      (ResponseF (ResponseBody (EmptyErrorForLegacyReasons s desc))))
-> ResponseF (ResponseBody (EmptyErrorForLegacyReasons s desc))
-> Maybe
     (ResponseF (ResponseBody (EmptyErrorForLegacyReasons s desc)))
forall a b. (a -> b) -> a -> b
$
      forall {k} (ct :: k) a. Accept ct => ResponseF a -> ResponseF a
forall ct a. Accept ct => ResponseF a -> ResponseF a
addContentType @PlainText
        Response
          { responseStatusCode :: Status
responseStatusCode = Proxy s -> Status
forall (n :: Nat) (proxy :: Nat -> *).
KnownStatus n =>
proxy n -> Status
forall (proxy :: Nat -> *). proxy s -> Status
statusVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @s),
            responseHeaders :: Seq Header
responseHeaders = Seq Header
forall a. Monoid a => a
mempty,
            responseBody :: ()
responseBody = (),
            responseHttpVersion :: HttpVersion
responseHttpVersion = HttpVersion
HTTP.http11
          }

  responseUnrender :: MediaType
-> ResponseF (ResponseBody (EmptyErrorForLegacyReasons s desc))
-> UnrenderResult
     (ResponseType (EmptyErrorForLegacyReasons s desc))
responseUnrender MediaType
_ ResponseF (ResponseBody (EmptyErrorForLegacyReasons s desc))
output = Bool -> UnrenderResult ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ResponseF () -> Status
forall a. ResponseF a -> Status
responseStatusCode ResponseF ()
ResponseF (ResponseBody (EmptyErrorForLegacyReasons s desc))
output Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy s -> Status
forall (n :: Nat) (proxy :: Nat -> *).
KnownStatus n =>
proxy n -> Status
forall (proxy :: Nat -> *). proxy s -> Status
statusVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @s))

instance
  (KnownSymbol desc) =>
  IsSwaggerResponse (EmptyErrorForLegacyReasons s desc)
  where
  responseSwagger :: Declare Response
responseSwagger =
    Response -> Declare Response
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> Declare Response) -> Response -> Declare Response
forall a b. (a -> b) -> a -> b
$
      Response
forall a. Monoid a => a
mempty
        Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> Response -> Identity Response
forall s a. HasDescription s a => Lens' s a
Lens' Response Text
S.description
          ((Text -> Identity Text) -> Response -> Identity Response)
-> Text -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( String -> Text
Text.pack (Proxy desc -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @desc))
                 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(**Note**: This error has an empty body for legacy reasons)"
             )