From 64363b99dfa3f25cd9176a04f6433fdfb44e0f8a Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Mon, 16 Sep 2019 12:21:58 +0200
Subject: [PATCH 01/13] Documentation update for restund and smoketester (#855)

Improves upon #775
---
 deploy/services-demo/README.md | 14 +++++--
 mailboxes.json                 |  7 ----
 services/restund/README.md     | 68 +++++++++++++++++++---------------
 3 files changed, 50 insertions(+), 39 deletions(-)
 delete mode 100644 mailboxes.json

diff --git a/deploy/services-demo/README.md b/deploy/services-demo/README.md
index 4abb9e6e2a5..d82818c905d 100644
--- a/deploy/services-demo/README.md
+++ b/deploy/services-demo/README.md
@@ -75,16 +75,24 @@ If you wish to send verification SMS/calls (to support registration using phone
 
 Note: This demo setup comes bundled with a postfix email sending docker image; however due to the minimal setup, emails will likely land in the Spam/Junk folder of the target email address, if you configure a common email provider. To get the smoketester to check the Spam folder as well, use e.g. (in the case of gmail) `--mailbox-folder INBOX --mailbox-folder '[Gmail]/Spam'`.
 
-Example:
+Configure an email inbox for the smoketester:
 
 ```
-# from the wire-server directory, after having compiled everything with 'make install'
+# from the root of wire-server directory
+cp tools/api-simulations/mailboxes.example.json mailboxes.json
+```
+
+Now adjust `mailboxes.json` and use credentials for an email account you own.
+
+Next, from the wire-server directory, after having compiled everything with 'make install':
+
+```bash
 ./dist/api-smoketest \
     --api-host=127.0.0.1 \
     --api-port=8080 \
     --api-websocket-host=127.0.0.1 \
     --api-websocket-port=8081 \
-    --mailbox-config=<path_to_mailboxes_file> \
+    --mailbox-config=mailboxes.json \
     --sender-email=backend-demo@mail.wiredemo.example.com \
     --mailbox-folder INBOX \
     --mailbox-folder '[Gmail]/Spam' \
diff --git a/mailboxes.json b/mailboxes.json
deleted file mode 100644
index b7b2803b19e..00000000000
--- a/mailboxes.json
+++ /dev/null
@@ -1,7 +0,0 @@
-[
-    { "host": "imap.bar.com"
-    , "user": "foo@bar.com"
-    , "pass": "secret"
-    , "conn": 1
-    }
-]
diff --git a/services/restund/README.md b/services/restund/README.md
index 260ecd131cf..47748b4003f 100644
--- a/services/restund/README.md
+++ b/services/restund/README.md
@@ -66,30 +66,38 @@ Makefile.
 
 ## Running restund on a server
 
-You need a restund config and pem file (for the following assumed to be under /etc/restund), and can then run the aci image with rkt.
+You need
 
-A config file could look like the following (with the ansible-style variables filled in accordingly):
+* the aci image built in the section above, or, alternatively, a natively compiled `restund` binary with all the shared libraries available.
+* an adapted restund config (see below)
+* (optionally) a TLS certificate chain in PEM format, including the private key
+
+Example config file:
+
+```conf
+# /etc/restund/restund.conf
 
-```
 # core
 daemon                  no
 debug                   no
 realm                   dummy.io
 syncinterval            600
-udp_listen              {{ ansible_default_ipv4.address }}:{{ restund_udp_listen_port }}
+udp_listen              {{ ansible_default_ipv4.address }}:3478
 udp_sockbuf_size        524288
-tcp_listen              {{ ansible_default_ipv4.address }}:{{ restund_tcp_listen_port }}
-tls_listen              {{ ansible_default_ipv4.address }}:{{ restund_tls_listen_port }},/usr/local/etc/restund/restund.pem
+tcp_listen              {{ ansible_default_ipv4.address }}:3478
+# tls_listen is optional, you can comment that line out. If set, you must provide a valid TLS certificate for the domain name you're advertising.
+# tls_listen              {{ ansible_default_ipv4.address }}:5349,/usr/local/etc/restund/restund.pem
 
 # modules
 module_path             /usr/local/lib/restund/modules
 module                  stat.so
 module                  drain.so
 module                  binding.so
-module                  auth.so
 module                  turn.so
-module                  zrest.so
 module                  status.so
+# The auth and zrest modules are optional. If enabled, ensure the zrest_secret below is set to a value shared with the configuration in brig.
+module                  zrest.so
+module                  auth.so
 
 # auth
 auth_nonce_expiry       3600
@@ -98,24 +106,40 @@ auth_nonce_expiry       3600
 turn_max_allocations    64000
 turn_max_lifetime       3600
 turn_relay_addr         {{ ansible_default_ipv4.address }}
-{% if ansible_default_ipv4.address != public_ipv4 %}
-turn_public_addr        {{ public_ipv4 }}
-{% endif %}
+
+# You generally don't need to set this (only if your server is on a private network and must be reachable from other restund servers that are on another network):
+# turn_public_addr is an IP which must be reachable for UDP traffic from other restund servers (and from this server itself). If unset, defaults to 'turn_relay_addr'
+#turn_public_addr        {{ public_ipv4 }}
 
 # syslog
 syslog_facility         24
 
 # status
 status_udp_addr         127.0.0.1
-status_udp_port         {{ restund_udp_status_port }}
+status_udp_port         33000
 status_http_addr        127.0.0.1
-status_http_port        {{ restund_http_status_port }}
+status_http_port        8080
+
+# zrest (shared secret shared with brig, optional)
+zrest_secret            {{ restund_zrest_secret }}
+```
+
+Adjust the above configuration:
 
-# zrest (shared secret shared with brig)
+* Replace the `{{ variables }}` with real values (without `{{`)):
+    * Put your private IP of the server in place of: `{{ ansible_default_ipv4.address }}`.
+* You may comment these out in case you don't want to use authentication:
+```
+module                  zrest.so
+module                  auth.so
 zrest_secret            {{ restund_zrest_secret }}
 ```
 
-Example rkt command:
+Next, list out TURN IP and port in `deploy/services-demo/resources/turn/servers.txt`, and `deploy/services-demo/resources/turn/servers-v2.txt`, as given below:
+`turn:<private-ip>:3478`
+Then run the command restund command and you'll get the live stun log in your terminal.
+
+Running restund with `rkt`:
 
 ```
 /usr/bin/rkt run \
@@ -127,17 +151,3 @@ Example rkt command:
     --user=restund \
     --group=restund
 ```
-
-In case You have set up restund without docker, you just need to make some of these changes:
-
-Put your private IP of the server in place of: `{{ ansible_default_ipv4.address }}`. And replace restund listen ports with `3478`, for both UDP and TCP.
-
-You may comment these out in case you don't want to use:
-```
-module                  zrest.so
-module                  auth.so
-zrest_secret            {{ restund_zrest_secret }}
-```
-It'll help in running the TURN server without interuption or further configuration for testing purpose. List out TURN IP and port in `deploy/services-demo/resources/turn/servers.txt`, and `deploy/services-demo/resources/turn/servers-v2.txt`, as given below:
-`turn:<private-ip>:3478`
-Then run the command restund command and You'll get the live stun log in your terminal.
\ No newline at end of file

From 21ddcf3e49566b3cec03b304213071ba74ef7a29 Mon Sep 17 00:00:00 2001
From: Tiago Manuel Ventura Loureiro <tiago.loureiro@gmail.com>
Date: Mon, 16 Sep 2019 22:00:22 +0200
Subject: [PATCH 02/13] Log warnings only when users are suspended (#854)

---
 services/brig/src/Brig/User/Auth.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs
index 035f00e84f1..e22ffd4049e 100644
--- a/services/brig/src/Brig/User/Auth.hs
+++ b/services/brig/src/Brig/User/Auth.hs
@@ -159,10 +159,10 @@ revokeAccess u pw cc ll = do
 catchSuspendInactiveUser :: UserId -> e -> ExceptT e AppIO ()
 catchSuspendInactiveUser uid errval = do
   mustsuspend <- lift $ mustSuspendInactiveUser uid
-  Log.warn $ msg (val "catchSuspendInactiveUser")
-    ~~ field "user" (toByteString uid)
-    ~~ field "mustsuspend" mustsuspend
   when mustsuspend $ do
+    Log.warn $ msg (val "Suspending user due to inactivity")
+      ~~ field "user" (toByteString uid)
+      ~~ field "action" ("user.suspend" :: String)
     lift $ suspendAccount (singleton uid)
     throwE errval
 

From ad5cad7424087f5543f94d0123f2070461591459 Mon Sep 17 00:00:00 2001
From: fisx <mf@zerobuzz.net>
Date: Tue, 17 Sep 2019 11:41:02 +0200
Subject: [PATCH 03/13] Cleanup stern (#845)

* More error info in backoffice UI.

This helps customer support to understand errors they run into without
consulting the server logs.  Stern is an internal tool, so it's ok to
be a little more generous with information on internal errors.

* Better types.

* Re-throw expected errors from galley (don't throw 5xx).

* Cleanup.
---
 libs/bilge/src/Bilge/Request.hs         |  2 +-
 services/galley/src/Galley/API/Teams.hs |  6 +--
 tools/stern/src/Stern/API.hs            | 48 ++++++++++++-------
 tools/stern/src/Stern/Intra.hs          | 62 +++++++++++--------------
 tools/stern/src/Stern/Swagger.hs        | 13 ++++++
 tools/stern/src/Stern/Types.hs          | 10 ++++
 6 files changed, 86 insertions(+), 55 deletions(-)

diff --git a/libs/bilge/src/Bilge/Request.hs b/libs/bilge/src/Bilge/Request.hs
index 4163f7e682f..b6d3049ae4e 100644
--- a/libs/bilge/src/Bilge/Request.hs
+++ b/libs/bilge/src/Bilge/Request.hs
@@ -28,7 +28,7 @@ module Bilge.Request
     , showRequest
     , noRedirect
     , timeout
-    , expect2xx, expect3xx, expect4xx
+    , expect2xx, expect3xx, expect4xx, expectStatus
     , checkStatus
     , cookie
     , cookieRaw
diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs
index 189893bd4d3..d36925c68cc 100644
--- a/services/galley/src/Galley/API/Teams.hs
+++ b/services/galley/src/Galley/API/Teams.hs
@@ -532,18 +532,18 @@ getLegalholdStatus (uid ::: tid ::: ct) = do
 -- | Get SSO status for a team.
 getSSOStatusInternal :: TeamId ::: JSON -> Galley Response
 getSSOStatusInternal (tid ::: _) = do
-    defConfig <- do
+    defConfig :: SSOTeamConfig <- do
         featureSSO <- view (options . optSettings . setFeatureFlags . flagSSO)
         pure . SSOTeamConfig $ case featureSSO of
             FeatureSSOEnabledByDefault  -> SSOEnabled
             FeatureSSODisabledByDefault -> SSODisabled
-    ssoTeamConfig <- SSOData.getSSOTeamConfig tid
+    ssoTeamConfig :: Maybe SSOTeamConfig <- SSOData.getSSOTeamConfig tid
     pure . json . fromMaybe defConfig $ ssoTeamConfig
 
 -- | Enable or disable SSO for a team.
 setSSOStatusInternal :: TeamId ::: JsonRequest SSOTeamConfig ::: JSON -> Galley Response
 setSSOStatusInternal (tid ::: req ::: _) = do
-    ssoTeamConfig <- fromJsonBody req
+    ssoTeamConfig :: SSOTeamConfig <- fromJsonBody req
     case ssoTeamConfigStatus ssoTeamConfig of
         SSODisabled -> throwM disableSsoNotImplemented
         SSOEnabled  -> pure () -- this one is easy to implement :)
diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs
index e08397b9366..920bcadc0cc 100644
--- a/tools/stern/src/Stern/API.hs
+++ b/tools/stern/src/Stern/API.hs
@@ -5,8 +5,6 @@
 {-# LANGUAGE ViewPatterns      #-}
 {-# LANGUAGE LambdaCase        #-}
 
-{-# OPTIONS_GHC -Wno-unused-binds #-}
-
 module Stern.API (start) where
 
 import Imports hiding (head)
@@ -297,26 +295,50 @@ sitemap = do
 
     -- feature flags
 
-    get "/teams/:tid/features/sso" (continue getSSOStatus) $
+    get "/teams/:tid/features/legalhold" (continue (liftM json . Intra.getLegalholdStatus)) $
+        capture "tid"
+
+    document "GET" "getLegalholdStatus" $ do
+        summary "Shows whether legalhold feature is enabled for team"
+        Doc.parameter Doc.Path "tid" Doc.bytes' $
+            description "Team ID"
+        Doc.returns Doc.docSetLegalHoldStatus
+        Doc.response 200 "Legalhold status" Doc.end
+        Doc.returns Doc.bool'
+
+    put "/teams/:tid/features/legalhold" (continue setLegalholdStatus) $
+        contentType "application" "json"
+        .&. capture "tid"
+        .&. jsonRequest @SetLegalHoldStatus
+
+    document "PUT" "setLegalholdStatus" $ do
+        summary "Disable / enable legalhold feature for team"
+        Doc.parameter Doc.Path "tid" Doc.bytes' $
+            description "Team ID"
+        Doc.body Doc.docSetLegalHoldStatus $
+            Doc.description "JSON body"
+        Doc.response 200 "Legalhold status" Doc.end
+
+    get "/teams/:tid/features/sso" (continue (liftM json . Intra.getSSOStatus)) $
         capture "tid"
 
     document "GET" "getSSOStatus" $ do
         summary "Shows whether SSO feature is enabled for team"
         Doc.parameter Doc.Path "tid" Doc.bytes' $
             description "Team ID"
-        Doc.returns Doc.bool'
+        Doc.returns Doc.docSetSSOStatus
         Doc.response 200 "SSO status" Doc.end
 
     put "/teams/:tid/features/sso" (continue setSSOStatus) $
         contentType "application" "json"
         .&. capture "tid"
-        .&. jsonRequest @Bool
+        .&. jsonRequest @SetSSOStatus
 
     document "PUT" "setSSOStatus" $ do
         summary "Disable / enable SSO feature for team"
         Doc.parameter Doc.Path "tid" Doc.bytes' $
             description "Team ID"
-        Doc.body Doc.bool' $
+        Doc.body Doc.docSetSSOStatus $
             Doc.description "JSON body"
         Doc.response 200 "SSO status" Doc.end
 
@@ -512,21 +534,15 @@ getTeamInfo :: TeamId -> Handler Response
 getTeamInfo = liftM json . Intra.getTeamInfo
 
 
-getLegalholdStatus :: TeamId -> Handler Response
-getLegalholdStatus = liftM json . Intra.getLegalholdStatus
-
-setLegalholdStatus :: JSON ::: TeamId ::: JsonRequest Bool -> Handler Response
+setLegalholdStatus :: JSON ::: TeamId ::: JsonRequest SetLegalHoldStatus -> Handler Response
 setLegalholdStatus (_ ::: tid ::: req) = do
     status <- parseBody req !>> Error status400 "client-error"
     liftM json $ Intra.setLegalholdStatus tid status
 
-getSSOStatus :: TeamId -> Handler Response
-getSSOStatus = liftM json . Intra.getSSOStatus
-
-setSSOStatus :: JSON ::: TeamId ::: JsonRequest Bool -> Handler Response
+setSSOStatus :: JSON ::: TeamId ::: JsonRequest SetSSOStatus -> Handler Response
 setSSOStatus (_ ::: tid ::: req) = do
-  status <- parseBody req !>> Error status400 "client-error"
-  liftM json $ Intra.setSSOStatus tid status
+    status :: SetSSOStatus <- parseBody req !>> Error status400 "client-error"
+    liftM json $ Intra.setSSOStatus tid status
 
 getTeamBillingInfo :: TeamId -> Handler Response
 getTeamBillingInfo tid = do
diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs
index 7c3cbc6bb33..fb42d6add53 100644
--- a/tools/stern/src/Stern/Intra.hs
+++ b/tools/stern/src/Stern/Intra.hs
@@ -50,7 +50,6 @@ import Stern.App
 import Control.Error
 import Control.Lens (view, (^.))
 import Control.Monad.Reader
-import Control.Monad.Catch (throwM)
 import Data.Aeson hiding (Error)
 import Data.Aeson.Types (emptyArray)
 import Data.ByteString (ByteString)
@@ -67,7 +66,6 @@ import Galley.Types.Teams
 import Galley.Types.Teams.Intra
 import Galley.Types.Teams.SSO
 import Gundeck.Types
-import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..), checkResponse)
 import Network.HTTP.Types.Method
 import Network.HTTP.Types.Status hiding (statusCode)
 import Network.Wai.Utilities (Error (..))
@@ -281,7 +279,7 @@ getInvoiceUrl tid iid = do
           ( method GET
           . paths ["i", "team", toByteString' tid, "invoice", toByteString' iid]
           . noRedirect
-          . expect [status307]
+          . expectStatus (== 307)
           )
     return $ getHeader' "Location" r
 
@@ -351,7 +349,7 @@ setBlacklistStatus status emailOrPhone = do
     statusToMethod False = DELETE
     statusToMethod True  = POST
 
-getLegalholdStatus :: TeamId -> Handler Bool
+getLegalholdStatus :: TeamId -> Handler SetLegalHoldStatus
 getLegalholdStatus tid = do
     info $ msg "Getting legalhold status"
     gly <- view galley
@@ -361,28 +359,30 @@ getLegalholdStatus tid = do
          . expect2xx
          )
   where
-    fromResponseBody :: Response (Maybe LByteString) -> Handler Bool
+    fromResponseBody :: Response (Maybe LByteString) -> Handler SetLegalHoldStatus
     fromResponseBody resp = case responseJsonEither resp of
-      Right (LegalHoldTeamConfig LegalHoldDisabled) -> pure False
-      Right (LegalHoldTeamConfig LegalHoldEnabled) -> pure True
+      Right (LegalHoldTeamConfig LegalHoldDisabled) -> pure SetLegalHoldDisabled
+      Right (LegalHoldTeamConfig LegalHoldEnabled) -> pure SetLegalHoldEnabled
       Left errmsg -> throwE (Error status502 "bad-upstream" ("bad response; error message: " <> pack errmsg))
 
-setLegalholdStatus :: TeamId -> Bool -> Handler ()
+setLegalholdStatus :: TeamId -> SetLegalHoldStatus -> Handler ()
 setLegalholdStatus tid status = do
     info $ msg "Setting legalhold status"
     gly <- view galley
-    void . catchRpcErrors $ rpc' "galley" gly
+    resp <- catchRpcErrors $ rpc' "galley" gly
          ( method PUT
          . paths ["/i/teams", toByteString' tid, "features", "legalhold"]
          . lbytes (encode $ toRequestBody status)
          . contentJson
-         . expect2xx
          )
+    case statusCode resp of
+      204 -> pure ()
+      _   -> throwE $ responseJsonUnsafe resp
   where
-    toRequestBody False = LegalHoldTeamConfig LegalHoldDisabled
-    toRequestBody True  = LegalHoldTeamConfig LegalHoldEnabled
+    toRequestBody SetLegalHoldDisabled = LegalHoldTeamConfig LegalHoldDisabled
+    toRequestBody SetLegalHoldEnabled  = LegalHoldTeamConfig LegalHoldEnabled
 
-getSSOStatus :: TeamId -> Handler Bool
+getSSOStatus :: TeamId -> Handler SetSSOStatus
 getSSOStatus tid = do
     info $ msg "Getting SSO status"
     gly <- view galley
@@ -392,42 +392,34 @@ getSSOStatus tid = do
          . expect2xx
          )
   where
-    fromResponseBody :: Response (Maybe LByteString) -> Handler Bool
+    fromResponseBody :: Response (Maybe LByteString) -> Handler SetSSOStatus
     fromResponseBody resp = case responseJsonEither resp of
-      Right (SSOTeamConfig SSODisabled) -> pure False
-      Right (SSOTeamConfig SSOEnabled) -> pure True
+      Right (SSOTeamConfig SSOEnabled) -> pure SetSSOEnabled
+      Right (SSOTeamConfig SSODisabled) -> pure SetSSODisabled
       Left errmsg -> throwE (Error status502 "bad-upstream" ("bad response; error message: " <> pack errmsg))
 
-setSSOStatus :: TeamId -> Bool -> Handler ()
+setSSOStatus :: TeamId -> SetSSOStatus -> Handler ()
 setSSOStatus tid status = do
     info $ msg "Setting SSO status"
     gly <- view galley
-    void . catchRpcErrors $ rpc' "galley" gly
+    resp <- catchRpcErrors $ rpc' "galley" gly
          ( method PUT
          . paths ["/i/teams", toByteString' tid, "features", "sso"]
          . lbytes (encode $ toRequestBody status)
          . contentJson
-         . expect2xx
          )
+    case statusCode resp of
+      204 -> pure ()
+      _   -> throwE $ responseJsonUnsafe resp
   where
-    toRequestBody False = SSOTeamConfig SSODisabled
-    toRequestBody True  = SSOTeamConfig SSOEnabled
+    toRequestBody SetSSODisabled = SSOTeamConfig SSODisabled
+    toRequestBody SetSSOEnabled  = SSOTeamConfig SSOEnabled
 
 --------------------------------------------------------------------------------
 -- Helper functions
 stripBS :: ByteString -> ByteString
 stripBS = encodeUtf8 . strip . decodeUtf8
 
--- TODO: Move this to Bilge after merging the current PR's
-expect :: [Status] -> Request -> Request
-expect ss rq = rq { checkResponse = check }
-  where
-    check rq' rs = do
-        let s   = responseStatus rs
-            rs' = rs { responseBody = () }
-        when (statusIsServerError s || s `notElem` ss) $
-            throwM $ HttpExceptionRequest rq' (StatusCodeException rs' mempty)
-
 userKeyToParam :: Either Email Phone -> Request -> Request
 userKeyToParam (Left e)  = queryItem "email" (stripBS $ toByteString' e)
 userKeyToParam (Right p) = queryItem "phone" (stripBS $ toByteString' p)
@@ -441,7 +433,7 @@ catchRpcErrors action = ExceptT $ catch (Right <$> action) catchRPCException
     catchRPCException :: RPCException -> App (Either Error a)
     catchRPCException rpcE = do
       Log.err $ rpcExceptionMsg rpcE
-      pure . Left $ Error status500 "io-error" "I/O Error"
+      pure . Left $ Error status500 "io-error" (pack $ show rpcE)
 
 getTeamData :: TeamId -> Handler TeamData
 getTeamData tid = do
@@ -450,7 +442,7 @@ getTeamData tid = do
     r <- catchRpcErrors $ rpc' "galley" g
          ( method GET
          . paths ["i", "teams", toByteString' tid]
-         . expect [status200, status404]
+         . expectStatus (`elem` [200, 404])
          )
     case Bilge.statusCode r of
         200 -> parseResponse (Error status502 "bad-upstream") r
@@ -500,7 +492,7 @@ getMarketoResult email = do
     r <- catchRpcErrors $ rpc' "galeb" g
          ( method GET
          . paths ["/i/marketo/emails", toByteString' email]
-         . expect [status200, status404]
+         . expectStatus (`elem` [200, 404])
          )
     -- 404 is acceptable when marketo doesn't know about this user, return an empty result
     case statusCode r of
@@ -620,7 +612,7 @@ getUserNotifications uid = do
              . path "/notifications"
              . queryItem "size" (toByteString' batchSize)
              . maybe id (queryItem "since" . toByteString') start
-             . expect [status200, status404]
+             . expectStatus (`elem` [200, 404])
              )
         -- 404 is an acceptable response, in case, for some reason,
         -- "start" is not found we still return a QueuedNotificationList
diff --git a/tools/stern/src/Stern/Swagger.hs b/tools/stern/src/Stern/Swagger.hs
index f902a2bcc6a..3a966547007 100644
--- a/tools/stern/src/Stern/Swagger.hs
+++ b/tools/stern/src/Stern/Swagger.hs
@@ -3,6 +3,7 @@
 module Stern.Swagger where
 
 import Data.Swagger.Build.Api
+import Stern.Types
 import Imports
 
 sternModels :: [Model]
@@ -71,3 +72,15 @@ teamBillingInfoUpdate = defineModel "teamBillingInfoUpdate" $ do
     property "state" string' $ do
         description "State of the company address (1 - 256 characters)"
         optional
+
+docSetSSOStatus :: DataType
+docSetSSOStatus = docBoundedEnum @SetSSOStatus
+
+docSetLegalHoldStatus :: DataType
+docSetLegalHoldStatus = docBoundedEnum @SetLegalHoldStatus
+
+-- (the double-call to show is to add extra double-quotes to the string.  this is important
+-- because the json instances also render this into a json string, and json string are wrapped
+-- in double-quotes.)
+docBoundedEnum :: forall a. (Bounded a, Enum a, Show a) => DataType
+docBoundedEnum = string . enum $ show . show <$> [(minBound :: a)..]
diff --git a/tools/stern/src/Stern/Types.hs b/tools/stern/src/Stern/Types.hs
index 475911a4139..a24ca114aae 100644
--- a/tools/stern/src/Stern/Types.hs
+++ b/tools/stern/src/Stern/Types.hs
@@ -94,3 +94,13 @@ data TeamBillingInfoUpdate = TeamBillingInfoUpdate
     } deriving (Eq, Show)
 
 deriveJSON toJSONFieldName ''TeamBillingInfoUpdate
+
+data SetLegalHoldStatus = SetLegalHoldDisabled | SetLegalHoldEnabled
+  deriving (Eq, Show, Ord, Enum, Bounded, Generic)
+
+deriveJSON toJSONFieldName ''SetLegalHoldStatus
+
+data SetSSOStatus = SetSSODisabled | SetSSOEnabled
+  deriving (Eq, Show, Ord, Enum, Bounded, Generic)
+
+deriveJSON toJSONFieldName ''SetSSOStatus

From 8a9c45366585758817e18ebc8e1a0c8a16200fe5 Mon Sep 17 00:00:00 2001
From: fisx <mf@zerobuzz.net>
Date: Wed, 18 Sep 2019 19:15:50 +0200
Subject: [PATCH 04/13] Fix metrics. (#853)

* Make cannon ws handler dictionaries slightly faster.

* Refactor: extract refresh logic from /i/monitoring end-points.

* Move `refresMetrics` from /i/monitoring end-point into async thread.  (Galley, Cannon)

* Catch all sync exceptions in side threads.

* Refactor: extract general-purpose code from spar into metrics-wai.
---
 libs/metrics-wai/src/Data/Metrics/Servant.hs | 20 ++++++++
 services/cannon/package.yaml                 |  1 +
 services/cannon/src/Cannon/API.hs            |  7 +--
 services/cannon/src/Cannon/Dict.hs           | 53 +++++++++++++++-----
 services/cannon/src/Cannon/Run.hs            | 26 +++++++++-
 services/cannon/src/Cannon/Types.hs          |  6 ++-
 services/galley/src/Galley/API.hs            |  6 +--
 services/galley/src/Galley/API/Internal.hs   | 20 +++++++-
 services/galley/src/Galley/Run.hs            |  6 ++-
 services/gundeck/src/Gundeck/API.hs          |  7 +--
 services/spar/src/Spar/Run.hs                | 24 ++-------
 11 files changed, 122 insertions(+), 54 deletions(-)

diff --git a/libs/metrics-wai/src/Data/Metrics/Servant.hs b/libs/metrics-wai/src/Data/Metrics/Servant.hs
index 4d0e0eba796..f4b55e8d5d6 100644
--- a/libs/metrics-wai/src/Data/Metrics/Servant.hs
+++ b/libs/metrics-wai/src/Data/Metrics/Servant.hs
@@ -17,6 +17,26 @@ import Data.Tree
 import GHC.TypeLits
 import Servant.API
 
+import qualified Data.Metrics.Types as Metrics
+import qualified Network.Wai as Wai
+import qualified Network.Wai.Middleware.Prometheus as Promth
+
+
+-- | This does not catch errors, so it must be called outside of 'WU.catchErrors'.
+servantPrometheusMiddleware :: forall proxy api. (RoutesToPaths api) => proxy api -> Wai.Middleware
+servantPrometheusMiddleware _ = Promth.prometheus conf . Promth.instrumentHandlerValue promthNormalize
+  where
+    conf = Promth.def
+      { Promth.prometheusEndPoint = ["i", "metrics"]
+      , Promth.prometheusInstrumentApp = False
+      }
+
+    promthNormalize :: Wai.Request -> Text
+    promthNormalize req = pathInfo
+      where
+        mPathInfo  = Metrics.treeLookup (routesToPaths @api) $ cs <$> Wai.pathInfo req
+        pathInfo   = cs $ fromMaybe "N/A" mPathInfo
+
 
 routesToPaths :: forall routes. RoutesToPaths routes => Paths
 routesToPaths = Paths (meltTree (getRoutes @routes))
diff --git a/services/cannon/package.yaml b/services/cannon/package.yaml
index efb9451090c..e3c2ef10019 100644
--- a/services/cannon/package.yaml
+++ b/services/cannon/package.yaml
@@ -36,6 +36,7 @@ library:
   - mwc-random >=0.13
   - prometheus-client
   - retry >=0.7
+  - safe-exceptions
   - singletons >=2.0
   - strict >=0.3.2
   - swagger >=0.2
diff --git a/services/cannon/src/Cannon/API.hs b/services/cannon/src/Cannon/API.hs
index f27645f68f0..e86131e4a17 100644
--- a/services/cannon/src/Cannon/API.hs
+++ b/services/cannon/src/Cannon/API.hs
@@ -7,7 +7,6 @@ import Cannon.WS hiding (env)
 import Control.Monad.Catch
 import Data.Aeson (encode)
 import Data.Id (ClientId, UserId, ConnId)
-import Data.Metrics.Middleware
 import Data.Swagger.Build.Api hiding (def, Response)
 import Network.HTTP.Types
 import Gundeck.Types
@@ -70,11 +69,7 @@ sitemap = do
     head "/i/status" (continue (const $ return empty)) true
 
 monitoring :: Media "application" "json" -> Cannon Response
-monitoring = const $ do
-    m <- monitor
-    s <- D.size =<< clients
-    gaugeSet (fromIntegral s) (path "net.websocket.clients") m
-    json <$> Metrics.render m
+monitoring _ = json <$> (Metrics.render =<< monitor)
 
 docs :: Media "application" "json" ::: Text -> Cannon Response
 docs (_ ::: url) = do
diff --git a/services/cannon/src/Cannon/Dict.hs b/services/cannon/src/Cannon/Dict.hs
index 91d2e5c2afb..730e49bdabf 100644
--- a/services/cannon/src/Cannon/Dict.hs
+++ b/services/cannon/src/Cannon/Dict.hs
@@ -18,45 +18,74 @@ import qualified Data.HashMap.Strict as M
 import qualified Data.Vector         as V
 
 newtype Dict a b = Dict
-    { _map :: Vector (IORef (HashMap a b)) }
+    { _map :: Vector (IORef (SizedHashMap a b)) }
 
 size :: MonadIO m => Dict a b -> m Int
-size d = liftIO $ sum <$> mapM (\r -> M.size <$> readIORef r) (_map d)
+size d = liftIO $ sum <$> mapM (\r -> hmsize <$> readIORef r) (_map d)
 
 empty :: MonadIO m => Int -> m (Dict a b)
 empty w = liftIO $ if w > 0 && w < 8192
-    then Dict <$> V.generateM w (const $ newIORef M.empty)
+    then Dict <$> V.generateM w (const $ newIORef hmempty)
     else error "Dict.empty: slice number out of range [1, 8191]"
 
 insert :: (Eq a, Hashable a, MonadIO m) => a -> b -> Dict a b -> m ()
-insert k v = mutDict (M.insert k v) . getSlice k
+insert k v = mutDict (hminsert k v) . getSlice k
 
 add :: (Eq a, Hashable a, MonadIO m) => a -> b -> Dict a b -> m Bool
 add k v d = liftIO $ atomicModifyIORef' (getSlice k d) $ \m ->
-    if k `elem` M.keys m
+    if k `elem` hmkeys m
         then (m, False)
-        else (M.insert k v m, True)
+        else (hminsert k v m, True)
 
 remove :: (Eq a, Hashable a, MonadIO m) => a -> Dict a b -> m Bool
 remove = removeIf (const True)
 
 removeIf :: (Eq a, Hashable a, MonadIO m) => (Maybe b -> Bool) -> a -> Dict a b -> m Bool
 removeIf f k d = liftIO $ atomicModifyIORef' (getSlice k d) $ \m ->
-    if f (M.lookup k m)
-        then (M.delete k m, True)
+    if f (hmlookup k m)
+        then (hmdelete k m, True)
         else (m, False)
 
 lookup :: (Eq a, Hashable a, MonadIO m) => a -> Dict a b -> m (Maybe b)
-lookup k = liftIO . fmap (M.lookup k) . readIORef . getSlice k
+lookup k = liftIO . fmap (hmlookup k) . readIORef . getSlice k
 
 -----------------------------------------------------------------------------
 -- Internal
 
 mutDict :: MonadIO m
-        => (HashMap a b -> HashMap a b)
-        -> IORef (HashMap a b)
+        => (SizedHashMap a b -> SizedHashMap a b)
+        -> IORef (SizedHashMap a b)
         -> m ()
 mutDict f d = liftIO $ atomicModifyIORef' d $ \m -> (f m, ())
 
-getSlice :: (Hashable a) => a -> Dict a b -> IORef (HashMap a b)
+getSlice :: (Hashable a) => a -> Dict a b -> IORef (SizedHashMap a b)
 getSlice k (Dict m) = m ! (hash k `mod` V.length m)
+
+----------------------------------------------------------------------
+-- hashmap with O(1) size operator
+
+data SizedHashMap a b = SizedHashMap !Int !(HashMap a b)
+
+hmsize :: forall k v. SizedHashMap k v -> Int
+hmsize (SizedHashMap s _) = s
+
+hmempty :: forall k v. SizedHashMap k v
+hmempty = SizedHashMap 0 M.empty
+
+hminsert :: forall k v. (Eq k, Hashable k) => k -> v -> SizedHashMap k v -> SizedHashMap k v
+hminsert k v (SizedHashMap n hm) = SizedHashMap n' hm'
+  where
+    n' = if M.member k hm then n else n + 1
+    hm' = M.insert k v hm
+
+hmkeys :: forall k v. SizedHashMap k v -> [k]
+hmkeys (SizedHashMap _ hm) = M.keys hm
+
+hmlookup :: forall k v. (Eq k, Hashable k) => k -> SizedHashMap k v -> Maybe v
+hmlookup k (SizedHashMap _ hm) = M.lookup k hm
+
+hmdelete :: forall k v. (Eq k, Hashable k) => k -> SizedHashMap k v -> SizedHashMap k v
+hmdelete k (SizedHashMap n hm) = SizedHashMap n' hm'
+  where
+    n' = if M.member k hm then n - 1 else n
+    hm' = M.delete k hm
diff --git a/services/cannon/src/Cannon/Run.hs b/services/cannon/src/Cannon/Run.hs
index 8cee8f35a51..80c9a8a02ae 100644
--- a/services/cannon/src/Cannon/Run.hs
+++ b/services/cannon/src/Cannon/Run.hs
@@ -4,11 +4,14 @@ import Imports hiding (head)
 import Bilge (newManager, defaultManagerSettings, ManagerSettings (..))
 import Cannon.App (maxPingInterval)
 import Cannon.API (sitemap)
-import Cannon.Types (mkEnv, applog, runCannon)
+import Cannon.Types (Cannon, mkEnv, applog, runCannon, runCannon', monitor, clients)
 import Cannon.Options
 import Cannon.WS hiding (env)
+import Control.Exception.Safe (catchAny)
+import Control.Monad.Catch (MonadCatch)
 import Control.Lens ((^.))
 import Control.Monad.Catch (finally)
+import Data.Metrics.Middleware (gaugeSet, path)
 import Data.Metrics.Middleware.Prometheus (waiPrometheusMiddleware)
 import Data.Metrics.WaiRoute (treeToPaths)
 import Data.Text (strip, pack)
@@ -18,10 +21,12 @@ import Network.Wai.Handler.Warp hiding (run)
 import System.Random.MWC (createSystemRandom)
 
 import qualified Cannon.Dict                 as D
+import qualified Control.Concurrent.Async    as Async
 import qualified Data.Metrics.Middleware     as Middleware
 import qualified Network.Wai                 as Wai
 import qualified Network.Wai.Middleware.Gzip as Gzip
 import qualified System.IO.Strict            as Strict
+import qualified System.Logger.Class         as LC
 import qualified System.Logger.Extended      as L
 
 run :: Opts -> IO ()
@@ -37,6 +42,7 @@ run o = do
                <*> newManager defaultManagerSettings { managerConnCount = 128 }
                <*> createSystemRandom
                <*> mkClock
+    refreshMetricsThread <- Async.async $ runCannon' e refreshMetrics
     s <- newSettings $ Server (o^.cannon.host) (o^.cannon.port) (applog e) m (Just idleTimeout)
     let rtree    = compile sitemap
         measured = measureRequests m (treeToPaths rtree)
@@ -47,7 +53,9 @@ run o = do
                    . catchErrors g [Right m]
                    . Gzip.gzip Gzip.def
         start    =  middleware app
-    runSettings s start `finally` L.close (applog e)
+    runSettings s start `finally` do
+        Async.cancel refreshMetricsThread
+        L.close (applog e)
   where
     idleTimeout = fromIntegral $ maxPingInterval + 3
 
@@ -60,3 +68,17 @@ run o = do
 
     readExternal :: FilePath -> IO ByteString
     readExternal f = encodeUtf8 . strip . pack <$> Strict.readFile f
+
+
+refreshMetrics :: Cannon ()
+refreshMetrics = do
+    m <- monitor
+    c <- clients
+    safeForever $ do
+        s <- D.size c
+        gaugeSet (fromIntegral s) (path "net.websocket.clients") m
+  where
+    safeForever :: (MonadIO m, LC.MonadLogger m, MonadCatch m) => m () -> m ()
+    safeForever action = forever $ action `catchAny` \exc -> do
+        LC.err $ "error" LC..= show exc LC.~~ LC.msg (LC.val "refreshMetrics failed")
+        threadDelay 60000000  -- pause to keep worst-case noise in logs manageable
diff --git a/services/cannon/src/Cannon/Types.hs b/services/cannon/src/Cannon/Types.hs
index 9005d85b079..2c27df247ef 100644
--- a/services/cannon/src/Cannon/Types.hs
+++ b/services/cannon/src/Cannon/Types.hs
@@ -12,6 +12,7 @@ module Cannon.Types
     , mapConcurrentlyCannon
     , mkEnv
     , runCannon
+    , runCannon'
     , options
     , clients
     , monitor
@@ -87,7 +88,10 @@ mkEnv m external o l d p g t = Env m o l d def $
 
 runCannon :: Env -> Cannon a -> Request -> IO a
 runCannon e c r = let e' = e { reqId = lookupReqId r } in
-    runReaderT (unCannon c) e'
+    runCannon' e' c
+
+runCannon' :: Env -> Cannon a -> IO a
+runCannon' e c = runReaderT (unCannon c) e
 
 lookupReqId :: Request -> RequestId
 lookupReqId = maybe def RequestId . lookup requestIdName . requestHeaders
diff --git a/services/galley/src/Galley/API.hs b/services/galley/src/Galley/API.hs
index 6717eb2d434..2b7f698e882 100644
--- a/services/galley/src/Galley/API.hs
+++ b/services/galley/src/Galley/API.hs
@@ -38,7 +38,6 @@ import qualified Galley.API.Error              as Error
 import qualified Galley.API.Internal           as Internal
 import qualified Galley.API.LegalHold          as LegalHold
 import qualified Galley.API.Teams              as Teams
-import qualified Galley.Queue                  as Q
 import qualified Galley.Types.Swagger          as Model
 import qualified Galley.Types.Teams.Swagger    as TeamsModel
 import qualified Network.Wai.Predicate         as P
@@ -1004,10 +1003,7 @@ docs (_ ::: url) = do
 
 monitoring :: JSON -> Galley Response
 monitoring _ = do
-    m <- view monitor
-    n <- Q.len =<< view deleteQueue
-    gaugeSet (fromIntegral n) (Metrics.path "galley.deletequeue.len") m
-    json <$> render m
+    json <$> (render =<< view monitor)
 
 filterMissing :: HasQuery r => Predicate r P.Error OtrFilterMissing
 filterMissing = (>>= go) <$> (query "ignore_missing" ||| query "report_missing")
diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs
index e104a74a222..95dc5a3f6ea 100644
--- a/services/galley/src/Galley/API/Internal.hs
+++ b/services/galley/src/Galley/API/Internal.hs
@@ -1,16 +1,20 @@
 module Galley.API.Internal
     ( rmUser
     , deleteLoop
+    , refreshMetrics
     ) where
 
 import Imports
 import Cassandra
 import Control.Exception.Safe (catchAny)
 import Control.Lens hiding ((.=))
+import Control.Monad.Catch (MonadCatch)
 import Data.Id
 import Data.List.NonEmpty (nonEmpty)
 import Data.List1
+import Data.Metrics.Middleware as Metrics
 import Data.Range
+import Data.String.Conversions (cs)
 import Galley.API.Util (isMember)
 import Galley.API.Teams (uncheckedRemoveTeamMember)
 import Galley.App
@@ -62,7 +66,7 @@ rmUser (user ::: conn) = do
 deleteLoop :: Galley ()
 deleteLoop = do
     q <- view deleteQueue
-    forever $ do
+    safeForever "deleteLoop" $ do
         i@(TeamItem tid usr con) <- Q.pop q
         Teams.uncheckedDeleteTeam usr con tid `catchAny` someError q i
   where
@@ -72,3 +76,17 @@ deleteLoop = do
         unless ok $
             err (msg (val "delete queue is full, dropping item") ~~ "item" .= show i)
         liftIO $ threadDelay 1000000
+
+refreshMetrics :: Galley ()
+refreshMetrics = do
+    m <- view monitor
+    q <- view deleteQueue
+    safeForever "refreshMetrics" $ do
+        n <- Q.len q
+        gaugeSet (fromIntegral n) (Metrics.path "galley.deletequeue.len") m
+        threadDelay 100000
+
+safeForever :: (MonadIO m, MonadLogger m, MonadCatch m) => String -> m () -> m ()
+safeForever funName action = forever $ action `catchAny` \exc -> do
+    err $ "error" .= show exc ~~ msg (val $ cs funName <> " failed")
+    threadDelay 60000000  -- pause to keep worst-case noise in logs manageable
diff --git a/services/galley/src/Galley/Run.hs b/services/galley/src/Galley/Run.hs
index 60b1aa50703..18c5bcac9e1 100644
--- a/services/galley/src/Galley/Run.hs
+++ b/services/galley/src/Galley/Run.hs
@@ -37,7 +37,8 @@ run o = do
                                      m
     runClient (e^.cstate) $
         versionCheck Data.schemaVersion
-    d <- Async.async $ evalGalley e Internal.deleteLoop
+    deleteQueueThread    <- Async.async $ evalGalley e Internal.deleteLoop
+    refreshMetricsThread <- Async.async $ evalGalley e Internal.refreshMetrics
     let rtree    = compile sitemap
         app r k  = runGalley e r (route rtree r k)
         measured :: Middleware
@@ -49,7 +50,8 @@ run o = do
                     . GZip.gunzip
                     . GZip.gzip GZip.def
     runSettingsWithShutdown s (middlewares app) 5 `finally` do
-        Async.cancel d
+        Async.cancel deleteQueueThread
+        Async.cancel refreshMetricsThread
         shutdown (e^.cstate)
         Log.flush l
         Log.close l
diff --git a/services/gundeck/src/Gundeck/API.hs b/services/gundeck/src/Gundeck/API.hs
index 761bbc32271..8f9cc5d31a5 100644
--- a/services/gundeck/src/Gundeck/API.hs
+++ b/services/gundeck/src/Gundeck/API.hs
@@ -1,7 +1,7 @@
 module Gundeck.API (sitemap) where
 
 import Imports hiding (head)
-import Control.Lens hiding (enum)
+import Control.Lens (view)
 import Data.Metrics.Middleware
 import Data.Range
 import Data.Swagger.Build.Api hiding (def, min, Response)
@@ -179,8 +179,5 @@ docs (url ::: _) =
     let doc = mkSwaggerApi (decodeLatin1 url) Model.gundeckModels sitemap in
     return $ json doc
 
--- REFACTOR: what does this function still do, after the fallback queue is gone?
 monitoring :: JSON -> Gundeck Response
-monitoring = const $ do
-    m  <- view monitor
-    json <$> render m
+monitoring _ = json <$> (render =<< view monitor)
diff --git a/services/spar/src/Spar/Run.hs b/services/spar/src/Spar/Run.hs
index 33f363c281c..182fad5b557 100644
--- a/services/spar/src/Spar/Run.hs
+++ b/services/spar/src/Spar/Run.hs
@@ -16,9 +16,10 @@ import Cassandra as Cas
 import Control.Lens
 import Data.Default (def)
 import Data.List.NonEmpty as NE
-import Data.Metrics.Servant (routesToPaths)
+import Data.Metrics.Servant (servantPrometheusMiddleware)
+import Data.Proxy (Proxy(Proxy))
 import Data.String.Conversions
-import Network.Wai (Application, Middleware)
+import Network.Wai (Application)
 import Network.Wai.Utilities.Request (lookupRequestId)
 import Spar.API (app, API)
 import Spar.API.Swagger ()
@@ -31,10 +32,8 @@ import Util.Options (casEndpoint, casKeyspace, epHost, epPort)
 
 import qualified Cassandra.Schema as Cas
 import qualified Cassandra.Settings as Cas
-import qualified Data.Metrics.Types as Metrics
 import qualified Network.Wai as Wai
 import qualified Network.Wai.Handler.Warp as Warp
-import qualified Network.Wai.Middleware.Prometheus as Promth
 import qualified Network.Wai.Utilities.Server as WU
 import qualified SAML2.WebSSO as SAML
 import qualified Spar.Data as Data
@@ -96,7 +95,7 @@ mkApp sparCtxOpts = do
         $ Bilge.empty
   let wrappedApp
         = WU.heavyDebugLogging heavyLogOnly logLevel sparCtxLogger
-        . promthRun
+        . servantPrometheusMiddleware (Proxy @API)
         . WU.catchErrors sparCtxLogger []
           -- Error 'Response's are usually not thrown as exceptions, but logged in
           -- 'renderSparErrorWithLogging' before the 'Application' can construct a 'Response'
@@ -117,18 +116,3 @@ lookupRequestIdMiddleware :: (RequestId -> Application) -> Application
 lookupRequestIdMiddleware mkapp req cont = do
   let reqid = maybe def RequestId $ lookupRequestId req
   mkapp reqid req cont
-
--- | This does not catch errors, so it must be called outside of 'WU.catchErrors'.
-promthRun :: Middleware
-promthRun = Promth.prometheus conf . Promth.instrumentHandlerValue promthNormalize
-  where
-    conf = Promth.def
-      { Promth.prometheusEndPoint = ["i", "metrics"]
-      , Promth.prometheusInstrumentApp = False
-      }
-
-promthNormalize :: Wai.Request -> Text
-promthNormalize req = pathInfo
-  where
-    mPathInfo  = Metrics.treeLookup (routesToPaths @API) $ cs <$> Wai.pathInfo req
-    pathInfo   = cs $ fromMaybe "N/A" mPathInfo

From 3e51c324da1e6c1a3f329d969aedfe5bd7e23eb7 Mon Sep 17 00:00:00 2001
From: fisx <mf@zerobuzz.net>
Date: Thu, 19 Sep 2019 10:29:02 +0200
Subject: [PATCH 05/13] Sneak up on flaky test. (#863)

perhaps this is it?  no other hypotheses available as to what it might have been about...
---
 services/gundeck/test/integration/API.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/services/gundeck/test/integration/API.hs b/services/gundeck/test/integration/API.hs
index 70def7a3115..a85fe35ce6a 100644
--- a/services/gundeck/test/integration/API.hs
+++ b/services/gundeck/test/integration/API.hs
@@ -159,8 +159,9 @@ removeStalePresence = do
     w <- wsRun ca uid con (wsCloser m)
     wsAssertPresences uid 1
     liftIO $ void $ putMVar m () >> wait w
-    sendPush (push uid [uid])
+    -- The websocket might take a few time units to drop so better to try a few pushes
     recoverAll (constantDelay 1000000 <> limitRetries 10) $ \_ -> do
+        sendPush (push uid [uid])
         ensurePresent uid 0
   where
     pload     = List1.singleton $ HashMap.fromList [ "foo" .= (42 :: Int) ]

From aa4d12def4aebb39c0b5449d25f8c29a63c0b84d Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Thu, 19 Sep 2019 12:12:33 +0200
Subject: [PATCH 06/13] Add issue templates (#862)

Following https://help.github.com/en/articles/creating-issue-templates-for-your-repository

This creates a template to use when issues are opened, which may help provide more context and require less back-and-forth initally.
---
 .github/ISSUE_TEMPLATE/bug_report.md | 27 +++++++++++++++++++++++++++
 .github/ISSUE_TEMPLATE/other.md      | 10 ++++++++++
 .github/ISSUE_TEMPLATE/question.md   | 12 ++++++++++++
 3 files changed, 49 insertions(+)
 create mode 100644 .github/ISSUE_TEMPLATE/bug_report.md
 create mode 100644 .github/ISSUE_TEMPLATE/other.md
 create mode 100644 .github/ISSUE_TEMPLATE/question.md

diff --git a/.github/ISSUE_TEMPLATE/bug_report.md b/.github/ISSUE_TEMPLATE/bug_report.md
new file mode 100644
index 00000000000..7369d67332f
--- /dev/null
+++ b/.github/ISSUE_TEMPLATE/bug_report.md
@@ -0,0 +1,27 @@
+---
+name: Bug report
+about: Create a bug report to help us improve
+title: ''
+labels: ''
+assignees: ''
+
+---
+
+**Describe the bug**
+A clear and concise description of what the bug is.
+
+**To Reproduce**
+Steps to reproduce the behavior:
+1. Go to '...'
+2. Run  '....'
+3. '....'
+4. See error
+
+**Expected behavior**
+A clear and concise description of what you expected to happen.
+
+**Screenshots**
+If applicable, add screenshots to help explain your problem.
+
+**Additional context**
+Add any other context about the problem here. Example: how did you compile or install wire-server? Which configuration are you using? Which version (if using docker images) or git branch are you using?
diff --git a/.github/ISSUE_TEMPLATE/other.md b/.github/ISSUE_TEMPLATE/other.md
new file mode 100644
index 00000000000..aa1c94acad1
--- /dev/null
+++ b/.github/ISSUE_TEMPLATE/other.md
@@ -0,0 +1,10 @@
+---
+name: Other
+about: Other
+title: ''
+labels: ''
+assignees: ''
+
+---
+
+
diff --git a/.github/ISSUE_TEMPLATE/question.md b/.github/ISSUE_TEMPLATE/question.md
new file mode 100644
index 00000000000..992392ddfc4
--- /dev/null
+++ b/.github/ISSUE_TEMPLATE/question.md
@@ -0,0 +1,12 @@
+---
+name: Question
+about: Question about wire-server
+title: ''
+labels: ''
+assignees: ''
+
+---
+
+* [ ] I have seen https://docs.wire.com/ and https://github.com/wireapp/wire-server-deploy - the documentation there does not answer my question.
+
+**My question:**

From 72586ff3e044032c4365e30dc77f856f3920267e Mon Sep 17 00:00:00 2001
From: fisx <mf@zerobuzz.net>
Date: Fri, 20 Sep 2019 07:09:23 +0200
Subject: [PATCH 07/13] Derive Generic everywhere. (#864)

---
 libs/brig-types/src/Brig/Types/Client.hs      |  8 ++---
 libs/brig-types/src/Brig/Types/Connection.hs  |  1 +
 libs/brig-types/src/Brig/Types/Intra.hs       |  1 +
 libs/galley-types/src/Galley/Types.hs         | 32 +++++++++----------
 .../src/Galley/Types/Teams/Intra.hs           |  5 ++-
 libs/types-common/src/Data/Id.hs              |  9 ++++--
 services/galley/src/Galley/Data/Types.hs      |  6 ++--
 7 files changed, 35 insertions(+), 27 deletions(-)

diff --git a/libs/brig-types/src/Brig/Types/Client.hs b/libs/brig-types/src/Brig/Types/Client.hs
index 496b47c818b..7db2eed4bc6 100644
--- a/libs/brig-types/src/Brig/Types/Client.hs
+++ b/libs/brig-types/src/Brig/Types/Client.hs
@@ -79,22 +79,22 @@ data Client = Client
     , clientCookie   :: !(Maybe CookieLabel)
     , clientLocation :: !(Maybe Location)
     , clientModel    :: !(Maybe Text)
-    } deriving (Eq, Show)
+    } deriving (Eq, Show, Generic)
 
 data PubClient = PubClient
     { pubClientId     :: !ClientId
     , pubClientClass  :: !(Maybe ClientClass)
-    } deriving (Eq, Show)
+    } deriving (Eq, Show, Generic)
 
 newtype RmClient = RmClient
     { rmPassword :: Maybe PlainTextPassword
-    }
+    } deriving (Generic)
 
 data UpdateClient = UpdateClient
     { updateClientPrekeys :: ![Prekey]
     , updateClientLastKey :: !(Maybe LastPrekey)
     , updateClientLabel   :: !(Maybe Text)
-    }
+    } deriving (Generic)
 
 -- * JSON instances:
 
diff --git a/libs/brig-types/src/Brig/Types/Connection.hs b/libs/brig-types/src/Brig/Types/Connection.hs
index a921e96d0ec..0229d144d91 100644
--- a/libs/brig-types/src/Brig/Types/Connection.hs
+++ b/libs/brig-types/src/Brig/Types/Connection.hs
@@ -79,6 +79,7 @@ data UserConnectionList = UserConnectionList
 -- 'Accepted' state.
 data UserIds = UserIds
     { cUsers :: [UserId] }
+    deriving (Eq, Show, Generic)
 
 -- | Data that is passed to the @\/i\/users\/connections-status@ endpoint.
 data ConnectionsStatusRequest = ConnectionsStatusRequest
diff --git a/libs/brig-types/src/Brig/Types/Intra.hs b/libs/brig-types/src/Brig/Types/Intra.hs
index 09de3dbb1c6..59a09817b2d 100644
--- a/libs/brig-types/src/Brig/Types/Intra.hs
+++ b/libs/brig-types/src/Brig/Types/Intra.hs
@@ -42,6 +42,7 @@ instance ToJSON AccountStatus where
 
 newtype AccountStatusUpdate = AccountStatusUpdate
     { suStatus :: AccountStatus }
+    deriving (Generic)
 
 instance FromJSON AccountStatusUpdate where
     parseJSON = withObject "account-status-update" $ \o ->
diff --git a/libs/galley-types/src/Galley/Types.hs b/libs/galley-types/src/Galley/Types.hs
index 67e30a18f16..af50bddebed 100644
--- a/libs/galley-types/src/Galley/Types.hs
+++ b/libs/galley-types/src/Galley/Types.hs
@@ -281,7 +281,7 @@ data NewOtrMessage = NewOtrMessage
 
 newtype UserClients = UserClients
     { userClients :: Map UserId (Set ClientId)
-    } deriving (Eq, Show, Semigroup, Monoid)
+    } deriving (Eq, Show, Semigroup, Monoid, Generic)
 
 filterClients :: (Set ClientId -> Bool) -> UserClients -> UserClients
 filterClients p (UserClients c) = UserClients $ Map.filter p c
@@ -293,19 +293,19 @@ data ClientMismatch = ClientMismatch
     -- | Clients that the message /should not/ have been encrypted for, but was.
     , redundantClients :: !UserClients
     , deletedClients   :: !UserClients
-    } deriving (Eq, Show)
+    } deriving (Eq, Show, Generic)
 
 -- | Request payload for accepting a 1-1 conversation.
 newtype Accept = Accept
     { aUser :: UserId
-    } deriving (Eq, Show)
+    } deriving (Eq, Show, Generic)
 
 -- Members ------------------------------------------------------------------
 
 -- The semantics of the possible different values is entirely up to clients,
 -- the server will not interpret this value in any way.
 newtype MutedStatus = MutedStatus { fromMutedStatus :: Int32 }
-    deriving (Eq, Num, Ord, Show, FromJSON, ToJSON)
+    deriving (Eq, Num, Ord, Show, FromJSON, ToJSON, Generic)
 
 data Member = Member
     { memId             :: !UserId
@@ -317,12 +317,12 @@ data Member = Member
     , memOtrArchivedRef :: !(Maybe Text)
     , memHidden         :: !Bool
     , memHiddenRef      :: !(Maybe Text)
-    } deriving (Eq, Show)
+    } deriving (Eq, Show, Generic)
 
 data OtherMember = OtherMember
     { omId      :: !UserId
     , omService :: !(Maybe ServiceRef)
-    } deriving (Eq, Show)
+    } deriving (Eq, Show, Generic)
 
 instance Ord OtherMember where
     compare a b = compare (omId a) (omId b)
@@ -357,7 +357,7 @@ data Event = Event
     , evtFrom :: !UserId
     , evtTime :: !UTCTime
     , evtData :: !(Maybe EventData)
-    } deriving Eq
+    } deriving (Eq, Generic)
 
 data EventType
     = MemberJoin
