Internal end-point for ejpd request processing.

charts/brig/templates/tests/configmap.yaml

@@ -22,6 +22,10 @@ data:
       host: cargohold
       port: 8080
 
+    gundeck:
+      host: gundeck
+      port: 8080
+
     spar:
       host: spar
       port: 8080

libs/brig-types/brig-types.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 1060fdc26ef57534c0f61722613ae48c5ebe98d481fcc21cae9c1ebab816a8bb
+-- hash: cdc8e9db5e496dfa5804937858da4ac01666e1c604c54b9c0ea9318d521aded2
 
 name:           brig-types
 version:        1.35.0
@@ -40,6 +40,7 @@ library
       Brig.Types.Test.Arbitrary
       Brig.Types.User
       Brig.Types.User.Auth
+      Brig.Types.User.EJPD
   other-modules:
       Paths_brig_types
   hs-source-dirs:
@@ -54,8 +55,12 @@ library
     , bytestring-conversion >=0.2
     , cassandra-util
     , containers >=0.5
+    , deriving-swagger2 >=0.1.0
     , imports
+    , servant-server >=0.18.2
+    , servant-swagger >=1.1.11
     , string-conversions
+    , swagger2 >=2.5
     , text >=0.11
     , time >=1.1
     , types-common >=0.16
@@ -77,18 +82,19 @@ test-suite brig-types-tests
   default-extensions: AllowAmbiguousTypes BangPatterns ConstraintKinds DataKinds DefaultSignatures DerivingStrategies DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable EmptyCase FlexibleContexts FlexibleInstances FunctionalDependencies GADTs InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PackageImports PatternSynonyms PolyKinds QuasiQuotes RankNTypes ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeFamilyDependencies TypeOperators UndecidableInstances ViewPatterns
   ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path -threaded -with-rtsopts=-N
   build-depends:
-      QuickCheck
-    , aeson
-    , attoparsec
-    , base
+      QuickCheck >=2.9
+    , aeson >=0.11
+    , attoparsec >=0.10
+    , base ==4.*
     , brig-types
-    , containers
+    , containers >=0.5
     , imports
+    , swagger2 >=2.5
     , tasty
     , tasty-quickcheck
-    , text
-    , time
-    , types-common
-    , unordered-containers
+    , text >=0.11
+    , time >=1.1
+    , types-common >=0.16
+    , unordered-containers >=0.2
     , wire-api
   default-language: Haskell2010

libs/brig-types/package.yaml

@@ -9,25 +9,29 @@ maintainer: Wire Swiss GmbH <backend@wire.com>
 copyright: (c) 2017 Wire Swiss GmbH
 license: AGPL-3
 dependencies:
+- aeson >=0.11
+- attoparsec >=0.10
+- base ==4.*
+- containers >=0.5
 - imports
+- QuickCheck >=2.9
+- swagger2 >=2.5
+- text >=0.11
+- time >=1.1
+- types-common >=0.16
+- unordered-containers >=0.2
 - wire-api
 library:
   source-dirs: src
   ghc-options:
   - -funbox-strict-fields
   dependencies:
-  - aeson >=0.11
-  - attoparsec >=0.10
-  - base ==4.*
   - bytestring-conversion >=0.2
   - cassandra-util
-  - containers >=0.5
-  - QuickCheck >=2.9
+  - deriving-swagger2 >=0.1.0
+  - servant-server >=0.18.2
+  - servant-swagger >=1.1.11
   - string-conversions
-  - text >=0.11
-  - time >=1.1
-  - types-common >=0.16
-  - unordered-containers >=0.2
 tests:
   brig-types-tests:
     main: Main.hs
@@ -36,15 +40,6 @@ tests:
     - -threaded
     - -with-rtsopts=-N
     dependencies:
-    - aeson
-    - attoparsec
-    - base
     - brig-types
-    - containers
-    - QuickCheck
     - tasty
     - tasty-quickcheck
-    - text
-    - time
-    - types-common
-    - unordered-containers

libs/brig-types/src/Brig/Types/User/EJPD.hs

