[WPB-664] Servantify brig Provider API (#3547)

* provider register * swagger * linter * provider activate * account approval is not needed * login * removed redundant apitags * provider begin password reset * complete password reset * wip * delete account * provider update * provider update email * update provider email * get provider and provider profile * require user id, but ignore it * changelog
wireapp · Oct 2, 2023 · 5f246fb · 5f246fb
1 parent 2ca6e3a
commit 5f246fb
Show file tree

Hide file tree

Showing 11 changed files with 402 additions and 305 deletions.
diff --git a/changelog.d/5-internal/WPB-664 b/changelog.d/5-internal/WPB-664
@@ -0,0 +1 @@
+Provider API has been migrated to servant
diff --git a/libs/wire-api/src/Wire/API/Error/Brig.hs b/libs/wire-api/src/Wire/API/Error/Brig.hs
@@ -86,10 +86,19 @@ data BrigError
   | TooManyConversationMembers
   | ServiceDisabled
   | InvalidBot
+  | VerificationCodeThrottled
+  | InvalidProvider
+  | ProviderNotFound
 
 instance (Typeable (MapError e), KnownError (MapError e)) => IsSwaggerError (e :: BrigError) where
   addToOpenApi = addStaticErrorToSwagger @(MapError e)
 
+type instance MapError 'ProviderNotFound = 'StaticError 404 "not-found" "Provider not found."
+
+type instance MapError 'InvalidProvider = 'StaticError 403 "invalid-provider" "The provider does not exist."
+
+type instance MapError 'VerificationCodeThrottled = 'StaticError 429 "too-many-requests" "Too many request to generate a verification code."
+
 type instance MapError 'ServiceDisabled = 'StaticError 403 "service-disabled" "The desired service is currently disabled."
 
 type instance MapError 'InvalidBot = 'StaticError 403 "invalid-bot" "The targeted user is not a bot."

diff --git a/libs/wire-api/src/Wire/API/Provider.hs b/libs/wire-api/src/Wire/API/Provider.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StrictData #-}
-{-# LANGUAGE TemplateHaskell #-}
 
 -- This file is part of the Wire Server implementation.
 --
@@ -52,12 +51,12 @@ module Wire.API.Provider
   )
 where
 
-import Data.Aeson
-import Data.Aeson.TH
+import Data.Aeson qualified as A
 import Data.Id
-import Data.Json.Util
 import Data.Misc (HttpsUrl (..), PlainTextPassword6, PlainTextPassword8)
 import Data.Range
+import Data.Schema
+import Data.Swagger qualified as S
 import Imports
 import Wire.API.Conversation.Code as Code
 import Wire.API.Provider.Service (ServiceToken (..))
@@ -79,32 +78,24 @@ data Provider = Provider
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform Provider)
-
-instance ToJSON Provider where
-  toJSON p =
-    object $
-      "id" .= providerId p
-        # "name" .= providerName p
-        # "email" .= providerEmail p
-        # "url" .= providerUrl p
-        # "description" .= providerDescr p
-        # []
-
-instance FromJSON Provider where
-  parseJSON = withObject "Provider" $ \o ->
-    Provider
-      <$> o .: "id"
-      <*> o .: "name"
-      <*> o .: "email"
-      <*> o .: "url"
-      <*> o .: "description"
+  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema Provider
+
+instance ToSchema Provider where
+  schema =
+    object "Provider" $
+      Provider
+        <$> providerId .= field "id" schema
+        <*> providerName .= field "name" schema
+        <*> providerEmail .= field "email" schema
+        <*> providerUrl .= field "url" schema
+        <*> providerDescr .= field "description" schema
 
 -- | A provider profile as seen by regular users.
 -- Note: This is a placeholder that may evolve to contain only a subset of
 -- the full provider information.
 newtype ProviderProfile = ProviderProfile Provider
   deriving stock (Eq, Show)
-  deriving newtype (FromJSON, ToJSON, Arbitrary)
+  deriving newtype (A.FromJSON, A.ToJSON, Arbitrary, S.ToSchema)
 
 --------------------------------------------------------------------------------
 -- NewProvider
