Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions changelog.d/1-api-changes/WPB-3798
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
The JSON schema of `NonConnectedBackends` has changed to have its single field now called `non_connected_backends`.
3 changes: 3 additions & 0 deletions changelog.d/5-internal/WPB-3798
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
JSON derived schemas have been changed to no longer pre-process record fields to drop prefixes that were required to disambiguate fields.
Prefix processing still exists to drop leading underscores from field names, as we are using prefixed field names with `makeLenses`.
Code has been updated to use `OverloadedRecordDot` with the changed field names.
4 changes: 2 additions & 2 deletions libs/types-common/src/Data/Code.hs
Original file line number Diff line number Diff line change
Expand Up @@ -119,8 +119,8 @@ deriving instance Cql Value
-- (but without a type, using plain fields). This will make it easier to re-use a key/value
-- pair in the API, keeping "code" in the JSON for backwards compatibility
data KeyValuePair = KeyValuePair
{ kcKey :: !Key,
kcCode :: !Value
{ key :: !Key,
code :: !Value
}
deriving (Eq, Generic, Show)

Expand Down
12 changes: 4 additions & 8 deletions libs/types-common/src/Data/Json/Util.hs
Original file line number Diff line number Diff line change
Expand Up @@ -172,20 +172,16 @@ instance ToSchema A.Object where
-- toJSONFieldName

-- | Convenient helper to convert field names to use as JSON fields.
-- it removes the prefix (assumed to be anything before an uppercase
-- character) and converts the rest to underscore
-- it converts the field names to snake_case.
--
-- Example:
-- newtype TeamName = TeamName { tnTeamName :: Text }
-- deriveJSON toJSONFieldName ''tnTeamName
-- newtype TeamName = TeamName { teamName :: Text }
-- deriveJSON toJSONFieldName ''teamName
--
-- would generate {To/From}JSON instances where
-- the field name is "team_name"
toJSONFieldName :: A.Options
toJSONFieldName = A.defaultOptions {A.fieldLabelModifier = A.camelTo2 '_' . dropPrefix}
where
dropPrefix :: String -> String
dropPrefix = dropWhile (not . isUpper)
toJSONFieldName = A.defaultOptions {A.fieldLabelModifier = A.camelTo2 '_'}

--------------------------------------------------------------------------------

Expand Down
10 changes: 5 additions & 5 deletions libs/types-common/src/Util/Options.hs
Original file line number Diff line number Diff line change
Expand Up @@ -75,8 +75,8 @@ urlPort u = do
makeLenses ''AWSEndpoint

data Endpoint = Endpoint
{ _epHost :: !Text,
_epPort :: !Word16
{ _host :: !Text,
_port :: !Word16
}
deriving (Show, Generic)

Expand All @@ -85,14 +85,14 @@ deriveFromJSON toOptionFieldName ''Endpoint
makeLenses ''Endpoint

data CassandraOpts = CassandraOpts
{ _casEndpoint :: !Endpoint,
_casKeyspace :: !Text,
{ _endpoint :: !Endpoint,
_keyspace :: !Text,
-- | If this option is unset, use all available nodes.
-- If this option is set, use only cassandra nodes in the given datacentre
--
-- This option is most likely only necessary during a cassandra DC migration
-- FUTUREWORK: remove this option again, or support a datacentre migration feature
_casFilterNodesByDatacentre :: !(Maybe Text)
_filterNodesByDatacentre :: !(Maybe Text)
}
deriving (Show, Generic)

Expand Down
9 changes: 4 additions & 5 deletions libs/types-common/src/Util/Options/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -28,12 +28,11 @@ import System.Posix.Env qualified as Posix
-- NOTE: We typically use this for options in the configuration files!
-- If you are looking into converting record field name to JSON to be used
-- over the API, look for toJSONFieldName in the Data.Json.Util module.
-- It removes the prefix (assumed to be anything before an uppercase
-- character) and lowers the first character
-- It converts field names into snake_case
--
-- Example:
-- newtype TeamName = TeamName { tnTeamName :: Text }
-- deriveJSON toJSONFieldName ''tnTeamName
-- newtype TeamName = TeamName { teamName :: Text }
-- deriveJSON toJSONFieldName ''teamName
--
-- would generate {To/From}JSON instances where
-- the field name is "teamName"
Expand All @@ -44,7 +43,7 @@ toOptionFieldName = defaultOptions {fieldLabelModifier = lowerFirst . dropPrefix
lowerFirst (x : xs) = toLower x : xs
lowerFirst [] = ""
dropPrefix :: String -> String
dropPrefix = dropWhile (not . isUpper)
dropPrefix = dropWhile ('_' ==)

optOrEnv :: (a -> b) -> Maybe a -> (String -> b) -> String -> IO b
optOrEnv getter conf reader var = case conf of
Expand Down
25 changes: 14 additions & 11 deletions libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs
Original file line number Diff line number Diff line change
Expand Up @@ -75,26 +75,29 @@ type BrigApi =
:<|> FedEndpoint "get-not-fully-connected-backends" DomainSet NonConnectedBackends

newtype DomainSet = DomainSet
{ dsDomains :: Set Domain
{ domains :: Set Domain
}
deriving stock (Eq, Show, Generic)
deriving (ToJSON, FromJSON) via (CustomEncoded DomainSet)

newtype NonConnectedBackends = NonConnectedBackends
-- TODO:
-- The encoding rules that were in place would make this "connectedBackends" over the wire.
-- I do not think that this was intended, so I'm leaving this note as it will be an API break.
{ nonConnectedBackends :: Set Domain
}
deriving stock (Eq, Show, Generic)
deriving (ToJSON, FromJSON) via (CustomEncoded NonConnectedBackends)

newtype GetUserClients = GetUserClients
{ gucUsers :: [UserId]
{ users :: [UserId]
}
deriving stock (Eq, Show, Generic)
deriving (ToJSON, FromJSON) via (CustomEncoded GetUserClients)

data MLSClientsRequest = MLSClientsRequest
{ mcrUserId :: UserId, -- implicitly qualified by the local domain
mcrSignatureScheme :: SignatureSchemeTag
{ userId :: UserId, -- implicitly qualified by the local domain
signatureScheme :: SignatureSchemeTag
}
deriving stock (Eq, Show, Generic)
deriving (ToJSON, FromJSON) via (CustomEncoded MLSClientsRequest)
Expand All @@ -117,10 +120,10 @@ data MLSClientsRequest = MLSClientsRequest

data NewConnectionRequest = NewConnectionRequest
{ -- | The 'from' userId is understood to always have the domain of the backend making the connection request
ncrFrom :: UserId,
from :: UserId,
-- | The 'to' userId is understood to always have the domain of the receiving backend.
ncrTo :: UserId,
ncrAction :: RemoteConnectionAction
to :: UserId,
action :: RemoteConnectionAction
}
deriving stock (Eq, Show, Generic)
deriving (Arbitrary) via (GenericUniform NewConnectionRequest)
Expand All @@ -144,20 +147,20 @@ type UserDeletedNotificationMaxConnections = 1000

data UserDeletedConnectionsNotification = UserDeletedConnectionsNotification
{ -- | This is qualified implicitly by the origin domain
udcnUser :: UserId,
user :: UserId,
-- | These are qualified implicitly by the target domain
udcnConnections :: Range 1 UserDeletedNotificationMaxConnections [UserId]
connections :: Range 1 UserDeletedNotificationMaxConnections [UserId]
}
deriving stock (Eq, Show, Generic)
deriving (Arbitrary) via (GenericUniform UserDeletedConnectionsNotification)
deriving (FromJSON, ToJSON) via (CustomEncoded UserDeletedConnectionsNotification)

data ClaimKeyPackageRequest = ClaimKeyPackageRequest
{ -- | The user making the request, implictly qualified by the origin domain.
ckprClaimant :: UserId,
claimant :: UserId,
-- | The user whose key packages are being claimed, implictly qualified by
-- the target domain.
ckprTarget :: UserId
target :: UserId
}
deriving stock (Eq, Show, Generic)
deriving (Arbitrary) via (GenericUniform ClaimKeyPackageRequest)
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -29,19 +29,19 @@ import Wire.Arbitrary (Arbitrary, GenericUniform (..))

data GetAsset = GetAsset
{ -- | User requesting the asset. Implictly qualified with the source domain.
gaUser :: UserId,
user :: UserId,
-- | Asset key for the asset to download. Implictly qualified with the
-- target domain.
gaKey :: AssetKey,
key :: AssetKey,
-- | Optional asset token.
gaToken :: Maybe AssetToken
token :: Maybe AssetToken
}
deriving stock (Eq, Show, Generic)
deriving (Arbitrary) via (GenericUniform GetAsset)
deriving (ToJSON, FromJSON) via (CustomEncoded GetAsset)

data GetAssetResponse = GetAssetResponse
{gaAvailable :: Bool}
{available :: Bool}
deriving stock (Eq, Show, Generic)
deriving (Arbitrary) via (GenericUniform GetAssetResponse)
deriving (ToJSON, FromJSON) via (CustomEncoded GetAssetResponse)
Expand Down
Loading