@@ -374,7 +374,7 @@ data EventType
     | ConvReceiptModeUpdate
     | OtrMessageAdd
     | Typing
-    deriving (Eq, Show)
+    deriving (Eq, Show, Generic)
 
 data EventData
     = EdMembers             !Members
@@ -388,25 +388,25 @@ data EventData
     | EdConversation        !Conversation
     | EdTyping              !TypingData
     | EdOtrMessage          !OtrMessage
-    deriving (Eq, Show)
+    deriving (Eq, Show, Generic)
 
 data OtrMessage = OtrMessage
     { otrSender     :: !ClientId
     , otrRecipient  :: !ClientId
     , otrCiphertext :: !Text
     , otrData       :: !(Maybe Text)
-    } deriving (Eq, Show)
+    } deriving (Eq, Show, Generic)
 
 newtype Members = Members
     { mUsers :: [UserId]
-    } deriving (Eq, Show)
+    } deriving (Eq, Show, Generic)
 
 data Connect = Connect
     { cRecipient :: !UserId
     , cMessage   :: !(Maybe Text)
     , cName      :: !(Maybe Text)
     , cEmail     :: !(Maybe Text)
-    } deriving (Eq, Show)
+    } deriving (Eq, Show, Generic)
 
 -- Outbound member updates.  Used for events (sent over the websocket, etc.).  See also
 -- 'MemberUpdate'.
