Servantify stern

changelog.d/5-internal/pr-2742

@@ -0,0 +1 @@
+Migrate stern to swagger2-ui (remaining backwards compatible with circulating backoffice images) (see also #2742 from last release) (#2744)

libs/galley-types/galley-types.cabal

@@ -84,6 +84,7 @@ library
     , QuickCheck
     , schema-profunctor
     , string-conversions
+    , swagger2
     , tagged
     , text                   >=0.11
     , time                   >=1.4

libs/galley-types/src/Galley/Types/Teams/Intra.hs

@@ -1,4 +1,9 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 -- This file is part of the Wire Server implementation.
@@ -31,6 +36,8 @@ import Data.Aeson
 import Data.Aeson.TH
 import qualified Data.Currency as Currency
 import Data.Json.Util
+import qualified Data.Schema as S
+import qualified Data.Swagger as Swagger hiding (schema)
 import Data.Time (UTCTime)
 import Imports
 import Test.QuickCheck.Arbitrary (Arbitrary)
@@ -46,42 +53,34 @@ data TeamStatus
   | Suspended
   | PendingActive
   deriving (Eq, Show, Generic)
-
-instance ToJSON TeamStatus where
-  toJSON Active = String "active"
-  toJSON PendingDelete = String "pending_delete"
-  toJSON Deleted = String "deleted"
-  toJSON Suspended = String "suspended"
-  toJSON PendingActive = String "pending_active"
-
-instance FromJSON TeamStatus where
-  parseJSON (String "active") = pure Active
-  parseJSON (String "pending_delete") = pure PendingDelete
-  parseJSON (String "deleted") = pure Deleted
-  parseJSON (String "suspended") = pure Suspended
-  parseJSON (String "pending_active") = pure PendingActive
-  parseJSON other = fail $ "Unknown TeamStatus: " <> show other
+  deriving (ToJSON, FromJSON, Swagger.ToSchema) via S.Schema TeamStatus
+
+instance S.ToSchema TeamStatus where
+  schema =
+    S.enum @Text "Access" $
+      mconcat
+        [ S.element "active" Active,
+          S.element "pending_delete" PendingDelete,
+          S.element "deleted" Deleted,
+          S.element "suspended" Suspended,
+          S.element "pending_active" PendingActive
+        ]
 
 data TeamData = TeamData
   { tdTeam :: !Team,
     tdStatus :: !TeamStatus,
     tdStatusTime :: !(Maybe UTCTime) -- This needs to be a Maybe due to backwards compatibility
   }
   deriving (Eq, Show, Generic)
-
-instance ToJSON TeamData where
-  toJSON (TeamData t s st) =
-    object $
-      "team" .= t
-        # "status" .= s
-        # "status_time" .= (toUTCTimeMillis <$> st)
-        # []
-
-instance FromJSON TeamData where
-  parseJSON = withObject "team-data" $ \o -> do
-    TeamData <$> o .: "team"
-      <*> o .: "status"
-      <*> o .:? "status_time"
+  deriving (ToJSON, FromJSON, Swagger.ToSchema) via S.Schema TeamData
+
+instance S.ToSchema TeamData where
+  schema =
+    S.object "TeamData" $
+      TeamData
+        <$> tdTeam S..= S.field "team" S.schema
+        <*> tdStatus S..= S.field "status" S.schema
+        <*> tdStatusTime S..= S.maybe_ (S.optField "status_time" utcTimeSchema)
 
 data TeamStatusUpdate = TeamStatusUpdate
   { tuStatus :: !TeamStatus,

libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal

@@ -13,6 +13,9 @@ build-type:    Simple
 library
   exposed-modules:
     Polysemy.TinyLog
+    Wire.Sem.Concurrency
+    Wire.Sem.Concurrency.IO
+    Wire.Sem.Concurrency.Sequential
     Wire.Sem.FromUTC
     Wire.Sem.Logger
     Wire.Sem.Logger.Level
@@ -25,9 +28,6 @@ library
     Wire.Sem.Paging.Cassandra
     Wire.Sem.Random
     Wire.Sem.Random.IO
-    Wire.Sem.Concurrency
-    Wire.Sem.Concurrency.IO
-    Wire.Sem.Concurrency.Sequential
 
   other-modules:      Paths_polysemy_wire_zoo
   hs-source-dirs:     src

libs/wire-api/src/Wire/API/Team/Feature.hs

@@ -47,6 +47,7 @@ module Wire.API.Team.Feature
     withLockStatus,
     withUnlocked,
     FeatureTTL,
+    FeatureTTLDays,
     FeatureTTL' (..),
     FeatureTTLUnit (..),
     convertFeatureTTLDaysToSeconds,
@@ -971,6 +972,19 @@ data FeatureStatus
   deriving (Arbitrary) via (GenericUniform FeatureStatus)
   deriving (ToJSON, FromJSON, S.ToSchema) via (Schema FeatureStatus)
 
+instance S.ToParamSchema FeatureStatus where
+  toParamSchema _ =
+    mempty
+      { S._paramSchemaType = Just S.SwaggerString,
+        S._paramSchemaEnum = Just (A.String . toQueryParam <$> [(minBound :: FeatureStatus) ..])
+      }
+
+instance FromHttpApiData FeatureStatus where
+  parseUrlPiece = maybe (Left "must be 'enabled' or 'disabled'") Right . fromByteString' . cs
+
+instance ToHttpApiData FeatureStatus where
+  toUrlPiece = cs . toByteString'
+
 typeFeatureStatus :: Doc.DataType
 typeFeatureStatus =
   Doc.string $

libs/wire-api/src/Wire/API/Team/Member.hs

@@ -31,6 +31,7 @@ module Wire.API.Team.Member
     teamMemberJson,
     setOptionalPerms,
     setOptionalPermsMany,
+    teamMemberObjectSchema,
 
     -- * TeamMemberList
     TeamMemberList,
@@ -133,11 +134,13 @@ mkTeamMember ::
 mkTeamMember uid perms inv = TeamMember (NewTeamMember uid perms inv)
 
 instance ToSchema TeamMember where
-  schema =
-    object "TeamMember" $
-      TeamMember
-        <$> _newTeamMember .= newTeamMemberSchema
-        <*> _legalHoldStatus .= (fromMaybe defUserLegalHoldStatus <$> optFieldWithDocModifier "legalhold_status" (description ?~ lhDesc) schema)
+  schema = object "TeamMember" teamMemberObjectSchema
+
+teamMemberObjectSchema :: ObjectSchema SwaggerDoc TeamMember
+teamMemberObjectSchema =
+  TeamMember
+    <$> _newTeamMember .= newTeamMemberSchema
+    <*> _legalHoldStatus .= (fromMaybe defUserLegalHoldStatus <$> optFieldWithDocModifier "legalhold_status" (description ?~ lhDesc) schema)
 
 instance ToSchema (TeamMember' 'Optional) where
   schema =

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

@@ -75,6 +75,7 @@ import SAML2.WebSSO.Test.Arbitrary ()
 import qualified SAML2.WebSSO.Types as SAML
 import qualified SAML2.WebSSO.Types.Email as SAMLEmail
 import qualified SAML2.WebSSO.XML as SAML
+import qualified Servant.API as S
 import System.FilePath ((</>))
 import qualified Test.QuickCheck as QC
 import qualified Text.Email.Validate as Email.V
@@ -187,6 +188,12 @@ instance ToByteString Email where
 instance FromByteString Email where
   parser = parser >>= maybe (fail "Invalid email") pure . parseEmail
 
+instance S.FromHttpApiData Email where
+  parseUrlPiece = maybe (Left "Invalid email") Right . fromByteString . cs
+
+instance S.ToHttpApiData Email where
+  toUrlPiece = cs . toByteString'
+
 instance Arbitrary Email where
   arbitrary = do
     localPart <- Text.filter (/= '@') <$> arbitrary
@@ -249,6 +256,9 @@ newtype Phone = Phone {fromPhone :: Text}
   deriving stock (Eq, Ord, Show, Generic)
   deriving (ToJSON, FromJSON, S.ToSchema) via (Schema Phone)
 
+instance ToParamSchema Phone where
+  toParamSchema _ = toParamSchema (Proxy @Text)
+
 instance ToSchema Phone where
   schema =
     over doc (S.description ?~ "E.164 phone number") $
@@ -260,6 +270,12 @@ instance ToByteString Phone where
 instance FromByteString Phone where
   parser = parser >>= maybe (fail "Invalid phone") pure . parsePhone
 
+instance S.FromHttpApiData Phone where
+  parseUrlPiece = maybe (Left "Invalid phone") Right . fromByteString . cs
+
+instance S.ToHttpApiData Phone where
+  toUrlPiece = cs . toByteString'
+
 instance Arbitrary Phone where
   arbitrary =
     Phone . Text.pack <$> do

tools/stern/README.md

@@ -1,9 +1,9 @@
-Stern - Backoffice facade
+Stern - Backoffice Facade
 =========================
 
-This tool can be used to create a very basic Backoffice tool to simplify performing operations on users and teams such as visualising their user profiles, suspending or even deleting accounts. It is used internally at Wire to provide customer support the means to respond to certain queries from our customers.
+This is a simple web app based on [swagger-ui](https://swagger.io/tools/swagger-ui/) for performing operations on users and teams such as browsing their user profiles, suspending, or deleting accounts. It is used internally at Wire by our customer support team.
 
-Stern provides a swagger interface that accesses multiple other services (mostly using internal endpoints) and is designed to be a simple way to create a basic backoffice functionality. The swagger interface is served at `<ip:stern_port>/stern/api-docs`
+Stern is based on a swagger interface that accesses multiple other services (mostly using internal endpoints) and is designed to be a simple way to create a basic backoffice functionality. Point your browser at `http://<ip-or-host>:<port>/backoffice/api/swagger-ui/`; `<port>` is usually 8091.
 
 ## IMPORTANT NOTES
 
@@ -13,19 +13,34 @@ It is intended to be deployed in a private network and accessible only through a
 
 Some endpoints (marked as such on the Swagger interface) depend on internal services (named galeb and ibis) that are not relevant for a generic wire server installation as they gather info from other internal systems at Wire (related to billing or other services) and as such will not work properly on installations without them.
 
+### Legacy mode
+
+stern used to be run together with a separate docker image that carried the swagger-ui frontend, while stern only served the swagger data and the actual rest api.  This is not recommended any more, but until all the infrastructure everywhere has caught up with the new mode of operation, stern still delivers the old swagger1.2 data as before under the same path.  For details see `./src/Stern/API/RoutesLegacy.hs`.
+
 ## How to run stern together with the rest of wire-server
 
 TODO: This section is under construction
 
 ## How to run stern locally with the `services-demo`
 
 Follow the instruction in [`deploy/services-demo/README.md`](../../deploy/services-demo/README.md),
-using the `--run-backoffice` option, e.g. `deploy/sevices-demo/demo.sh --run-backoffice`
+using the `--run-backoffice` option, e.g. `deploy/sevices-demo/demo.sh --run-backoffice`.
 
-When you now open `localhost:8080/swagger-ui` in a browser, you can switch to the
-"Back Office" tab.
+Open `http://localhost:8091/backoffice/api/swagger-ui/` in a browser.
+(Legacy mode: when you now open `localhost:8080/swagger-ui` in a
+browser, you can switch to the "Back Office" tab.)
 
 ## Screenshots
 
-![screen shot 1](screenshots/1.png)
-![screen shot 2](screenshots/2.png)
+![screen shot 1](screenshots/a.png)
+![screen shot 2](screenshots/b.png)
+
+# Legacy mode:
+
+![screen shot 1](screenshots/legacy/1.png)
+![screen shot 2](screenshots/legacy/2.png)
+
+(one could argue that the old swagger-ui was a little more
+end-user-friendly, to which one could respond that neither version is
+intended for end-users, but for web-devs, and we should just spend a
+week writing an elm app that does this right.  :))