@@ -0,0 +1,105 @@
+{-# LANGUAGE DerivingVia #-}
+
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2020 Wire Swiss GmbH <opensource@wire.com>
+--
+-- This program is free software: you can redistribute it and/or modify it under
+-- the terms of the GNU Affero General Public License as published by the Free
+-- Software Foundation, either version 3 of the License, or (at your option) any
+-- later version.
+--
+-- This program is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
+-- details.
+--
+-- You should have received a copy of the GNU Affero General Public License along
+-- with this program. If not, see <https://www.gnu.org/licenses/>.
+
+-- | Identify users for law enforcement.  (Wire has legal requirements to cooperate with the
+-- authorities.  The wire backend operations team uses this to answer identification requests
+-- manually.)
+module Brig.Types.User.EJPD
+  ( EJPDRequestBody (EJPDRequestBody, ejpdRequestBody),
+    EJPDResponseBody (EJPDResponseBody, ejpdResponseBody),
+    EJPDResponseItem (EJPDResponseItem, ejpdResponseHandle, ejpdResponsePushTokens, ejpdResponseContacts),
+  )
+where
+
+import Data.Aeson hiding (json)
+import Data.Handle (Handle)
+import Data.Id (TeamId, UserId)
+import Data.Swagger (ToSchema)
+import Deriving.Swagger (CamelToSnake, CustomSwagger (..), FieldLabelModifier, StripSuffix)
+import Imports hiding (head)
+import Test.QuickCheck (Arbitrary)
+import Wire.API.Arbitrary (GenericUniform (..))
+import Wire.API.Connection (Relation)
+import Wire.API.Team.Member (NewListType)
+import Wire.API.User.Identity (Email, Phone)
+import Wire.API.User.Profile (Name)
+
+newtype EJPDRequestBody = EJPDRequestBody {ejpdRequestBody :: [Handle]}
+  deriving stock (Eq, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform EJPDRequestBody)
+  deriving (ToSchema) via CustomSwagger '[FieldLabelModifier (CamelToSnake, StripSuffix "_body")] EJPDRequestBody
+
+newtype EJPDResponseBody = EJPDResponseBody {ejpdResponseBody :: [EJPDResponseItem]}
+  deriving stock (Eq, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform EJPDResponseBody)
+  deriving (ToSchema) via CustomSwagger '[FieldLabelModifier (CamelToSnake, StripSuffix "_body")] EJPDResponseBody
+
+data EJPDResponseItem = EJPDResponseItem
+  { ejpdResponseUserId :: UserId,
+    ejpdResponseTeamId :: Maybe TeamId,
+    ejpdResponseName :: Name,
+    ejpdResponseHandle :: Maybe Handle,
+    ejpdResponseEmail :: Maybe Email,
+    ejpdResponsePhone :: Maybe Phone,
+    ejpdResponsePushTokens :: Set Text, -- 'Wire.API.Push.V2.Token.Token', but that would produce an orphan instance.
+    ejpdResponseContacts :: Maybe (Set (Relation, EJPDResponseItem)),
+    ejpdResponseTeamContacts :: Maybe (Set EJPDResponseItem, NewListType)
+  }
+  deriving stock (Eq, Ord, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform EJPDResponseItem)
+  deriving (ToSchema) via CustomSwagger '[FieldLabelModifier CamelToSnake] EJPDResponseItem
+
+instance ToJSON EJPDRequestBody where
+  toJSON (EJPDRequestBody hs) = object ["ejpd_request" .= hs]
+
+instance FromJSON EJPDRequestBody where
+  parseJSON = withObject "EJPDRequestBody" $ EJPDRequestBody <$$> (.: "ejpd_request")
+
+instance ToJSON EJPDResponseBody where
+  toJSON (EJPDResponseBody is) = object ["ejpd_response" .= is]
+
+instance FromJSON EJPDResponseBody where
+  parseJSON = withObject "EJPDResponseBody" $ EJPDResponseBody <$$> (.: "ejpd_response")
+
+instance ToJSON EJPDResponseItem where
+  toJSON rspi =
+    object
+      [ "ejpd_response_user_id" .= ejpdResponseUserId rspi,
+        "ejpd_response_team_id" .= ejpdResponseTeamId rspi,
+        "ejpd_response_name" .= ejpdResponseName rspi,
+        "ejpd_response_handle" .= ejpdResponseHandle rspi,
+        "ejpd_response_email" .= ejpdResponseEmail rspi,
+        "ejpd_response_phone" .= ejpdResponsePhone rspi,
+        "ejpd_response_push_tokens" .= ejpdResponsePushTokens rspi,
+        "ejpd_response_contacts" .= ejpdResponseContacts rspi,
+        "ejpd_response_team_contacts" .= ejpdResponseTeamContacts rspi
+      ]
+
+instance FromJSON EJPDResponseItem where
+  parseJSON = withObject "EJPDResponseItem" $ \obj ->
+    EJPDResponseItem
+      <$> obj .: "ejpd_response_user_id"
+      <*> obj .:? "ejpd_response_team_id"
+      <*> obj .: "ejpd_response_name"
+      <*> obj .:? "ejpd_response_handle"
+      <*> obj .:? "ejpd_response_email"
+      <*> obj .:? "ejpd_response_phone"
+      <*> obj .: "ejpd_response_push_tokens"
+      <*> obj .:? "ejpd_response_contacts"
+      <*> obj .:? "ejpd_response_team_contacts"

libs/brig-types/test/unit/Test/Brig/Roundtrip.hs

@@ -19,11 +19,13 @@ module Test.Brig.Roundtrip where
 
 import Data.Aeson (FromJSON, ToJSON, parseJSON, toJSON)
 import Data.Aeson.Types (parseEither)
+import Data.Swagger (ToSchema, validatePrettyToJSON)
 import Imports
 import Test.Tasty (TestTree)
-import Test.Tasty.QuickCheck (Arbitrary, counterexample, testProperty, (===))
+import Test.Tasty.QuickCheck (Arbitrary, counterexample, testProperty, (.&&.), (===))
 import Type.Reflection (typeRep)
 
+-- FUTUREWORK: make this an alias for 'testRoundTripWithSwagger' (or just remove the latter).
 testRoundTrip ::
   forall a.
   (Arbitrary a, Typeable a, ToJSON a, FromJSON a, Eq a, Show a) =>
@@ -34,3 +36,22 @@ testRoundTrip = testProperty msg trip
     trip (v :: a) =
       counterexample (show $ toJSON v) $
         Right v === (parseEither parseJSON . toJSON) v
+
+testRoundTripWithSwagger ::
+  forall a.
+  (Arbitrary a, Typeable a, ToJSON a, FromJSON a, ToSchema a, Eq a, Show a) =>
+  TestTree
+testRoundTripWithSwagger = testProperty msg (trip .&&. scm)
+  where
+    msg = show (typeRep @a)
+
+    trip (v :: a) =
+      counterexample (show $ toJSON v) $
+        Right v === (parseEither parseJSON . toJSON) v
+
+    scm (v :: a) =
+      counterexample
+        ( fromMaybe "Schema validation failed, but there were no errors. This looks like a bug in swagger2!" $
+            validatePrettyToJSON v
+        )
+        $ isNothing (validatePrettyToJSON v)

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

@@ -29,8 +29,9 @@ module Test.Brig.Types.User where
 
 import Brig.Types.Intra (NewUserScimInvitation (..), ReAuthUser (..))
 import Brig.Types.User (ManagedByUpdate (..), RichInfoUpdate (..))
+import Brig.Types.User.EJPD (EJPDRequestBody (..), EJPDResponseBody (..))
 import Imports
-import Test.Brig.Roundtrip (testRoundTrip)
+import Test.Brig.Roundtrip (testRoundTrip, testRoundTripWithSwagger)
 import Test.QuickCheck (Arbitrary (arbitrary))
 import Test.Tasty
 
@@ -42,7 +43,9 @@ roundtripTests =
   [ testRoundTrip @ManagedByUpdate,
     testRoundTrip @ReAuthUser,
     testRoundTrip @RichInfoUpdate,
-    testRoundTrip @NewUserScimInvitation
+    testRoundTrip @NewUserScimInvitation,
+    testRoundTripWithSwagger @EJPDRequestBody,
+    testRoundTripWithSwagger @EJPDResponseBody
   ]
 
 instance Arbitrary ManagedByUpdate where

libs/hscim/src/Web/Scim/Schema/User/Phone.hs

@@ -26,7 +26,7 @@ data Phone = Phone
   { typ :: Maybe Text,
     value :: Maybe Text
   }
-  deriving (Show, Eq, Generic)
+  deriving (Show, Eq, Ord, Generic)
 
 instance FromJSON Phone where
   parseJSON = genericParseJSON parseOptions . jsonLower

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

@@ -46,7 +46,7 @@ import Util.Attoparsec (takeUpToWhile)
 -- | Also called username.
 newtype Handle = Handle
   {fromHandle :: Text}
-  deriving stock (Eq, Show, Generic)
+  deriving stock (Eq, Ord, Show, Generic)
   deriving newtype (ToJSON, ToByteString, Hashable, ToSchema, ToParamSchema)
 
 instance FromHttpApiData Handle where

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

@@ -50,7 +50,9 @@ import Data.Id
 import Data.Json.Util (UTCTimeMillis)
 import Data.Range
 import qualified Data.Swagger.Build.Api as Doc
+import Data.Swagger.Schema
 import Data.Text as Text
+import Deriving.Swagger (CamelToSnake, ConstructorTagModifier, CustomSwagger)
 import Imports
 import Wire.API.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))
 