@@ -418,22 +418,22 @@ data MemberUpdateData = MemberUpdateData
     , misOtrArchivedRef :: !(Maybe Text)
     , misHidden         :: !(Maybe Bool)
     , misHiddenRef      :: !(Maybe Text)
-    } deriving (Eq, Show)
+    } deriving (Eq, Show, Generic)
 
 newtype TypingData = TypingData
     { tdStatus :: TypingStatus
-    } deriving (Eq, Show)
+    } deriving (Eq, Show, Generic)
 
 data TypingStatus
     = StartedTyping
     | StoppedTyping
-    deriving (Eq, Ord, Show)
+    deriving (Eq, Ord, Show, Generic)
 
 data ConversationCode = ConversationCode
     { conversationKey   :: !Code.Key
     , conversationCode  :: !Code.Value
     , conversationUri   :: !(Maybe HttpsUrl)
-    } deriving (Eq, Show)
+    } deriving (Eq, Show, Generic)
 
 mkConversationCode :: Code.Key -> Code.Value -> HttpsUrl -> ConversationCode
 mkConversationCode k v (HttpsUrl prefix) = ConversationCode
diff --git a/libs/galley-types/src/Galley/Types/Teams/Intra.hs b/libs/galley-types/src/Galley/Types/Teams/Intra.hs
index 1ed15fd3b40..23f5adf499a 100644
--- a/libs/galley-types/src/Galley/Types/Teams/Intra.hs
+++ b/libs/galley-types/src/Galley/Types/Teams/Intra.hs
@@ -18,7 +18,7 @@ data TeamStatus
     | Deleted
     | Suspended
     | PendingActive
