{-# LANGUAGE TemplateHaskell #-}

-- 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.Bot.Service
  ( Service (..),
    newService,
    serviceRef,
    serviceUrl,
    serviceToken,
    serviceFingerprints,
    serviceEnabled,
  )
where

import Control.Lens (makeLenses)
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Misc (Fingerprint, HttpsUrl, Rsa)
import Data.OpenApi qualified as S
import Data.Schema
import Imports
import Wire.API.Provider.Service hiding (Service (..))

-- Service --------------------------------------------------------------------

-- | Internal service connection information that is needed by galley.
data Service = Service
  { Service -> ServiceRef
_serviceRef :: !ServiceRef,
    Service -> HttpsUrl
_serviceUrl :: !HttpsUrl,
    Service -> ServiceToken
_serviceToken :: !ServiceToken,
    Service -> [Fingerprint Rsa]
_serviceFingerprints :: ![Fingerprint Rsa],
    Service -> Bool
_serviceEnabled :: !Bool
  }
  deriving (Value -> Parser [Service]
Value -> Parser Service
(Value -> Parser Service)
-> (Value -> Parser [Service]) -> FromJSON Service
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Service
parseJSON :: Value -> Parser Service
$cparseJSONList :: Value -> Parser [Service]
parseJSONList :: Value -> Parser [Service]
FromJSON, [Service] -> Value
[Service] -> Encoding
Service -> Value
Service -> Encoding
(Service -> Value)
-> (Service -> Encoding)
-> ([Service] -> Value)
-> ([Service] -> Encoding)
-> ToJSON Service
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Service -> Value
toJSON :: Service -> Value
$ctoEncoding :: Service -> Encoding
toEncoding :: Service -> Encoding
$ctoJSONList :: [Service] -> Value
toJSONList :: [Service] -> Value
$ctoEncodingList :: [Service] -> Encoding
toEncodingList :: [Service] -> Encoding
ToJSON, Typeable Service
Typeable Service =>
(Proxy Service -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Service
Proxy Service -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Service -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Service -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema Service

newService :: ServiceRef -> HttpsUrl -> ServiceToken -> [Fingerprint Rsa] -> Service
newService :: ServiceRef
-> HttpsUrl -> ServiceToken -> [Fingerprint Rsa] -> Service
newService ServiceRef
ref HttpsUrl
url ServiceToken
tok [Fingerprint Rsa]
fps = ServiceRef
-> HttpsUrl -> ServiceToken -> [Fingerprint Rsa] -> Bool -> Service
Service ServiceRef
ref HttpsUrl
url ServiceToken
tok [Fingerprint Rsa]
fps Bool
True

instance ToSchema Service where
  schema :: ValueSchema NamedSwaggerDoc Service
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] Service Service
-> ValueSchema NamedSwaggerDoc Service
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"BotService" (SchemaP SwaggerDoc Object [Pair] Service Service
 -> ValueSchema NamedSwaggerDoc Service)
-> SchemaP SwaggerDoc Object [Pair] Service Service
-> ValueSchema NamedSwaggerDoc Service
forall a b. (a -> b) -> a -> b
$
      ServiceRef
-> HttpsUrl -> ServiceToken -> [Fingerprint Rsa] -> Bool -> Service
Service
        (ServiceRef
 -> HttpsUrl
 -> ServiceToken
 -> [Fingerprint Rsa]
 -> Bool
 -> Service)
-> SchemaP SwaggerDoc Object [Pair] Service ServiceRef
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Service
     (HttpsUrl -> ServiceToken -> [Fingerprint Rsa] -> Bool -> Service)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Service -> ServiceRef
_serviceRef (Service -> ServiceRef)
-> SchemaP SwaggerDoc Object [Pair] ServiceRef ServiceRef
-> SchemaP SwaggerDoc Object [Pair] Service ServiceRef
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ServiceRef ServiceRef
-> SchemaP SwaggerDoc Object [Pair] ServiceRef ServiceRef
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"ref" SchemaP NamedSwaggerDoc Value Value ServiceRef ServiceRef
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Service
  (HttpsUrl -> ServiceToken -> [Fingerprint Rsa] -> Bool -> Service)
-> SchemaP SwaggerDoc Object [Pair] Service HttpsUrl
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Service
     (ServiceToken -> [Fingerprint Rsa] -> Bool -> Service)
forall a b.
SchemaP SwaggerDoc Object [Pair] Service (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Service a
-> SchemaP SwaggerDoc Object [Pair] Service b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Service -> HttpsUrl
_serviceUrl (Service -> HttpsUrl)
-> SchemaP SwaggerDoc Object [Pair] HttpsUrl HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] Service HttpsUrl
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value HttpsUrl HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] HttpsUrl HttpsUrl
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"base_url" SchemaP NamedSwaggerDoc Value Value HttpsUrl HttpsUrl
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Service
  (ServiceToken -> [Fingerprint Rsa] -> Bool -> Service)
-> SchemaP SwaggerDoc Object [Pair] Service ServiceToken
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Service
     ([Fingerprint Rsa] -> Bool -> Service)
forall a b.
SchemaP SwaggerDoc Object [Pair] Service (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Service a
-> SchemaP SwaggerDoc Object [Pair] Service b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Service -> ServiceToken
_serviceToken (Service -> ServiceToken)
-> SchemaP SwaggerDoc Object [Pair] ServiceToken ServiceToken
-> SchemaP SwaggerDoc Object [Pair] Service ServiceToken
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ServiceToken ServiceToken
-> SchemaP SwaggerDoc Object [Pair] ServiceToken ServiceToken
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"auth_token" SchemaP NamedSwaggerDoc Value Value ServiceToken ServiceToken
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Service
  ([Fingerprint Rsa] -> Bool -> Service)
-> SchemaP SwaggerDoc Object [Pair] Service [Fingerprint Rsa]
-> SchemaP SwaggerDoc Object [Pair] Service (Bool -> Service)
forall a b.
SchemaP SwaggerDoc Object [Pair] Service (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Service a
-> SchemaP SwaggerDoc Object [Pair] Service b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Service -> [Fingerprint Rsa]
_serviceFingerprints (Service -> [Fingerprint Rsa])
-> SchemaP
     SwaggerDoc Object [Pair] [Fingerprint Rsa] [Fingerprint Rsa]
-> SchemaP SwaggerDoc Object [Pair] Service [Fingerprint Rsa]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     SwaggerDoc Value Value [Fingerprint Rsa] [Fingerprint Rsa]
-> SchemaP
     SwaggerDoc Object [Pair] [Fingerprint Rsa] [Fingerprint Rsa]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"fingerprints" (ValueSchema NamedSwaggerDoc (Fingerprint Rsa)
-> SchemaP
     SwaggerDoc Value Value [Fingerprint Rsa] [Fingerprint Rsa]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc (Fingerprint Rsa)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP SwaggerDoc Object [Pair] Service (Bool -> Service)
-> SchemaP SwaggerDoc Object [Pair] Service Bool
-> SchemaP SwaggerDoc Object [Pair] Service Service
forall a b.
SchemaP SwaggerDoc Object [Pair] Service (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Service a
-> SchemaP SwaggerDoc Object [Pair] Service b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Service -> Bool
_serviceEnabled (Service -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Service Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"enabled" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

makeLenses ''Service