Revert "Servantify own client API (#1584)"

This reverts commit ea71a38.

libs/schema-profunctor/src/Data/Schema.hs

@@ -258,6 +258,7 @@ schemaOut (SchemaP _ _ (SchemaOut o)) = o
 
 -- | A schema for a one-field JSON object.
 field ::
+  forall doc' doc a b.
   HasField doc' doc =>
   Text ->
   SchemaP doc' A.Value A.Value a b ->
@@ -292,8 +293,8 @@ fieldWithDocModifier ::
   HasField doc' doc =>
   Text ->
   (doc' -> doc') ->
-  SchemaP doc' A.Value A.Value a b ->
-  SchemaP doc A.Object [A.Pair] a b
+  ValueSchema doc' a ->
+  ObjectSchema doc a
 fieldWithDocModifier name modify sch = field name (over doc modify sch)
 
 -- | Change the input type of a schema.

libs/types-common/src/Data/Misc.hs

@@ -64,6 +64,7 @@ import Cassandra
 import Control.Lens (makeLenses, (.~), (?~), (^.))
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as A
+import qualified Data.Aeson.Types as A
 import qualified Data.Attoparsec.ByteString.Char8 as Chars
 import Data.Bifunctor (Bifunctor (first))
 import qualified Data.ByteString.Base64 as B64
@@ -80,7 +81,6 @@ import qualified Data.Swagger.Build.Api as Doc
 import qualified Data.Text as Text
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Imports
-import Servant (FromHttpApiData (..))
 import Test.QuickCheck (Arbitrary (arbitrary), chooseInteger)
 import qualified Test.QuickCheck as QC
 import Text.Read (Read (..))
@@ -93,12 +93,6 @@ import qualified URI.ByteString.QQ as URI.QQ
 newtype IpAddr = IpAddr {ipAddr :: IP}
   deriving stock (Eq, Ord, Show, Generic)
 
-instance S.ToParamSchema IpAddr where
-  toParamSchema _ = mempty & S.type_ ?~ S.SwaggerString
-
-instance FromHttpApiData IpAddr where
-  parseQueryParam p = first Text.pack (runParser parser (encodeUtf8 p))
-
 instance FromByteString IpAddr where
   parser = do
     s <- Chars.takeWhile1 (not . isSpace)
@@ -153,14 +147,6 @@ data Location = Location
     _longitude :: !Double
   }
   deriving stock (Eq, Ord, Generic)
-  deriving (FromJSON, ToJSON, S.ToSchema) via Schema Location
-
-instance ToSchema Location where
-  schema =
-    object "Location" $
-      Location
-        <$> _latitude .= field "lat" genericToSchema
-        <*> _longitude .= field "lon" genericToSchema
 
 instance Show Location where
   show p =
@@ -191,6 +177,28 @@ modelLocation = Doc.defineModel "Location" $ do
   Doc.property "lon" Doc.double' $
     Doc.description "Longitude"
 
+instance ToJSON Location where
+  toJSON p = A.object ["lat" A..= (p ^. latitude), "lon" A..= (p ^. longitude)]
+
+instance FromJSON Location where
+  parseJSON = A.withObject "Location" $ \o ->
+    location
+      <$> (Latitude <$> o A..: "lat")
+      <*> (Longitude <$> o A..: "lon")
+
+instance S.ToSchema Location where
+  declareNamedSchema _ = do
+    doubleSchema <- S.declareSchemaRef (Proxy @Double)
+    return $
+      S.NamedSchema (Just "Location") $
+        mempty
+          & S.type_ ?~ S.SwaggerObject
+          & S.properties
+            .~ [ ("lat", doubleSchema),
+                 ("lon", doubleSchema)
+               ]
+          & S.required .~ ["lat", "lon"]
+
 instance Arbitrary Location where
   arbitrary = Location <$> arbitrary <*> arbitrary
 
@@ -330,15 +338,15 @@ instance Arbitrary (Fingerprint Rsa) where
 newtype PlainTextPassword = PlainTextPassword
   {fromPlainTextPassword :: Text}
   deriving stock (Eq, Generic)
-  deriving (FromJSON, ToJSON, S.ToSchema) via Schema PlainTextPassword
+  deriving newtype (ToJSON)
 
 instance Show PlainTextPassword where
   show _ = "PlainTextPassword <hidden>"
 
-instance ToSchema PlainTextPassword where
-  schema =
-    PlainTextPassword
-      <$> fromPlainTextPassword .= untypedRangedSchema 6 1024 schema
+instance FromJSON PlainTextPassword where
+  parseJSON x =
+    PlainTextPassword . fromRange
+      <$> (parseJSON x :: A.Parser (Range 6 1024 Text))
 
 instance Arbitrary PlainTextPassword where
   -- TODO: why 6..1024? For tests we might want invalid passwords as well, e.g. 3 chars

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

@@ -84,8 +84,3 @@ type UnknownClient = ErrorDescription 403 "Unknown Client"
 
 unknownClient :: UnknownClient
 unknownClient = ErrorDescription "unknown-client" "Sending client not known"