@@ -160,6 +162,7 @@ data Relation
   | Cancelled
   deriving stock (Eq, Ord, Show, Generic)
   deriving (Arbitrary) via (GenericUniform Relation)
+  deriving (ToSchema) via (CustomSwagger '[ConstructorTagModifier CamelToSnake] Relation)
 
 typeRelation :: Doc.DataType
 typeRelation =

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

@@ -37,6 +37,8 @@ module Wire.API.Team.Member
     teamMemberListType,
     HardTruncationLimit,
     hardTruncationLimit,
+    NewListType (..),
+    toNewListType,
     ListType (..),
     teamMemberListJson,
 
@@ -68,6 +70,8 @@ import Data.Misc (PlainTextPassword (..))
 import Data.Proxy
 import Data.String.Conversions (cs)
 import qualified Data.Swagger.Build.Api as Doc
+import Data.Swagger.Schema (ToSchema)
+import Deriving.Swagger (CamelToSnake, ConstructorTagModifier, CustomSwagger, StripPrefix)
 import GHC.TypeLits
 import Imports
 import Wire.API.Arbitrary (Arbitrary, GenericUniform (..))
@@ -195,10 +199,33 @@ type HardTruncationLimit = (2000 :: Nat)
 hardTruncationLimit :: Integral a => a
 hardTruncationLimit = fromIntegral $ natVal (Proxy @HardTruncationLimit)
 
+-- | Like 'ListType', but without backwards-compatible and boolean-blind json serialization.
+data NewListType
+  = NewListComplete
+  | NewListTruncated
+  deriving stock (Eq, Ord, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform NewListType)
+  deriving (ToSchema) via (CustomSwagger '[ConstructorTagModifier (StripPrefix "New", CamelToSnake)] NewListType)
+
+-- This replaces the previous `hasMore` but has no boolean blindness. At the API level
+-- though we do want this to remain true/false
+instance ToJSON NewListType where
+  toJSON NewListComplete = String "list_complete"
+  toJSON NewListTruncated = String "list_truncated"
+
+instance FromJSON NewListType where
+  parseJSON (String "list_complete") = pure NewListComplete
+  parseJSON (String "list_truncated") = pure NewListTruncated
+  parseJSON bad = fail $ "NewListType: " <> cs (encode bad)
+
+toNewListType :: ListType -> NewListType
+toNewListType ListComplete = NewListComplete
+toNewListType ListTruncated = NewListTruncated
+
 data ListType
   = ListComplete
   | ListTruncated
-  deriving stock (Eq, Show, Generic)
+  deriving stock (Eq, Ord, Show, Generic)
   deriving (Arbitrary) via (GenericUniform ListType)
 
 -- This replaces the previous `hasMore` but has no boolean blindness. At the API level

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

@@ -225,7 +225,7 @@ validateEmail =
 -- Phone
 
 newtype Phone = Phone {fromPhone :: Text}
-  deriving stock (Eq, Show, Generic)
+  deriving stock (Eq, Ord, Show, Generic)
   deriving newtype (ToJSON, ToSchema)
 
 instance FromJSON Phone where

libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs

@@ -218,6 +218,7 @@ tests =
       testRoundTrip @Team.LegalHold.External.LegalHoldServiceRemove,
       testRoundTrip @Team.Member.TeamMember,
       testRoundTrip @Team.Member.ListType,
+      testRoundTrip @Team.Member.NewListType,
       testRoundTrip @Team.Member.TeamMemberList,
       testRoundTrip @Team.Member.NewTeamMember,
       testRoundTrip @Team.Member.TeamMemberDeleteData,