-    deriving (Eq, Show)
+    deriving (Eq, Show, Generic)
 
 instance ToJSON TeamStatus where
     toJSON Active        = String "active"
@@ -40,6 +40,7 @@ data TeamData = TeamData
     , tdStatus     :: !TeamStatus
     , tdStatusTime :: !(Maybe UTCTime) -- This needs to be a Maybe due to backwards compatibility
     }
+    deriving (Eq, Show, Generic)
 
 instance ToJSON TeamData where
     toJSON (TeamData t s st) = object
@@ -59,6 +60,7 @@ data TeamStatusUpdate = TeamStatusUpdate
     , tuCurrency :: !(Maybe Currency.Alpha)
     -- TODO: Remove Currency selection once billing supports currency changes after team creation
     }
+    deriving (Eq, Show, Generic)
 
 instance FromJSON TeamStatusUpdate where
     parseJSON = withObject "team-status-update" $ \o ->
@@ -72,5 +74,6 @@ instance ToJSON TeamStatusUpdate where
 
 newtype TeamName = TeamName
     { tnName :: Text }
+    deriving (Eq, Show, Generic)
 
 deriveJSON toJSONFieldName ''TeamName
diff --git a/libs/types-common/src/Data/Id.hs b/libs/types-common/src/Data/Id.hs
index 7db643384fe..ac0b61539f0 100644
--- a/libs/types-common/src/Data/Id.hs
+++ b/libs/types-common/src/Data/Id.hs
@@ -57,13 +57,13 @@ type ScimTokenId  = Id STo
 
 -- Id -------------------------------------------------------------------------
 
