[feat] improve type safety for Named, servantify brig internal route (#…

…3634)

* [feat] improve type safety for Named, servantify brig internal route
- improve type safety of Named by making it possible to rule out
  weakly typed arguments to the type (e.g. Type)
- servantify the internal route for querying the teams API for servant

changelog.d/5-internal/WBP-1224

@@ -0,0 +1 @@
+Servantify internal end-points: brig/teams

libs/wire-api-federation/src/Wire/API/Federation/API.hs

@@ -78,7 +78,7 @@ instance HasEmptyResponse (Post '[JSON] EmptyResponse)
 
 instance HasEmptyResponse api => HasEmptyResponse (x :> api)
 
-instance HasEmptyResponse api => HasEmptyResponse (Named name api)
+instance HasEmptyResponse api => HasEmptyResponse (UntypedNamed name api)
 
 -- | Return a client for a named endpoint.
 --

libs/wire-api/src/Wire/API/Error.hs

@@ -68,7 +68,7 @@ import Polysemy.Error
 import Servant
 import Servant.OpenApi
 import Wire.API.Routes.MultiVerb
-import Wire.API.Routes.Named (Named)
+import Wire.API.Routes.Named (UntypedNamed)
 import Wire.API.Routes.Version
 
 -- | Runtime representation of a statically-known error.
@@ -209,7 +209,7 @@ type family DeclaredErrorEffects api :: EffectRow where
   DeclaredErrorEffects (CanThrowMany '(e, es) :> api) =
     DeclaredErrorEffects (CanThrow e :> CanThrowMany es :> api)
   DeclaredErrorEffects (x :> api) = DeclaredErrorEffects api
-  DeclaredErrorEffects (Named n api) = DeclaredErrorEffects api
+  DeclaredErrorEffects (UntypedNamed n api) = DeclaredErrorEffects api
   DeclaredErrorEffects api = '[]
 
 errorResponseSwagger :: forall e. (Typeable e, KnownError e) => S.Response

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

@@ -36,6 +36,7 @@ module Wire.API.Routes.Internal.Brig
     NewKeyPackageRef (..),
     NewKeyPackage (..),
     NewKeyPackageResult (..),
+    FoundInvitationCode (..),
   )
 where
 
@@ -68,10 +69,13 @@ import Wire.API.Routes.Internal.Brig.SearchIndex (ISearchIndexAPI)
 import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti qualified as Multi
 import Wire.API.Routes.MultiVerb
 import Wire.API.Routes.Named
-import Wire.API.Routes.Public (ZUser {- yes, this is a bit weird -})
+import Wire.API.Routes.Public (ZUser)
 import Wire.API.Team.Feature
+import Wire.API.Team.Invitation (Invitation)
 import Wire.API.Team.LegalHold.Internal
-import Wire.API.User
+import Wire.API.Team.Size qualified as Teamsize
+import Wire.API.User hiding (InvitationCode)
+import Wire.API.User qualified as User
 import Wire.API.User.Auth
 import Wire.API.User.Auth.LegalHold
 import Wire.API.User.Auth.ReAuth
@@ -664,6 +668,82 @@ type TeamsAPI =
         :> ReqBody '[Servant.JSON] (Multi.TeamStatus SearchVisibilityInboundConfig)
         :> Post '[Servant.JSON] ()
     )
