Skip to content

Commit 2fbc78c

Browse files
battermannbattermann
authored
Servantify stern part 1 (#2742)
1 parent 52e30c2 commit 2fbc78c

File tree

12 files changed

+229
-81
lines changed

12 files changed

+229
-81
lines changed

‎changelog.d/5-internal/pr-2742

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
Add swagger2-ui to stern (#2742 ...)

‎libs/brig-types/brig-types.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -84,6 +84,7 @@ library
8484
, deriving-swagger2 >=0.1.0
8585
, imports
8686
, QuickCheck >=2.9
87+
, schema-profunctor
8788
, servant-server >=0.18.2
8889
, servant-swagger >=1.1.10
8990
, string-conversions
@@ -165,6 +166,7 @@ test-suite brig-types-tests
165166
, QuickCheck >=2.9
166167
, swagger2 >=2.5
167168
, tasty
169+
, tasty-hunit
168170
, tasty-quickcheck
169171
, text >=0.11
170172
, time >=1.1

‎libs/brig-types/src/Brig/Types/Intra.hs

Lines changed: 27 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,3 @@
1-
{-# LANGUAGE OverloadedStrings #-}
2-
31
-- This file is part of the Wire Server implementation.
42
--
53
-- Copyright (C) 2022 Wire Swiss GmbH <[email protected]>
@@ -30,14 +28,16 @@ module Brig.Types.Intra
3028
)
3129
where
3230

33-
import Data.Aeson
34-
import qualified Data.Aeson.KeyMap as KeyMap
31+
import Data.Aeson as A
3532
import Data.Code as Code
3633
import Data.Id (TeamId)
3734
import Data.Misc (PlainTextPassword (..))
38-
import qualified Data.Text as Text
35+
import qualified Data.Schema as Schema
36+
import qualified Data.Swagger as S
3937
import Imports
38+
import Test.QuickCheck (Arbitrary)
4039
import Wire.API.User
40+
import Wire.Arbitrary (GenericUniform (..))
4141

4242
-------------------------------------------------------------------------------
4343
-- AccountStatus
@@ -52,22 +52,19 @@ data AccountStatus
5252
-- creating via scim.
5353
PendingInvitation
5454
deriving (Eq, Show, Generic)
55-
56-
instance FromJSON AccountStatus where
57-
parseJSON = withText "account-status" $ \s -> case Text.toLower s of
58-
"active" -> pure Active
59-
"suspended" -> pure Suspended
60-
"deleted" -> pure Deleted
61-
"ephemeral" -> pure Ephemeral
62-
"pending-invitation" -> pure PendingInvitation
63-
_ -> fail $ "Invalid account status: " ++ Text.unpack s
64-
65-
instance ToJSON AccountStatus where
66-
toJSON Active = String "active"
67-
toJSON Suspended = String "suspended"
68-
toJSON Deleted = String "deleted"
69-
toJSON Ephemeral = String "ephemeral"
70-
toJSON PendingInvitation = String "pending-invitation"
55+
deriving (Arbitrary) via (GenericUniform AccountStatus)
56+
deriving (ToJSON, FromJSON, S.ToSchema) via Schema.Schema AccountStatus
57+
58+
instance Schema.ToSchema AccountStatus where
59+
schema =
60+
Schema.enum @Text "AccountStatus" $
61+
mconcat
62+
[ Schema.element "active" Active,
63+
Schema.element "suspended" Suspended,
64+
Schema.element "deleted" Deleted,
65+
Schema.element "ephemeral" Ephemeral,
66+
Schema.element "pending-invitation" PendingInvitation
67+
]
7168

7269
data AccountStatusResp = AccountStatusResp {fromAccountStatusResp :: AccountStatus}
7370

@@ -100,21 +97,15 @@ data UserAccount = UserAccount
10097
accountStatus :: !AccountStatus
10198
}
10299
deriving (Eq, Show, Generic)
103-
104-
instance FromJSON UserAccount where
105-
parseJSON j@(Object o) = do
106-
u <- parseJSON j
107-
s <- o .: "status"
108-
pure $ UserAccount u s
109-
parseJSON _ = mzero
110-
111-
instance ToJSON UserAccount where
112-
toJSON (UserAccount u s) =
113-
case toJSON u of
114-
Object o ->
115-
Object $ KeyMap.insert "status" (toJSON s) o
116-
other ->
117-
error $ "toJSON UserAccount: not an object: " <> show (encode other)
100+
deriving (Arbitrary) via (GenericUniform UserAccount)
101+
deriving (ToJSON, FromJSON, S.ToSchema) via Schema.Schema UserAccount
102+
103+
instance Schema.ToSchema UserAccount where
104+
schema =
105+
Schema.object "UserAccount" $
106+
UserAccount
107+
<$> accountUser Schema..= userObjectSchema
108+
<*> accountStatus Schema..= Schema.field "status" Schema.schema
118109

119110
-------------------------------------------------------------------------------
120111
-- NewUserScimInvitation

‎libs/brig-types/test/unit/Test/Brig/Types/User.hs

Lines changed: 18 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -26,13 +26,15 @@
2626
module Test.Brig.Types.User where
2727

2828
import Brig.Types.Connection (UpdateConnectionsInternal (..))
29-
import Brig.Types.Intra (NewUserScimInvitation (..), ReAuthUser (..))
29+
import Brig.Types.Intra (NewUserScimInvitation (..), ReAuthUser (..), UserAccount (..))
3030
import Brig.Types.Search (SearchVisibilityInbound (..))
3131
import Brig.Types.User (ManagedByUpdate (..), RichInfoUpdate (..))
32+
import Data.Aeson
3233
import Imports
3334
import Test.Brig.Roundtrip (testRoundTrip, testRoundTripWithSwagger)
3435
import Test.QuickCheck (Arbitrary (arbitrary))
3536
import Test.Tasty
37+
import Test.Tasty.HUnit
3638
import Wire.API.Routes.Internal.Brig.EJPD (EJPDRequestBody (..), EJPDResponseBody (..))
3739

3840
tests :: TestTree
@@ -47,7 +49,10 @@ roundtripTests =
4749
testRoundTripWithSwagger @EJPDRequestBody,
4850
testRoundTripWithSwagger @EJPDResponseBody,
4951
testRoundTrip @UpdateConnectionsInternal,
50-
testRoundTrip @SearchVisibilityInbound
52+
testRoundTrip @SearchVisibilityInbound,
53+
testRoundTripWithSwagger @UserAccount,
54+
testGroup "golden tests" $
55+
[testCaseUserAccount]
5156
]
5257