-data NoId = NoId deriving (Eq, Show)
+data NoId = NoId deriving (Eq, Show, Generic)
 
 instance NFData NoId where rnf a = seq a ()
 
 newtype Id a = Id
     { toUUID :: UUID
-    } deriving (Eq, Ord, NFData, Hashable)
+    } deriving (Eq, Ord, NFData, Hashable, Generic)
 
 -- REFACTOR: non-derived, custom show instances break pretty-show and violate the law
 -- that @show . read == id@.  can we derive Show here?
@@ -149,6 +149,7 @@ newtype ConnId = ConnId
                , ToByteString
                , Hashable
                , NFData
+               , Generic
                )
 
 instance ToJSON ConnId where
@@ -164,7 +165,7 @@ instance FromJSON ConnId where
 -- lives as long as the device is registered.  See also: 'ConnId'.
 newtype ClientId = ClientId
     { client :: Text
-    } deriving (Eq, Ord, Show, ToByteString, Hashable, NFData, ToJSON, ToJSONKey)
+    } deriving (Eq, Ord, Show, ToByteString, Hashable, NFData, ToJSON, ToJSONKey, Generic)
 
 newClientId :: Word64 -> ClientId
 newClientId = ClientId . toStrict . toLazyText . hexadecimal
@@ -215,6 +216,7 @@ newtype BotId = BotId
              , NFData
              , FromJSON
              , ToJSON