+    :<|> InvitationByEmail
+    :<|> InvitationCode
+    :<|> SuspendTeam
+    :<|> UnsuspendTeam
+    :<|> TeamSize
+    :<|> TeamInvitations
+
+type InvitationByEmail =
+  Named
+    "get-invitation-by-email"
+    ( "teams"
+        :> "invitations"
+        :> "by-email"
+        :> QueryParam' [Required, Strict] "email" Email
+        :> Get '[Servant.JSON] Invitation
+    )
+
+type InvitationCode =
+  Named
+    "get-invitation-code"
+    ( "teams"
+        :> "invitation-code"
+        :> QueryParam' [Required, Strict] "team" TeamId
+        :> QueryParam' [Required, Strict] "invitation_id" InvitationId
+        :> Get '[Servant.JSON] FoundInvitationCode
+    )
+
+newtype FoundInvitationCode = FoundInvitationCode {getFoundInvitationCode :: User.InvitationCode}
+  deriving stock (Eq, Show, Generic)
+  deriving (FromJSON, ToJSON, S.ToSchema) via (Schema FoundInvitationCode)
+
+instance ToSchema FoundInvitationCode where
+  schema =
+    FoundInvitationCode
+      <$> getFoundInvitationCode .= object "FoundInvitationCode" (field "code" (schema @User.InvitationCode))
+
+type SuspendTeam =
+  Named
+    "suspend-team"
+    ( "teams"
+        :> Capture "tid" TeamId
+        :> "suspend"
+        :> Post
+             '[Servant.JSON]
+             NoContent
+    )
+
+type UnsuspendTeam =
+  Named
+    "unsuspend-team"
+    ( "teams"
+        :> Capture "tid" TeamId
+        :> "unsuspend"
+        :> Post
+             '[Servant.JSON]
+             NoContent
+    )
+
+type TeamSize =
+  Named
+    "team-size"
+    ( "teams"
+        :> Capture "tid" TeamId
+        :> "size"
+        :> Get '[JSON] Teamsize.TeamSize
+    )
+
+type TeamInvitations =
+  Named
+    "create-invitations-via-scim"
+    ( "teams"
+        :> Capture "tid" TeamId
+        :> "invitations"
+        :> Servant.ReqBody '[JSON] NewUserScimInvitation
+        :> Post '[JSON] UserAccount
+    )
 
 type UserAPI =
   UpdateUserLocale

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

@@ -23,7 +23,7 @@ import Servant hiding (Handler, JSON, Tagged, addHeader, respond)
 import Servant.OpenApi.Internal.Orphans ()
 import Wire.API.Error
 import Wire.API.OAuth
-import Wire.API.Routes.Named (Named (..))
+import Wire.API.Routes.Named (Named)
 
 --------------------------------------------------------------------------------
 -- API Internal

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

@@ -20,7 +20,7 @@ module Wire.API.Routes.Internal.Brig.SearchIndex where
 import Servant (JSON)
 import Servant hiding (Handler, JSON, Tagged, addHeader, respond)
 import Servant.OpenApi.Internal.Orphans ()
-import Wire.API.Routes.Named (Named (..))
+import Wire.API.Routes.Named (Named)
 
 type ISearchIndexAPI =
   Named

libs/wire-api/src/Wire/API/Routes/Named.hs

@@ -33,7 +33,15 @@ import Servant.Client.Core (clientIn)
 import Servant.OpenApi
 
 -- | See http://docs.wire.com/developer/developer/servant.html#named-and-internal-route-ids-in-swagger
-newtype Named name x = Named {unnamed :: x}
+--
+-- as 'UntypedNamed' is of kind $k -> Type -> Type$, we can pass any
+-- argument to it, however, most commonly we want to pass a 'Symbol' to
+-- it. To avoid mistakes, we make it possible to rule out untyped arguments
+-- like 'Type', this is done by the 'IsStronglyTyped' TyFam that will throw
+-- a type error when passed a 'Type'
+type Named name = UntypedNamed (IsStronglyTyped name)
+
+newtype UntypedNamed name x = Named {unnamed :: x}
   deriving (Functor)
 
 -- | For 'HasSwagger' instance of 'Named'.  'KnownSymbol' isn't enough because we're using