5358
instance Arbitrary ManagedByUpdate where
@@ -61,3 +66,14 @@ instance Arbitrary ReAuthUser where
6166

6267
instance Arbitrary NewUserScimInvitation where
6368
arbitrary = NewUserScimInvitation <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
69+
70+
testCaseUserAccount :: TestTree
71+
testCaseUserAccount = testCase "UserAcccount" $ do
72+
assertEqual "1" (Just json1) (encode <$> decode @UserAccount json1)
73+
assertEqual "2" (Just json2) (encode <$> decode @UserAccount json2)
74+
where
75+
json1 :: LByteString
76+
json1 = "{\"accent_id\":1,\"assets\":[],\"deleted\":true,\"expires_at\":\"1864-05-09T17:20:22.192Z\",\"handle\":\"-ve\",\"id\":\"00000001-0000-0000-0000-000000000001\",\"locale\":\"lu\",\"managed_by\":\"wire\",\"name\":\"bla\",\"phone\":\"+433017355611929\",\"picture\":[],\"qualified_id\":{\"domain\":\"4-o60.j7-i\",\"id\":\"00000000-0000-0001-0000-000100000000\"},\"service\":{\"id\":\"00000000-0000-0001-0000-000000000001\",\"provider\":\"00000001-0000-0001-0000-000000000001\"},\"status\":\"suspended\",\"team\":\"00000000-0000-0001-0000-000100000001\"}"
77+
78+
json2 :: LByteString
79+
json2 = "{\"accent_id\":0,\"assets\":[{\"key\":\"3-4-00000000-0000-0001-0000-000000000000\",\"size\":\"preview\",\"type\":\"image\"}],\"email\":\"@\",\"expires_at\":\"1864-05-10T22:45:44.823Z\",\"handle\":\"b8m\",\"id\":\"00000001-0000-0000-0000-000100000000\",\"locale\":\"tk-KZ\",\"managed_by\":\"wire\",\"name\":\"name2\",\"picture\":[],\"qualified_id\":{\"domain\":\"1-8wq0.b22k1.w5\",\"id\":\"00000000-0000-0000-0000-000000000001\"},\"service\":{\"id\":\"00000000-0000-0001-0000-000000000001\",\"provider\":\"00000001-0000-0001-0000-000100000000\"},\"status\":\"pending-invitation\",\"team\":\"00000000-0000-0001-0000-000000000001\"}"

