-- 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/>.
{-# LANGUAGE OverloadedLists #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Wire.API.Component
  ( Component (..),
    ShowComponent,
  )
where

import Data.Aeson
import Data.Schema
import GHC.TypeLits
import Imports
import Servant.API
import Test.QuickCheck (Arbitrary)
import Wire.Arbitrary (GenericUniform (..))

data Component
  = Brig
  | Galley
  | Cargohold
  deriving (Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
(Int -> Component -> ShowS)
-> (Component -> String)
-> ([Component] -> ShowS)
-> Show Component
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Component -> ShowS
showsPrec :: Int -> Component -> ShowS
$cshow :: Component -> String
show :: Component -> String
$cshowList :: [Component] -> ShowS
showList :: [Component] -> ShowS
Show, Component -> Component -> Bool
(Component -> Component -> Bool)
-> (Component -> Component -> Bool) -> Eq Component
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Component -> Component -> Bool
== :: Component -> Component -> Bool
$c/= :: Component -> Component -> Bool
/= :: Component -> Component -> Bool
Eq, (forall x. Component -> Rep Component x)
-> (forall x. Rep Component x -> Component) -> Generic Component
forall x. Rep Component x -> Component
forall x. Component -> Rep Component x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Component -> Rep Component x
from :: forall x. Component -> Rep Component x
$cto :: forall x. Rep Component x -> Component
to :: forall x. Rep Component x -> Component
Generic)
  deriving (Gen Component
Gen Component -> (Component -> [Component]) -> Arbitrary Component
Component -> [Component]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Component
arbitrary :: Gen Component
$cshrink :: Component -> [Component]
shrink :: Component -> [Component]
Arbitrary) via (GenericUniform Component)
  deriving ([Component] -> Value
[Component] -> Encoding
Component -> Value
Component -> Encoding
(Component -> Value)
-> (Component -> Encoding)
-> ([Component] -> Value)
-> ([Component] -> Encoding)
-> ToJSON Component
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Component -> Value
toJSON :: Component -> Value
$ctoEncoding :: Component -> Encoding
toEncoding :: Component -> Encoding
$ctoJSONList :: [Component] -> Value
toJSONList :: [Component] -> Value
$ctoEncodingList :: [Component] -> Encoding
toEncodingList :: [Component] -> Encoding
ToJSON, Value -> Parser [Component]
Value -> Parser Component
(Value -> Parser Component)
-> (Value -> Parser [Component]) -> FromJSON Component
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Component
parseJSON :: Value -> Parser Component
$cparseJSONList :: Value -> Parser [Component]
parseJSONList :: Value -> Parser [Component]
FromJSON) via (Schema Component)

instance ToSchema Component where
  schema :: ValueSchema NamedSwaggerDoc Component
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"Component" (SchemaP [Value] Text (Alt Maybe Text) Component Component
 -> ValueSchema NamedSwaggerDoc Component)
-> SchemaP [Value] Text (Alt Maybe Text) Component Component
-> ValueSchema NamedSwaggerDoc Component
forall a b. (a -> b) -> a -> b
$
      [SchemaP [Value] Text (Alt Maybe Text) Component Component]
-> SchemaP [Value] Text (Alt Maybe Text) Component Component
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> Component
-> SchemaP [Value] Text (Alt Maybe Text) Component Component
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"brig" Component
Brig,
          Text
-> Component
-> SchemaP [Value] Text (Alt Maybe Text) Component Component
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"galley" Component
Galley,
          Text
-> Component
-> SchemaP [Value] Text (Alt Maybe Text) Component Component
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"cargohold" Component
Cargohold
        ]

instance FromHttpApiData Component where
  parseUrlPiece :: Text -> Either Text Component
  parseUrlPiece :: Text -> Either Text Component
parseUrlPiece = \case
    Text
"brig" -> Component -> Either Text Component
forall a b. b -> Either a b
Right Component
Brig
    Text
"galley" -> Component -> Either Text Component
forall a b. b -> Either a b
Right Component
Galley
    Text
"cargohold" -> Component -> Either Text Component
forall a b. b -> Either a b
Right Component
Cargohold
    Text
c -> Text -> Either Text Component
forall a b. a -> Either a b
Left (Text -> Either Text Component) -> Text -> Either Text Component
forall a b. (a -> b) -> a -> b
$ Text
"Invalid component: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c

instance ToHttpApiData Component where
  toUrlPiece :: Component -> Text
toUrlPiece = \case
    Component
Brig -> Text
"brig"
    Component
Galley -> Text
"galley"
    Component
Cargohold -> Text
"cargohold"

-- | Get a symbol representation of our component.
type family ShowComponent (x :: Component) = (res :: Symbol) | res -> x where
  ShowComponent 'Brig = "brig"
  ShowComponent 'Galley = "galley"
  ShowComponent 'Cargohold = "cargohold"