@@ -120,25 +111,17 @@ data NewProvider = NewProvider
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform NewProvider)
-
-instance ToJSON NewProvider where
-  toJSON p =
-    object $
-      "name" .= newProviderName p
-        # "email" .= newProviderEmail p
-        # "url" .= newProviderUrl p
-        # "description" .= newProviderDescr p
-        # "password" .= newProviderPassword p
-        # []
-
-instance FromJSON NewProvider where
-  parseJSON = withObject "NewProvider" $ \o ->
-    NewProvider
-      <$> o .: "name"
-      <*> o .: "email"
-      <*> o .: "url"
-      <*> o .: "description"
-      <*> o .:? "password"
+  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema NewProvider
+
+instance ToSchema NewProvider where
+  schema =
+    object "NewProvider" $
+      NewProvider
+        <$> newProviderName .= field "name" schema
+        <*> newProviderEmail .= field "email" schema
+        <*> newProviderUrl .= field "url" schema
+        <*> newProviderDescr .= field "description" schema
+        <*> newProviderPassword .= maybe_ (optField "password" schema)
 
 -- | Response data upon registering a new provider.
 data NewProviderResponse = NewProviderResponse
@@ -149,19 +132,14 @@ data NewProviderResponse = NewProviderResponse
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform NewProviderResponse)
+  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema NewProviderResponse
 
-instance ToJSON NewProviderResponse where
-  toJSON r =
-    object $
-      "id" .= rsNewProviderId r
-        # "password" .= rsNewProviderPassword r
-        # []
-
-instance FromJSON NewProviderResponse where
-  parseJSON = withObject "NewProviderResponse" $ \o ->
-    NewProviderResponse
-      <$> o .: "id"
-      <*> o .:? "password"
+instance ToSchema NewProviderResponse where
+  schema =
+    object "NewProviderResponse" $
+      NewProviderResponse
+        <$> rsNewProviderId .= field "id" schema
+        <*> rsNewProviderPassword .= maybe_ (optField "password" schema)
 
 --------------------------------------------------------------------------------
 -- UpdateProvider
@@ -174,21 +152,15 @@ data UpdateProvider = UpdateProvider
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform UpdateProvider)
+  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema UpdateProvider
 
-instance ToJSON UpdateProvider where
-  toJSON p =
-    object $
-      "name" .= updateProviderName p
-        # "url" .= updateProviderUrl p
-        # "description" .= updateProviderDescr p
-        # []
-
-instance FromJSON UpdateProvider where
-  parseJSON = withObject "UpdateProvider" $ \o ->
-    UpdateProvider
-      <$> o .:? "name"
-      <*> o .:? "url"
-      <*> o .:? "description"
+instance ToSchema UpdateProvider where
+  schema =
+    object "UpdateProvider" $
+      UpdateProvider
+        <$> updateProviderName .= maybe_ (optField "name" schema)
+        <*> updateProviderUrl .= maybe_ (optField "url" schema)
+        <*> updateProviderDescr .= maybe_ (optField "description" schema)
 
 --------------------------------------------------------------------------------
 -- ProviderActivationResponse
@@ -199,14 +171,13 @@ newtype ProviderActivationResponse = ProviderActivationResponse
   {activatedProviderIdentity :: Email}
   deriving stock (Eq, Show)
   deriving newtype (Arbitrary)
+  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema ProviderActivationResponse
 
-instance ToJSON ProviderActivationResponse where
-  toJSON (ProviderActivationResponse e) =
-    object ["email" .= e]
-
-instance FromJSON ProviderActivationResponse where
-  parseJSON = withObject "ProviderActivationResponse" $ \o ->
-    ProviderActivationResponse <$> o .: "email"
+instance ToSchema ProviderActivationResponse where
+  schema =
+    object "ProviderActivationResponse" $
+      ProviderActivationResponse
+        <$> activatedProviderIdentity .= field "email" schema
 
 --------------------------------------------------------------------------------
 -- ProviderLogin
@@ -218,19 +189,14 @@ data ProviderLogin = ProviderLogin
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform ProviderLogin)
+  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema ProviderLogin
 
-instance ToJSON ProviderLogin where
-  toJSON l =
-    object
-      [ "email" .= providerLoginEmail l,
-        "password" .= providerLoginPassword l
-      ]
-
-instance FromJSON ProviderLogin where
-  parseJSON = withObject "ProviderLogin" $ \o ->
-    ProviderLogin
-      <$> o .: "email"
-      <*> o .: "password"
+instance ToSchema ProviderLogin where
+  schema =
+    object "ProviderLogin" $
+      ProviderLogin
+        <$> providerLoginEmail .= field "email" schema
+        <*> providerLoginPassword .= field "password" schema
 
 --------------------------------------------------------------------------------
 -- DeleteProvider