‎libs/wire-api/src/Wire/API/SwaggerHelper.hs

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
-- This file is part of the Wire Server implementation.
2+
--
3+
-- Copyright (C) 2022 Wire Swiss GmbH <[email protected]>
4+
--
5+
-- This program is free software: you can redistribute it and/or modify it under
6+
-- the terms of the GNU Affero General Public License as published by the Free
7+
-- Software Foundation, either version 3 of the License, or (at your option) any
8+
-- later version.
9+
--
10+
-- This program is distributed in the hope that it will be useful, but WITHOUT
11+
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12+
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
13+
-- details.
14+
--
15+
-- You should have received a copy of the GNU Affero General Public License along
16+
-- with this program. If not, see <https://www.gnu.org/licenses/>.
17+
18+
module Wire.API.SwaggerHelper where
19+
20+
import Control.Lens
21+
import Data.Containers.ListUtils (nubOrd)
22+
import Data.Swagger hiding (Contact, Header, Schema, ToSchema)
23+
import qualified Data.Swagger as S
24+
import Imports hiding (head)
25+
26+
cleanupSwagger :: Swagger -> Swagger
27+
cleanupSwagger =
28+
(S.security %~ nub)
29+
-- sanitise definitions
30+
. (S.definitions . traverse %~ sanitise)
31+
-- sanitise general responses
32+
. (S.responses . traverse . S.schema . _Just . S._Inline %~ sanitise)
33+
-- sanitise all responses of all paths
34+
. ( S.allOperations . S.responses . S.responses
35+
. traverse
36+
. S._Inline
37+
. S.schema
38+
. _Just
39+
. S._Inline
40+
%~ sanitise
41+
)
42+
where
43+
sanitise :: S.Schema -> S.Schema
44+
sanitise =
45+
(S.properties . traverse . S._Inline %~ sanitise)
46+
. (S.required %~ nubOrd)
47+
. (S.enum_ . _Just %~ nub)

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

Lines changed: 20 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,7 @@ module Wire.API.User
4040
ssoIssuerAndNameId,
4141
connectedProfile,
4242
publicProfile,
43+
userObjectSchema,
4344

4445
-- * NewUser
4546
NewUserPublic (..),
@@ -364,23 +365,25 @@ data User = User
364365
-- -- FUTUREWORK:
365366
-- -- disentangle json serializations for 'User', 'NewUser', 'UserIdentity', 'NewUserOrigin'.
366367
instance ToSchema User where
367-
schema =
368-
object "User" $
369-
User
370-
<$> userId .= field "id" schema
371-
<*> userQualifiedId .= field "qualified_id" schema
372-
<*> userIdentity .= maybeUserIdentityObjectSchema
373-
<*> userDisplayName .= field "name" schema
374-
<*> userPict .= (fromMaybe noPict <$> optField "picture" schema)
375-
<*> userAssets .= (fromMaybe [] <$> optField "assets" (array schema))
376-
<*> userAccentId .= field "accent_id" schema
377-
<*> (fromMaybe False <$> (\u -> if userDeleted u then Just True else Nothing) .= maybe_ (optField "deleted" schema))
378-
<*> userLocale .= field "locale" schema
379-
<*> userService .= maybe_ (optField "service" schema)
380-
<*> userHandle .= maybe_ (optField "handle" schema)
381-
<*> userExpire .= maybe_ (optField "expires_at" schema)
382-
<*> userTeam .= maybe_ (optField "team" schema)
383-
<*> userManagedBy .= (fromMaybe ManagedByWire <$> optField "managed_by" schema)
368+
schema = object "User" userObjectSchema
369+
370+
userObjectSchema :: ObjectSchema SwaggerDoc User
371+
userObjectSchema =
372+
User
373+
<$> userId .= field "id" schema
374+
<*> userQualifiedId .= field "qualified_id" schema
375+
<*> userIdentity .= maybeUserIdentityObjectSchema
376+
<*> userDisplayName .= field "name" schema
377+
<*> userPict .= (fromMaybe noPict <$> optField "picture" schema)
378+
<*> userAssets .= (fromMaybe [] <$> optField "assets" (array schema))
379+
<*> userAccentId .= field "accent_id" schema
380+
<*> (fromMaybe False <$> (\u -> if userDeleted u then Just True else Nothing) .= maybe_ (optField "deleted" schema))
381+
<*> userLocale .= field "locale" schema
382+
<*> userService .= maybe_ (optField "service" schema)
383+
<*> userHandle .= maybe_ (optField "handle" schema)
384+
<*> userExpire .= maybe_ (optField "expires_at" schema)
385+
<*> userTeam .= maybe_ (optField "team" schema)
386+
<*> userManagedBy .= (fromMaybe ManagedByWire <$> optField "managed_by" schema)
384387