+             , Generic
              )
 
 instance Show BotId where
@@ -243,6 +245,7 @@ newtype RequestId = RequestId
                , ToByteString
                , Hashable
                , NFData
+               , Generic
                )
 
 -- | Returns "N/A"
diff --git a/services/galley/src/Galley/Data/Types.hs b/services/galley/src/Galley/Data/Types.hs
index 0cf31a7e08a..ab010323570 100644
--- a/services/galley/src/Galley/Data/Types.hs
+++ b/services/galley/src/Galley/Data/Types.hs
@@ -43,7 +43,7 @@ data Conversation = Conversation
     , convDeleted :: Maybe Bool
     , convMessageTimer :: Maybe Milliseconds      -- ^ Global message timer
     , convReceiptMode  :: Maybe ReceiptMode
-    } deriving (Eq, Show)
+    } deriving (Eq, Show, Generic)
 
 isSelfConv :: Conversation -> Bool
 isSelfConv = (SelfConv ==) . convType
@@ -69,11 +69,11 @@ data Code = Code
     , codeTTL           :: !Timeout
     , codeConversation  :: !ConvId
     , codeScope         :: !Scope
-    } deriving (Eq, Show)
+    } deriving (Eq, Show, Generic)
 
 
 data Scope = ReusableCode
-    deriving (Eq, Show)
+    deriving (Eq, Show, Generic)
 
 instance Cql Scope where
     ctype = Tagged IntColumn