@@ -240,16 +206,13 @@ newtype DeleteProvider = DeleteProvider
   {deleteProviderPassword :: PlainTextPassword6}
   deriving stock (Eq, Show)
   deriving newtype (Arbitrary)
+  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema DeleteProvider
 
-instance ToJSON DeleteProvider where
-  toJSON d =
-    object
-      [ "password" .= deleteProviderPassword d
-      ]
-
-instance FromJSON DeleteProvider where
-  parseJSON = withObject "DeleteProvider" $ \o ->
-    DeleteProvider <$> o .: "password"
+instance ToSchema DeleteProvider where
+  schema =
+    object "DeleteProvider" $
+      DeleteProvider
+        <$> deleteProviderPassword .= field "password" schema
 
 --------------------------------------------------------------------------------
 -- Password Change/Reset
@@ -258,8 +221,13 @@ instance FromJSON DeleteProvider where
 newtype PasswordReset = PasswordReset {email :: Email}
   deriving stock (Eq, Show)
   deriving newtype (Arbitrary)
+  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema PasswordReset
 
-deriveJSON toJSONFieldName ''PasswordReset
+instance ToSchema PasswordReset where
+  schema =
+    object "PasswordReset" $
+      PasswordReset
+        <$> (.email) .= field "email" schema
 
 -- | The payload for completing a password reset.
 data CompletePasswordReset = CompletePasswordReset
@@ -269,8 +237,15 @@ data CompletePasswordReset = CompletePasswordReset
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform CompletePasswordReset)
+  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema CompletePasswordReset
 
-deriveJSON toJSONFieldName ''CompletePasswordReset
+instance ToSchema CompletePasswordReset where
+  schema =
+    object "CompletePasswordReset" $
+      CompletePasswordReset
+        <$> key .= field "key" schema
+        <*> (.code) .= field "code" schema
+        <*> (.password) .= field "password" schema
 
 -- | The payload for changing a password.
 data PasswordChange = PasswordChange
@@ -279,12 +254,23 @@ data PasswordChange = PasswordChange
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform PasswordChange)
+  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema PasswordChange
 
-deriveJSON toJSONFieldName ''PasswordChange
+instance ToSchema PasswordChange where
+  schema =
+    object "PasswordChange" $
+      PasswordChange
+        <$> oldPassword .= field "old_password" schema
+        <*> newPassword .= field "new_password" schema
 
 -- | The payload for updating an email address
 newtype EmailUpdate = EmailUpdate {email :: Email}
   deriving stock (Eq, Show, Generic)
   deriving newtype (Arbitrary)
+  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema EmailUpdate
 
-deriveJSON toJSONFieldName ''EmailUpdate
+instance ToSchema EmailUpdate where
+  schema =
+    object "EmailUpdate" $
+      EmailUpdate
+        <$> (.email) .= field "email" schema
diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs
@@ -58,6 +58,7 @@ import Wire.API.Routes.Named
 import Wire.API.Routes.Public
 import Wire.API.Routes.Public.Brig.Bot (BotAPI)
 import Wire.API.Routes.Public.Brig.OAuth (OAuthAPI)
+import Wire.API.Routes.Public.Brig.Provider (ProviderAPI)
 import Wire.API.Routes.Public.Util
 import Wire.API.Routes.QualifiedCapture
 import Wire.API.Routes.Version
@@ -93,6 +94,7 @@ type BrigAPI =
     :<|> SystemSettingsAPI
     :<|> OAuthAPI
     :<|> BotAPI
+    :<|> ProviderAPI
 
 data BrigAPITag
 

diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig/Bot.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig/Bot.hs
@@ -27,7 +27,6 @@ import Wire.API.Conversation.Bot
 import Wire.API.Error (CanThrow, ErrorResponse)
 import Wire.API.Error.Brig (BrigError (..))
 import Wire.API.Provider.Bot (BotUserView)
-import Wire.API.Routes.API (ServiceAPI (..))
 import Wire.API.Routes.MultiVerb
 import Wire.API.Routes.Named (Named (..))
 import Wire.API.Routes.Public
@@ -161,8 +160,3 @@ type BotAPI =
                :> "clients"
                :> Get '[JSON] [PubClient]
            )
-
-data BotAPITag
-
-instance ServiceAPI BotAPITag v where
-  type ServiceAPIRoutes BotAPITag = BotAPI