385388
userEmail :: User -> Maybe Email
386389
userEmail = emailIdentity <=< userIdentity

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

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -64,6 +64,7 @@ import qualified Data.CaseInsensitive as CI
6464
import Data.Proxy (Proxy (..))
6565
import Data.Schema
6666
import Data.String.Conversions (cs)
67+
import Data.Swagger (ToParamSchema (..))
6768
import qualified Data.Swagger as S
6869
import qualified Data.Text as Text
6970
import Data.Text.Encoding (decodeUtf8', encodeUtf8)
@@ -163,6 +164,9 @@ data Email = Email
163164
deriving stock (Eq, Ord, Generic)
164165
deriving (FromJSON, ToJSON, S.ToSchema) via Schema Email
165166

167+
instance ToParamSchema Email where
168+
toParamSchema _ = toParamSchema (Proxy @Text)
169+
166170
instance ToSchema Email where
167171
schema =
168172
fromEmail

‎libs/wire-api/wire-api.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -95,6 +95,7 @@ library
9595
Wire.API.Routes.WebSocket
9696
Wire.API.ServantProto
9797
Wire.API.Swagger
98+
Wire.API.SwaggerHelper
9899
Wire.API.Team
99100
Wire.API.Team.Conversation
100101
Wire.API.Team.Export

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

Lines changed: 3 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -70,14 +70,13 @@ import Brig.User.Phone
7070
import qualified Cassandra as C
7171
import qualified Cassandra as Data
7272
import Control.Error hiding (bool)
73-
import Control.Lens (view, (%~), (.~), (?~), (^.), _Just)
73+
import Control.Lens (view, (.~), (?~), (^.))
7474
import Control.Monad.Catch (throwM)
7575
import Data.Aeson hiding (json)
7676
import Data.Bifunctor
7777
import qualified Data.ByteString.Lazy as Lazy
7878
import qualified Data.ByteString.Lazy.Char8 as LBS
7979
import Data.CommaSeparatedList (CommaSeparatedList (fromCommaSeparatedList))
80-
import Data.Containers.ListUtils (nubOrd)
8180
import Data.Domain
8281
import Data.FileEmbed
8382
import Data.Handle (Handle, parseHandle)
@@ -122,6 +121,7 @@ import qualified Wire.API.Routes.Public.Spar as SparAPI
122121
import qualified Wire.API.Routes.Public.Util as Public
123122
import Wire.API.Routes.Version
124123
import qualified Wire.API.Swagger as Public.Swagger (models)
124+
import Wire.API.SwaggerHelper (cleanupSwagger)
125125
import qualified Wire.API.Team as Public
126126
import Wire.API.Team.LegalHold (LegalholdProtectee (..))
127127
import Wire.API.User (RegisterError (RegisterErrorWhitelistError))
@@ -152,25 +152,7 @@ swaggerDocsAPI (Just V3) =
152152
)
153153
& S.info . S.title .~ "Wire-Server API"
154154
& S.info . S.description ?~ $(embedText =<< makeRelativeToProject "docs/swagger.md")
155-
& S.security %~ nub
156-
-- sanitise definitions
157-
& S.definitions . traverse %~ sanitise
158-
-- sanitise general responses
159-
& S.responses . traverse . S.schema . _Just . S._Inline %~ sanitise
160-
-- sanitise all responses of all paths
161-
& S.allOperations . S.responses . S.responses
162-
. traverse
163-
. S._Inline
164-
. S.schema
165-
. _Just
166-
. S._Inline
167-
%~ sanitise
168-
where
169-
sanitise :: S.Schema -> S.Schema
170-
sanitise =
171-
(S.properties . traverse . S._Inline %~ sanitise)
172-
. (S.required %~ nubOrd)
173-
. (S.enum_ . _Just %~ nub)
155+
& cleanupSwagger
174156
swaggerDocsAPI (Just V0) = swaggerPregenUIServer $(pregenSwagger V0)
175157
swaggerDocsAPI (Just V1) = swaggerPregenUIServer $(pregenSwagger V1)
176158
swaggerDocsAPI (Just V2) = swaggerPregenUIServer $(pregenSwagger V2)

0 commit comments

Comments
 (0)