-
-type ClientNotFound = ErrorDescription 404 "Client not found"
-
-clientNotFound :: ClientNotFound
-clientNotFound = ErrorDescription "client-not-found" "client not found"

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

@@ -23,18 +23,16 @@ import Data.CommaSeparatedList (CommaSeparatedList)
 import Data.Domain
 import Data.Handle
 import Data.Id as Id
-import Data.Misc (IpAddr)
 import Data.Qualified (Qualified (..))
 import Data.Range
-import Data.Swagger hiding (Contact, Header)
+import Data.Swagger hiding (Contact)
 import Imports hiding (head)
 import Servant (JSON)
 import Servant hiding (Handler, JSON, addHeader, respond)
 import Servant.API.Generic
 import Servant.Swagger (HasSwagger (toSwagger))
 import Servant.Swagger.Internal.Orphans ()
-import Wire.API.ErrorDescription (ClientNotFound)
-import Wire.API.Routes.Public (EmptyResult, ZConn, ZUser)
+import Wire.API.Routes.Public (EmptyResult, ZUser)
 import Wire.API.User
 import Wire.API.User.Client
 import Wire.API.User.Client.Prekey
@@ -50,10 +48,6 @@ type CaptureUserId name = Capture' '[Description "User Id"] name UserId
 
 type CaptureClientId name = Capture' '[Description "ClientId"] name ClientId
 
-type NewClientResponse = Headers '[Header "Location" ClientId] Client
-
-type GetClientResponse = [WithStatus 200 Client, ClientNotFound]
-
 data Api routes = Api
   { -- Note [document responses]
     --
@@ -274,65 +268,6 @@ data Api routes = Api
         :> "list-prekeys"
         :> ReqBody '[JSON] QualifiedUserClients
         :> Post '[JSON] QualifiedUserClientPrekeyMap,
-    -- User Client API ----------------------------------------------------
-
-    -- This endpoint can lead to the following events being sent:
-    -- - ClientAdded event to self
-    -- - ClientRemoved event to self, if removing old clients due to max number
-    --   Doc.errorResponse tooManyClients
-    --   Doc.errorResponse missingAuthError
-    --   Doc.errorResponse malformedPrekeys
-    addClient ::
-      routes :- Summary "Register a new client"
-        :> ZUser
-        :> ZConn
-        :> "clients"
-        :> Header "X-Forwarded-For" IpAddr
-        :> ReqBody '[JSON] NewClient
-        :> Verb 'POST 201 '[JSON] NewClientResponse,
-    --   Doc.errorResponse malformedPrekeys
-    updateClient ::
-      routes :- Summary "Update a registered client"
-        :> ZUser
-        :> "clients"
-        :> CaptureClientId "client"
-        :> ReqBody '[JSON] UpdateClient
-        :> Put '[] (EmptyResult 200),
-    -- This endpoint can lead to the following events being sent:
-    -- - ClientRemoved event to self
-    deleteClient ::
-      routes :- Summary "Delete an existing client"
-        :> ZUser
-        :> ZConn
-        :> "clients"
-        :> CaptureClientId "client"
-        :> ReqBody '[JSON] RmClient
-        :> Delete '[] (EmptyResult 200),
-    listClients ::
-      routes :- Summary "List the registered clients"
-        :> ZUser
-        :> "clients"
-        :> Get '[JSON] [Client],
-    getClient ::
-      routes :- Summary "Get a register client by ID"
-        :> ZUser
-        :> "clients"
-        :> CaptureClientId "client"
-        :> UVerb 'GET '[JSON] GetClientResponse,
-    getClientCapabilities ::
-      routes :- Summary "Read back what the client has been posting about itself"
-        :> ZUser
-        :> "clients"
-        :> CaptureClientId "client"
-        :> "capabilities"
-        :> Get '[JSON] ClientCapabilityList,
-    getClientPrekeys ::
-      routes :- Summary "List the remaining prekey IDs of a client"
-        :> ZUser
-        :> "clients"
-        :> CaptureClientId "client"
-        :> "prekeys"
-        :> Get '[JSON] [PrekeyId],
     searchContacts ::
       routes :- Summary "Search for users"
         :> ZUser

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

@@ -59,8 +59,7 @@ import qualified Data.Code as Code
 import Data.Handle (Handle)
 import Data.Id (UserId)
 import Data.Misc (PlainTextPassword (..))
-import Data.Schema (ToSchema)
-import qualified Data.Swagger as S
+import Data.Swagger (ToSchema)
 import qualified Data.Swagger.Build.Api as Doc
 import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)
 import Data.Time.Clock (UTCTime)
@@ -321,16 +320,7 @@ instance FromJSON (Cookie ()) where
 newtype CookieLabel = CookieLabel
   {cookieLabelText :: Text}
   deriving stock (Eq, Ord, Show, Generic)
-  deriving newtype
-    ( FromJSON,
-      ToJSON,
-      FromByteString,
-      ToByteString,
-      IsString,
-      Arbitrary,
-      S.ToSchema,
-      ToSchema
-    )
+  deriving newtype (FromJSON, ToJSON, FromByteString, ToByteString, IsString, Arbitrary, ToSchema)
 
 newtype CookieId = CookieId
   {cookieIdNum :: Word32}