From cfb60bc5786ef3e9975390fbc56a4321a8cfa8ac Mon Sep 17 00:00:00 2001
From: fisx <mf@zerobuzz.net>
Date: Mon, 23 Sep 2019 10:54:33 +0200
Subject: [PATCH 08/13] Fix: metrics refresh in cannon (#866)

* Fix: add missing pause in refreshMetrics thread.

* We don't collect metrics faster than this...
---
 services/cannon/src/Cannon/Run.hs          | 1 +
 services/galley/src/Galley/API/Internal.hs | 2 +-
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/services/cannon/src/Cannon/Run.hs b/services/cannon/src/Cannon/Run.hs
index 80c9a8a02ae..dfcb3a9ee2e 100644
--- a/services/cannon/src/Cannon/Run.hs
+++ b/services/cannon/src/Cannon/Run.hs
@@ -77,6 +77,7 @@ refreshMetrics = do
     safeForever $ do
         s <- D.size c
         gaugeSet (fromIntegral s) (path "net.websocket.clients") m
+        threadDelay 1000000
   where
     safeForever :: (MonadIO m, LC.MonadLogger m, MonadCatch m) => m () -> m ()
     safeForever action = forever $ action `catchAny` \exc -> do
diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs
index 95dc5a3f6ea..0148b24a1d3 100644
--- a/services/galley/src/Galley/API/Internal.hs
+++ b/services/galley/src/Galley/API/Internal.hs
@@ -84,7 +84,7 @@ refreshMetrics = do
     safeForever "refreshMetrics" $ do
         n <- Q.len q
         gaugeSet (fromIntegral n) (Metrics.path "galley.deletequeue.len") m
-        threadDelay 100000
+        threadDelay 1000000
 
 safeForever :: (MonadIO m, MonadLogger m, MonadCatch m) => String -> m () -> m ()
 safeForever funName action = forever $ action `catchAny` \exc -> do

From dbebc7c3656cbfff122c2c9cf8e3a60f892ea9b9 Mon Sep 17 00:00:00 2001
From: Arian van Putten <arian.vanputten@gmail.com>
Date: Mon, 30 Sep 2019 11:41:36 +0200
Subject: [PATCH 09/13] Add debug logging for endpoints that don't have a user
 but affect a user (#856)

* Add debug logging for endpoints that don't have a user but affect a user

E.g.  this is useful to see if someone is actively trying to reset
someone's password.

* Put action in field instead of log message
---
 services/brig/src/Brig/API/User.hs          |  5 ++++-
 services/brig/src/Brig/User/Auth.hs         |  9 ++++++++-
 services/galley/src/Galley/API/LegalHold.hs | 12 ++++++------
 services/galley/src/Galley/API/Teams.hs     | 12 ++++++------
 4 files changed, 24 insertions(+), 14 deletions(-)

diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs
index b87cc38d23c..20952ada5b9 100644
--- a/services/brig/src/Brig/API/User.hs
+++ b/services/brig/src/Brig/API/User.hs
@@ -155,7 +155,7 @@ createUser new@NewUser{..} = do
     -- Create account
     (account, pw) <- lift $ newAccount new { newUserIdentity = ident } (Team.inInvitation . fst <$> teamInvitation) tid
     let uid = userId (accountUser account)
-
+    Log.debug $ field "user" (toByteString uid) . field "action" (Log.val "User.createUser")
     Log.info $ field "user" (toByteString uid) . msg (val "Creating user")
     activatedTeam <- lift $ do
         Data.insertAccount account Nothing pw False searchable
@@ -514,6 +514,7 @@ preverify tgt code = do
 onActivated :: ActivationEvent -> AppIO (UserId, Maybe UserIdentity, Bool)
 onActivated (AccountActivated account) = do
     let uid = userId (accountUser account)
+    Log.debug $ field "user" (toByteString uid) . field  "action" (Log.val "User.onActivated")
     Log.info $ field "user" (toByteString uid) . msg (val "User activated")
     Intra.onUserEvent uid Nothing $ UserActivated account
     return (uid, userIdentity (accountUser account), True)
@@ -638,6 +639,7 @@ beginPasswordReset :: Either Email Phone -> ExceptT PasswordResetError AppIO (Us
 beginPasswordReset target = do
     let key = either userEmailKey userPhoneKey target
     user <- lift (Data.lookupKey key) >>= maybe (throwE InvalidPasswordResetKey) return
+    Log.debug $ field "user" (toByteString user) . field "action" (Log.val "User.beginPasswordReset")
     status <- lift $ Data.lookupStatus user
     unless (status == Just Active) $
         throwE InvalidPasswordResetKey
@@ -653,6 +655,7 @@ completePasswordReset ident code pw = do
     case muid of
         Nothing  -> throwE InvalidPasswordResetCode
         Just uid -> do
+            Log.debug $ field "user" (toByteString uid) . field "action" (Log.val "User.completePasswordReset")
             checkNewIsDifferent uid pw
             lift $ do
                 Data.updatePassword uid pw
diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs
index e22ffd4049e..a8aa5bde81a 100644
--- a/services/brig/src/Brig/User/Auth.hs
+++ b/services/brig/src/Brig/User/Auth.hs
@@ -67,6 +67,7 @@ sendLoginCode phone call force = do
     case user of
         Nothing -> throwE $ SendLoginInvalidPhone phone
         Just  u -> do
+            Log.debug $ field "user" (toByteString u) . field "action" (Log.val "User.sendLoginCode")
             pw <- lift $ Data.lookupPassword u
             unless (isNothing pw || force) $
                 throwE SendLoginPasswordExists
@@ -81,11 +82,14 @@ sendLoginCode phone call force = do
 lookupLoginCode :: Phone -> AppIO (Maybe PendingLoginCode)
 lookupLoginCode phone = Data.lookupKey (userPhoneKey phone) >>= \case
     Nothing -> return Nothing
-    Just  u -> Data.lookupLoginCode u
+    Just  u -> do
+      Log.debug $ field "user" (toByteString u) . field "action" (Log.val "User.lookupLoginCode")
+      Data.lookupLoginCode u
 
 login :: Login -> CookieType -> ExceptT LoginError AppIO (Access ZAuth.User)
 login (PasswordLogin li pw label) typ = do
     uid <- resolveLoginId li
+    Log.debug $ field "user" (toByteString uid) . field "action" (Log.val "User.login")
     checkRetryLimit uid
     Data.authenticate uid pw `catchE` \case
         AuthSuspended          -> throwE LoginSuspended
@@ -95,6 +99,7 @@ login (PasswordLogin li pw label) typ = do
     newAccess @ZAuth.User @ZAuth.Access uid typ label
 login (SmsLogin phone code label) typ = do
     uid <- resolveLoginId (LoginByPhone phone)
+    Log.debug $ field "user" (toByteString uid) . field "action" (Log.val "User.login")
     checkRetryLimit uid
     ok <- lift $ Data.verifyLoginCode uid code
     unless ok $
@@ -138,6 +143,7 @@ renewAccess
     -> ExceptT ZAuth.Failure AppIO (Access u)
 renewAccess ut at = do
     (uid, ck) <- validateTokens ut at
+    Log.debug $ field "user" (toByteString uid) . field "action" (Log.val "User.renewAccess")
     catchSuspendInactiveUser uid ZAuth.Expired
     ck' <- lift $ nextCookie ck
     at' <- lift $ newAccessToken (fromMaybe ck ck') at
@@ -150,6 +156,7 @@ revokeAccess
     -> [CookieLabel]
     -> ExceptT AuthError AppIO ()
 revokeAccess u pw cc ll = do
+    Log.debug $ field "user" (toByteString u) . field "action" (Log.val "User.revokeAccess")
     Data.authenticate u pw
     lift $ revokeCookies u cc ll
 
diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs
index c097e8ca622..469089653f8 100644
--- a/services/galley/src/Galley/API/LegalHold.hs
+++ b/services/galley/src/Galley/API/LegalHold.hs
@@ -44,7 +44,7 @@ createSettings (zusr ::: tid ::: req ::: _) = do
     membs <- Data.teamMembers tid
     let zothers = map (view userId) membs
     Log.debug $ Log.field "targets" (toByteString . show $ toByteString <$> zothers)
-              . Log.msg (Log.val "LegalHold.createSettings")
+              . Log.field "action" (Log.val "LegalHold.createSettings")
     
     void $ permissionCheck zusr ChangeLegalHoldTeamSettings membs
 
@@ -78,7 +78,7 @@ removeSettings (zusr ::: tid ::: req ::: _) = do
     membs <- Data.teamMembers tid
     let zothers = map (view userId) membs
     Log.debug $ Log.field "targets" (toByteString . show $ toByteString <$> zothers)
-              . Log.msg (Log.val "LegalHold.removeSettings")
+              . Log.field "action" (Log.val "LegalHold.removeSettings")
 
     void $ permissionCheck zusr ChangeLegalHoldTeamSettings membs
     RemoveLegalHoldSettingsRequest mPassword <- fromJsonBody req
@@ -96,7 +96,7 @@ removeSettings' tid mMembers = do
     membs <- maybe (Data.teamMembers tid) pure mMembers
     let zothers = map (view userId) membs
     Log.debug $ Log.field "targets" (toByteString . show $ toByteString <$> zothers)
-              . Log.msg (Log.val "LegalHold.removeSettings'")
+              . Log.field "action" (Log.val "LegalHold.removeSettings'")
 
     let lhMembers = filter ((== UserLegalHoldEnabled) . view legalHoldStatus) membs
     -- I picked this number by fair dice roll, feel free to change it :P
@@ -141,7 +141,7 @@ requestDevice (zusr ::: tid ::: uid ::: _) = do
     assertLegalHoldEnabled tid
 
     Log.debug $ Log.field "targets" (toByteString uid)
-              . Log.msg (Log.val "LegalHold.requestDevice")
+              . Log.field "action" (Log.val "LegalHold.requestDevice")
     membs <- Data.teamMembers tid
     void $ permissionCheck zusr ChangeLegalHoldUserSettings membs
 
@@ -178,7 +178,7 @@ approveDevice
 approveDevice (zusr ::: tid ::: uid ::: connId ::: req ::: _) = do
     assertLegalHoldEnabled tid
     Log.debug $ Log.field "targets" (toByteString uid)
-              . Log.msg (Log.val "LegalHold.approveDevice")
+              . Log.field "action" (Log.val "LegalHold.approveDevice")
 
     unless (zusr == uid) (throwM accessDenied)
     assertOnTeam uid tid
@@ -220,7 +220,7 @@ disableForUser
   -> Galley Response
 disableForUser (zusr ::: tid ::: uid ::: req ::: _) = do
     Log.debug $ Log.field "targets" (toByteString uid)
-              . Log.msg (Log.val "LegalHold.disableForUser")
+              . Log.field "action" (Log.val "LegalHold.disableForUser")
     membs <- Data.teamMembers tid
     void $ permissionCheck zusr ChangeLegalHoldUserSettings membs
     if userLHNotDisabled membs
diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs
index d36925c68cc..b90c7207500 100644
--- a/services/galley/src/Galley/API/Teams.hs
+++ b/services/galley/src/Galley/API/Teams.hs
@@ -114,7 +114,7 @@ createNonBindingTeam (zusr::: zcon ::: req ::: _) = do
     ensureUnboundUsers (zusr : zothers)
     ensureConnected zusr zothers
     Log.debug $ Log.field "targets" (toByteString . show $ toByteString <$> zothers)
-              . Log.msg (Log.val "Teams.createNonBindingTeam")
+              . Log.field "action" (Log.val "Teams.createNonBindingTeam")
     team <- Data.createTeam Nothing zusr (body^.newTeamName) (body^.newTeamIcon) (body^.newTeamIconKey) NonBinding
     finishCreateTeam team owner others (Just zcon)
 
@@ -154,7 +154,7 @@ updateTeam (zusr::: zcon ::: tid ::: req ::: _) = do
     membs <- Data.teamMembers tid
     let zothers = map (view userId) membs
     Log.debug $ Log.field "targets" (toByteString . show $ toByteString <$> zothers)
-              . Log.msg (Log.val "Teams.updateTeam")
+              . Log.field "action" (Log.val "Teams.updateTeam")
     void $ permissionCheck zusr SetTeamData membs
     Data.updateTeam tid body
     now <- liftIO getCurrentTime
@@ -256,7 +256,7 @@ addTeamMember (zusr ::: zcon ::: tid ::: req ::: _) = do
     nmem <- fromJsonBody req
     let uid = nmem^.ntmNewTeamMember.userId
     Log.debug $ Log.field "targets" (toByteString uid)
-              . Log.msg (Log.val "Teams.addTeamMember")
+              . Log.field "action" (Log.val "Teams.addTeamMember")
     mems <- Data.teamMembers tid
     -- verify permissions
     tmem <- permissionCheck zusr AddTeamMember mems
@@ -285,7 +285,7 @@ updateTeamMember (zusr ::: zcon ::: tid ::: req ::: _) = do
         targetPermissions = targetMember^.permissions
 
     Log.debug $ Log.field "targets" (toByteString targetId)
-              . Log.msg (Log.val "Teams.updateTeamMember")
+              . Log.field "action" (Log.val "Teams.updateTeamMember")
 
     -- get the team and verify permissions
     team    <- tdTeam <$> (Data.team tid >>= ifNothing teamNotFound)
@@ -332,7 +332,7 @@ updateTeamMember (zusr ::: zcon ::: tid ::: req ::: _) = do
 deleteTeamMember :: UserId ::: ConnId ::: TeamId ::: UserId ::: Request ::: Maybe JSON ::: JSON -> Galley Response
 deleteTeamMember (zusr::: zcon ::: tid ::: remove ::: req ::: _ ::: _) = do
     Log.debug $ Log.field "targets" (toByteString remove)
-              . Log.msg (Log.val "Teams.deleteTeamMember")
+              . Log.field "action" (Log.val "Teams.deleteTeamMember")
     mems <- Data.teamMembers tid
     void $ permissionCheck zusr RemoveTeamMember mems
     okToDelete <- canBeDeleted [] remove tid
@@ -468,7 +468,7 @@ addTeamMemberInternal :: TeamId -> Maybe UserId -> Maybe ConnId -> NewTeamMember
 addTeamMemberInternal tid origin originConn newMem mems = do
     let new = newMem^.ntmNewTeamMember
     Log.debug $ Log.field "targets" (toByteString (new^.userId))
-              . Log.msg (Log.val "Teams.addTeamMemberInternal")
+              . Log.field "action" (Log.val "Teams.addTeamMemberInternal")
     o <- view options
     unless (length mems < fromIntegral (o^.optSettings.setMaxTeamSize)) $
         throwM tooManyTeamMembers

From 50b23ec6fb9a7e3eeedd284b5f8102f0be05d280 Mon Sep 17 00:00:00 2001
From: Arian van Putten <arian.vanputten@gmail.com>
Date: Mon, 30 Sep 2019 18:54:43 +0200
Subject: [PATCH 10/13] Update Changelog

---
 CHANGELOG.md | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index dbd92c353f9..c0ebd08f57c 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,22 @@
+# 2019-09-30
+
+## Relevant for self-hosters
+- More information is logged about user actions (#856)
+
+## Relevant for client developers
+
+## Bug fixes
+- Fix bugs related to metrics (#853, #866)
+- Sneak up on flaky test. (#863)
+
+## Internal Changes
+- Derive Generic everywhere (#864)
+- Add issue templates (#862)
+- Cleanup stern (#845)
+- Log warnings only when users are suspended (#854)
+- Documentation update for restund and smoketester (#855)
+
+
 # 2019-09-16 #858
 
 ## Relevant for self-hosters

From 5304776840c784512189db3c61d9548b2f5d45e2 Mon Sep 17 00:00:00 2001
From: Arian van Putten <arian.vanputten@gmail.com>
Date: Tue, 1 Oct 2019 15:11:33 +0200
Subject: [PATCH 11/13] Update CHANGELOG.md

Co-Authored-By: jschaul <jschaul@users.noreply.github.com>
---
 CHANGELOG.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index c0ebd08f57c..bd2d7e31f9a 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,4 +1,4 @@
-# 2019-09-30
+# 2019-09-30 #868
 
 ## Relevant for self-hosters
 - More information is logged about user actions (#856)

From 870b10b80a3dceaae07da21bbed29fc1d025f627 Mon Sep 17 00:00:00 2001
From: Arian van Putten <arian.vanputten@gmail.com>
Date: Tue, 1 Oct 2019 17:37:12 +0200
Subject: [PATCH 12/13] Make property size configurable (#867)

---
 services/brig/brig.integration.yaml           |  2 ++
 services/brig/src/Brig/API.hs                 |  7 ++---
 services/brig/src/Brig/Options.hs             | 12 ++++++++
 .../test/integration/API/User/Property.hs     | 29 ++++++++++++++++++-
 4 files changed, 45 insertions(+), 5 deletions(-)

diff --git a/services/brig/brig.integration.yaml b/services/brig/brig.integration.yaml
index d6ac7dd4ffb..69aa47ead48 100644
--- a/services/brig/brig.integration.yaml
+++ b/services/brig/brig.integration.yaml
@@ -148,6 +148,8 @@ optSettings:
   setMaxTeamSize: 32
   setMaxConvSize: 16
   setEmailVisibility: visible_to_self
+  setPropertyMaxKeyLen: 1024
+  setPropertyMaxValueLen: 4096
 
 logLevel: Warn
 logNetStrings: false
diff --git a/services/brig/src/Brig/API.hs b/services/brig/src/Brig/API.hs
index d834240398a..a9d126fa34b 100644
--- a/services/brig/src/Brig/API.hs
+++ b/services/brig/src/Brig/API.hs
@@ -954,7 +954,9 @@ sitemap o = do
 
 setProperty :: UserId ::: ConnId ::: PropertyKey ::: JsonRequest PropertyValue -> Handler Response
 setProperty (u ::: c ::: k ::: req) = do
-    unless (Text.compareLength (Ascii.toText (propertyKeyName k)) maxKeyLen <= EQ) $
+    maxKeyLen <- fromMaybe defMaxKeyLen <$> view (settings . propertyMaxKeyLen)
+    maxValueLen <- fromMaybe defMaxValueLen <$> view (settings . propertyMaxValueLen)
+    unless (Text.compareLength (Ascii.toText (propertyKeyName k)) (fromIntegral maxKeyLen) <= EQ) $
         throwStd propertyKeyTooLarge
     lbs <- Lazy.take (maxValueLen + 1) <$> liftIO (lazyRequestBody (fromJsonRequest req))
     unless (Lazy.length lbs <= maxValueLen) $
@@ -962,9 +964,6 @@ setProperty (u ::: c ::: k ::: req) = do
     val <- hoistEither $ fmapL (StdError . badRequest . pack) (eitherDecode lbs)
     API.setProperty u c k val !>> propDataError
     return empty
-  where
-    maxKeyLen   = 256
-    maxValueLen = 512
 
 deleteProperty :: UserId ::: ConnId ::: PropertyKey -> Handler Response
 deleteProperty (u ::: c ::: k) = lift (API.deleteProperty u c k) >> return empty
diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs
index 523edca134f..49937ca5541 100644
--- a/services/brig/src/Brig/Options.hs
+++ b/services/brig/src/Brig/Options.hs
@@ -309,8 +309,18 @@ data Settings = Settings
     , setProviderSearchFilter  :: !(Maybe ProviderId) -- ^ Filter ONLY services with
                                                       --   the given provider id
     , setEmailVisibility       :: !EmailVisibility -- ^ Whether to expose user emails and to whom
+
+    , setPropertyMaxKeyLen     :: !(Maybe Int64)
+    , setPropertyMaxValueLen   :: !(Maybe Int64)
+
     } deriving (Show, Generic)
 
+defMaxKeyLen :: Int64
+defMaxKeyLen = 256
+
+defMaxValueLen :: Int64
+defMaxValueLen = 512
+
 instance FromJSON Timeout where
     parseJSON (Y.Number n) =
         let defaultV = 3600
@@ -326,3 +336,5 @@ instance FromJSON Opts
 
 Lens.makeLensesFor [("optSettings", "optionSettings")] ''Opts
 Lens.makeLensesFor [("setEmailVisibility", "emailVisibility")] ''Settings
+Lens.makeLensesFor [("setPropertyMaxKeyLen", "propertyMaxKeyLen")] ''Settings
+Lens.makeLensesFor [("setPropertyMaxValueLen", "propertyMaxValueLen")] ''Settings
diff --git a/services/brig/test/integration/API/User/Property.hs b/services/brig/test/integration/API/User/Property.hs
index e7d0db4a1c2..6b739e010d4 100644
--- a/services/brig/test/integration/API/User/Property.hs
+++ b/services/brig/test/integration/API/User/Property.hs
@@ -4,8 +4,10 @@ import Imports
 import API.User.Util
 import Bilge hiding (accept, timeout)
 import Bilge.Assert
+import Brig.Options
 import Brig.Types
 import Data.Aeson
+import Data.String.Conversions (cs)
 import Test.Tasty hiding (Timeout)
 import Util
 
@@ -15,13 +17,14 @@ import qualified Data.Text                   as T
 import qualified Network.Wai.Utilities.Error as Error
 
 tests :: ConnectionLimit -> Opt.Timeout -> Maybe Opt.Opts -> Manager -> Brig -> Cannon -> Galley -> TestTree
-tests _cl _at _conf p b _c _g = testGroup "property"
+tests _cl _at opts p b _c _g = testGroup "property"
     [ test p "put/get /properties/:key - 200" $ testSetGetProperty b
     , test p "delete /properties/:key - 200"  $ testDeleteProperty b
     , test p "get /properties - 200"          $ testListPropertyKeys b
     , test p "get /properties-values - 200"   $ testListPropertyKeysAndValues b
     , test p "delete /properties - 200"       $ testClearProperties b
     , test p "put /properties/:key - 403"     $ testPropertyLimits b
+    , test p "size limits"                    $ testSizeLimits opts b
     ]
 
 testSetGetProperty :: Brig -> Http ()
@@ -119,3 +122,27 @@ testPropertyLimits brig = do
     setProperty brig (userId u) "bar" (String "hello") !!! do
         const 403 === statusCode
         const (Just "too-many-properties") === fmap Error.label . responseJsonMaybe
+
+testSizeLimits :: HasCallStack => Maybe Opt.Opts -> Brig -> Http ()
+testSizeLimits Nothing _ = error "no config!"
+testSizeLimits (Just opts) brig = do
+    let maxKeyLen = fromIntegral $ fromMaybe defMaxKeyLen . setPropertyMaxKeyLen $ optSettings opts
+        maxValueLen = fromIntegral $ fromMaybe defMaxValueLen . setPropertyMaxValueLen $ optSettings opts
+
+        badKey = cs $ replicate (maxKeyLen + 2) '_'
+        okKey = cs $ replicate (maxKeyLen - 2) '_'
+
+        -- we use String Values here that have an encoding that is 2 characters longer than
+        -- the decoded string value (because of the quotes).
+        badValue = String . cs $ replicate maxValueLen '_'
+        okValue = String . cs $ replicate (maxValueLen - 3) '_'
+
+    u <- randomUser brig
+    setProperty brig (userId u) okKey okValue !!!
+        const 200 === statusCode
+    setProperty brig (userId u) badKey okValue !!!
+        const 403 === statusCode
+    setProperty brig (userId u) okKey badValue !!!
+        const 403 === statusCode
+    setProperty brig (userId u) badKey badValue !!!
+        const 403 === statusCode

From 6290b2ba2077018e727ddc82b2171772ca85ad0e Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Wed, 2 Oct 2019 09:45:46 +0200
Subject: [PATCH 13/13] CHANGELOG

---
 CHANGELOG.md | 1 +
 1 file changed, 1 insertion(+)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index bd2d7e31f9a..58fbbc44fcd 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -4,6 +4,7 @@
 - More information is logged about user actions (#856)
 
 ## Relevant for client developers
+- Make team member property size configurable (#867)
 
 ## Bug fixes
 - Fix bugs related to metrics (#853, #866)