@@ -47,7 +55,12 @@ instance {-# OVERLAPPABLE #-} KnownSymbol a => RenderableSymbol a where
 instance {-# OVERLAPPING #-} (RenderableSymbol a, RenderableSymbol b) => RenderableSymbol '(a, b) where
   renderSymbol = "(" <> (renderSymbol @a) <> ", " <> (renderSymbol @b) <> ")"
 
-instance (HasOpenApi api, RenderableSymbol name) => HasOpenApi (Named name api) where
+type IsStronglyTyped :: forall k. k -> k
+type family IsStronglyTyped typ where
+  IsStronglyTyped (typ :: Type) = TypeError ('Text "Please don't use \"Type\" as first parameter to \"Named\"")
+  IsStronglyTyped typ = typ
+
+instance (HasOpenApi api, RenderableSymbol name) => HasOpenApi (UntypedNamed name api) where
   toOpenApi _ =
     toOpenApi (Proxy @api)
       & allOperations . description %~ (Just (dscr <> "\n\n") <>)
@@ -58,27 +71,27 @@ instance (HasOpenApi api, RenderableSymbol name) => HasOpenApi (Named name api)
           <> cs (renderSymbol @name)
           <> "]"
 
-instance HasServer api ctx => HasServer (Named name api) ctx where
-  type ServerT (Named name api) m = Named name (ServerT api m)
+instance HasServer api ctx => HasServer (UntypedNamed name api) ctx where
+  type ServerT (UntypedNamed name api) m = UntypedNamed name (ServerT api m)
 
   route _ ctx action = route (Proxy @api) ctx (fmap unnamed action)
   hoistServerWithContext _ ctx f =
     fmap (hoistServerWithContext (Proxy @api) ctx f)
 
-instance HasLink endpoint => HasLink (Named name endpoint) where
-  type MkLink (Named name endpoint) a = MkLink endpoint a
+instance HasLink endpoint => HasLink (UntypedNamed name endpoint) where
+  type MkLink (UntypedNamed name endpoint) a = MkLink endpoint a
   toLink toA _ = toLink toA (Proxy @endpoint)
 
-instance RoutesToPaths api => RoutesToPaths (Named name api) where
+instance RoutesToPaths api => RoutesToPaths (UntypedNamed name api) where
   getRoutes = getRoutes @api
 
-instance HasClient m api => HasClient m (Named n api) where
-  type Client m (Named n api) = Client m api
+instance HasClient m api => HasClient m (UntypedNamed n api) where
+  type Client m (UntypedNamed n api) = Client m api
   clientWithRoute pm _ req = clientWithRoute pm (Proxy @api) req
   hoistClientMonad pm _ f = hoistClientMonad pm (Proxy @api) f
 
 type family FindName n (api :: Type) :: (n, Type) where
-  FindName n (Named name api) = '(name, api)
+  FindName n (UntypedNamed name api) = '(name, api)
   FindName n (x :> api) = AddPrefix x (FindName n api)
   FindName n api = '(TypeError ('Text "Named combinator not found"), api)
 
