[SQSERVICES-1643] Servantify brig account API 8 - POST /onboading/v3

changelog.d/5-internal/pr-2707

@@ -0,0 +1 @@
+The account API is now migrated to servant. (#2699, #2700, #2701, #2702, #2703, #2704, #2705, #2707)

libs/wire-api/src/Wire/API/Routes/Public/Brig.hs

@@ -19,6 +19,7 @@
 
 module Wire.API.Routes.Public.Brig where
 
+import qualified Data.Aeson as A (FromJSON, ToJSON, Value)
 import Data.ByteString.Conversion
 import Data.Code (Timeout)
 import Data.CommaSeparatedList (CommaSeparatedList)
@@ -30,7 +31,9 @@ import Data.Nonce (Nonce)
 import Data.Qualified (Qualified (..))
 import Data.Range
 import Data.SOP
-import Data.Swagger hiding (Contact, Header)
+import Data.Schema as Schema
+import Data.Swagger hiding (Contact, Header, Schema, ToSchema)
+import qualified Data.Swagger as S
 import qualified Generics.SOP as GSOP
 import Imports hiding (head)
 import Servant (JSON)
@@ -489,6 +492,35 @@ type AccountAPI =
                :> ReqBody '[JSON] PasswordReset
                :> MultiVerb 'POST '[JSON] '[RespondEmpty 200 "Password reset successful."] ()
            )
+    :<|> Named
+           "onboarding"
+           ( Summary "Upload contacts and invoke matching."
+               :> Description
+                    "DEPRECATED: the feature has been turned off, the end-point does \
+                    \nothing and always returns '{\"results\":[],\"auto-connects\":[]}'."
+               :> ZUser
+               :> "onboarding"
+               :> "v3"
+               :> ReqBody '[JSON] JsonValue
+               :> Post '[JSON] DeprecatedMatchingResult
+           )
+
+newtype JsonValue = JsonValue {fromJsonValue :: A.Value}
+  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema JsonValue)
+
+instance ToSchema JsonValue where
+  schema = fromJsonValue .= (JsonValue <$> named "Body" jsonValue)
+
+data DeprecatedMatchingResult = DeprecatedMatchingResult
+  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema DeprecatedMatchingResult)
+
+instance ToSchema DeprecatedMatchingResult where
+  schema =
+    object
+      "DeprecatedMatchingResult"
+      $ DeprecatedMatchingResult
+        <$ const [] .= field "results" (array (null_ @SwaggerDoc))
+        <* const [] .= field "auto-connects" (array (null_ @SwaggerDoc))
 
 data ActivationRespWithStatus
   = ActivationResp ActivationResponse

services/brig/src/Brig/API/Public.hs

@@ -95,12 +95,10 @@ import qualified Data.ZAuth.Token as ZAuth
 import FileEmbedLzma
 import Galley.Types.Teams (HiddenPerm (..), hasPermission)
 import Imports hiding (head)
-import Network.Wai
 import Network.Wai.Predicate hiding (result, setStatus)
 import Network.Wai.Routing
 import Network.Wai.Utilities as Utilities
-import Network.Wai.Utilities.Swagger (document, mkSwaggerApi)
-import Network.Wai.Utilities.ZAuth (zauthUserId)
+import Network.Wai.Utilities.Swagger (mkSwaggerApi)
 import Polysemy
 import Servant hiding (Handler, JSON, addHeader, respond)
 import qualified Servant
@@ -231,6 +229,7 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey
         :<|> Named @"post-password-reset" beginPasswordReset
         :<|> Named @"post-password-reset-complete" completePasswordReset
         :<|> Named @"post-password-reset-key-deprecated" deprecatedCompletePasswordReset
+        :<|> Named @"onboarding" deprecatedOnboarding
 
     clientAPI :: ServerT ClientAPI (Handler r)
     clientAPI =
@@ -317,23 +316,6 @@ sitemap ::
     r =>
   Routes Doc.ApiBuilder (Handler r) ()
 sitemap = do
