Isovector/brig servant 2022

changelog.d/5-internal/brig-servant-2022

@@ -0,0 +1 @@
+Port brig UserHandle API to servant

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

@@ -320,6 +320,36 @@ type SelfAPI =
                :> MultiVerb 'PUT '[JSON] ChangeHandleResponses (Maybe ChangeHandleError)
            )
 
+type UserHandleAPI =
+  Named
+    "check-user-handles"
+    ( Summary "Check availability of user handles"
+        :> ZUser
+        :> "users"
+        :> "handles"
+        :> ReqBody '[JSON] CheckHandles
+        :> MultiVerb
+             'POST
+             '[JSON]
+             '[Respond 200 "List of free handles" [Handle]]
+             [Handle]
+    )
+    :<|> Named
+           "check-user-handle"
+           ( Summary "Check whether a user handle can be taken"
+               :> CanThrow 'InvalidHandle
+               :> CanThrow 'HandleNotFound
+               :> ZUser
+               :> "users"
+               :> "handles"
+               :> Capture "handle" Text
+               :> MultiVerb
+                    'HEAD
+                    '[JSON]
+                    '[Respond 200 "Handle is taken" ()]
+                    ()
+           )
+
 type AccountAPI =
   -- docs/reference/user/registration.md {#RefRegistration}
   --
@@ -838,6 +868,7 @@ type BrigAPI =
     :<|> ConnectionAPI
     :<|> PropertiesAPI
     :<|> MLSAPI
+    :<|> UserHandleAPI
 
 brigSwagger :: Swagger
 brigSwagger = toSwagger (Proxy @BrigAPI)

libs/wire-api/src/Wire/API/User/Handle.hs

@@ -74,6 +74,7 @@ data CheckHandles = CheckHandles
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform CheckHandles)
+  deriving (S.ToSchema) via Schema CheckHandles
 
 modelCheckHandles :: Doc.Model
 modelCheckHandles = Doc.defineModel "CheckHandles" $ do
@@ -96,3 +97,10 @@ instance FromJSON CheckHandles where
     CheckHandles
       <$> o A..: "handles"
       <*> o A..:? "return" A..!= unsafeRange 1
+
+instance ToSchema CheckHandles where
+  schema =
+    object "CheckHandles" $
+      CheckHandles
+        <$> checkHandlesList .= field "handles" (fromRange .= rangedSchema (array schema))
+        <*> checkHandlesNum .= field "return" schema

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

@@ -180,7 +180,7 @@ swaggerDocsAPI (Just V1) =
 swaggerDocsAPI Nothing = swaggerDocsAPI (Just maxBound)
 
 servantSitemap :: ServerT BrigAPI (Handler r)
-servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekeyAPI :<|> userClientAPI :<|> connectionAPI :<|> propertiesAPI :<|> mlsAPI
+servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekeyAPI :<|> userClientAPI :<|> connectionAPI :<|> propertiesAPI :<|> mlsAPI :<|> userHandleAPI
   where
     userAPI :: ServerT UserAPI (Handler r)
     userAPI =
@@ -266,6 +266,11 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey
         :<|> Named @"mls-key-packages-claim" claimKeyPackages
         :<|> Named @"mls-key-packages-count" countKeyPackages
 
+    userHandleAPI :: ServerT UserHandleAPI (Handler r)
+    userHandleAPI =
+      Named @"check-user-handles" checkHandles
+        :<|> Named @"check-user-handle" checkHandle
+
 -- Note [ephemeral user sideeffect]
 -- If the user is ephemeral and expired, it will be removed upon calling
 -- CheckUserExists[Un]Qualified, see 'Brig.API.User.userGC'.
@@ -277,33 +282,6 @@ sitemap ::
   Members '[CodeStore, PasswordResetStore] r =>
   Routes Doc.ApiBuilder (Handler r) ()
 sitemap = do
-  -- User Handle API ----------------------------------------------------
-
-  post "/users/handles" (continue checkHandlesH) $
-    accept "application" "json"
-      .&. zauthUserId
-      .&. jsonRequest @Public.CheckHandles
-  document "POST" "checkUserHandles" $ do
-    Doc.summary "Check availability of user handles"
-    Doc.body (Doc.ref Public.modelCheckHandles) $
-      Doc.description "JSON body"
-    Doc.returns (Doc.array Doc.string')
-    Doc.response 200 "List of free handles" Doc.end
-
-  head "/users/handles/:handle" (continue checkHandleH) $
-    zauthUserId
-      .&. capture "handle"
-  document "HEAD" "checkUserHandle" $ do
-    Doc.summary "Check whether a user handle can be taken"
-    Doc.parameter Doc.Path "handle" Doc.bytes' $
-      Doc.description "Handle to check"
-    Doc.response 200 "Handle is taken" Doc.end
-    Doc.errorResponse (errorToWai @'E.InvalidHandle)
-    Doc.errorResponse (errorToWai @'E.HandleNotFound)
-
-  -- some APIs moved to servant
-  -- end User Handle API
-
   get "/users/:uid/rich-info" (continue getRichInfoH) $
     zauthUserId
       .&. capture "uid"
@@ -786,19 +764,19 @@ changeLocale u conn l = lift $ API.changeLocale u conn l
 
 -- | (zusr is ignored by this handler, ie. checking handles is allowed as long as you have
 -- *any* account.)
-checkHandleH :: UserId ::: Text -> (Handler r) Response
-checkHandleH (_uid ::: hndl) =
+checkHandle :: UserId -> Text -> Handler r ()
+checkHandle _uid hndl =
   API.checkHandle hndl >>= \case
-    API.CheckHandleInvalid -> throwE (StdError (errorToWai @'E.InvalidHandle))
-    API.CheckHandleFound -> pure $ setStatus status200 empty
-    API.CheckHandleNotFound -> pure $ setStatus status404 empty
+    API.CheckHandleInvalid -> throwStd (errorToWai @'E.InvalidHandle)
+    API.CheckHandleFound -> pure ()
+    API.CheckHandleNotFound -> throwStd (errorToWai @'E.HandleNotFound)
 
-checkHandlesH :: JSON ::: UserId ::: JsonRequest Public.CheckHandles -> (Handler r) Response
-checkHandlesH (_ ::: _ ::: req) = do
-  Public.CheckHandles hs num <- parseJsonBody req
+-- | (zusr is ignored by this handler, ie. checking handles is allowed as long as you have
+-- *any* account.)
+checkHandles :: UserId -> Public.CheckHandles -> Handler r [Handle]
+checkHandles _ (Public.CheckHandles hs num) = do
   let handles = mapMaybe parseHandle (fromRange hs)
-  free <- lift . wrapClient $ API.checkHandles handles (fromRange num)
-  pure $ json (free :: [Handle])
+  lift $ wrapHttpClient $ API.checkHandles handles (fromRange num)
 
 -- | This endpoint returns UserHandleInfo instead of UserProfile for backwards
 -- compatibility, whereas the corresponding qualified endpoint (implemented by