@@ -116,7 +129,7 @@ type family FMap (f :: a -> b) (m :: Maybe a) :: Maybe b where
   FMap f ('Just a) = 'Just (f a)
 
 type family LookupEndpoint api name :: Maybe Type where
-  LookupEndpoint (Named name endpoint) name = 'Just endpoint
+  LookupEndpoint (UntypedNamed name endpoint) name = 'Just endpoint
   LookupEndpoint (api1 :<|> api2) name =
     MappendMaybe
       (LookupEndpoint api1 name)
@@ -142,5 +155,5 @@ namedClient = clientIn (Proxy @endpoint) (Proxy @m)
 type family x ::> api
 
 type instance
-  x ::> (Named name api) =
+  x ::> (UntypedNamed name api) =
     Named name (x :> api)

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

@@ -28,7 +28,7 @@ import Wire.API.Error (CanThrow, ErrorResponse)
 import Wire.API.Error.Brig (BrigError (..))
 import Wire.API.Provider.Bot (BotUserView)
 import Wire.API.Routes.MultiVerb
-import Wire.API.Routes.Named (Named (..))
+import Wire.API.Routes.Named (Named)
 import Wire.API.Routes.Public
 import Wire.API.User
 import Wire.API.User.Client

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

@@ -27,7 +27,7 @@ import Wire.API.Error
 import Wire.API.OAuth
 import Wire.API.Routes.API
 import Wire.API.Routes.MultiVerb
-import Wire.API.Routes.Named (Named (..))
+import Wire.API.Routes.Named (Named)
 import Wire.API.Routes.Public
 
 type OAuthAPI =

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

@@ -27,7 +27,7 @@ import Wire.API.Error
 import Wire.API.Error.Brig
 import Wire.API.Provider
 import Wire.API.Routes.MultiVerb
-import Wire.API.Routes.Named (Named (..))
+import Wire.API.Routes.Named (Named)
 import Wire.API.Routes.Public
 import Wire.API.User.Auth
 

libs/wire-api/src/Wire/API/Routes/Version.hs

@@ -220,7 +220,7 @@ type instance
     s :> SpecialiseToVersion v api
 
 type instance
-  SpecialiseToVersion v (Named n api) =
+  SpecialiseToVersion v (UntypedNamed n api) =
     Named n (SpecialiseToVersion v api)
 
 type instance

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

@@ -1896,6 +1896,7 @@ instance Schema.ToSchema UserAccount where
 -- NewUserScimInvitation
 
 data NewUserScimInvitation = NewUserScimInvitation
+  -- FIXME: the TID should be captured in the route as usual
   { newUserScimInvTeamId :: TeamId,
     newUserScimInvLocale :: Maybe Locale,
     newUserScimInvName :: Name,

services/brig/src/Brig/API.hs

@@ -22,18 +22,10 @@ where
 
 import Brig.API.Handler (Handler)
 import Brig.API.Internal qualified as Internal
-import Brig.Effects.BlacklistStore (BlacklistStore)
 import Brig.Effects.GalleyProvider (GalleyProvider)
-import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore)
 import Network.Wai.Routing (Routes)
 import Polysemy
 
-sitemap ::
-  forall r p.
-  ( Member BlacklistStore r,
-    Member GalleyProvider r,
-    Member (UserPendingActivationStore p) r
-  ) =>
-  Routes () (Handler r) ()
+sitemap :: forall r. (Member GalleyProvider r) => Routes () (Handler r) ()
 sitemap = do
   Internal.sitemap

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

@@ -197,8 +197,20 @@ accountAPI =
     :<|> Named @"iLegalholdAddClient" legalHoldClientRequestedH
     :<|> Named @"iLegalholdDeleteClient" removeLegalHoldClientH
 
-teamsAPI :: ServerT BrigIRoutes.TeamsAPI (Handler r)
-teamsAPI = Named @"updateSearchVisibilityInbound" Index.updateSearchVisibilityInbound
+teamsAPI ::
+  ( Member GalleyProvider r,
+    Member (UserPendingActivationStore p) r,
+    Member BlacklistStore r
+  ) =>
+  ServerT BrigIRoutes.TeamsAPI (Handler r)
+teamsAPI =
+  Named @"updateSearchVisibilityInbound" Index.updateSearchVisibilityInbound
+    :<|> Named @"get-invitation-by-email" Team.getInvitationByEmail
+    :<|> Named @"get-invitation-code" Team.getInvitationCode
+    :<|> Named @"suspend-team" Team.suspendTeam
+    :<|> Named @"unsuspend-team" Team.unsuspendTeam
+    :<|> Named @"team-size" Team.teamSize
+    :<|> Named @"create-invitations-via-scim" Team.createInvitationViaScim
 
 userAPI :: ServerT BrigIRoutes.UserAPI (Handler r)
 userAPI =
@@ -436,14 +448,11 @@ internalSearchIndexAPI =
 -- Sitemap (wai-route)
 
 sitemap ::
-  ( Member BlacklistStore r,
-    Member GalleyProvider r,
-    Member (UserPendingActivationStore p) r
+  ( Member GalleyProvider r
   ) =>
   Routes a (Handler r) ()
 sitemap = unsafeCallsFed @'Brig @"on-user-deleted-connections" $ do
   Provider.routesInternal
-  Team.routesInternal
 
 ---------------------------------------------------------------------------
 -- Handlers

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

@@ -48,7 +48,7 @@ import Wire.API.Error
 import Wire.API.OAuth as OAuth
 import Wire.API.Password (Password, mkSafePassword)
 import Wire.API.Routes.Internal.Brig.OAuth qualified as I
-import Wire.API.Routes.Named (Named (..))
+import Wire.API.Routes.Named (UntypedNamed (Named))
 import Wire.API.Routes.Public.Brig.OAuth
 import Wire.Sem.Jwk
 import Wire.Sem.Jwk qualified as Jwk

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

@@ -118,7 +118,7 @@ import Wire.API.Routes.Internal.Cargohold qualified as CargoholdInternalAPI
 import Wire.API.Routes.Internal.Galley qualified as GalleyInternalAPI
 import Wire.API.Routes.Internal.Spar qualified as SparInternalAPI
 import Wire.API.Routes.MultiTablePaging qualified as Public
-import Wire.API.Routes.Named (Named (Named))
+import Wire.API.Routes.Named (UntypedNamed (Named))
 import Wire.API.Routes.Public.Brig
 import Wire.API.Routes.Public.Brig.OAuth
 import Wire.API.Routes.Public.Cannon

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

@@ -113,7 +113,7 @@ import Wire.API.Provider.External qualified as Ext
 import Wire.API.Provider.Service
 import Wire.API.Provider.Service qualified as Public
 import Wire.API.Provider.Service.Tag qualified as Public
-import Wire.API.Routes.Named (Named (Named))
+import Wire.API.Routes.Named (UntypedNamed (Named))
 import Wire.API.Routes.Public.Brig.Bot (BotAPI)
 import Wire.API.Routes.Public.Brig.Provider (ProviderAPI)
 import Wire.API.Routes.Public.Brig.Services (ServicesAPI)