-  -- /activate, /password-reset ----------------------------------
-
-  -- This endpoint is used to test /i/metrics, when this is servantified, please
-  -- make sure some other endpoint is used to test that routes defined in this
-  -- function are recorded and reported correctly in /i/metrics.
-  -- see test/integration/API/Metrics.hs
-  post "/onboarding/v3" (continue deprecatedOnboardingH) $
-    accept "application" "json"
-      .&. zauthUserId
-      .&. jsonRequest @Value
-  document "POST" "onboardingV3" $ do
-    Doc.deprecated
-    Doc.summary "Upload contacts and invoke matching."
-    Doc.notes
-      "DEPRECATED: the feature has been turned off, the end-point does \
-      \nothing and always returns '{\"results\":[],\"auto-connects\":[]}'."
-
   Provider.routesPublic
   Auth.routesPublic
   Team.routesPublic
@@ -966,17 +948,8 @@ sendVerificationCode req = do
 
 -- Deprecated
 
-deprecatedOnboardingH :: JSON ::: UserId ::: JsonRequest Value -> (Handler r) Response
-deprecatedOnboardingH (_ ::: _ ::: _) = pure $ json DeprecatedMatchingResult
-
-data DeprecatedMatchingResult = DeprecatedMatchingResult
-
-instance ToJSON DeprecatedMatchingResult where
-  toJSON DeprecatedMatchingResult =
-    object
-      [ "results" .= ([] :: [()]),
-        "auto-connects" .= ([] :: [()])
-      ]
+deprecatedOnboarding :: UserId -> JsonValue -> (Handler r) DeprecatedMatchingResult
+deprecatedOnboarding _ _ = pure DeprecatedMatchingResult
 
 deprecatedCompletePasswordReset ::
   Members '[CodeStore, PasswordResetStore] r =>

services/brig/src/Brig/User/API/Auth.hs

@@ -110,6 +110,10 @@ routesPublic = do
     Doc.errorResponse passwordExists
     Doc.errorResponse' loginCodePending Doc.pendingLoginError
 
+  -- This endpoint is used to test /i/metrics, when this is servantified, please
+  -- make sure some other wai-route endpoint is used to test that routes defined in
+  -- this function ('Brig.API.Public.sitemap') are recorded and reported correctly in /i/metrics.
+  -- see test/integration/API/Metrics.hs
   post "/login" (continue loginH) $
     jsonRequest @Public.Login
       .&. def False (query "persist")

services/brig/test/integration/API/Metrics.hs

@@ -54,23 +54,23 @@ testMetricsEndpoint :: Brig -> Http ()
 testMetricsEndpoint brig = do
   let p1 = "/self"
       p2 uid = "/users/" <> uid <> "/clients"
-      p3 = "/onboarding/v3"
+      p3 = "/login"
   beforeSelf <- getCount "/self" "GET"
   beforeClients <- getCount "/users/:uid/clients" "GET"
-  beforeProperties <- getCount "/onboarding/v3" "POST"
-  uid <- userId <$> randomUser brig
+  beforeProperties <- getCount "/login" "POST"
+  (uid, Just email) <- (\u -> (userId u, userEmail u)) <$> randomUser brig
   uid' <- userId <$> randomUser brig
   _ <- get (brig . path p1 . zAuthAccess uid "conn" . expect2xx)
   _ <- get (brig . path (p2 $ toByteString' uid) . zAuthAccess uid "conn" . expect2xx)
   _ <- get (brig . path (p2 $ toByteString' uid') . zAuthAccess uid "conn" . expect2xx)
-  _ <- post (brig . path p3 . zAuthAccess uid "conn" . json 'x' . expect2xx)
-  _ <- post (brig . path p3 . zAuthAccess uid "conn" . json 'x' . expect2xx)
+  _ <- post (brig . path p3 . contentJson . queryItem "persist" "true" . json (defEmailLogin email) . expect2xx)
+  _ <- post (brig . path p3 . contentJson . queryItem "persist" "true" . json (defEmailLogin email) . expect2xx)
   countSelf <- getCount "/self" "GET"
   liftIO $ assertEqual "/self was called once" (beforeSelf + 1) countSelf
   countClients <- getCount "/users/:uid/clients" "GET"
   liftIO $ assertEqual "/users/:uid/clients was called twice" (beforeClients + 2) countClients
-  countProperties <- getCount "/onboarding/v3" "POST"
-  liftIO $ assertEqual "/onboarding/v3 was called twice" (beforeProperties + 2) countProperties
+  countProperties <- getCount "/login" "POST"
+  liftIO $ assertEqual "/login was called twice" (beforeProperties + 2) countProperties
   where
     getCount endpoint m = do
       rsp <- responseBody <$> get (brig . path "i/metrics")