Merge branch 'wireapp:develop' into develop

cabal.project

@@ -11,7 +11,6 @@ packages:
   , libs/dns-util/
   , libs/deriving-swagger2/
   , libs/galley-types/
-  , libs/gundeck-types/
   , libs/hscim/
   , libs/http2-manager/
   , libs/imports/
@@ -50,6 +49,7 @@ packages:
   , tools/db/move-team/
   , tools/db/phone-users/
   , tools/db/repair-handles/
+  , tools/db/team-info/
   , tools/db/repair-brig-clients-table/
   , tools/db/service-backfill/
   , tools/fedcalls/

changelog.d/5-internal/WPB-11301-db-tool-team-info

@@ -0,0 +1 @@
+tools/db/team-info: collects last login times of all team members

changelog.d/5-internal/gundeck-internal-swagger

@@ -0,0 +1 @@
+Expose gundeck internal API on swagger.  Mv some types and routes to wire-api.

docs/src/understand/api-client-perspective/swagger.md

@@ -75,6 +75,8 @@ Internal APIs are not under version control.
     endpoints](https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/cargohold)
     - [`galley` - **internal** (private)
     endpoints](https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/galley)
+    - [`gundeck` - **internal** (private)
+    endpoints](https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/gundeck)
     - [`spar` - **internal** (private)
     endpoints](https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/spar)
 

libs/wire-api/default.nix

@@ -63,6 +63,7 @@
 , metrics-wai
 , mime
 , mtl
+, network-uri
 , openapi3
 , pem
 , polysemy
@@ -169,6 +170,7 @@ mkDerivation {
     metrics-wai
     mime
     mtl
+    network-uri
     openapi3
     pem
     polysemy

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

@@ -0,0 +1,18 @@
+module Wire.API.CannonId where
+
+import Data.Aeson
+import Data.OpenApi
+import Data.Proxy
+import Imports
+import Web.HttpApiData
+
+newtype CannonId = CannonId
+  { cannonId :: Text
+  }
+  deriving (Eq, Ord, Show, FromJSON, ToJSON)
+
+instance ToParamSchema CannonId where
+  toParamSchema _ = toParamSchema (Proxy @Text)
+
+instance FromHttpApiData CannonId where
+  parseUrlPiece = pure . CannonId

libs/wire-api/src/Wire/API/Event/Gundeck.hs

@@ -0,0 +1,24 @@
+module Wire.API.Event.Gundeck where
+
+import Data.Aeson
+import Data.Aeson.KeyMap qualified as KeyMap
+import Data.Json.Util
+import Imports
+import Wire.API.Push.V2.Token
+
+newtype PushRemove = PushRemove PushToken
+  deriving (Eq, Show)
+
+instance FromJSON PushRemove where
+  parseJSON = withObject "push-removed object" $ \o ->
+    PushRemove <$> o .: "token"
+
+instance ToJSON PushRemove where
+  toJSON = Object . toJSONObject
+
+instance ToJSONObject PushRemove where
+  toJSONObject (PushRemove t) =
+    KeyMap.fromList
+      [ "type" .= ("user.push-remove" :: Text),
+        "token" .= t
+      ]

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

@@ -0,0 +1,98 @@
+module Wire.API.Presence (Presence (..), URI (..), parse) where
+
+import Control.Lens ((?~))
+import Data.Aeson qualified as A
+import Data.Aeson.Types qualified as A
+import Data.Attoparsec.ByteString (takeByteString)
+import Data.ByteString.Char8 qualified as Bytes
+import Data.ByteString.Conversion
+import Data.ByteString.Lazy qualified as Lazy
+import Data.Id
+import Data.Misc (Milliseconds)
+import Data.OpenApi qualified as S
+import Data.Proxy
+import Data.Schema
+import Data.Text qualified as Text
+import Data.Text.Encoding (decodeUtf8)
+import Imports
+import Network.URI qualified as Net
+import Servant.API (ToHttpApiData (toUrlPiece))
+
+-- FUTUREWORK: use Network.URI and toss this newtype.  servant should have all these instances for us these days.
+newtype URI = URI
+  { fromURI :: Net.URI
+  }
+  deriving (Eq, Ord, Show)
+
+instance A.FromJSON URI where
+  parseJSON = A.withText "URI" (parse . Text.unpack)
+
+instance A.ToJSON URI where
+  toJSON uri = A.String $ Text.pack (show (fromURI uri))
+
+instance ToByteString URI where
+  builder = builder . show . fromURI
+
+instance FromByteString URI where
+  parser = takeByteString >>= parse . Bytes.unpack
+
+instance ToHttpApiData URI where
+  toUrlPiece = decodeUtf8 . toByteString'
+
+instance S.ToParamSchema URI where
+  toParamSchema _ =
+    S.toParamSchema (Proxy @Text)
+      & S.type_ ?~ S.OpenApiString
+      & S.description ?~ "Valid URI"
+
+parse :: (MonadFail m) => String -> m URI
+parse = maybe (fail "Invalid URI") (pure . URI) . Net.parseURI
+
+-- | This is created in gundeck by cannon every time the client opens a new websocket connection.
+-- (That's why we always have a 'ConnId' from the most recent connection by that client.)
+data Presence = Presence
+  { userId :: !UserId,
+    connId :: !ConnId,
+    -- | cannon instance hosting the presence
+    resource :: !URI,
+    -- | This is 'Nothing' if either (a) the presence is older
+    -- than mandatory end-to-end encryption, or (b) the client is
+    -- operating the team settings pages without the need for
+    -- end-to-end crypto.
+    clientId :: !(Maybe ClientId),
+    createdAt :: !Milliseconds,
+    -- | REFACTOR: temp. addition to ease migration
+    __field :: !Lazy.ByteString
+  }
+  deriving (Eq, Ord, Show)
+  deriving (A.FromJSON, A.ToJSON, S.ToSchema) via (Schema Presence)
+
+instance ToSchema Presence where
+  schema =
+    object "Presence" $
+      ( Presence
+          <$> userId .= field "user_id" schema
+          <*> connId .= field "device_id" schema
+          <*> resource .= field "resource" uriSchema
+          <*> clientId .= optField "client_id" (maybeWithDefault A.Null schema) -- keep null for backwards compat
+          <*> createdAt .= (fromMaybe 0 <$> (optField "created_at" schema))
+      )
+        <&> ($ ("" :: Lazy.ByteString))
+
+uriSchema :: ValueSchema NamedSwaggerDoc URI
+uriSchema = mkSchema desc uriFromJSON (Just . uriToJSON)
+  where
+    desc :: NamedSwaggerDoc
+    desc =
+      swaggerDoc @Text
+        & (S.schema . S.type_ ?~ S.OpenApiString)
+        & (S.schema . S.description ?~ "Valid URI.")
+
+uriFromJSON :: A.Value -> A.Parser URI
+uriFromJSON = A.withText "URI" (p . Text.unpack)
+  where
+    p :: (MonadFail m) => String -> m URI
+    p = maybe (fail "Invalid URI") pure . parse
+
+uriToJSON :: URI -> A.Value
+uriToJSON (URI uri) = A.String . Text.pack $ Net.uriToString id uri mempty