From 14b36921a4c20a4c10f39447bb5c88ededc1fd7d Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Tue, 21 Jul 2020 17:56:12 +0200
Subject: [PATCH 01/48] Add comment, minor hlint

---
 libs/wire-api/src/Wire/API/Call/TURN.hs | 10 +++++-----
 services/brig/src/Brig/TURN/API.hs      |  8 +++++---
 2 files changed, 10 insertions(+), 8 deletions(-)

diff --git a/libs/wire-api/src/Wire/API/Call/TURN.hs b/libs/wire-api/src/Wire/API/Call/TURN.hs
index f49be9689c9..32310b958c6 100644
--- a/libs/wire-api/src/Wire/API/Call/TURN.hs
+++ b/libs/wire-api/src/Wire/API/Call/TURN.hs
@@ -207,7 +207,7 @@ parseTurnURI = parseOnly (parser <* endOfInput)
         <$> ((takeWhile1 (/= ':') <* char ':' >>= parseScheme) <?> "parsingScheme")
         <*> ((takeWhile1 (/= ':') <* char ':' >>= parseHost) <?> "parsingHost")
         <*> (decimal <?> "parsingPort")
-        <*> ((optional ((string "?transport=" *> takeText) >>= parseTransport)) <?> "parsingTransport")
+        <*> (optional ((string "?transport=" *> takeText) >>= parseTransport) <?> "parsingTransport")
     parseScheme = parse "parseScheme"
     parseHost = parse "parseHost"
     parseTransport = parse "parseTransport"
@@ -421,19 +421,19 @@ limitServers uris limit = limitServers' [] limit uris
 isUdp :: TurnURI -> Bool
 isUdp uri =
   _turiScheme uri == SchemeTurn
-    && ( _turiTransport uri == Just (TransportUDP)
-           || _turiTransport uri == Nothing
+    && ( _turiTransport uri == Just TransportUDP
+           || isNothing (_turiTransport uri)
        )
 
 isTcp :: TurnURI -> Bool
 isTcp uri =
   _turiScheme uri == SchemeTurn
-    && _turiTransport uri == Just (TransportTCP)
+    && _turiTransport uri == Just TransportTCP
 
 isTls :: TurnURI -> Bool
 isTls uri =
   _turiScheme uri == SchemeTurns
-    && _turiTransport uri == Just (TransportTCP)
+    && _turiTransport uri == Just TransportTCP
 
 makeLenses ''RTCConfiguration
 makeLenses ''RTCIceServer
diff --git a/services/brig/src/Brig/TURN/API.hs b/services/brig/src/Brig/TURN/API.hs
index ec0785cc0bd..777d48b3ca0 100644
--- a/services/brig/src/Brig/TURN/API.hs
+++ b/services/brig/src/Brig/TURN/API.hs
@@ -50,6 +50,8 @@ import qualified Wire.API.Call.TURN as Public
 
 routesPublic :: Routes Doc.ApiBuilder Handler ()
 routesPublic = do
+  -- Deprecated endpoint, but still used by old clients.
+  -- See https://github.com/zinfra/backend-issues/issues/1616 for context
   get "/calls/config" (continue getCallsConfigH) $
     accept "application" "json"
       .&. header "Z-User"
@@ -78,7 +80,7 @@ routesPublic = do
     Doc.response 200 "RTCConfiguration" Doc.end
 
 getCallsConfigV2H :: JSON ::: UserId ::: ConnId ::: Maybe (Range 1 10 Int) -> Handler Response
-getCallsConfigV2H (_ ::: uid ::: connid ::: limit) = do
+getCallsConfigV2H (_ ::: uid ::: connid ::: limit) =
   json <$> getCallsConfigV2 uid connid limit
 
 -- | ('UserId', 'ConnId' are required as args here to make sure this is an authenticated end-point.)
@@ -88,7 +90,7 @@ getCallsConfigV2 _ _ limit = do
   newConfig env limit
 
 getCallsConfigH :: JSON ::: UserId ::: ConnId -> Handler Response
-getCallsConfigH (_ ::: uid ::: connid) = do
+getCallsConfigH (_ ::: uid ::: connid) =
   json <$> getCallsConfig uid connid
 
 getCallsConfig :: UserId -> ConnId -> Handler Public.RTCConfiguration
@@ -125,7 +127,7 @@ newConfig env limit = do
       (f : fs) <- shuffleM (toList xs)
       return $ List1.list1 f fs
     limitedList :: List1 Public.TurnURI -> Range 1 10 Int -> List1 Public.TurnURI
-    limitedList uris lim = do
+    limitedList uris lim =
       -- assuming limitServers is safe with respect to the length of its return value
       -- (see property tests in brig-types)
       -- since the input is List1 and limit is in Range 1 10

From 189043ff9a99365a94106a35d2550ebf1c06af14 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 23 Jul 2020 14:21:27 +0200
Subject: [PATCH 02/48] Add FUTUREWORK to ensure we watch the threads we spawn

---
 services/brig/src/Brig/Run.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs
index 4215bd3c223..f1d4fd7e3b6 100644
--- a/services/brig/src/Brig/Run.hs
+++ b/services/brig/src/Brig/Run.hs
@@ -43,6 +43,9 @@ import Network.Wai.Utilities.Server
 import qualified Network.Wai.Utilities.Server as Server
 import Util.Options
 
+-- FUTUREWORK: If any of these async threads die, we will have no clue about it
+-- and brig could start misbehaving. We should ensure that brig dies whenever a
+-- thread is returns for any reason.
 run :: Opts -> IO ()
 run o = do
   (app, e) <- mkApp o

From 27fc2e88521b6e4bc7e7f2c7dd6e1e8ae4a1b436 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Fri, 24 Jul 2020 13:54:02 +0200
Subject: [PATCH 03/48] Copy code for SRV lookup from federation-util to
 dedicated package

Differences:
- Uses polysemy to expose the lookup itself
- Doesn't order targets, ordering requires randomization, maybe it can be
exposed with some other effect.
---
 libs/dns-srv/dns-srv.cabal                    | 62 ++++++++++++++
 libs/dns-srv/package.yaml                     | 34 ++++++++
 libs/dns-srv/src/Wire/Network/DNS/Effect.hs   | 41 ++++++++++
 libs/dns-srv/src/Wire/Network/DNS/SRV.hs      | 53 ++++++++++++
 libs/dns-srv/test/Spec.hs                     | 18 +++++
 .../test/Test/Wire/Network/DNS/SRVSpec.hs     | 47 +++++++++++
 stack.yaml                                    |  5 ++
 stack.yaml.lock                               | 80 ++++---------------
 8 files changed, 274 insertions(+), 66 deletions(-)
 create mode 100644 libs/dns-srv/dns-srv.cabal
 create mode 100644 libs/dns-srv/package.yaml
 create mode 100644 libs/dns-srv/src/Wire/Network/DNS/Effect.hs
 create mode 100644 libs/dns-srv/src/Wire/Network/DNS/SRV.hs
 create mode 100644 libs/dns-srv/test/Spec.hs
 create mode 100644 libs/dns-srv/test/Test/Wire/Network/DNS/SRVSpec.hs

diff --git a/libs/dns-srv/dns-srv.cabal b/libs/dns-srv/dns-srv.cabal
new file mode 100644
index 00000000000..bd85b4445f9
--- /dev/null
+++ b/libs/dns-srv/dns-srv.cabal
@@ -0,0 +1,62 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.33.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 2b22f84e0da77b424651866179a468047b326b1b1d904a05a1a9fb9b06e26bfe
+
+name:           dns-srv
+version:        0.1.0
+synopsis:       Library to deal with DNS SRV records
+description:    Library to deal with DNS SRV records
+category:       Network
+author:         Wire Swiss GmbH
+maintainer:     Wire Swiss GmbH <backend@wire.com>
+copyright:      (c) 2020 Wire Swiss GmbH
+license:        AGPL-3
+build-type:     Simple
+
+library
+  exposed-modules:
+      Wire.Network.DNS.Effect
+      Wire.Network.DNS.SRV
+  other-modules:
+      Paths_dns_srv
+  hs-source-dirs:
+      src
+  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
+  build-depends:
+      base >=4.6 && <5.0
+    , dns
+    , imports
+    , polysemy
+    , random
+    , text >=0.11
+  default-language: Haskell2010
+
+test-suite spec
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Test.Wire.Network.DNS.SRVSpec
+      Paths_dns_srv
+  hs-source-dirs:
+      test
+  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 -rtsopts -with-rtsopts=-N
+  build-tool-depends:
+      hspec-discover:hspec-discover
+  build-depends:
+      QuickCheck
+    , base >=4.6 && <5.0
+    , dns
+    , dns-srv
+    , hspec
+    , hspec-discover
+    , imports
+    , polysemy
+    , random
+    , text >=0.11
+  default-language: Haskell2010
diff --git a/libs/dns-srv/package.yaml b/libs/dns-srv/package.yaml
new file mode 100644
index 00000000000..b93c56cb825
--- /dev/null
+++ b/libs/dns-srv/package.yaml
@@ -0,0 +1,34 @@
+defaults:
+  local: ../../package-defaults.yaml
+name: dns-srv
+version: '0.1.0'
+synopsis: Library to deal with DNS SRV records
+description: Library to deal with DNS SRV records
+category: Network
+author: Wire Swiss GmbH
+maintainer: Wire Swiss GmbH <backend@wire.com>
+copyright: (c) 2020 Wire Swiss GmbH
+license: AGPL-3
+dependencies:
+- base >=4.6 && <5.0
+- dns
+- random
+- text >=0.11
+- imports
+- polysemy
+library:
+  source-dirs: src
+
+tests:
+  spec:
+    main: Spec.hs
+    source-dirs:
+      - test
+    ghc-options: -threaded -rtsopts -with-rtsopts=-N
+    build-tools:
+    - hspec-discover:hspec-discover
+    dependencies:
+      - hspec
+      - hspec-discover
+      - QuickCheck
+      - dns-srv
diff --git a/libs/dns-srv/src/Wire/Network/DNS/Effect.hs b/libs/dns-srv/src/Wire/Network/DNS/Effect.hs
new file mode 100644
index 00000000000..79611b42e9c
--- /dev/null
+++ b/libs/dns-srv/src/Wire/Network/DNS/Effect.hs
@@ -0,0 +1,41 @@
+-- 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/>.
+
+module Wire.Network.DNS.Effect where
+
+import Imports
+import Network.DNS (Domain)
+import qualified Network.DNS as DNS
+import Polysemy
+import Wire.Network.DNS.SRV
+
+data DNSLookup m a where
+  LookupSRV :: Domain -> DNSLookup m SrvResponse
+
+makeSem ''DNSLookup
+
+runDNSLookupDefault :: Member (Embed IO) r => Sem (DNSLookup ': r) a -> Sem r a
+runDNSLookupDefault =
+  interpret $ \l -> do
+    rs <- embed $ DNS.makeResolvSeed DNS.defaultResolvConf
+    embed $ DNS.withResolver rs $ \resolver ->
+      case l of
+        LookupSRV domain -> interpretResponse <$> DNS.lookupSRV resolver domain
+
+-- class Monad m => MonadDNSLookup m where
+--   monadLookupSRV :: Domain -> m SrvResponse
+-- I don't know how to make this choice at runtime
diff --git a/libs/dns-srv/src/Wire/Network/DNS/SRV.hs b/libs/dns-srv/src/Wire/Network/DNS/SRV.hs
new file mode 100644
index 00000000000..b20ea43659f
--- /dev/null
+++ b/libs/dns-srv/src/Wire/Network/DNS/SRV.hs
@@ -0,0 +1,53 @@
+-- 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/>.
+
+module Wire.Network.DNS.SRV where
+
+import Data.List.NonEmpty
+import Imports
+import Network.DNS (DNSError, Domain)
+
+data SrvEntry = SrvEntry
+  { srvPriority :: !Word16,
+    srvWeight :: !Word16,
+    srvTarget :: !SrvTarget
+  }
+  deriving (Eq, Show)
+
+data SrvTarget = SrvTarget
+  { -- | the hostname on which the service is offered
+    srvTargetDomain :: !Domain,
+    -- | the port on which the service is offered
+    srvTargetPort :: !Word16
+  }
+  deriving (Eq, Show)
+
+data SrvResponse
+  = SrvNotAvailable
+  | SrvAvailable (NonEmpty SrvEntry)
+  | SrvResponseError DNSError
+  deriving (Eq, Show)
+
+interpretResponse :: Either DNSError [(Word16, Word16, Word16, Domain)] -> SrvResponse
+interpretResponse = \case
+  Left err -> SrvResponseError err
+  Right [] -> SrvNotAvailable
+  Right [(_, _, _, ".")] -> SrvNotAvailable -- According to RFC2782
+  Right (r : rs) -> SrvAvailable $ fmap toSrvEntry (r :| rs)
+  where
+    toSrvEntry :: (Word16, Word16, Word16, Domain) -> SrvEntry
+    toSrvEntry (prio, weight, port, domain) = SrvEntry prio weight (SrvTarget domain port)
diff --git a/libs/dns-srv/test/Spec.hs b/libs/dns-srv/test/Spec.hs
new file mode 100644
index 00000000000..7b57431c0d0
--- /dev/null
+++ b/libs/dns-srv/test/Spec.hs
@@ -0,0 +1,18 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+
+-- 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/>.
diff --git a/libs/dns-srv/test/Test/Wire/Network/DNS/SRVSpec.hs b/libs/dns-srv/test/Test/Wire/Network/DNS/SRVSpec.hs
new file mode 100644
index 00000000000..9de3190ccb3
--- /dev/null
+++ b/libs/dns-srv/test/Test/Wire/Network/DNS/SRVSpec.hs
@@ -0,0 +1,47 @@
+-- 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/>.
+
+module Test.Wire.Network.DNS.SRVSpec where
+
+import Data.List.NonEmpty
+import Imports
+import qualified Network.DNS as DNS
+import Test.Hspec
+import Wire.Network.DNS.SRV
+
+spec :: Spec
+spec = describe "interpretResponse" $ do
+  it "should interpret error correctly" $
+    interpretResponse (Left DNS.UnknownDNSError) `shouldBe` SrvResponseError DNS.UnknownDNSError
+
+  it "should interpret empty response as SrvNotAvailable" $
+    interpretResponse (Right []) `shouldBe` SrvNotAvailable
+
+  it "should interpret explicitly not available response as SrvNotAvailable" $
+    interpretResponse (Right [(0, 0, 0, ".")]) `shouldBe` SrvNotAvailable
+
+  it "should interpret an available service correctly" $ do
+    let input =
+          [ (0, 1, 443, "service01.example.com."),
+            (10, 20, 8443, "service02.example.com.")
+          ]
+    let expectedOutput =
+          SrvAvailable
+            ( SrvEntry 0 1 (SrvTarget "service01.example.com." 443)
+                :| [SrvEntry 10 20 (SrvTarget "service02.example.com." 8443)]
+            )
+    interpretResponse (Right input) `shouldBe` expectedOutput
diff --git a/stack.yaml b/stack.yaml
index e4b80a6b2f4..b353557ecc1 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -9,6 +9,7 @@ packages:
 - libs/cassandra-util
 - libs/extended
 - libs/federation-util
+- libs/dns-srv
 - libs/galley-types
 - libs/gundeck-types
 - libs/hscim
@@ -170,6 +171,10 @@ extra-deps:
 - QuickCheck-2.14
 - splitmix-0.0.4 # needed for QuickCheck
 
+# Newer than the one one stackage
+- polysemy-1.3.0.0
+- polysemy-plugin-0.2.5.0
+
 ############################################################
 # Development tools
 ############################################################
diff --git a/stack.yaml.lock b/stack.yaml.lock
index 0fea55f66bc..20f7b220cf7 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -13,9 +13,6 @@ packages:
     hackage: swagger2-2.4
 - completed:
     subdir: wai-middleware-prometheus
-    cabal-file:
-      size: 1314
-      sha256: 1625792914fb2139f005685be8ce519111451cfb854816e430fbf54af46238b4
     name: wai-middleware-prometheus
     version: 1.0.0
     git: https://github.com/fimad/prometheus-haskell
@@ -28,9 +25,6 @@ packages:
     git: https://github.com/fimad/prometheus-haskell
     commit: 2e3282e5fb27ba8d989c271a0a989823fad7ec43
 - completed:
-    cabal-file:
-      size: 8392
-      sha256: 2c5d7f46633fb414eeb43facfe1018378f001b8b67dd77a45d110db84e46034c
     name: saml2-web-sso
     version: '0.18'
     git: https://github.com/wireapp/saml2-web-sso
@@ -42,9 +36,6 @@ packages:
     git: https://github.com/wireapp/saml2-web-sso
     commit: 687d9ac8ac2994aff8436189c6ecce29faad8500
 - completed:
-    cabal-file:
-      size: 912
-      sha256: 71d9fd9fd55cfb7b549eb2cecfb5258171be14669f990e4d05c6b3508dd5878b
     name: collectd
     version: 0.0.0.2
     git: https://github.com/kim/hs-collectd
@@ -56,9 +47,6 @@ packages:
     git: https://github.com/kim/hs-collectd
     commit: 885da222be2375f78c7be36127620ed772b677c9
 - completed:
-    cabal-file:
-      size: 1196
-      sha256: 1321f0148c87e75202829edac7f375bffa6159dad050b9737403306a493579ba
     name: snappy-framing
     version: 0.1.1
     git: https://github.com/kim/snappy-framing
@@ -70,9 +58,6 @@ packages:
     git: https://github.com/kim/snappy-framing
     commit: d99f702c0086729efd6848dea8a01e5266c3a61c
 - completed:
-    cabal-file:
-      size: 3722
-      sha256: 1509c11cbcc23595f4b9503bac28df4b10cc870cd7869f1859d43a373476d5a8
     name: wai-routing
     version: 0.13.0
     git: https://gitlab.com/twittner/wai-routing
@@ -84,9 +69,6 @@ packages:
     git: https://gitlab.com/twittner/wai-routing
     commit: 7e996a93fec5901767f845a50316b3c18e51a61d
 - completed:
-    cabal-file:
-      size: 2490
-      sha256: 7cca808c05cb584f1d4c6f60893bd28b0de41f450135bf48b70414a1f547d31f
     name: multihash
     version: 0.1.6
     git: https://github.com/wireapp/haskell-multihash.git
@@ -98,9 +80,6 @@ packages:
     git: https://github.com/wireapp/haskell-multihash.git
     commit: 300a6f46384bfca33e545c8bab52ef3717452d12
 - completed:
-    cabal-file:
-      size: 2289
-      sha256: 07c1e684acf4ba1c097fe5dd2525cb887269f7d3335c42783c1f4d2bfdc01283
     name: hspec-wai
     version: 0.9.2
     git: https://github.com/wireapp/hspec-wai
@@ -112,9 +91,6 @@ packages:
     git: https://github.com/wireapp/hspec-wai
     commit: 0a5142cd3ba48116ff059c041348b817fb7bdb25
 - completed:
-    cabal-file:
-      size: 3403
-      sha256: 2fd9aef25802bf62848b7087a9476264b50bc7d9f195c7f0012e52d19ed2ebe3
     name: bloodhound
     version: 0.17.0.0
     git: https://github.com/wireapp/bloodhound
@@ -143,9 +119,6 @@ packages:
     size: 11138812
     subdir: amazonka
     url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz
-    cabal-file:
-      size: 3457
-      sha256: 7ac360751e371ba853f56d357e861c5fe103b1da17f045ac47fd285c164a37f7
     name: amazonka
     version: 1.6.1
     sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00
@@ -161,9 +134,6 @@ packages:
     size: 11138812
     subdir: amazonka-cloudfront
     url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz
-    cabal-file:
-      size: 5668
-      sha256: 79c95e0ec544437a613cab891a2057bc35f1b0fed2361b36e7f05437839bdce2
     name: amazonka-cloudfront
     version: 1.6.1
     sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00
@@ -179,9 +149,6 @@ packages:
     size: 11138812
     subdir: amazonka-dynamodb
     url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz
-    cabal-file:
-      size: 4459
-      sha256: 6b8852049c65207a7b3741aafa3e4e6c77cfa115e05de3c74868218ae642b6b0
     name: amazonka-dynamodb
     version: 1.6.1
     sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00
@@ -197,9 +164,6 @@ packages:
     size: 11138812
     subdir: amazonka-s3
     url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz
-    cabal-file:
-      size: 6317
-      sha256: 9d07240fca59ad5197fb614ce3051e701e4951e6d4625a2dab4a9c17a1900194
     name: amazonka-s3
     version: 1.6.1
     sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00
@@ -215,9 +179,6 @@ packages:
     size: 11138812
     subdir: amazonka-ses
     url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz
-    cabal-file:
-      size: 6425
-      sha256: 335796c855121ca34affd35097676587d5ebe0b2e576da42faaedd9d163881b0
     name: amazonka-ses
     version: 1.6.1
     sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00
@@ -233,9 +194,6 @@ packages:
     size: 11138812
     subdir: amazonka-sns
     url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz
-    cabal-file:
-      size: 4271
-      sha256: b07fbf8a2806fe775b25ea74d0d78f14f286811e4aa59f9c50e97ed99f2a14a6
     name: amazonka-sns
     version: 1.6.1
     sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00
@@ -251,9 +209,6 @@ packages:
     size: 11138812
     subdir: amazonka-sqs
     url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz
-    cabal-file:
-      size: 3708
-      sha256: 1578844a31a2e53f9f21fd217e14406a3f02aefa637678ef88b201b01fbed492
     name: amazonka-sqs
     version: 1.6.1
     sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00
@@ -269,9 +224,6 @@ packages:
     size: 11138812
     subdir: core
     url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz
-    cabal-file:
-      size: 4957
-      sha256: 8ff9614130407588370e12e905f3539a733b76f6d9397ed3522ce54fc154d918
     name: amazonka-core
     version: 1.6.1
     sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00
@@ -284,9 +236,6 @@ packages:
     url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz
     sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00
 - completed:
-    cabal-file:
-      size: 1150
-      sha256: bbb1a78c1c8a2fe2a7b46a734f3b60754a86e07f07a1a27d781f121831918289
     name: cryptobox-haskell
     version: 0.1.1
     git: https://github.com/wireapp/cryptobox-haskell
@@ -298,9 +247,6 @@ packages:
     git: https://github.com/wireapp/cryptobox-haskell
     commit: 7546a1a25635ef65183e3d44c1052285e8401608
 - completed:
-    cabal-file:
-      size: 3593
-      sha256: 1f822adc38dcba267caa05c4f1405f92c60a340ea17c4fbbf92934e71ccf4809
     name: hsaml2
     version: '0.1'
     git: https://github.com/wireapp/hsaml2
@@ -313,9 +259,6 @@ packages:
     commit: fe08618e81dee9b7a25f10f5b9d26d1ff1837c79
 - completed:
     subdir: http-client
-    cabal-file:
-      size: 5350
-      sha256: 868faa3479fa330ac6eb897e6888296a32f10a249d2d91ece5ab2add9f0c24d4
     name: http-client
     version: 0.7.0
     git: https://github.com/wireapp/http-client
@@ -329,9 +272,6 @@ packages:
     commit: 9100baeddbd15d93dc58a826ae812dafff29d5fd
 - completed:
     subdir: http-client-openssl
-    cabal-file:
-      size: 1494
-      sha256: 423d74b93d5b2a79991340da8d2cd8fccd496fb470483bad8c73857200509e4e
     name: http-client-openssl
     version: 0.3.1.0
     git: https://github.com/wireapp/http-client
@@ -345,9 +285,6 @@ packages:
     commit: 9100baeddbd15d93dc58a826ae812dafff29d5fd
 - completed:
     subdir: http-client-tls
-    cabal-file:
-      size: 2041
-      sha256: 1043cb22bc772acdc5176b3db88ea74ae299a658d03aa7d4027f970328487f4c
     name: http-client-tls
     version: 0.3.5.3
     git: https://github.com/wireapp/http-client
@@ -361,9 +298,6 @@ packages:
     commit: 9100baeddbd15d93dc58a826ae812dafff29d5fd
 - completed:
     subdir: http-conduit
-    cabal-file:
-      size: 2910
-      sha256: 4e0024c25cb1a6c5a20b687201c78a7a2c781a582f669d0f88125d113e65c326
     name: http-conduit
     version: 2.3.7.3
     git: https://github.com/wireapp/http-client
@@ -564,6 +498,20 @@ packages:
       sha256: e58892088b95190bfb59a7c0803f7ef65338e57fc9b938d7c166563605003902
   original:
     hackage: splitmix-0.0.4
+- completed:
+    hackage: polysemy-1.3.0.0@sha256:fa76e96a883fd1c4bdbad792a0a9d88f59f84817651aea5c71d9b4f74e42c5b6,6141
+    pantry-tree:
+      size: 4309
+      sha256: 3d2fb15ddda9053f6bfd4b0810a79a9542505acb5e7e528856ec3cd86d6df066
+  original:
+    hackage: polysemy-1.3.0.0
+- completed:
+    hackage: polysemy-plugin-0.2.5.0@sha256:67e30be568a141b852aace1a60e180cb5060fbb2835365a81a3ea779536d6d35,2952
+    pantry-tree:
+      size: 1232
+      sha256: 5c90dac2eba48b4e337b302347c233ecaedb63e333641e094e718a548ac86711
+  original:
+    hackage: polysemy-plugin-0.2.5.0
 - completed:
     hackage: ormolu-0.0.5.0@sha256:e5f49c51c6ebd8b3cd16113e585312de7315c1e1561fbb599988cebc61c14f4e,7956
     pantry-tree:

From f9de188f2a6f20950aebefa9699a875cde76a60d Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Fri, 24 Jul 2020 16:45:57 +0200
Subject: [PATCH 04/48] Read SFT options and start service discovery thread

---
 services/brig/brig.cabal                     | 10 +++-
 services/brig/package.yaml                   |  6 ++
 services/brig/src/Brig/App.hs                |  5 ++
 services/brig/src/Brig/Calling.hs            | 63 ++++++++++++++++++++
 services/brig/src/Brig/Options.hs            | 28 ++++++++-
 services/brig/src/Brig/Run.hs                |  5 ++
 services/brig/test/unit/Main.hs              |  4 +-
 services/brig/test/unit/Test/Brig/Calling.hs | 43 +++++++++++++
 8 files changed, 158 insertions(+), 6 deletions(-)
 create mode 100644 services/brig/src/Brig/Calling.hs
 create mode 100644 services/brig/test/unit/Test/Brig/Calling.hs

diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal
index 9fe0cc99d48..6ce76d52e76 100644
--- a/services/brig/brig.cabal
+++ b/services/brig/brig.cabal
@@ -4,7 +4,7 @@ cabal-version: 2.0
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: f150b19d31eda4f6f32ad2782dccc7deae05b01ffd46558fe1f403ba49500307
+-- hash: 66e9d5651b6bea264d8f71f929a1477a8ef70a8fa3e6af97f623cbd977663a3c
 
 name:           brig
 version:        1.35.0
@@ -36,6 +36,7 @@ library
       Brig.AWS.SesNotification
       Brig.AWS.Types
       Brig.Budget
+      Brig.Calling
       Brig.Code
       Brig.Data.Activation
       Brig.Data.Blacklist
@@ -103,7 +104,7 @@ library
   hs-source-dirs:
       src
   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 -funbox-strict-fields
+  ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path -funbox-strict-fields -fplugin=Polysemy.Plugin
   build-depends:
       HaskellNet >=0.3
     , HaskellNet-SSL >=0.3
@@ -137,6 +138,8 @@ library
     , data-default >=0.5
     , data-timeout >=0.3
     , directory >=1.2
+    , dns
+    , dns-srv
     , either >=4.3
     , enclosed-exceptions >=1.0
     , errors >=1.4
@@ -172,6 +175,8 @@ library
     , network-uri >=2.6
     , optparse-applicative >=0.11
     , pem >=0.2
+    , polysemy
+    , polysemy-plugin
     , prometheus-client
     , proto-lens >=0.1
     , random-shuffle >=0.0.3
@@ -462,6 +467,7 @@ test-suite brig-tests
   type: exitcode-stdio-1.0
   main-is: Main.hs
   other-modules:
+      Test.Brig.Calling
       Test.Brig.User.Search.Index.Types
       Paths_brig
   hs-source-dirs:
diff --git a/services/brig/package.yaml b/services/brig/package.yaml
index 53aee10de4d..7d3194132cf 100644
--- a/services/brig/package.yaml
+++ b/services/brig/package.yaml
@@ -12,6 +12,8 @@ ghc-options:
 - -funbox-strict-fields
 library:
   source-dirs: src
+  ghc-options:
+  - -fplugin=Polysemy.Plugin
   dependencies:
   - aeson >=0.11
   - amazonka >=1.3.7
@@ -40,6 +42,8 @@ library:
   - data-default >=0.5
   - data-timeout >=0.3
   - directory >=1.2
+  - dns
+  - dns-srv
   - either >=4.3
   - enclosed-exceptions >=1.0
   - errors >=1.4
@@ -80,6 +84,8 @@ library:
   - network-uri >=2.6
   - optparse-applicative >=0.11
   - pem >=0.2
+  - polysemy
+  - polysemy-plugin
   - proto-lens >=0.1
   - prometheus-client
   - resourcet >=1.1
diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs
index a711ac4f39a..72f8d6c9e24 100644
--- a/services/brig/src/Brig/App.hs
+++ b/services/brig/src/Brig/App.hs
@@ -51,6 +51,7 @@ module Brig.App
     applog,
     turnEnv,
     turnEnvV2,
+    sftEnv,
     internalEvents,
 
     -- * App Monad
@@ -67,6 +68,7 @@ import Bilge (Manager, MonadHttp, RequestId (..), newManager, withResponse)
 import qualified Bilge as RPC
 import Bilge.RPC (HasRequestId (..))
 import qualified Brig.AWS as AWS
+import qualified Brig.Calling as Calling
 import Brig.Options (Opts, Settings)
 import qualified Brig.Options as Opt
 import Brig.Provider.Template
@@ -157,6 +159,7 @@ data Env = Env
     _fsWatcher :: FS.WatchManager,
     _turnEnv :: IORef TURN.Env,
     _turnEnvV2 :: IORef TURN.Env,
+    _sftEnv :: Maybe Calling.SFTEnv,
     _currentTime :: IO UTCTime,
     _zauthEnv :: ZAuth.Env,
     _digestSHA256 :: Digest,
@@ -202,6 +205,7 @@ newEnv o = do
   eventsQueue <- case Opt.internalEventsQueue (Opt.internalEvents o) of
     StompQueue q -> pure (StompQueue q)
     SqsQueue q -> SqsQueue <$> AWS.getQueueUrl (aws ^. AWS.amazonkaEnv) q
+  mSFTEnv <- mapM Calling.mkSFTEnv $ Opt.sft o
   return
     $! Env
       { _cargohold = mkEndpoint $ Opt.cargohold o,
@@ -227,6 +231,7 @@ newEnv o = do
         _geoDb = g,
         _turnEnv = turn,
         _turnEnvV2 = turnV2,
+        _sftEnv = mSFTEnv,
         _fsWatcher = w,
         _currentTime = clock,
         _zauthEnv = zau,
diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs
new file mode 100644
index 00000000000..e8979acc91f
--- /dev/null
+++ b/services/brig/src/Brig/Calling.hs
@@ -0,0 +1,63 @@
+-- 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/>.
+
+module Brig.Calling where
+
+import Brig.Options (SFTOptions (..))
+import Data.List.NonEmpty
+import Imports
+import qualified Network.DNS as DNS
+import Polysemy
+import Wire.Network.DNS.Effect
+import Wire.Network.DNS.SRV
+
+data SFTEnv = SFTEnv
+  { sftServers :: IORef [SrvEntry],
+    sftDomain :: DNS.Domain
+  }
+
+-- TODO: Log stuff here (and test it?)
+discoverSFTServers :: Member DNSLookup r => DNS.Domain -> Sem r (Maybe (NonEmpty SrvEntry))
+discoverSFTServers domain =
+  lookupSRV domain >>= \case
+    SrvAvailable es -> pure $ Just es
+    SrvNotAvailable -> pure Nothing
+    SrvResponseError _ -> pure Nothing
+
+mkSFTDomain :: SFTOptions -> DNS.Domain
+mkSFTDomain (SFTOptions base maybeSrv) = DNS.normalize $ maybe "_sft" ("_" <>) maybeSrv <> "._tcp." <> base
+
+-- TODO: How can I remove the Embed IO? Even if I cannot, this is better than
+-- just IO () as I can still mock DNSLookup
+sftDiscoveryLoop :: Members [DNSLookup, Embed IO] r => SFTEnv -> Sem r ()
+sftDiscoveryLoop (SFTEnv serversRef domain) = forever $ do
+  servers <- discoverSFTServers domain
+  case servers of
+    Nothing -> pure ()
+    Just (e :| es) -> atomicWriteIORef serversRef (e : es)
+  -- TODO: What should this number be? Use Control.Retry?
+  threadDelay 1000000
+
+mkSFTEnv :: SFTOptions -> IO SFTEnv
+mkSFTEnv opts =
+  SFTEnv
+    <$> newIORef []
+    <*> pure (mkSFTDomain opts)
+
+startSFTServiceDiscovery :: SFTEnv -> IO ()
+startSFTServiceDiscovery =
+  runM . runDNSLookupDefault . sftDiscoveryLoop
diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs
index 76c301ec2de..1763ca23e1a 100644
--- a/services/brig/src/Brig/Options.hs
+++ b/services/brig/src/Brig/Options.hs
@@ -30,13 +30,17 @@ import qualified Control.Lens as Lens
 import Data.Aeson (withText)
 import qualified Data.Aeson as Aeson
 import Data.Aeson.Types (typeMismatch)
+import qualified Data.Char as Char
 import Data.Domain (Domain)
 import Data.Id
 import Data.Scientific (toBoundedInteger)
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
 import Data.Time.Clock (NominalDiffTime)
-import Data.Yaml (FromJSON (..), ToJSON (..))
+import Data.Yaml ((.:), (.:?), FromJSON (..), ToJSON (..))
 import qualified Data.Yaml as Y
 import Imports
+import qualified Network.DNS as DNS
 import System.Logger.Extended (Level, LogFormat)
 import Util.Options
 
@@ -379,8 +383,8 @@ data Opts = Opts
     logFormat :: !(Maybe (Last LogFormat)),
     -- | TURN server settings
     turn :: !TurnOpts,
-    -- Runtime settings
-
+    -- | SFT Settings
+    sft :: !(Maybe SFTOptions),
     -- | Runtime settings
     optSettings :: !Settings
   }
@@ -519,6 +523,24 @@ data CustomerExtensions = CustomerExtensions
 newtype DomainsBlockedForRegistration = DomainsBlockedForRegistration [Domain]
   deriving newtype (Show, FromJSON, Generic)
 
+data SFTOptions = SFTOptions
+  { sftBaseDomain :: !DNS.Domain,
+    sftSRVServiceName :: !(Maybe ByteString)
+  }
+  deriving (Show, Generic)
+
+instance FromJSON SFTOptions where
+  parseJSON = Y.withObject "SFTOptions" $ \o ->
+    SFTOptions
+      <$> (asciiOnly =<< o .: "sftBaseDomain")
+      <*> (mapM asciiOnly =<< o .:? "sftSRVServiceName")
+    where
+      asciiOnly :: Text -> Y.Parser ByteString
+      asciiOnly t =
+        if Text.all Char.isAscii t
+          then pure $ Text.encodeUtf8 t
+          else fail $ "Expected ascii string only, found: " <> Text.unpack t
+
 defMaxKeyLen :: Int64
 defMaxKeyLen = 1024
 
diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs
index f1d4fd7e3b6..a7916eb907e 100644
--- a/services/brig/src/Brig/Run.hs
+++ b/services/brig/src/Brig/Run.hs
@@ -27,6 +27,7 @@ import Brig.AWS (sesQueue)
 import qualified Brig.AWS as AWS
 import qualified Brig.AWS.SesNotification as SesNotification
 import Brig.App
+import qualified Brig.Calling as Calling
 import qualified Brig.InternalEvent.Process as Internal
 import Brig.Options hiding (internalEvents, sesQueue)
 import qualified Brig.Queue as Queue
@@ -59,9 +60,13 @@ run o = do
     Async.async
       $ AWS.execute (e ^. awsEnv)
       $ AWS.listen throttleMillis q (runAppT e . SesNotification.onEvent)
+  sftDiscovery <- case e ^. sftEnv of
+    Nothing -> Async.async (pure ()) -- TODO: This looks fishy
+    Just sftEnv' -> Async.async $ Calling.startSFTServiceDiscovery sftEnv'
   runSettingsWithShutdown s app 5 `finally` do
     mapM_ Async.cancel emailListener
     Async.cancel internalEventListener
+    Async.cancel sftDiscovery
     closeEnv e
   where
     endpoint = brig o
diff --git a/services/brig/test/unit/Main.hs b/services/brig/test/unit/Main.hs
index 6f12acae661..eda70cb0068 100644
--- a/services/brig/test/unit/Main.hs
+++ b/services/brig/test/unit/Main.hs
@@ -21,6 +21,7 @@ module Main
 where
 
 import Imports
+import qualified Test.Brig.Calling
 import qualified Test.Brig.User.Search.Index.Types
 import Test.Tasty
 
@@ -29,5 +30,6 @@ main =
   defaultMain $
     testGroup
       "Tests"
-      [ Test.Brig.User.Search.Index.Types.tests
+      [ Test.Brig.User.Search.Index.Types.tests,
+        Test.Brig.Calling.tests
       ]
diff --git a/services/brig/test/unit/Test/Brig/Calling.hs b/services/brig/test/unit/Test/Brig/Calling.hs
new file mode 100644
index 00000000000..8b1481e0065
--- /dev/null
+++ b/services/brig/test/unit/Test/Brig/Calling.hs
@@ -0,0 +1,43 @@
+-- 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/>.
+
+module Test.Brig.Calling where
+
+import Brig.Calling
+import Brig.Options
+import Imports
+import Test.Tasty
+import Test.Tasty.HUnit
+
+tests :: TestTree
+tests =
+  testGroup
+    "Calling"
+    [ testGroup
+        "sftDomain"
+        [ testCase "when service name is provided" $
+            assertEqual
+              "should use the service name to form domain"
+              "_foo._tcp.example.com."
+              (mkSFTDomain (SFTOptions "example.com" (Just "foo"))),
+          testCase "when service name is not provided" $
+            assertEqual
+              "should assume service name to be 'sft'"
+              "_sft._tcp.example.com."
+              (mkSFTDomain (SFTOptions "example.com" Nothing))
+        ]
+    ]

From 07f848afe365d4a41dabe1317e9ee1df3102b68c Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Mon, 27 Jul 2020 17:11:28 +0200
Subject: [PATCH 05/48] [WIP] Return discovered SFT servers in /calls/config/v2

* Refactor all `List1` to `NonEmpty` in RTCConfiguration
* Integration tests now depend on globally created DNS entries

Pending:
* Unit tests for discovery
* Unit tests for translating an SrvTarget to an SFTServer
* Figure out if we can override the domain used for integration tests
---
 libs/wire-api/src/Wire/API/Call/TURN.hs    | 59 +++++++++++++++++++---
 services/brig/src/Brig/Calling.hs          |  7 +--
 services/brig/src/Brig/Options.hs          |  5 +-
 services/brig/src/Brig/TURN/API.hs         | 55 +++++++++++++++-----
 services/brig/test/integration/API/TURN.hs | 43 +++++++++++++---
 services/brig/test/integration/Main.hs     |  2 +-
 services/brig/test/integration/Util.hs     | 16 ++++--
 7 files changed, 149 insertions(+), 38 deletions(-)

diff --git a/libs/wire-api/src/Wire/API/Call/TURN.hs b/libs/wire-api/src/Wire/API/Call/TURN.hs
index 32310b958c6..ad350586048 100644
--- a/libs/wire-api/src/Wire/API/Call/TURN.hs
+++ b/libs/wire-api/src/Wire/API/Call/TURN.hs
@@ -20,11 +20,13 @@
 -- 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/>.
 
+-- TODO: Rename this module to Call.Config
 module Wire.API.Call.TURN
   ( -- * RTCConfiguration
     RTCConfiguration,
     rtcConfiguration,
     rtcConfIceServers,
+    rtcConfSftServers,
     rtcConfTTL,
 
     -- * RTCIceServer
@@ -55,6 +57,11 @@ module Wire.API.Call.TURN
     tuT,
     tuRandom,
 
+    -- * SFTServer
+    SFTServer,
+    sftServer,
+    sftURL,
+
     -- * convenience
     isUdp,
     isTcp,
@@ -74,8 +81,8 @@ import Data.Attoparsec.Text hiding (parse)
 import Data.ByteString.Builder
 import qualified Data.ByteString.Conversion as BC
 import qualified Data.IP as IP
-import Data.List1
-import Data.Misc (IpAddr (IpAddr), Port (..))
+import Data.List.NonEmpty (NonEmpty)
+import Data.Misc (HttpsUrl (..), IpAddr (IpAddr), Port (..))
 import qualified Data.Swagger.Build.Api as Doc
 import qualified Data.Text as Text
 import Data.Text.Ascii
@@ -93,16 +100,18 @@ import Wire.API.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))
 -- | A configuration object resembling \"RTCConfiguration\"
 --
 -- The \"ttl\" field is a proprietary extension
+-- The \"sft_servers\" field is a proprietary extension
 --
 -- cf. https://developer.mozilla.org/en-US/docs/Web/API/RTCPeerConnection/RTCPeerConnection#RTCConfiguration_dictionary
 data RTCConfiguration = RTCConfiguration
-  { _rtcConfIceServers :: List1 RTCIceServer,
+  { _rtcConfIceServers :: NonEmpty RTCIceServer,
+    _rtcConfSftServers :: Maybe (NonEmpty SFTServer),
     _rtcConfTTL :: Word32
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform RTCConfiguration)
 
-rtcConfiguration :: List1 RTCIceServer -> Word32 -> RTCConfiguration
+rtcConfiguration :: NonEmpty RTCIceServer -> Maybe (NonEmpty SFTServer) -> Word32 -> RTCConfiguration
 rtcConfiguration = RTCConfiguration
 
 modelRtcConfiguration :: Doc.Model
@@ -110,19 +119,52 @@ modelRtcConfiguration = Doc.defineModel "RTCConfiguration" $ do
   Doc.description "A subset of the WebRTC 'RTCConfiguration' dictionary"
   Doc.property "ice_servers" (Doc.array (Doc.ref modelRtcIceServer)) $
     Doc.description "Array of 'RTCIceServer' objects"
+  Doc.property "sft_servers" (Doc.array (Doc.ref modelRtcSftServer)) $
+    Doc.description "Array of 'SFTServer' objects (optional)"
   Doc.property "ttl" Doc.int32' $
     Doc.description "Number of seconds after which the configuration should be refreshed (advisory)"
 
 instance ToJSON RTCConfiguration where
-  toJSON (RTCConfiguration srvs ttl) =
+  toJSON (RTCConfiguration srvs sfts ttl) =
     object
       [ "ice_servers" .= srvs,
+        "sft_servers" .= sfts,
         "ttl" .= ttl
       ]
 
 instance FromJSON RTCConfiguration where
   parseJSON = withObject "RTCConfiguration" $ \o ->
-    RTCConfiguration <$> o .: "ice_servers" <*> o .: "ttl"
+    RTCConfiguration <$> o .: "ice_servers" <*> o .: "sft_servers" <*> o .: "ttl"
+
+--------------------------------------------------------------------------------
+-- SFTServer
+
+newtype SFTServer = SFTServer
+  { _sftURL :: HttpsUrl
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform SFTServer) --TODO is this correct?
+
+instance ToJSON SFTServer where
+  toJSON (SFTServer url) =
+    object
+      [ "urls" .= [url]
+      ]
+
+instance FromJSON SFTServer where
+  parseJSON = withObject "SFTServer" $ \o ->
+    o .: "urls" >>= \case
+      [url] -> pure $ SFTServer url
+      xs -> fail $ "SFTServer can only have exactly one URL, found " <> show (length xs)
+
+sftServer :: HttpsUrl -> SFTServer
+sftServer = SFTServer
+
+modelRtcSftServer :: Doc.Model
+modelRtcSftServer = Doc.defineModel "RTC SFT Server" $ do
+  Doc.description "Inspired by WebRTC 'RTCIceServer' object, contains details of SFT servers"
+  Doc.property "urls" (Doc.array Doc.string') $
+    Doc.description "Array of SFT server addresses of the form 'https://<addr>:<port>'"
 
 --------------------------------------------------------------------------------
 -- RTCIceServer
@@ -131,14 +173,14 @@ instance FromJSON RTCConfiguration where
 --
 -- cf. https://developer.mozilla.org/en-US/docs/Web/API/RTCIceServer
 data RTCIceServer = RTCIceServer
-  { _iceURLs :: List1 TurnURI,
+  { _iceURLs :: NonEmpty TurnURI,
     _iceUsername :: TurnUsername,
     _iceCredential :: AsciiBase64
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform RTCIceServer)
 
-rtcIceServer :: List1 TurnURI -> TurnUsername -> AsciiBase64 -> RTCIceServer
+rtcIceServer :: NonEmpty TurnURI -> TurnUsername -> AsciiBase64 -> RTCIceServer
 rtcIceServer = RTCIceServer
 
 modelRtcIceServer :: Doc.Model
@@ -439,3 +481,4 @@ makeLenses ''RTCConfiguration
 makeLenses ''RTCIceServer
 makeLenses ''TurnURI
 makeLenses ''TurnUsername
+makeLenses ''SFTServer
diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs
index e8979acc91f..cb44fae746f 100644
--- a/services/brig/src/Brig/Calling.hs
+++ b/services/brig/src/Brig/Calling.hs
@@ -26,7 +26,7 @@ import Wire.Network.DNS.Effect
 import Wire.Network.DNS.SRV
 
 data SFTEnv = SFTEnv
-  { sftServers :: IORef [SrvEntry],
+  { sftServers :: IORef (Maybe (NonEmpty SrvEntry)),
     sftDomain :: DNS.Domain
   }
 
@@ -43,19 +43,20 @@ mkSFTDomain (SFTOptions base maybeSrv) = DNS.normalize $ maybe "_sft" ("_" <>) m
 
 -- TODO: How can I remove the Embed IO? Even if I cannot, this is better than
 -- just IO () as I can still mock DNSLookup
+-- TODO: Test that `Nothing` is never explicitly written to the IORef
 sftDiscoveryLoop :: Members [DNSLookup, Embed IO] r => SFTEnv -> Sem r ()
 sftDiscoveryLoop (SFTEnv serversRef domain) = forever $ do
   servers <- discoverSFTServers domain
   case servers of
     Nothing -> pure ()
-    Just (e :| es) -> atomicWriteIORef serversRef (e : es)
+    es -> atomicWriteIORef serversRef es
   -- TODO: What should this number be? Use Control.Retry?
   threadDelay 1000000
 
 mkSFTEnv :: SFTOptions -> IO SFTEnv
 mkSFTEnv opts =
   SFTEnv
-    <$> newIORef []
+    <$> newIORef Nothing
     <*> pure (mkSFTDomain opts)
 
 startSFTServiceDiscovery :: SFTEnv -> IO ()
diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs
index 1763ca23e1a..6d31f18a12e 100644
--- a/services/brig/src/Brig/Options.hs
+++ b/services/brig/src/Brig/Options.hs
@@ -573,7 +573,8 @@ instance FromJSON Opts
 -- TODO: Does it make sense to generate lens'es for all?
 Lens.makeLensesFor
   [ ("optSettings", "optionSettings"),
-    ("elasticsearch", "elasticsearchL")
+    ("elasticsearch", "elasticsearchL"),
+    ("sft", "sftL")
   ]
   ''Opts
 
@@ -594,3 +595,5 @@ Lens.makeLensesFor
     ("additionalWriteIndex", "additionalWriteIndexL")
   ]
   ''ElasticSearchOpts
+
+Lens.makeLensesFor [("sftBaseDomain", "sftBaseDomainL")] ''SFTOptions
diff --git a/services/brig/src/Brig/TURN/API.hs b/services/brig/src/Brig/TURN/API.hs
index 777d48b3ca0..87ec9805415 100644
--- a/services/brig/src/Brig/TURN/API.hs
+++ b/services/brig/src/Brig/TURN/API.hs
@@ -15,6 +15,7 @@
 -- 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/>.
 
+-- TODO: Rename this module to Brig.Calling.API
 module Brig.TURN.API
   ( routesPublic,
   )
@@ -22,16 +23,20 @@ where
 
 import Brig.API.Handler
 import Brig.App
+import Brig.Calling
 import Brig.TURN hiding (Env)
 import qualified Brig.TURN as TURN
 import Control.Lens
 import Control.Monad.Fail (MonadFail)
 import Control.Monad.Random.Class
+import qualified Data.ByteString.Char8 as BS
 import Data.ByteString.Conversion (toByteString')
 import Data.ByteString.Lens
 import Data.Id
-import Data.List1 (List1)
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.List1 as List1
+import Data.Misc ((<$$>), mkHttpsUrl)
 import Data.Range
 import qualified Data.Swagger.Build.Api as Doc
 import Data.Text.Ascii (AsciiBase64, encodeBase64)
@@ -46,7 +51,10 @@ import Network.Wai.Utilities.Swagger (document)
 import OpenSSL.EVP.Digest (Digest, hmacBS)
 import qualified System.Random.MWC as MWC
 import System.Random.Shuffle
+import qualified URI.ByteString as URI
+import qualified URI.ByteString.QQ as URI
 import qualified Wire.API.Call.TURN as Public
+import Wire.Network.DNS.SRV (SrvTarget (..), srvTarget)
 
 routesPublic :: Routes Doc.ApiBuilder Handler ()
 routesPublic = do
@@ -87,7 +95,8 @@ getCallsConfigV2H (_ ::: uid ::: connid ::: limit) =
 getCallsConfigV2 :: UserId -> ConnId -> Maybe (Range 1 10 Int) -> Handler Public.RTCConfiguration
 getCallsConfigV2 _ _ limit = do
   env <- liftIO =<< readIORef <$> view turnEnvV2
-  newConfig env limit
+  sftEnv' <- view sftEnv
+  newConfig env sftEnv' limit
 
 getCallsConfigH :: JSON ::: UserId ::: ConnId -> Handler Response
 getCallsConfigH (_ ::: uid ::: connid) =
@@ -96,7 +105,7 @@ getCallsConfigH (_ ::: uid ::: connid) =
 getCallsConfig :: UserId -> ConnId -> Handler Public.RTCConfiguration
 getCallsConfig _ _ = do
   env <- liftIO =<< readIORef <$> view turnEnv
-  dropTransport <$> newConfig env Nothing
+  dropTransport <$> newConfig env Nothing Nothing
   where
     -- In order to avoid being backwards incompatible, remove the `transport` query param from the URIs
     dropTransport :: Public.RTCConfiguration -> Public.RTCConfiguration
@@ -105,11 +114,11 @@ getCallsConfig _ _ = do
         (Public.rtcConfIceServers . traverse . Public.iceURLs . traverse . Public.turiTransport)
         Nothing
 
-newConfig :: MonadIO m => TURN.Env -> Maybe (Range 1 10 Int) -> m Public.RTCConfiguration
-newConfig env limit = do
+newConfig :: MonadIO m => TURN.Env -> Maybe SFTEnv -> Maybe (Range 1 10 Int) -> m Public.RTCConfiguration
+newConfig env mSftEnv limit = do
   let (sha, secret, tTTL, cTTL, prng) = (env ^. turnSHA512, env ^. turnSecret, env ^. turnTokenTTL, env ^. turnConfigTTL, env ^. turnPrng)
   -- randomize list of servers (before limiting the list, to ensure not always the same servers are chosen if limit is set)
-  randomizedUris <- liftIO $ randomize (env ^. turnServers)
+  randomizedUris <- liftIO $ randomize (List1.toNonEmpty $ env ^. turnServers)
   let limitedUris = case limit of
         Nothing -> randomizedUris
         Just lim -> limitedList randomizedUris lim
@@ -117,22 +126,25 @@ newConfig env limit = do
   finalUris <- liftIO $ randomize limitedUris
   srvs <- for finalUris $ \uri -> do
     u <- liftIO $ genUsername tTTL prng
-    pure $ Public.rtcIceServer (List1.singleton uri) u (computeCred sha secret u)
-  pure $ Public.rtcConfiguration srvs cTTL
+    pure $ Public.rtcIceServer (uri :| []) u (computeCred sha secret u)
+  sftSrvEntries <- maybe (pure Nothing) (readIORef . sftServers) mSftEnv
+  -- According to RFC2782, the SRV Entries are supposed to be tried in order of
+  -- priority and weight, but the clients try all of them concurrently, so there
+  -- is no point ordering these entries
+  pure $ Public.rtcConfiguration srvs (sftServerFromSrvTarget . srvTarget <$$> sftSrvEntries) cTTL
   where
     -- NOTE: even though `shuffleM` works only for [a], input is List1 so it's
     --       safe to pattern match; ideally, we'd have `shuffleM` for `NonEmpty`
-    randomize :: (MonadRandom m, MonadFail m) => List1 Public.TurnURI -> m (List1 Public.TurnURI)
-    randomize xs = do
-      (f : fs) <- shuffleM (toList xs)
-      return $ List1.list1 f fs
-    limitedList :: List1 Public.TurnURI -> Range 1 10 Int -> List1 Public.TurnURI
+    randomize :: (MonadRandom m, MonadFail m) => NonEmpty Public.TurnURI -> m (NonEmpty Public.TurnURI)
+    randomize xs = NonEmpty.fromList <$> shuffleM (NonEmpty.toList xs)
+    --
+    limitedList :: NonEmpty Public.TurnURI -> Range 1 10 Int -> NonEmpty Public.TurnURI
     limitedList uris lim =
       -- assuming limitServers is safe with respect to the length of its return value
       -- (see property tests in brig-types)
       -- since the input is List1 and limit is in Range 1 10
       -- it should also be safe to assume the returning list has length >= 1
-      List1.maybeList1 (Public.limitServers (toList uris) (fromRange lim))
+      NonEmpty.nonEmpty (Public.limitServers (NonEmpty.toList uris) (fromRange lim))
         & fromMaybe (error "newConfig:limitedList: empty list of servers")
     genUsername :: Word32 -> MWC.GenIO -> IO Public.TurnUsername
     genUsername ttl prng = do
@@ -141,3 +153,18 @@ newConfig env limit = do
       pure $ Public.turnUsername t rnd
     computeCred :: Digest -> ByteString -> Public.TurnUsername -> AsciiBase64
     computeCred dig secret = encodeBase64 . hmacBS dig secret . toByteString'
+
+-- TODO: Write unit test
+sftServerFromSrvTarget :: SrvTarget -> Public.SFTServer
+sftServerFromSrvTarget (SrvTarget host port) =
+  let uriPort = URI.Port (fromIntegral port)
+      uri =
+        [URI.uri|https://|]
+          & URI.authorityL ?~ URI.Authority Nothing (URI.Host (dropTrailingDot host)) (Just uriPort)
+   in either (error "sftServerFromSrvTarget: invalid https URI") Public.sftServer (mkHttpsUrl uri)
+  where
+    dropTrailingDot :: ByteString -> ByteString
+    dropTrailingDot bs =
+      if BS.last bs == '.'
+        then BS.init bs
+        else bs
diff --git a/services/brig/test/integration/API/TURN.hs b/services/brig/test/integration/API/TURN.hs
index a7804c6e65d..66edb003971 100644
--- a/services/brig/test/integration/API/TURN.hs
+++ b/services/brig/test/integration/API/TURN.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
 -- This file is part of the Wire Server implementation.
 --
 -- Copyright (C) 2020 Wire Swiss GmbH <opensource@wire.com>
@@ -19,33 +21,39 @@ module API.TURN where
 
 import Bilge
 import Bilge.Assert
+import qualified Brig.Options as Opts
 import Brig.Types
-import Control.Lens ((^.))
+import Control.Lens ((?~), (^.), view)
+import Control.Monad.Catch (MonadCatch, MonadThrow)
 import Data.ByteString.Conversion
 import qualified Data.ByteString.Lazy as LB
 import Data.Id
 import Data.List ((\\))
+import Data.List.NonEmpty (NonEmpty (..))
 import Data.List1 (List1)
 import qualified Data.List1 as List1
-import Data.Misc (Port)
+import Data.Misc (Port, mkHttpsUrl)
 import Imports
 import Network.HTTP.Client (Manager)
 import System.FilePath ((</>))
 import Test.Tasty
 import Test.Tasty.HUnit
+import URI.ByteString.QQ (uri)
 import UnliftIO.Exception (finally)
 import qualified UnliftIO.Temporary as Temp
 import Util
+import Wire.API.Call.TURN
 
-tests :: Manager -> Brig -> FilePath -> FilePath -> IO TestTree
-tests m b turn turnV2 = do
+tests :: Manager -> Brig -> Opts.Opts -> FilePath -> FilePath -> IO TestTree
+tests m b opts turn turnV2 = do
   return $
     testGroup
       "turn"
       [ test m "basic /calls/config - 200" $ testCallsConfig b,
         -- FIXME: requires tests to run on same host as brig
         test m "multiple servers /calls/config - 200" . withTurnFile turn $ testCallsConfigMultiple b,
-        test m "multiple servers /calls/config/v2 - 200" . withTurnFile turnV2 $ testCallsConfigMultipleV2 b
+        test m "multiple servers /calls/config/v2 - 200" . withTurnFile turnV2 $ testCallsConfigMultipleV2 b,
+        test m "SFT servers /calls/config/v2 - 200" $ testSFT b opts
       ]
 
 testCallsConfig :: Brig -> Http ()
@@ -75,6 +83,25 @@ testCallsConfigMultiple b turnUpdater = do
   let _expected = List1.singleton (toTurnURILegacy "127.0.0.1" 3478)
   modifyAndAssert b uid getTurnConfigurationV1 turnUpdater "turn:127.0.0.1:3478" _expected
 
+testSFT :: Brig -> Opts.Opts -> Http ()
+testSFT b opts = do
+  uid <- userId <$> randomUser b
+  cfg <- getTurnConfigurationV2 uid b
+  liftIO $
+    assertEqual
+      "when SFT discovery is not enabled, sft_servers shouldn't be returned"
+      Nothing
+      (cfg ^. rtcConfSftServers)
+  withSettingsOverrides (opts & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing) $ do
+    cfg1 <- retryWhileN 10 (isJust . view rtcConfSftServers) (getTurnConfigurationV2 uid b)
+    let Right server1 = mkHttpsUrl [uri|https://sft01.integration-tests.zinfra.io:443|]
+    let Right server2 = mkHttpsUrl [uri|https://sft02.integration-tests.zinfra.io:8443|]
+    liftIO $
+      assertEqual
+        "when SFT discovery is enabled, sft_servers should be returned"
+        (Just (sftServer server1 :| [sftServer server2]))
+        (cfg1 ^. rtcConfSftServers)
+
 modifyAndAssert ::
   Brig ->
   UserId ->
@@ -150,10 +177,10 @@ assertConfiguration cfg turns =
 getTurnConfigurationV1 :: UserId -> Brig -> Http RTCConfiguration
 getTurnConfigurationV1 = getAndValidateTurnConfiguration ""
 
-getTurnConfigurationV2 :: UserId -> Brig -> Http RTCConfiguration
+getTurnConfigurationV2 :: HasCallStack => UserId -> Brig -> ((Monad m, MonadHttp m, MonadIO m, MonadCatch m) => m RTCConfiguration)
 getTurnConfigurationV2 = getAndValidateTurnConfiguration "v2"
 
-getTurnConfiguration :: ByteString -> UserId -> Brig -> Http (Response (Maybe LB.ByteString))
+getTurnConfiguration :: ByteString -> UserId -> Brig -> ((MonadHttp m, MonadIO m) => m (Response (Maybe LB.ByteString)))
 getTurnConfiguration suffix u b =
   get
     ( b
@@ -162,7 +189,7 @@ getTurnConfiguration suffix u b =
         . zConn "conn"
     )
 
-getAndValidateTurnConfiguration :: HasCallStack => ByteString -> UserId -> Brig -> Http RTCConfiguration
+getAndValidateTurnConfiguration :: HasCallStack => ByteString -> UserId -> Brig -> ((Monad m, MonadIO m, MonadHttp m, MonadThrow m, MonadCatch m) => m RTCConfiguration)
 getAndValidateTurnConfiguration suffix u b =
   responseJsonError =<< (getTurnConfiguration suffix u b <!! const 200 === statusCode)
 
diff --git a/services/brig/test/integration/Main.hs b/services/brig/test/integration/Main.hs
index f5d167cfc92..4d073cbfe51 100644
--- a/services/brig/test/integration/Main.hs
+++ b/services/brig/test/integration/Main.hs
@@ -97,7 +97,7 @@ runTests iConf bConf otherArgs = do
   providerApi <- Provider.tests (provider <$> iConf) mg db b c g
   searchApis <- Search.tests brigOpts mg g b
   teamApis <- Team.tests brigOpts mg n b c g awsEnv
-  turnApi <- TURN.tests mg b turnFile turnFileV2
+  turnApi <- TURN.tests mg b brigOpts turnFile turnFileV2
   idMappingApi <- pure $ IdMapping.tests brigOpts mg b
   metricsApi <- Metrics.tests mg b
   settingsApi <- Settings.tests brigOpts mg b g
diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs
index 6e21af2e25e..3370547480d 100644
--- a/services/brig/test/integration/Util.hs
+++ b/services/brig/test/integration/Util.hs
@@ -25,6 +25,8 @@ import Bilge
 import Bilge.Assert
 import qualified Brig.AWS as AWS
 import Brig.AWS.Types
+import Brig.App (sftEnv)
+import Brig.Calling as Calling
 import qualified Brig.Options as Opts
 import qualified Brig.Run as Run
 import Brig.Types.Activation
@@ -33,7 +35,7 @@ import Brig.Types.Connection
 import Brig.Types.Intra
 import Brig.Types.User
 import Brig.Types.User.Auth
-import Control.Lens ((^?), (^?!))
+import Control.Lens ((^.), (^?), (^?!))
 import Control.Monad.Catch (MonadCatch)
 import Control.Monad.Fail (MonadFail)
 import Control.Retry
@@ -62,6 +64,7 @@ import Test.Tasty (TestName, TestTree)
 import Test.Tasty.Cannon
 import qualified Test.Tasty.Cannon as WS
 import Test.Tasty.HUnit
+import qualified UnliftIO.Async as Async
 import Util.AWS
 import Wire.API.Conversation.Member (Member (..))
 
@@ -704,10 +707,17 @@ retryWhileN n f m =
 -- | This allows you to run requests against a brig instantiated using the given options.
 --   Note that ONLY 'brig' calls should occur within the provided action, calls to other
 --   services will fail.
+--
+--   Beware: Not all async parts of brig are running in this.
 withSettingsOverrides :: MonadIO m => Opts.Opts -> WaiTest.Session a -> m a
 withSettingsOverrides opts action = liftIO $ do
-  (brigApp, _) <- Run.mkApp opts
-  WaiTest.runSession action brigApp
+  (brigApp, env) <- Run.mkApp opts
+  asyncDiscovery <- case env ^. sftEnv of
+    Nothing -> Async.async (pure ()) --TODO: This looks fishy
+    Just e -> Async.async $ Calling.startSFTServiceDiscovery e
+  res <- WaiTest.runSession action brigApp
+  Async.cancel asyncDiscovery
+  pure res
 
 -- | When we remove the customer-specific extension of domain blocking, this test will fail to
 -- compile.

From a345016b6d14c12249e6ec8497b5638374dd60c1 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Tue, 28 Jul 2020 13:31:34 +0200
Subject: [PATCH 06/48] Fix typo

Co-authored-by: fisx <mf@zerobuzz.net>
---
 services/brig/src/Brig/Run.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs
index a7916eb907e..25a05c4244b 100644
--- a/services/brig/src/Brig/Run.hs
+++ b/services/brig/src/Brig/Run.hs
@@ -46,7 +46,7 @@ import Util.Options
 
 -- FUTUREWORK: If any of these async threads die, we will have no clue about it
 -- and brig could start misbehaving. We should ensure that brig dies whenever a
--- thread is returns for any reason.
+-- thread terminates for any reason.
 run :: Opts -> IO ()
 run o = do
   (app, e) <- mkApp o

From 8a5f36386ce907148d0129942c2c8ace3ead419a Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Tue, 28 Jul 2020 16:02:45 +0200
Subject: [PATCH 07/48] Add unit tests for sftDiscoveryLoop

---
 services/brig/brig.cabal                     | 10 +-
 services/brig/package.yaml                   |  7 ++
 services/brig/src/Brig/Calling.hs            |  1 -
 services/brig/test/unit/Test/Brig/Calling.hs | 96 +++++++++++++++++++-
 4 files changed, 109 insertions(+), 5 deletions(-)

diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal
index 6ce76d52e76..d3653f0d062 100644
--- a/services/brig/brig.cabal
+++ b/services/brig/brig.cabal
@@ -4,7 +4,7 @@ cabal-version: 2.0
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 66e9d5651b6bea264d8f71f929a1477a8ef70a8fa3e6af97f623cbd977663a3c
+-- hash: c68f27a03bfd39881dae41fb34852c67f4859be99feab6635121ed7425b20210
 
 name:           brig
 version:        1.35.0
@@ -473,16 +473,22 @@ test-suite brig-tests
   hs-source-dirs:
       test/unit
   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 -funbox-strict-fields -threaded -with-rtsopts=-N
+  ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path -funbox-strict-fields -threaded -with-rtsopts=-N -fplugin=Polysemy.Plugin
   build-depends:
       aeson
     , base
     , bloodhound
     , brig
     , brig-types
+    , dns
+    , dns-srv
     , imports
+    , polysemy
+    , polysemy-plugin
+    , retry
     , tasty
     , tasty-hunit
     , types-common
+    , unliftio
     , uuid
   default-language: Haskell2010
diff --git a/services/brig/package.yaml b/services/brig/package.yaml
index 7d3194132cf..94f81532682 100644
--- a/services/brig/package.yaml
+++ b/services/brig/package.yaml
@@ -163,16 +163,23 @@ tests:
     ghc-options:
     - -threaded
     - -with-rtsopts=-N
+    - -fplugin=Polysemy.Plugin
     dependencies:
     - aeson
     - base
     - bloodhound
     - brig
     - brig-types
+    - dns
+    - dns-srv
+    - polysemy
+    - polysemy-plugin
     - imports
+    - retry
     - tasty
     - tasty-hunit
     - types-common
+    - unliftio
     - uuid
 executables:
   brig-schema:
diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs
index cb44fae746f..83b006c9e25 100644
--- a/services/brig/src/Brig/Calling.hs
+++ b/services/brig/src/Brig/Calling.hs
@@ -43,7 +43,6 @@ mkSFTDomain (SFTOptions base maybeSrv) = DNS.normalize $ maybe "_sft" ("_" <>) m
 
 -- TODO: How can I remove the Embed IO? Even if I cannot, this is better than
 -- just IO () as I can still mock DNSLookup
--- TODO: Test that `Nothing` is never explicitly written to the IORef
 sftDiscoveryLoop :: Members [DNSLookup, Embed IO] r => SFTEnv -> Sem r ()
 sftDiscoveryLoop (SFTEnv serversRef domain) = forever $ do
   servers <- discoverSFTServers domain
diff --git a/services/brig/test/unit/Test/Brig/Calling.hs b/services/brig/test/unit/Test/Brig/Calling.hs
index 8b1481e0065..8874de70c2f 100644
--- a/services/brig/test/unit/Test/Brig/Calling.hs
+++ b/services/brig/test/unit/Test/Brig/Calling.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE RecordWildCards #-}
+
 -- This file is part of the Wire Server implementation.
 --
 -- Copyright (C) 2020 Wire Swiss GmbH <opensource@wire.com>
@@ -19,16 +21,37 @@ module Test.Brig.Calling where
 
 import Brig.Calling
 import Brig.Options
+import Control.Retry
+import Data.List.NonEmpty (NonEmpty (..))
 import Imports
+import Network.DNS
+import Polysemy
 import Test.Tasty
 import Test.Tasty.HUnit
+import qualified UnliftIO.Async as Async
+import Wire.Network.DNS.Effect
+import Wire.Network.DNS.SRV
+
+data FakeDNSEnv = FakeDNSEnv
+  { fakeLookupFn :: Domain -> SrvResponse,
+    fakeLookupCalls :: IORef [Domain]
+  }
+
+newFakeDNSEnv :: (Domain -> SrvResponse) -> IO FakeDNSEnv
+newFakeDNSEnv lookupFn = do
+  FakeDNSEnv lookupFn <$> newIORef []
+
+runFakeDNSLookup :: Member (Embed IO) r => FakeDNSEnv -> Sem (DNSLookup ': r) a -> Sem r a
+runFakeDNSLookup FakeDNSEnv {..} = interpret $ \case
+  LookupSRV domain -> do
+    modifyIORef' fakeLookupCalls (++ [domain])
+    pure $ fakeLookupFn domain
 
 tests :: TestTree
 tests =
   testGroup
     "Calling"
-    [ testGroup
-        "sftDomain"
+    [ testGroup "mkSFTDomain" $
         [ testCase "when service name is provided" $
             assertEqual
               "should use the service name to form domain"
@@ -39,5 +62,74 @@ tests =
               "should assume service name to be 'sft'"
               "_sft._tcp.example.com."
               (mkSFTDomain (SFTOptions "example.com" Nothing))
+        ],
+      testGroup "sftDiscoveryLoop" $
+        [ testCase "when service can be discovered" $ void testDiscoveryWhenSuccessful,
+          testCase "when service can be discovered and the URLs change" testDiscoveryWhenURLsChange,
+          testCase "when service cannot be discovered" testDiscoveryWhenUnsuccessful,
+          testCase "when service cannot be discovered after a successful discovery" testDiscoveryWhenUnsuccessfulAfterSuccess
         ]
     ]
+
+testDiscoveryWhenSuccessful :: IO SFTEnv
+testDiscoveryWhenSuccessful = do
+  let entry1 = SrvEntry 0 0 (SrvTarget "sft1.foo.example.com." 443)
+      entry2 = SrvEntry 0 0 (SrvTarget "sft2.foo.example.com." 443)
+      entry3 = SrvEntry 0 0 (SrvTarget "sft3.foo.example.com." 443)
+      returnedEntries = (entry1 :| [entry2, entry3])
+  fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvAvailable returnedEntries)
+  sftEnv <- mkSFTEnv (SFTOptions "foo.example.com" Nothing)
+  discoveryLoop <- Async.async $ runM . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
+  void $ retryEveryMillisecondWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
+  Async.cancel discoveryLoop
+  actualServers <- readIORef (sftServers sftEnv)
+  assertEqual "servers should be the ones read from DNS" (Just returnedEntries) actualServers
+  pure sftEnv
+
+testDiscoveryWhenUnsuccessful :: IO ()
+testDiscoveryWhenUnsuccessful = do
+  fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvNotAvailable)
+  sftEnv <- mkSFTEnv (SFTOptions "foo.example.com" Nothing)
+  discoveryLoop <- Async.async $ runM . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
+  void $ retryEveryMillisecondWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
+  Async.cancel discoveryLoop
+  actualServers <- readIORef (sftServers sftEnv)
+  assertEqual "servers should be the ones read from DNS" Nothing actualServers
+
+testDiscoveryWhenUnsuccessfulAfterSuccess :: IO ()
+testDiscoveryWhenUnsuccessfulAfterSuccess = do
+  sftEnv <- testDiscoveryWhenSuccessful
+  previousEntries <- readIORef (sftServers sftEnv)
+
+  -- In the following lines we re-use the 'sftEnv' from a successful lookup to
+  -- replicate what will happen when a dns lookup fails after success
+  failingFakeDNSEnv <- newFakeDNSEnv (\_ -> SrvNotAvailable)
+  discoveryLoop <- Async.async $ runM . runFakeDNSLookup failingFakeDNSEnv $ sftDiscoveryLoop sftEnv
+  void $ retryEveryMillisecondWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls failingFakeDNSEnv))
+  Async.cancel discoveryLoop
+  actualServers <- readIORef (sftServers sftEnv)
+  assertEqual "servers shouldn't get overwriten" previousEntries actualServers
+
+testDiscoveryWhenURLsChange :: IO ()
+testDiscoveryWhenURLsChange = do
+  sftEnv <- testDiscoveryWhenSuccessful
+
+  -- In the following lines we re-use the 'sftEnv' from a successful lookup to
+  -- replicate what will happen when a dns lookup returns new URLs
+  let entry1 = SrvEntry 0 0 (SrvTarget "sft4.foo.example.com." 443)
+      entry2 = SrvEntry 0 0 (SrvTarget "sft5.foo.example.com." 443)
+      newEntries = (entry1 :| [entry2])
+
+  fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvAvailable newEntries)
+  discoveryLoop <- Async.async $ runM . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
+  void $ retryEveryMillisecondWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
+  Async.cancel discoveryLoop
+  actualServers <- readIORef (sftServers sftEnv)
+  assertEqual "servers should get overwritten" (Just newEntries) actualServers
+
+retryEveryMillisecondWhileN :: (MonadIO m) => Int -> (a -> Bool) -> m a -> m a
+retryEveryMillisecondWhileN n f m =
+  retrying
+    (constantDelay 1000 <> limitRetries n)
+    (const (return . f))
+    (const m)

From a0d7fe52ea4a937e23965ea35312f7c4bb6998ce Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Tue, 28 Jul 2020 22:32:06 +0200
Subject: [PATCH 08/48] rename Wire.API.TURN -> Wire.API.Calling

---
 libs/brig-types/src/Brig/Types/TURN.hs           |  2 +-
 .../src/Wire/API/Call/{TURN.hs => Config.hs}     |  3 +--
 libs/wire-api/src/Wire/API/Swagger.hs            |  6 +++---
 libs/wire-api/test/unit/Main.hs                  |  4 ++--
 .../Test/Wire/API/Call/{TURN.hs => Config.hs}    |  4 ++--
 .../test/unit/Test/Wire/API/Roundtrip/Aeson.hs   | 16 ++++++++--------
 .../unit/Test/Wire/API/Roundtrip/ByteString.hs   | 12 ++++++------
 libs/wire-api/wire-api.cabal                     |  4 ++--
 services/brig/src/Brig/TURN/API.hs               |  2 +-
 services/brig/test/integration/API/TURN.hs       |  2 +-
 10 files changed, 27 insertions(+), 28 deletions(-)
 rename libs/wire-api/src/Wire/API/Call/{TURN.hs => Config.hs} (99%)
 rename libs/wire-api/test/unit/Test/Wire/API/Call/{TURN.hs => Config.hs} (95%)

diff --git a/libs/brig-types/src/Brig/Types/TURN.hs b/libs/brig-types/src/Brig/Types/TURN.hs
index 0244e753405..f8f52dfa5bd 100644
--- a/libs/brig-types/src/Brig/Types/TURN.hs
+++ b/libs/brig-types/src/Brig/Types/TURN.hs
@@ -50,4 +50,4 @@ module Brig.Types.TURN
   )
 where
 
-import Wire.API.Call.TURN
+import Wire.API.Call.Config
diff --git a/libs/wire-api/src/Wire/API/Call/TURN.hs b/libs/wire-api/src/Wire/API/Call/Config.hs
similarity index 99%
rename from libs/wire-api/src/Wire/API/Call/TURN.hs
rename to libs/wire-api/src/Wire/API/Call/Config.hs
index ad350586048..21e361df45a 100644
--- a/libs/wire-api/src/Wire/API/Call/TURN.hs
+++ b/libs/wire-api/src/Wire/API/Call/Config.hs
@@ -20,8 +20,7 @@
 -- 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/>.
 
--- TODO: Rename this module to Call.Config
-module Wire.API.Call.TURN
+module Wire.API.Call.Config
   ( -- * RTCConfiguration
     RTCConfiguration,
     rtcConfiguration,
diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs
index 3feada1b9db..32e0f205732 100644
--- a/libs/wire-api/src/Wire/API/Swagger.hs
+++ b/libs/wire-api/src/Wire/API/Swagger.hs
@@ -18,7 +18,7 @@
 module Wire.API.Swagger where
 
 import Data.Swagger.Build.Api (Model)
-import qualified Wire.API.Call.TURN as Call.TURN
+import qualified Wire.API.Call.Config as Call.Config
 import qualified Wire.API.Connection as Connection
 import qualified Wire.API.Conversation as Conversation
 import qualified Wire.API.Conversation.Code as Conversation.Code
@@ -53,8 +53,8 @@ import qualified Wire.API.User.Search as User.Search
 
 models :: [Model]
 models =
-  [ Call.TURN.modelRtcConfiguration,
-    Call.TURN.modelRtcIceServer,
+  [ Call.Config.modelRtcConfiguration,
+    Call.Config.modelRtcIceServer,
     Connection.modelConnectionList,
     Connection.modelConnection,
     Connection.modelConnectionRequest,
diff --git a/libs/wire-api/test/unit/Main.hs b/libs/wire-api/test/unit/Main.hs
index 53893a18af8..15bfb7b4178 100644
--- a/libs/wire-api/test/unit/Main.hs
+++ b/libs/wire-api/test/unit/Main.hs
@@ -22,7 +22,7 @@ where
 
 import Imports
 import Test.Tasty
-import qualified Test.Wire.API.Call.TURN as Call.TURN
+import qualified Test.Wire.API.Call.Config as Call.Config
 import qualified Test.Wire.API.Roundtrip.Aeson as Roundtrip.Aeson
 import qualified Test.Wire.API.Roundtrip.ByteString as Roundtrip.ByteString
 import qualified Test.Wire.API.Team.Member as Team.Member
@@ -34,7 +34,7 @@ main =
   defaultMain $
     testGroup
       "Tests"
-      [ Call.TURN.tests,
+      [ Call.Config.tests,
         Team.Member.tests,
         User.tests,
         User.RichInfo.tests,
diff --git a/libs/wire-api/test/unit/Test/Wire/API/Call/TURN.hs b/libs/wire-api/test/unit/Test/Wire/API/Call/Config.hs
similarity index 95%
rename from libs/wire-api/test/unit/Test/Wire/API/Call/TURN.hs
rename to libs/wire-api/test/unit/Test/Wire/API/Call/Config.hs
index 84c13902572..b9885328a63 100644
--- a/libs/wire-api/test/unit/Test/Wire/API/Call/TURN.hs
+++ b/libs/wire-api/test/unit/Test/Wire/API/Call/Config.hs
@@ -15,14 +15,14 @@
 -- 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/>.
 
-module Test.Wire.API.Call.TURN where
+module Test.Wire.API.Call.Config where
 
 import Data.Aeson
 import Imports
 import Test.Tasty
 import Test.Tasty.QuickCheck hiding (total)
 import Wire.API.Arbitrary ()
-import Wire.API.Call.TURN (TurnURI, isTcp, isTls, isUdp, limitServers)
+import Wire.API.Call.Config (TurnURI, isTcp, isTls, isUdp, limitServers)
 
 tests :: TestTree
 tests =
diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs
index e0fd13d2500..e6b6514b379 100644
--- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs
+++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs
@@ -27,7 +27,7 @@ import Test.Tasty.QuickCheck ((===), Arbitrary, counterexample, testProperty)
 import Type.Reflection (typeRep)
 import qualified Wire.API.Asset as Asset
 import qualified Wire.API.Asset.V3.Resumable as Asset.Resumable
-import qualified Wire.API.Call.TURN as Call.TURN
+import qualified Wire.API.Call.Config as Call.Config
 import qualified Wire.API.Connection as Connection
 import qualified Wire.API.Conversation as Conversation
 import qualified Wire.API.Conversation.Bot as Conversation.Bot
@@ -85,13 +85,13 @@ tests =
       testRoundTrip @Asset.Resumable.ChunkSize,
       testRoundTrip @Asset.Resumable.Offset,
       currentlyFailing (testRoundTrip @Asset.Resumable.ResumableAsset), -- because ToJSON is rounding UTCTime
-      testRoundTrip @Call.TURN.TurnHost,
-      testRoundTrip @Call.TURN.Scheme,
-      testRoundTrip @Call.TURN.Transport,
-      testRoundTrip @Call.TURN.TurnURI,
-      testRoundTrip @Call.TURN.TurnUsername,
-      testRoundTrip @Call.TURN.RTCIceServer,
-      testRoundTrip @Call.TURN.RTCConfiguration,
+      testRoundTrip @Call.Config.TurnHost,
+      testRoundTrip @Call.Config.Scheme,
+      testRoundTrip @Call.Config.Transport,
+      testRoundTrip @Call.Config.TurnURI,
+      testRoundTrip @Call.Config.TurnUsername,
+      testRoundTrip @Call.Config.RTCIceServer,
+      testRoundTrip @Call.Config.RTCConfiguration,
       testRoundTrip @Connection.ConnectionRequest,
       testRoundTrip @Connection.Relation,
       testRoundTrip @Connection.Message,
diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/ByteString.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/ByteString.hs
index 579ecdeb5d1..00dfe9263c3 100644
--- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/ByteString.hs
+++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/ByteString.hs
@@ -25,7 +25,7 @@ import Type.Reflection (typeRep)
 import qualified Wire.API.Arbitrary as Arbitrary ()
 import qualified Wire.API.Asset.V3 as Asset.V3
 import qualified Wire.API.Asset.V3.Resumable as Asset.V3.Resumable
-import qualified Wire.API.Call.TURN as Call.TURN
+import qualified Wire.API.Call.Config as Call.Config
 import qualified Wire.API.Conversation.Code as Conversation.Code
 import qualified Wire.API.Conversation.Role as Conversation.Role
 import qualified Wire.API.Properties as Properties
@@ -50,10 +50,10 @@ tests =
       testRoundTrip @Asset.V3.Resumable.ChunkSize,
       testRoundTrip @Asset.V3.Resumable.Offset,
       testRoundTrip @Asset.V3.Resumable.TotalSize,
-      testRoundTrip @Call.TURN.Scheme,
-      testRoundTrip @Call.TURN.Transport,
-      testRoundTrip @Call.TURN.TurnHost,
-      testRoundTrip @Call.TURN.TurnURI,
+      testRoundTrip @Call.Config.Scheme,
+      testRoundTrip @Call.Config.Transport,
+      testRoundTrip @Call.Config.TurnHost,
+      testRoundTrip @Call.Config.TurnURI,
       testRoundTrip @Conversation.Code.Key,
       testRoundTrip @Conversation.Code.Value,
       testRoundTrip @Conversation.Role.RoleName,
@@ -77,7 +77,7 @@ tests =
       testRoundTrip @(Provider.Service.Tag.QueryAllTags 3 5),
       testRoundTrip @(Provider.Service.Tag.QueryAnyTags 3 5)
       -- FUTUREWORK:
-      -- testCase "Call.TURN.TurnUsername (doesn't have FromByteString)" ...
+      -- testCase "Call.Config.TurnUsername (doesn't have FromByteString)" ...
       -- testCase "User.Activation.ActivationTarget (doesn't have FromByteString)" ...
     ]
 
diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal
index f084cc5bf6e..5509101fba5 100644
--- a/libs/wire-api/wire-api.cabal
+++ b/libs/wire-api/wire-api.cabal
@@ -23,7 +23,7 @@ library
       Wire.API.Asset
       Wire.API.Asset.V3
       Wire.API.Asset.V3.Resumable
-      Wire.API.Call.TURN
+      Wire.API.Call.Config
       Wire.API.Connection
       Wire.API.Conversation
       Wire.API.Conversation.Bot
@@ -121,7 +121,7 @@ test-suite wire-api-tests
   type: exitcode-stdio-1.0
   main-is: Main.hs
   other-modules:
-      Test.Wire.API.Call.TURN
+      Test.Wire.API.Call.Config
       Test.Wire.API.Roundtrip.Aeson
       Test.Wire.API.Roundtrip.ByteString
       Test.Wire.API.Team.Member
diff --git a/services/brig/src/Brig/TURN/API.hs b/services/brig/src/Brig/TURN/API.hs
index 87ec9805415..15c0d2d6070 100644
--- a/services/brig/src/Brig/TURN/API.hs
+++ b/services/brig/src/Brig/TURN/API.hs
@@ -53,7 +53,7 @@ import qualified System.Random.MWC as MWC
 import System.Random.Shuffle
 import qualified URI.ByteString as URI
 import qualified URI.ByteString.QQ as URI
-import qualified Wire.API.Call.TURN as Public
+import qualified Wire.API.Call.Config as Public
 import Wire.Network.DNS.SRV (SrvTarget (..), srvTarget)
 
 routesPublic :: Routes Doc.ApiBuilder Handler ()
diff --git a/services/brig/test/integration/API/TURN.hs b/services/brig/test/integration/API/TURN.hs
index 66edb003971..6be2e10e797 100644
--- a/services/brig/test/integration/API/TURN.hs
+++ b/services/brig/test/integration/API/TURN.hs
@@ -42,7 +42,7 @@ import URI.ByteString.QQ (uri)
 import UnliftIO.Exception (finally)
 import qualified UnliftIO.Temporary as Temp
 import Util
-import Wire.API.Call.TURN
+import Wire.API.Call.Config
 
 tests :: Manager -> Brig -> Opts.Opts -> FilePath -> FilePath -> IO TestTree
 tests m b opts turn turnV2 = do

From eaaa4f390a99032fe2d17f6b5c2405801256c318 Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Tue, 28 Jul 2020 22:46:46 +0200
Subject: [PATCH 09/48] second rename TURN -> Calling

---
 libs/brig-types/brig-types.cabal              |  6 +--
 libs/brig-types/src/Brig/Types.hs             |  2 +-
 .../src/Brig/Types/{TURN.hs => Calling.hs}    |  2 +-
 services/brig/brig.cabal                      |  7 ++--
 services/brig/src/Brig/API/Public.hs          |  2 +-
 services/brig/src/Brig/App.hs                 |  2 +-
 .../brig/src/Brig/{TURN => Calling}/API.hs    |  6 +--
 services/brig/src/Brig/TURN.hs                | 39 -------------------
 .../integration/API/{TURN.hs => Calling.hs}   |  2 +-
 services/brig/test/integration/Main.hs        |  2 +-
 10 files changed, 14 insertions(+), 56 deletions(-)
 rename libs/brig-types/src/Brig/Types/{TURN.hs => Calling.hs} (98%)
 rename services/brig/src/Brig/{TURN => Calling}/API.hs (98%)
 delete mode 100644 services/brig/src/Brig/TURN.hs
 rename services/brig/test/integration/API/{TURN.hs => Calling.hs} (99%)

diff --git a/libs/brig-types/brig-types.cabal b/libs/brig-types/brig-types.cabal
index 53bcdd0e1fd..d467905e717 100644
--- a/libs/brig-types/brig-types.cabal
+++ b/libs/brig-types/brig-types.cabal
@@ -1,10 +1,10 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.31.2.
+-- This file has been generated from package.yaml by hpack version 0.33.0.
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 7497d04521f12339e2a8f5537dacf242839dea9034f69e67f0a254b1548cadd9
+-- hash: fe16e52e870cb548573366fe9192319004e52c3e4d2ece172df69e408cbe391b
 
 name:           brig-types
 version:        1.35.0
@@ -21,6 +21,7 @@ library
   exposed-modules:
       Brig.Types
       Brig.Types.Activation
+      Brig.Types.Calling
       Brig.Types.Client
       Brig.Types.Client.Prekey
       Brig.Types.Code
@@ -37,7 +38,6 @@ library
       Brig.Types.Team.Invitation
       Brig.Types.Team.LegalHold
       Brig.Types.Test.Arbitrary
-      Brig.Types.TURN
       Brig.Types.User
       Brig.Types.User.Auth
   other-modules:
diff --git a/libs/brig-types/src/Brig/Types.hs b/libs/brig-types/src/Brig/Types.hs
index b4f3307ba91..045a5b1ceaa 100644
--- a/libs/brig-types/src/Brig/Types.hs
+++ b/libs/brig-types/src/Brig/Types.hs
@@ -25,6 +25,6 @@ import Brig.Types.Client as M
 import Brig.Types.Connection as M
 import Brig.Types.Properties as M
 import Brig.Types.Search as M
-import Brig.Types.TURN as M
+import Brig.Types.Calling as M
 import Brig.Types.Team as M
 import Brig.Types.User as M
diff --git a/libs/brig-types/src/Brig/Types/TURN.hs b/libs/brig-types/src/Brig/Types/Calling.hs
similarity index 98%
rename from libs/brig-types/src/Brig/Types/TURN.hs
rename to libs/brig-types/src/Brig/Types/Calling.hs
index f8f52dfa5bd..2d7ee7ecfc1 100644
--- a/libs/brig-types/src/Brig/Types/TURN.hs
+++ b/libs/brig-types/src/Brig/Types/Calling.hs
@@ -15,7 +15,7 @@
 -- 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/>.
 
-module Brig.Types.TURN
+module Brig.Types.Calling
   ( -- * re-exports
     RTCConfiguration,
     rtcConfiguration,
diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal
index d3653f0d062..ea07be45878 100644
--- a/services/brig/brig.cabal
+++ b/services/brig/brig.cabal
@@ -4,7 +4,7 @@ cabal-version: 2.0
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: c68f27a03bfd39881dae41fb34852c67f4859be99feab6635121ed7425b20210
+-- hash: 7791287309106815961c909f52ba63652c036239415e412ce1edc5c025614994
 
 name:           brig
 version:        1.35.0
@@ -37,6 +37,7 @@ library
       Brig.AWS.Types
       Brig.Budget
       Brig.Calling
+      Brig.Calling.API
       Brig.Code
       Brig.Data.Activation
       Brig.Data.Blacklist
@@ -77,8 +78,6 @@ library
       Brig.Team.Template
       Brig.Team.Util
       Brig.Template
-      Brig.TURN
-      Brig.TURN.API
       Brig.Unique
       Brig.User.API.Auth
       Brig.User.API.Search
@@ -294,6 +293,7 @@ executable brig-index
 executable brig-integration
   main-is: Main.hs
   other-modules:
+      API.Calling
       API.IdMapping
       API.Metrics
       API.Provider
@@ -303,7 +303,6 @@ executable brig-integration
       API.Settings
       API.Team
       API.Team.Util
-      API.TURN
       API.User
       API.User.Account
       API.User.Auth
diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs
index 071c441b831..0318407e987 100644
--- a/services/brig/src/Brig/API/Public.hs
+++ b/services/brig/src/Brig/API/Public.hs
@@ -35,7 +35,7 @@ import Brig.App
 import qualified Brig.Data.User as Data
 import Brig.Options hiding (internalEvents, sesQueue)
 import qualified Brig.Provider.API as Provider
-import qualified Brig.TURN.API as TURN
+import qualified Brig.Calling.API as TURN
 import qualified Brig.Team.API as Team
 import qualified Brig.Team.Email as Team
 import Brig.Types.Intra (AccountStatus (Ephemeral), UserAccount (UserAccount, accountUser))
diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs
index 72f8d6c9e24..be11a0d53b9 100644
--- a/services/brig/src/Brig/App.hs
+++ b/services/brig/src/Brig/App.hs
@@ -75,7 +75,7 @@ import Brig.Provider.Template
 import qualified Brig.Queue.Stomp as Stomp
 import Brig.Queue.Types (Queue (..))
 import qualified Brig.SMTP as SMTP
-import qualified Brig.TURN as TURN
+import qualified Brig.Calling as TURN
 import Brig.Team.Template
 import Brig.Template (Localised, TemplateBranding, forLocale, genTemplateBranding)
 import Brig.Types (Locale (..), TurnURI)
diff --git a/services/brig/src/Brig/TURN/API.hs b/services/brig/src/Brig/Calling/API.hs
similarity index 98%
rename from services/brig/src/Brig/TURN/API.hs
rename to services/brig/src/Brig/Calling/API.hs
index 15c0d2d6070..5483da1b495 100644
--- a/services/brig/src/Brig/TURN/API.hs
+++ b/services/brig/src/Brig/Calling/API.hs
@@ -15,8 +15,7 @@
 -- 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/>.
 
--- TODO: Rename this module to Brig.Calling.API
-module Brig.TURN.API
+module Brig.Calling.API
   ( routesPublic,
   )
 where
@@ -24,8 +23,7 @@ where
 import Brig.API.Handler
 import Brig.App
 import Brig.Calling
-import Brig.TURN hiding (Env)
-import qualified Brig.TURN as TURN
+import qualified Brig.Calling as TURN
 import Control.Lens
 import Control.Monad.Fail (MonadFail)
 import Control.Monad.Random.Class
diff --git a/services/brig/src/Brig/TURN.hs b/services/brig/src/Brig/TURN.hs
deleted file mode 100644
index 0c95068938e..00000000000
--- a/services/brig/src/Brig/TURN.hs
+++ /dev/null
@@ -1,39 +0,0 @@
--- 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/>.
-
-module Brig.TURN where
-
-import Brig.Types (TurnURI)
-import Control.Lens
-import Data.List1
-import Imports
-import OpenSSL.EVP.Digest (Digest)
-import System.Random.MWC (GenIO, createSystemRandom)
-
-data Env = Env
-  { _turnServers :: List1 TurnURI,
-    _turnTokenTTL :: Word32,
-    _turnConfigTTL :: Word32,
-    _turnSecret :: ByteString,
-    _turnSHA512 :: Digest,
-    _turnPrng :: GenIO
-  }
-
-makeLenses ''Env
-
-newEnv :: Digest -> List1 TurnURI -> Word32 -> Word32 -> ByteString -> IO Env
-newEnv sha512 srvs tTTL cTTL secret = Env srvs tTTL cTTL secret sha512 <$> createSystemRandom
diff --git a/services/brig/test/integration/API/TURN.hs b/services/brig/test/integration/API/Calling.hs
similarity index 99%
rename from services/brig/test/integration/API/TURN.hs
rename to services/brig/test/integration/API/Calling.hs
index 6be2e10e797..cd2b1fd4933 100644
--- a/services/brig/test/integration/API/TURN.hs
+++ b/services/brig/test/integration/API/Calling.hs
@@ -17,7 +17,7 @@
 -- 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/>.
 
-module API.TURN where
+module API.Calling where
 
 import Bilge
 import Bilge.Assert
diff --git a/services/brig/test/integration/Main.hs b/services/brig/test/integration/Main.hs
index 4d073cbfe51..b0d6ad2e88c 100644
--- a/services/brig/test/integration/Main.hs
+++ b/services/brig/test/integration/Main.hs
@@ -25,7 +25,7 @@ import qualified API.Metrics as Metrics
 import qualified API.Provider as Provider
 import qualified API.Search as Search
 import qualified API.Settings as Settings
-import qualified API.TURN as TURN
+import qualified API.Calling as TURN
 import qualified API.Team as Team
 import qualified API.User as User
 import Bilge hiding (header)

From 7101bd9c9e559a839a8a8d50ef0897d0ffa4eeaa Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Tue, 28 Jul 2020 22:47:23 +0200
Subject: [PATCH 10/48] merge TURN into Calling

---
 services/brig/src/Brig/Calling.hs | 21 +++++++++++++++++++++
 1 file changed, 21 insertions(+)

diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs
index 83b006c9e25..f80e416a2f4 100644
--- a/services/brig/src/Brig/Calling.hs
+++ b/services/brig/src/Brig/Calling.hs
@@ -18,10 +18,15 @@
 module Brig.Calling where
 
 import Brig.Options (SFTOptions (..))
+import Brig.Types (TurnURI)
+import Control.Lens
 import Data.List.NonEmpty
+import Data.List1
 import Imports
 import qualified Network.DNS as DNS
+import OpenSSL.EVP.Digest (Digest)
 import Polysemy
+import System.Random.MWC (GenIO, createSystemRandom)
 import Wire.Network.DNS.Effect
 import Wire.Network.DNS.SRV
 
@@ -61,3 +66,19 @@ mkSFTEnv opts =
 startSFTServiceDiscovery :: SFTEnv -> IO ()
 startSFTServiceDiscovery =
   runM . runDNSLookupDefault . sftDiscoveryLoop
+
+-- TURN specific
+
+data Env = Env
+  { _turnServers :: List1 TurnURI,
+    _turnTokenTTL :: Word32,
+    _turnConfigTTL :: Word32,
+    _turnSecret :: ByteString,
+    _turnSHA512 :: Digest,
+    _turnPrng :: GenIO
+  }
+
+makeLenses ''Env
+
+newEnv :: Digest -> List1 TurnURI -> Word32 -> Word32 -> ByteString -> IO Env
+newEnv sha512 srvs tTTL cTTL secret = Env srvs tTTL cTTL secret sha512 <$> createSystemRandom

From fb42bc30136cfea85e8f732796b8da175c480afd Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Tue, 28 Jul 2020 22:51:29 +0200
Subject: [PATCH 11/48] another TURN -> Calling rename

---
 services/brig/src/Brig/API/Public.hs   |  4 ++--
 services/brig/src/Brig/App.hs          | 13 ++++++-------
 services/brig/src/Brig/Calling/API.hs  |  4 ++--
 services/brig/test/integration/Main.hs |  4 ++--
 4 files changed, 12 insertions(+), 13 deletions(-)

diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs
index 0318407e987..be36b60ab9e 100644
--- a/services/brig/src/Brig/API/Public.hs
+++ b/services/brig/src/Brig/API/Public.hs
@@ -35,7 +35,7 @@ import Brig.App
 import qualified Brig.Data.User as Data
 import Brig.Options hiding (internalEvents, sesQueue)
 import qualified Brig.Provider.API as Provider
-import qualified Brig.Calling.API as TURN
+import qualified Brig.Calling.API as Calling
 import qualified Brig.Team.API as Team
 import qualified Brig.Team.Email as Team
 import Brig.Types.Intra (AccountStatus (Ephemeral), UserAccount (UserAccount, accountUser))
@@ -781,7 +781,7 @@ sitemap o = do
   Auth.routesPublic
   Search.routesPublic
   Team.routesPublic
-  TURN.routesPublic
+  Calling.routesPublic
 
 apiDocs :: Opts -> Routes Doc.ApiBuilder Handler ()
 apiDocs o = do
diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs
index be11a0d53b9..4980a07850f 100644
--- a/services/brig/src/Brig/App.hs
+++ b/services/brig/src/Brig/App.hs
@@ -75,7 +75,6 @@ import Brig.Provider.Template
 import qualified Brig.Queue.Stomp as Stomp
 import Brig.Queue.Types (Queue (..))
 import qualified Brig.SMTP as SMTP
-import qualified Brig.Calling as TURN
 import Brig.Team.Template
 import Brig.Template (Localised, TemplateBranding, forLocale, genTemplateBranding)
 import Brig.Types (Locale (..), TurnURI)
@@ -157,8 +156,8 @@ data Env = Env
     _twilioCreds :: Twilio.Credentials,
     _geoDb :: Maybe (IORef GeoIp.GeoDB),
     _fsWatcher :: FS.WatchManager,
-    _turnEnv :: IORef TURN.Env,
-    _turnEnvV2 :: IORef TURN.Env,
+    _turnEnv :: IORef Calling.Env,
+    _turnEnvV2 :: IORef Calling.Env,
     _sftEnv :: Maybe Calling.SFTEnv,
     _currentTime :: IO UTCTime,
     _zauthEnv :: ZAuth.Env,
@@ -269,7 +268,7 @@ geoSetup lgr w (Just db) = do
   startWatching w path (replaceGeoDb lgr geodb)
   return $ Just geodb
 
-turnSetup :: Logger -> FS.WatchManager -> Digest -> Opt.TurnOpts -> IO (IORef TURN.Env, IORef TURN.Env)
+turnSetup :: Logger -> FS.WatchManager -> Digest -> Opt.TurnOpts -> IO (IORef Calling.Env, IORef Calling.Env)
 turnSetup lgr w dig o = do
   secret <- Text.encodeUtf8 . Text.strip <$> Text.readFile (Opt.secret o)
   cfg <- setupTurn secret (Opt.servers o)
@@ -279,7 +278,7 @@ turnSetup lgr w dig o = do
     setupTurn secret cfg = do
       path <- canonicalizePath cfg
       servers <- fromMaybe (error "Empty TURN list, check turn file!") <$> readTurnList path
-      te <- newIORef =<< TURN.newEnv dig servers (Opt.tokenTTL o) (Opt.configTTL o) secret
+      te <- newIORef =<< Calling.newEnv dig servers (Opt.tokenTTL o) (Opt.configTTL o) secret
       startWatching w path (replaceTurnServers lgr te)
       return te
 
@@ -298,13 +297,13 @@ replaceGeoDb g ref e = do
     GeoIp.openGeoDB (FS.eventPath e) >>= atomicWriteIORef ref
     Log.info g (msg $ val "New GeoIP database loaded.")
 
-replaceTurnServers :: Logger -> IORef TURN.Env -> FS.Event -> IO ()
+replaceTurnServers :: Logger -> IORef Calling.Env -> FS.Event -> IO ()
 replaceTurnServers g ref e = do
   let logErr x = Log.err g (msg $ val "Error loading turn servers: " +++ show x)
   handleAny logErr $
     readTurnList (FS.eventPath e) >>= \case
       Just servers -> readIORef ref >>= \old -> do
-        atomicWriteIORef ref (old & TURN.turnServers .~ servers)
+        atomicWriteIORef ref (old & Calling.turnServers .~ servers)
         Log.info g (msg $ val "New turn servers loaded.")
       Nothing -> Log.warn g (msg $ val "Empty or malformed turn servers list, ignoring!")
 
diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs
index 5483da1b495..ed200c8a9f8 100644
--- a/services/brig/src/Brig/Calling/API.hs
+++ b/services/brig/src/Brig/Calling/API.hs
@@ -23,7 +23,7 @@ where
 import Brig.API.Handler
 import Brig.App
 import Brig.Calling
-import qualified Brig.Calling as TURN
+import qualified Brig.Calling as Calling
 import Control.Lens
 import Control.Monad.Fail (MonadFail)
 import Control.Monad.Random.Class
@@ -112,7 +112,7 @@ getCallsConfig _ _ = do
         (Public.rtcConfIceServers . traverse . Public.iceURLs . traverse . Public.turiTransport)
         Nothing
 
-newConfig :: MonadIO m => TURN.Env -> Maybe SFTEnv -> Maybe (Range 1 10 Int) -> m Public.RTCConfiguration
+newConfig :: MonadIO m => Calling.Env -> Maybe SFTEnv -> Maybe (Range 1 10 Int) -> m Public.RTCConfiguration
 newConfig env mSftEnv limit = do
   let (sha, secret, tTTL, cTTL, prng) = (env ^. turnSHA512, env ^. turnSecret, env ^. turnTokenTTL, env ^. turnConfigTTL, env ^. turnPrng)
   -- randomize list of servers (before limiting the list, to ensure not always the same servers are chosen if limit is set)
diff --git a/services/brig/test/integration/Main.hs b/services/brig/test/integration/Main.hs
index b0d6ad2e88c..61e8eaa1d87 100644
--- a/services/brig/test/integration/Main.hs
+++ b/services/brig/test/integration/Main.hs
@@ -25,7 +25,7 @@ import qualified API.Metrics as Metrics
 import qualified API.Provider as Provider
 import qualified API.Search as Search
 import qualified API.Settings as Settings
-import qualified API.Calling as TURN
+import qualified API.Calling as Calling
 import qualified API.Team as Team
 import qualified API.User as User
 import Bilge hiding (header)
@@ -97,7 +97,7 @@ runTests iConf bConf otherArgs = do
   providerApi <- Provider.tests (provider <$> iConf) mg db b c g
   searchApis <- Search.tests brigOpts mg g b
   teamApis <- Team.tests brigOpts mg n b c g awsEnv
-  turnApi <- TURN.tests mg b brigOpts turnFile turnFileV2
+  turnApi <- Calling.tests mg b brigOpts turnFile turnFileV2
   idMappingApi <- pure $ IdMapping.tests brigOpts mg b
   metricsApi <- Metrics.tests mg b
   settingsApi <- Settings.tests brigOpts mg b g

From 1b5804d15f952ea13eb39f3e75525280e7071847 Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Tue, 28 Jul 2020 22:58:32 +0200
Subject: [PATCH 12/48] rename dns-srv to dns-util

---
 .../{dns-srv/dns-srv.cabal => dns-util/dns-util.cabal} | 10 +++++-----
 libs/{dns-srv => dns-util}/package.yaml                |  4 ++--
 .../src/Wire/Network/DNS/Effect.hs                     |  0
 libs/{dns-srv => dns-util}/src/Wire/Network/DNS/SRV.hs |  0
 libs/{dns-srv => dns-util}/test/Spec.hs                |  0
 .../test/Test/Wire/Network/DNS/SRVSpec.hs              |  0
 services/brig/brig.cabal                               |  4 ++--
 services/brig/package.yaml                             |  4 ++--
 stack.yaml                                             |  2 +-
 9 files changed, 12 insertions(+), 12 deletions(-)
 rename libs/{dns-srv/dns-srv.cabal => dns-util/dns-util.cabal} (94%)
 rename libs/{dns-srv => dns-util}/package.yaml (95%)
 rename libs/{dns-srv => dns-util}/src/Wire/Network/DNS/Effect.hs (100%)
 rename libs/{dns-srv => dns-util}/src/Wire/Network/DNS/SRV.hs (100%)
 rename libs/{dns-srv => dns-util}/test/Spec.hs (100%)
 rename libs/{dns-srv => dns-util}/test/Test/Wire/Network/DNS/SRVSpec.hs (100%)

diff --git a/libs/dns-srv/dns-srv.cabal b/libs/dns-util/dns-util.cabal
similarity index 94%
rename from libs/dns-srv/dns-srv.cabal
rename to libs/dns-util/dns-util.cabal
index bd85b4445f9..dcca0c83f34 100644
--- a/libs/dns-srv/dns-srv.cabal
+++ b/libs/dns-util/dns-util.cabal
@@ -4,9 +4,9 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 2b22f84e0da77b424651866179a468047b326b1b1d904a05a1a9fb9b06e26bfe
+-- hash: 0af5ccb9df7c6ce9225b19b4bf037e5c8813c7a2a1741cd44855366c1ef1928a
 
-name:           dns-srv
+name:           dns-util
 version:        0.1.0
 synopsis:       Library to deal with DNS SRV records
 description:    Library to deal with DNS SRV records
@@ -22,7 +22,7 @@ library
       Wire.Network.DNS.Effect
       Wire.Network.DNS.SRV
   other-modules:
-      Paths_dns_srv
+      Paths_dns_util
   hs-source-dirs:
       src
   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
@@ -41,7 +41,7 @@ test-suite spec
   main-is: Spec.hs
   other-modules:
       Test.Wire.Network.DNS.SRVSpec
-      Paths_dns_srv
+      Paths_dns_util
   hs-source-dirs:
       test
   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
@@ -52,7 +52,7 @@ test-suite spec
       QuickCheck
     , base >=4.6 && <5.0
     , dns
-    , dns-srv
+    , dns-util
     , hspec
     , hspec-discover
     , imports
diff --git a/libs/dns-srv/package.yaml b/libs/dns-util/package.yaml
similarity index 95%
rename from libs/dns-srv/package.yaml
rename to libs/dns-util/package.yaml
index b93c56cb825..210a4299ab6 100644
--- a/libs/dns-srv/package.yaml
+++ b/libs/dns-util/package.yaml
@@ -1,6 +1,6 @@
 defaults:
   local: ../../package-defaults.yaml
-name: dns-srv
+name: dns-util
 version: '0.1.0'
 synopsis: Library to deal with DNS SRV records
 description: Library to deal with DNS SRV records
@@ -31,4 +31,4 @@ tests:
       - hspec
       - hspec-discover
       - QuickCheck
-      - dns-srv
+      - dns-util
diff --git a/libs/dns-srv/src/Wire/Network/DNS/Effect.hs b/libs/dns-util/src/Wire/Network/DNS/Effect.hs
similarity index 100%
rename from libs/dns-srv/src/Wire/Network/DNS/Effect.hs
rename to libs/dns-util/src/Wire/Network/DNS/Effect.hs
diff --git a/libs/dns-srv/src/Wire/Network/DNS/SRV.hs b/libs/dns-util/src/Wire/Network/DNS/SRV.hs
similarity index 100%
rename from libs/dns-srv/src/Wire/Network/DNS/SRV.hs
rename to libs/dns-util/src/Wire/Network/DNS/SRV.hs
diff --git a/libs/dns-srv/test/Spec.hs b/libs/dns-util/test/Spec.hs
similarity index 100%
rename from libs/dns-srv/test/Spec.hs
rename to libs/dns-util/test/Spec.hs
diff --git a/libs/dns-srv/test/Test/Wire/Network/DNS/SRVSpec.hs b/libs/dns-util/test/Test/Wire/Network/DNS/SRVSpec.hs
similarity index 100%
rename from libs/dns-srv/test/Test/Wire/Network/DNS/SRVSpec.hs
rename to libs/dns-util/test/Test/Wire/Network/DNS/SRVSpec.hs
diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal
index ea07be45878..826dd0bf099 100644
--- a/services/brig/brig.cabal
+++ b/services/brig/brig.cabal
@@ -138,7 +138,7 @@ library
     , data-timeout >=0.3
     , directory >=1.2
     , dns
-    , dns-srv
+    , dns-util
     , either >=4.3
     , enclosed-exceptions >=1.0
     , errors >=1.4
@@ -480,7 +480,7 @@ test-suite brig-tests
     , brig
     , brig-types
     , dns
-    , dns-srv
+    , dns-util
     , imports
     , polysemy
     , polysemy-plugin
diff --git a/services/brig/package.yaml b/services/brig/package.yaml
index 94f81532682..fa53ee3f12b 100644
--- a/services/brig/package.yaml
+++ b/services/brig/package.yaml
@@ -43,7 +43,7 @@ library:
   - data-timeout >=0.3
   - directory >=1.2
   - dns
-  - dns-srv
+  - dns-util
   - either >=4.3
   - enclosed-exceptions >=1.0
   - errors >=1.4
@@ -171,7 +171,7 @@ tests:
     - brig
     - brig-types
     - dns
-    - dns-srv
+    - dns-util
     - polysemy
     - polysemy-plugin
     - imports
diff --git a/stack.yaml b/stack.yaml
index b353557ecc1..cb4969d0e19 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -9,7 +9,7 @@ packages:
 - libs/cassandra-util
 - libs/extended
 - libs/federation-util
-- libs/dns-srv
+- libs/dns-util
 - libs/galley-types
 - libs/gundeck-types
 - libs/hscim

From b6c81ad9549aa1446a91c45f0694bf2e123fa97d Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Wed, 29 Jul 2020 08:52:02 +0200
Subject: [PATCH 13/48] Rename testGroup "turn" -> "calling"

---
 services/brig/test/integration/API/Calling.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs
index cd2b1fd4933..8fee17ed692 100644
--- a/services/brig/test/integration/API/Calling.hs
+++ b/services/brig/test/integration/API/Calling.hs
@@ -48,7 +48,7 @@ tests :: Manager -> Brig -> Opts.Opts -> FilePath -> FilePath -> IO TestTree
 tests m b opts turn turnV2 = do
   return $
     testGroup
-      "turn"
+      "calling"
       [ test m "basic /calls/config - 200" $ testCallsConfig b,
         -- FIXME: requires tests to run on same host as brig
         test m "multiple servers /calls/config - 200" . withTurnFile turn $ testCallsConfigMultiple b,

From c00e688973d662bea1983f661fbffaf92038355d Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Wed, 29 Jul 2020 08:58:47 +0200
Subject: [PATCH 14/48] Ormolu for module rename

---
 libs/brig-types/src/Brig/Types.hs      | 2 +-
 services/brig/src/Brig/API/Public.hs   | 2 +-
 services/brig/test/integration/Main.hs | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/libs/brig-types/src/Brig/Types.hs b/libs/brig-types/src/Brig/Types.hs
index 045a5b1ceaa..fb1cff375a9 100644
--- a/libs/brig-types/src/Brig/Types.hs
+++ b/libs/brig-types/src/Brig/Types.hs
@@ -21,10 +21,10 @@ module Brig.Types
 where
 
 import Brig.Types.Activation as M
+import Brig.Types.Calling as M
 import Brig.Types.Client as M
 import Brig.Types.Connection as M
 import Brig.Types.Properties as M
 import Brig.Types.Search as M
-import Brig.Types.Calling as M
 import Brig.Types.Team as M
 import Brig.Types.User as M
diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs
index be36b60ab9e..809b5b661dd 100644
--- a/services/brig/src/Brig/API/Public.hs
+++ b/services/brig/src/Brig/API/Public.hs
@@ -32,10 +32,10 @@ import qualified Brig.API.Properties as API
 import Brig.API.Types
 import qualified Brig.API.User as API
 import Brig.App
+import qualified Brig.Calling.API as Calling
 import qualified Brig.Data.User as Data
 import Brig.Options hiding (internalEvents, sesQueue)
 import qualified Brig.Provider.API as Provider
-import qualified Brig.Calling.API as Calling
 import qualified Brig.Team.API as Team
 import qualified Brig.Team.Email as Team
 import Brig.Types.Intra (AccountStatus (Ephemeral), UserAccount (UserAccount, accountUser))
diff --git a/services/brig/test/integration/Main.hs b/services/brig/test/integration/Main.hs
index 61e8eaa1d87..6782d7aecae 100644
--- a/services/brig/test/integration/Main.hs
+++ b/services/brig/test/integration/Main.hs
@@ -20,12 +20,12 @@ module Main
   )
 where
 
+import qualified API.Calling as Calling
 import qualified API.IdMapping as IdMapping
 import qualified API.Metrics as Metrics
 import qualified API.Provider as Provider
 import qualified API.Search as Search
 import qualified API.Settings as Settings
-import qualified API.Calling as Calling
 import qualified API.Team as Team
 import qualified API.User as User
 import Bilge hiding (header)

From a7820b54d26a9aa5e81f99bcab99a041e2610657 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Wed, 29 Jul 2020 09:19:22 +0200
Subject: [PATCH 15/48] Remove dependency on polysemy-plugin so we can compile
 on alpine

The plugin is not really required at the point anyway.
---
 services/brig/brig.cabal   | 8 +++-----
 services/brig/package.yaml | 5 -----
 stack.yaml                 | 1 -
 stack.yaml.lock            | 7 -------
 4 files changed, 3 insertions(+), 18 deletions(-)

diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal
index 826dd0bf099..e7a40b133a2 100644
--- a/services/brig/brig.cabal
+++ b/services/brig/brig.cabal
@@ -4,7 +4,7 @@ cabal-version: 2.0
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 7791287309106815961c909f52ba63652c036239415e412ce1edc5c025614994
+-- hash: 8e2e09c1b88f68da089efdd2db9f705a1fcad7e4365bf4ca44bdc488b7186edb
 
 name:           brig
 version:        1.35.0
@@ -103,7 +103,7 @@ library
   hs-source-dirs:
       src
   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 -funbox-strict-fields -fplugin=Polysemy.Plugin
+  ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path -funbox-strict-fields
   build-depends:
       HaskellNet >=0.3
     , HaskellNet-SSL >=0.3
@@ -175,7 +175,6 @@ library
     , optparse-applicative >=0.11
     , pem >=0.2
     , polysemy
-    , polysemy-plugin
     , prometheus-client
     , proto-lens >=0.1
     , random-shuffle >=0.0.3
@@ -472,7 +471,7 @@ test-suite brig-tests
   hs-source-dirs:
       test/unit
   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 -funbox-strict-fields -threaded -with-rtsopts=-N -fplugin=Polysemy.Plugin
+  ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path -funbox-strict-fields -threaded -with-rtsopts=-N
   build-depends:
       aeson
     , base
@@ -483,7 +482,6 @@ test-suite brig-tests
     , dns-util
     , imports
     , polysemy
-    , polysemy-plugin
     , retry
     , tasty
     , tasty-hunit
diff --git a/services/brig/package.yaml b/services/brig/package.yaml
index fa53ee3f12b..7b583b7201c 100644
--- a/services/brig/package.yaml
+++ b/services/brig/package.yaml
@@ -12,8 +12,6 @@ ghc-options:
 - -funbox-strict-fields
 library:
   source-dirs: src
-  ghc-options:
-  - -fplugin=Polysemy.Plugin
   dependencies:
   - aeson >=0.11
   - amazonka >=1.3.7
@@ -85,7 +83,6 @@ library:
   - optparse-applicative >=0.11
   - pem >=0.2
   - polysemy
-  - polysemy-plugin
   - proto-lens >=0.1
   - prometheus-client
   - resourcet >=1.1
@@ -163,7 +160,6 @@ tests:
     ghc-options:
     - -threaded
     - -with-rtsopts=-N
-    - -fplugin=Polysemy.Plugin
     dependencies:
     - aeson
     - base
@@ -173,7 +169,6 @@ tests:
     - dns
     - dns-util
     - polysemy
-    - polysemy-plugin
     - imports
     - retry
     - tasty
diff --git a/stack.yaml b/stack.yaml
index cb4969d0e19..85d9040a1b8 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -173,7 +173,6 @@ extra-deps:
 
 # Newer than the one one stackage
 - polysemy-1.3.0.0
-- polysemy-plugin-0.2.5.0
 
 ############################################################
 # Development tools
diff --git a/stack.yaml.lock b/stack.yaml.lock
index 20f7b220cf7..17bbcfc454a 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -505,13 +505,6 @@ packages:
       sha256: 3d2fb15ddda9053f6bfd4b0810a79a9542505acb5e7e528856ec3cd86d6df066
   original:
     hackage: polysemy-1.3.0.0
-- completed:
-    hackage: polysemy-plugin-0.2.5.0@sha256:67e30be568a141b852aace1a60e180cb5060fbb2835365a81a3ea779536d6d35,2952
-    pantry-tree:
-      size: 1232
-      sha256: 5c90dac2eba48b4e337b302347c233ecaedb63e333641e094e718a548ac86711
-  original:
-    hackage: polysemy-plugin-0.2.5.0
 - completed:
     hackage: ormolu-0.0.5.0@sha256:e5f49c51c6ebd8b3cd16113e585312de7315c1e1561fbb599988cebc61c14f4e,7956
     pantry-tree:

From 6fcb23f6b3a59193d2588ddf915a531b0b7b1ee4 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Wed, 29 Jul 2020 10:03:21 +0200
Subject: [PATCH 16/48] Add unit test for SrvTarget -> SFTServer conversion

---
 services/brig/brig.cabal                      |  6 ++-
 services/brig/package.yaml                    |  2 +
 services/brig/src/Brig/Calling/API.hs         | 23 ++-------
 services/brig/src/Brig/Calling/Internal.hs    | 41 ++++++++++++++++
 services/brig/test/unit/Main.hs               |  4 +-
 services/brig/test/unit/Test/Brig/Calling.hs  |  3 +-
 .../test/unit/Test/Brig/Calling/Internal.hs   | 48 +++++++++++++++++++
 7 files changed, 103 insertions(+), 24 deletions(-)
 create mode 100644 services/brig/src/Brig/Calling/Internal.hs
 create mode 100644 services/brig/test/unit/Test/Brig/Calling/Internal.hs

diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal
index e7a40b133a2..f0377d6543c 100644
--- a/services/brig/brig.cabal
+++ b/services/brig/brig.cabal
@@ -4,7 +4,7 @@ cabal-version: 2.0
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 8e2e09c1b88f68da089efdd2db9f705a1fcad7e4365bf4ca44bdc488b7186edb
+-- hash: 96200db468bfe0719ac1316ddc3667540214310c093f5a1fa30776c32d6dba11
 
 name:           brig
 version:        1.35.0
@@ -38,6 +38,7 @@ library
       Brig.Budget
       Brig.Calling
       Brig.Calling.API
+      Brig.Calling.Internal
       Brig.Code
       Brig.Data.Activation
       Brig.Data.Blacklist
@@ -466,6 +467,7 @@ test-suite brig-tests
   main-is: Main.hs
   other-modules:
       Test.Brig.Calling
+      Test.Brig.Calling.Internal
       Test.Brig.User.Search.Index.Types
       Paths_brig
   hs-source-dirs:
@@ -487,5 +489,7 @@ test-suite brig-tests
     , tasty-hunit
     , types-common
     , unliftio
+    , uri-bytestring
     , uuid
+    , wire-api
   default-language: Haskell2010
diff --git a/services/brig/package.yaml b/services/brig/package.yaml
index 7b583b7201c..b2ebb8beb34 100644
--- a/services/brig/package.yaml
+++ b/services/brig/package.yaml
@@ -175,7 +175,9 @@ tests:
     - tasty-hunit
     - types-common
     - unliftio
+    - uri-bytestring
     - uuid
+    - wire-api
 executables:
   brig-schema:
     main: Main.hs
diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs
index ed200c8a9f8..9ea5fdb12fe 100644
--- a/services/brig/src/Brig/Calling/API.hs
+++ b/services/brig/src/Brig/Calling/API.hs
@@ -24,17 +24,17 @@ import Brig.API.Handler
 import Brig.App
 import Brig.Calling
 import qualified Brig.Calling as Calling
+import Brig.Calling.Internal
 import Control.Lens
 import Control.Monad.Fail (MonadFail)
 import Control.Monad.Random.Class
-import qualified Data.ByteString.Char8 as BS
 import Data.ByteString.Conversion (toByteString')
 import Data.ByteString.Lens
 import Data.Id
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.List1 as List1
-import Data.Misc ((<$$>), mkHttpsUrl)
+import Data.Misc ((<$$>))
 import Data.Range
 import qualified Data.Swagger.Build.Api as Doc
 import Data.Text.Ascii (AsciiBase64, encodeBase64)
@@ -49,10 +49,8 @@ import Network.Wai.Utilities.Swagger (document)
 import OpenSSL.EVP.Digest (Digest, hmacBS)
 import qualified System.Random.MWC as MWC
 import System.Random.Shuffle
-import qualified URI.ByteString as URI
-import qualified URI.ByteString.QQ as URI
 import qualified Wire.API.Call.Config as Public
-import Wire.Network.DNS.SRV (SrvTarget (..), srvTarget)
+import Wire.Network.DNS.SRV (srvTarget)
 
 routesPublic :: Routes Doc.ApiBuilder Handler ()
 routesPublic = do
@@ -151,18 +149,3 @@ newConfig env mSftEnv limit = do
       pure $ Public.turnUsername t rnd
     computeCred :: Digest -> ByteString -> Public.TurnUsername -> AsciiBase64
     computeCred dig secret = encodeBase64 . hmacBS dig secret . toByteString'
-
--- TODO: Write unit test
-sftServerFromSrvTarget :: SrvTarget -> Public.SFTServer
-sftServerFromSrvTarget (SrvTarget host port) =
-  let uriPort = URI.Port (fromIntegral port)
-      uri =
-        [URI.uri|https://|]
-          & URI.authorityL ?~ URI.Authority Nothing (URI.Host (dropTrailingDot host)) (Just uriPort)
-   in either (error "sftServerFromSrvTarget: invalid https URI") Public.sftServer (mkHttpsUrl uri)
-  where
-    dropTrailingDot :: ByteString -> ByteString
-    dropTrailingDot bs =
-      if BS.last bs == '.'
-        then BS.init bs
-        else bs
diff --git a/services/brig/src/Brig/Calling/Internal.hs b/services/brig/src/Brig/Calling/Internal.hs
new file mode 100644
index 00000000000..badcb50dacd
--- /dev/null
+++ b/services/brig/src/Brig/Calling/Internal.hs
@@ -0,0 +1,41 @@
+-- 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/>.
+
+module Brig.Calling.Internal where
+
+import Control.Lens ((?~))
+import qualified Data.ByteString.Char8 as BS
+import Data.Misc (mkHttpsUrl)
+import Imports
+import qualified URI.ByteString as URI
+import qualified URI.ByteString.QQ as URI
+import qualified Wire.API.Call.Config as Public
+import Wire.Network.DNS.SRV (SrvTarget (..))
+
+sftServerFromSrvTarget :: SrvTarget -> Public.SFTServer
+sftServerFromSrvTarget (SrvTarget host port) =
+  let uriPort = URI.Port (fromIntegral port)
+      uri =
+        [URI.uri|https://|]
+          & URI.authorityL ?~ URI.Authority Nothing (URI.Host (dropTrailingDot host)) (Just uriPort)
+   in either (error "sftServerFromSrvTarget: invalid https URI") Public.sftServer (mkHttpsUrl uri)
+  where
+    dropTrailingDot :: ByteString -> ByteString
+    dropTrailingDot bs =
+      if BS.last bs == '.'
+        then BS.init bs
+        else bs
diff --git a/services/brig/test/unit/Main.hs b/services/brig/test/unit/Main.hs
index eda70cb0068..75aa2dfddf8 100644
--- a/services/brig/test/unit/Main.hs
+++ b/services/brig/test/unit/Main.hs
@@ -22,6 +22,7 @@ where
 
 import Imports
 import qualified Test.Brig.Calling
+import qualified Test.Brig.Calling.Internal
 import qualified Test.Brig.User.Search.Index.Types
 import Test.Tasty
 
@@ -31,5 +32,6 @@ main =
     testGroup
       "Tests"
       [ Test.Brig.User.Search.Index.Types.tests,
-        Test.Brig.Calling.tests
+        Test.Brig.Calling.tests,
+        Test.Brig.Calling.Internal.tests
       ]
diff --git a/services/brig/test/unit/Test/Brig/Calling.hs b/services/brig/test/unit/Test/Brig/Calling.hs
index 8874de70c2f..b8c6fe7b64a 100644
--- a/services/brig/test/unit/Test/Brig/Calling.hs
+++ b/services/brig/test/unit/Test/Brig/Calling.hs
@@ -49,8 +49,7 @@ runFakeDNSLookup FakeDNSEnv {..} = interpret $ \case
 
 tests :: TestTree
 tests =
-  testGroup
-    "Calling"
+  testGroup "Calling" $
     [ testGroup "mkSFTDomain" $
         [ testCase "when service name is provided" $
             assertEqual
diff --git a/services/brig/test/unit/Test/Brig/Calling/Internal.hs b/services/brig/test/unit/Test/Brig/Calling/Internal.hs
new file mode 100644
index 00000000000..5289db03eb7
--- /dev/null
+++ b/services/brig/test/unit/Test/Brig/Calling/Internal.hs
@@ -0,0 +1,48 @@
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+-- 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/>.
+
+module Test.Brig.Calling.Internal where
+
+import Brig.Calling.Internal
+import Data.Misc (mkHttpsUrl)
+import Imports
+import Test.Tasty
+import Test.Tasty.HUnit
+import URI.ByteString.QQ as URI
+import Wire.API.Call.Config (sftServer)
+import Wire.Network.DNS.SRV (SrvTarget (SrvTarget))
+
+tests :: TestTree
+tests =
+  testGroup "Calling.API" $
+    [ testGroup "sftServerFromSrvTarget" $
+        [ testCase "when srvTarget ends with a dot" $ do
+            let Right expectedServer = sftServer <$> mkHttpsUrl [URI.uri|https://sft1.env.example.com:9364|]
+            assertEqual
+              "the dot should be stripped from sft server"
+              expectedServer
+              (sftServerFromSrvTarget $ SrvTarget "sft1.env.example.com." 9364),
+          testCase "when srvTarget doesn't end with a dot" $ do
+            let Right expectedServer = sftServer <$> mkHttpsUrl [URI.uri|https://sft2.env.example.com:443|]
+            assertEqual
+              "the dot should be stripped from sft server"
+              expectedServer
+              (sftServerFromSrvTarget $ SrvTarget "sft2.env.example.com" 443)
+        ]
+    ]

From 28d99718c07aa0ddc66b3f784d13563c0a41c2b9 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Wed, 29 Jul 2020 10:31:01 +0200
Subject: [PATCH 17/48] Deflake brig calling unit tests

---
 services/brig/test/unit/Test/Brig/Calling.hs | 18 ++++++++++++++++--
 1 file changed, 16 insertions(+), 2 deletions(-)

diff --git a/services/brig/test/unit/Test/Brig/Calling.hs b/services/brig/test/unit/Test/Brig/Calling.hs
index b8c6fe7b64a..e786808c62f 100644
--- a/services/brig/test/unit/Test/Brig/Calling.hs
+++ b/services/brig/test/unit/Test/Brig/Calling.hs
@@ -78,9 +78,13 @@ testDiscoveryWhenSuccessful = do
       returnedEntries = (entry1 :| [entry2, entry3])
   fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvAvailable returnedEntries)
   sftEnv <- mkSFTEnv (SFTOptions "foo.example.com" Nothing)
+
   discoveryLoop <- Async.async $ runM . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
   void $ retryEveryMillisecondWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
+  -- We don't want to stop the loop before it has written to the sftServers IORef
+  void $ retryEveryMillisecondWhileN 2000 (isNothing) (readIORef (sftServers sftEnv))
   Async.cancel discoveryLoop
+
   actualServers <- readIORef (sftServers sftEnv)
   assertEqual "servers should be the ones read from DNS" (Just returnedEntries) actualServers
   pure sftEnv
@@ -89,9 +93,13 @@ testDiscoveryWhenUnsuccessful :: IO ()
 testDiscoveryWhenUnsuccessful = do
   fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvNotAvailable)
   sftEnv <- mkSFTEnv (SFTOptions "foo.example.com" Nothing)
+
   discoveryLoop <- Async.async $ runM . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
-  void $ retryEveryMillisecondWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
+  -- We wait for at least two lookups to be sure that the lookup loop looped at
+  -- least once
+  void $ retryEveryMillisecondWhileN 2000 (<= 1) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
   Async.cancel discoveryLoop
+
   actualServers <- readIORef (sftServers sftEnv)
   assertEqual "servers should be the ones read from DNS" Nothing actualServers
 
@@ -104,8 +112,11 @@ testDiscoveryWhenUnsuccessfulAfterSuccess = do
   -- replicate what will happen when a dns lookup fails after success
   failingFakeDNSEnv <- newFakeDNSEnv (\_ -> SrvNotAvailable)
   discoveryLoop <- Async.async $ runM . runFakeDNSLookup failingFakeDNSEnv $ sftDiscoveryLoop sftEnv
-  void $ retryEveryMillisecondWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls failingFakeDNSEnv))
+  -- We wait for at least two lookups to be sure that the lookup loop looped at
+  -- least once
+  void $ retryEveryMillisecondWhileN 2000 (<= 1) (length <$> readIORef (fakeLookupCalls failingFakeDNSEnv))
   Async.cancel discoveryLoop
+
   actualServers <- readIORef (sftServers sftEnv)
   assertEqual "servers shouldn't get overwriten" previousEntries actualServers
 
@@ -122,7 +133,10 @@ testDiscoveryWhenURLsChange = do
   fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvAvailable newEntries)
   discoveryLoop <- Async.async $ runM . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
   void $ retryEveryMillisecondWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
+  -- We don't want to stop the loop before it has written to the sftServers IORef
+  void $ retryEveryMillisecondWhileN 2000 (== Just newEntries) (readIORef (sftServers sftEnv))
   Async.cancel discoveryLoop
+
   actualServers <- readIORef (sftServers sftEnv)
   assertEqual "servers should get overwritten" (Just newEntries) actualServers
 

From 05145d17fc29b7a0633a30c534052d8470ed55ca Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Wed, 29 Jul 2020 11:12:53 +0200
Subject: [PATCH 18/48] Make SFT discovery interval configurable

Side benefit: faster tests \o/
---
 services/brig/src/Brig/Calling.hs            | 29 +++++++++++++++-----
 services/brig/src/Brig/Options.hs            |  7 +++--
 services/brig/test/unit/Test/Brig/Calling.hs | 26 +++++++++---------
 3 files changed, 40 insertions(+), 22 deletions(-)

diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs
index f80e416a2f4..ba9e87db8ff 100644
--- a/services/brig/src/Brig/Calling.hs
+++ b/services/brig/src/Brig/Calling.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE RecordWildCards #-}
+
 -- This file is part of the Wire Server implementation.
 --
 -- Copyright (C) 2020 Wire Swiss GmbH <opensource@wire.com>
@@ -18,10 +20,12 @@
 module Brig.Calling where
 
 import Brig.Options (SFTOptions (..))
+import qualified Brig.Options as Opts
 import Brig.Types (TurnURI)
 import Control.Lens
 import Data.List.NonEmpty
 import Data.List1
+import Data.Time.Clock (DiffTime, diffTimeToPicoseconds)
 import Imports
 import qualified Network.DNS as DNS
 import OpenSSL.EVP.Digest (Digest)
@@ -32,7 +36,9 @@ import Wire.Network.DNS.SRV
 
 data SFTEnv = SFTEnv
   { sftServers :: IORef (Maybe (NonEmpty SrvEntry)),
-    sftDomain :: DNS.Domain
+    sftDomain :: DNS.Domain,
+    -- | Microseconds, as expected by 'threadDelay'
+    sftDiscoveryInterval :: Int
   }
 
 -- TODO: Log stuff here (and test it?)
@@ -44,29 +50,38 @@ discoverSFTServers domain =
     SrvResponseError _ -> pure Nothing
 
 mkSFTDomain :: SFTOptions -> DNS.Domain
-mkSFTDomain (SFTOptions base maybeSrv) = DNS.normalize $ maybe "_sft" ("_" <>) maybeSrv <> "._tcp." <> base
+mkSFTDomain SFTOptions {..} = DNS.normalize $ maybe "_sft" ("_" <>) sftSRVServiceName <> "._tcp." <> sftBaseDomain
 
 -- TODO: How can I remove the Embed IO? Even if I cannot, this is better than
 -- just IO () as I can still mock DNSLookup
 sftDiscoveryLoop :: Members [DNSLookup, Embed IO] r => SFTEnv -> Sem r ()
-sftDiscoveryLoop (SFTEnv serversRef domain) = forever $ do
-  servers <- discoverSFTServers domain
+sftDiscoveryLoop SFTEnv {..} = forever $ do
+  servers <- discoverSFTServers sftDomain
   case servers of
     Nothing -> pure ()
-    es -> atomicWriteIORef serversRef es
-  -- TODO: What should this number be? Use Control.Retry?
-  threadDelay 1000000
+    es -> atomicWriteIORef sftServers es
+  threadDelay sftDiscoveryInterval
 
 mkSFTEnv :: SFTOptions -> IO SFTEnv
 mkSFTEnv opts =
   SFTEnv
     <$> newIORef Nothing
     <*> pure (mkSFTDomain opts)
+    <*> pure (maybe defaultDiscoveryInterval diffTimeToMicroseconds (Opts.sftDiscoveryIntervalSeconds opts))
+
+-- | 10 seconds
+defaultDiscoveryInterval :: Int
+defaultDiscoveryInterval = 10000000
 
 startSFTServiceDiscovery :: SFTEnv -> IO ()
 startSFTServiceDiscovery =
   runM . runDNSLookupDefault . sftDiscoveryLoop
 
+-- | >>> diffTimeToMicroseconds 1
+-- 1000000
+diffTimeToMicroseconds :: DiffTime -> Int
+diffTimeToMicroseconds = fromIntegral . (`quot` 1000000) . diffTimeToPicoseconds
+
 -- TURN specific
 
 data Env = Env
diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs
index 6d31f18a12e..c02db992528 100644
--- a/services/brig/src/Brig/Options.hs
+++ b/services/brig/src/Brig/Options.hs
@@ -33,10 +33,11 @@ import Data.Aeson.Types (typeMismatch)
 import qualified Data.Char as Char
 import Data.Domain (Domain)
 import Data.Id
+import Data.Misc ((<$$>))
 import Data.Scientific (toBoundedInteger)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
-import Data.Time.Clock (NominalDiffTime)
+import Data.Time.Clock (DiffTime, NominalDiffTime, secondsToDiffTime)
 import Data.Yaml ((.:), (.:?), FromJSON (..), ToJSON (..))
 import qualified Data.Yaml as Y
 import Imports
@@ -525,7 +526,8 @@ newtype DomainsBlockedForRegistration = DomainsBlockedForRegistration [Domain]
 
 data SFTOptions = SFTOptions
   { sftBaseDomain :: !DNS.Domain,
-    sftSRVServiceName :: !(Maybe ByteString)
+    sftSRVServiceName :: !(Maybe ByteString),
+    sftDiscoveryIntervalSeconds :: !(Maybe DiffTime)
   }
   deriving (Show, Generic)
 
@@ -534,6 +536,7 @@ instance FromJSON SFTOptions where
     SFTOptions
       <$> (asciiOnly =<< o .: "sftBaseDomain")
       <*> (mapM asciiOnly =<< o .:? "sftSRVServiceName")
+      <*> (secondsToDiffTime <$$> o .:? "sftDiscoveryIntervalSeconds")
     where
       asciiOnly :: Text -> Y.Parser ByteString
       asciiOnly t =
diff --git a/services/brig/test/unit/Test/Brig/Calling.hs b/services/brig/test/unit/Test/Brig/Calling.hs
index e786808c62f..1f1e6e1868f 100644
--- a/services/brig/test/unit/Test/Brig/Calling.hs
+++ b/services/brig/test/unit/Test/Brig/Calling.hs
@@ -55,12 +55,12 @@ tests =
             assertEqual
               "should use the service name to form domain"
               "_foo._tcp.example.com."
-              (mkSFTDomain (SFTOptions "example.com" (Just "foo"))),
+              (mkSFTDomain (SFTOptions "example.com" (Just "foo") Nothing)),
           testCase "when service name is not provided" $
             assertEqual
               "should assume service name to be 'sft'"
               "_sft._tcp.example.com."
-              (mkSFTDomain (SFTOptions "example.com" Nothing))
+              (mkSFTDomain (SFTOptions "example.com" Nothing Nothing))
         ],
       testGroup "sftDiscoveryLoop" $
         [ testCase "when service can be discovered" $ void testDiscoveryWhenSuccessful,
@@ -77,12 +77,12 @@ testDiscoveryWhenSuccessful = do
       entry3 = SrvEntry 0 0 (SrvTarget "sft3.foo.example.com." 443)
       returnedEntries = (entry1 :| [entry2, entry3])
   fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvAvailable returnedEntries)
-  sftEnv <- mkSFTEnv (SFTOptions "foo.example.com" Nothing)
+  sftEnv <- mkSFTEnv (SFTOptions "foo.example.com" Nothing (Just 0.001))
 
   discoveryLoop <- Async.async $ runM . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
-  void $ retryEveryMillisecondWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
+  void $ retryEvery10MicrosWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
   -- We don't want to stop the loop before it has written to the sftServers IORef
-  void $ retryEveryMillisecondWhileN 2000 (isNothing) (readIORef (sftServers sftEnv))
+  void $ retryEvery10MicrosWhileN 2000 (isNothing) (readIORef (sftServers sftEnv))
   Async.cancel discoveryLoop
 
   actualServers <- readIORef (sftServers sftEnv)
@@ -92,12 +92,12 @@ testDiscoveryWhenSuccessful = do
 testDiscoveryWhenUnsuccessful :: IO ()
 testDiscoveryWhenUnsuccessful = do
   fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvNotAvailable)
-  sftEnv <- mkSFTEnv (SFTOptions "foo.example.com" Nothing)
+  sftEnv <- mkSFTEnv (SFTOptions "foo.example.com" Nothing (Just 0.001))
 
   discoveryLoop <- Async.async $ runM . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
   -- We wait for at least two lookups to be sure that the lookup loop looped at
   -- least once
-  void $ retryEveryMillisecondWhileN 2000 (<= 1) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
+  void $ retryEvery10MicrosWhileN 2000 (<= 1) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
   Async.cancel discoveryLoop
 
   actualServers <- readIORef (sftServers sftEnv)
@@ -114,7 +114,7 @@ testDiscoveryWhenUnsuccessfulAfterSuccess = do
   discoveryLoop <- Async.async $ runM . runFakeDNSLookup failingFakeDNSEnv $ sftDiscoveryLoop sftEnv
   -- We wait for at least two lookups to be sure that the lookup loop looped at
   -- least once
-  void $ retryEveryMillisecondWhileN 2000 (<= 1) (length <$> readIORef (fakeLookupCalls failingFakeDNSEnv))
+  void $ retryEvery10MicrosWhileN 2000 (<= 1) (length <$> readIORef (fakeLookupCalls failingFakeDNSEnv))
   Async.cancel discoveryLoop
 
   actualServers <- readIORef (sftServers sftEnv)
@@ -132,17 +132,17 @@ testDiscoveryWhenURLsChange = do
 
   fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvAvailable newEntries)
   discoveryLoop <- Async.async $ runM . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
-  void $ retryEveryMillisecondWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
+  void $ retryEvery10MicrosWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
   -- We don't want to stop the loop before it has written to the sftServers IORef
-  void $ retryEveryMillisecondWhileN 2000 (== Just newEntries) (readIORef (sftServers sftEnv))
+  void $ retryEvery10MicrosWhileN 2000 (== Just newEntries) (readIORef (sftServers sftEnv))
   Async.cancel discoveryLoop
 
   actualServers <- readIORef (sftServers sftEnv)
   assertEqual "servers should get overwritten" (Just newEntries) actualServers
 
-retryEveryMillisecondWhileN :: (MonadIO m) => Int -> (a -> Bool) -> m a -> m a
-retryEveryMillisecondWhileN n f m =
+retryEvery10MicrosWhileN :: (MonadIO m) => Int -> (a -> Bool) -> m a -> m a
+retryEvery10MicrosWhileN n f m =
   retrying
-    (constantDelay 1000 <> limitRetries n)
+    (constantDelay 10 <> limitRetries n)
     (const (return . f))
     (const m)

From 46df70e07e8e53b676c7b69ccc055f40a08e92d5 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Wed, 29 Jul 2020 11:37:12 +0200
Subject: [PATCH 19/48] Fix brig's API.Calling integration test

- Set discovery interval for sft
- Use retryWhileN correctly by looping while discovery is not done
- Do not assert on the order of servers as it doesn't seem to be stable
---
 libs/types-common/src/Data/Misc.hs            |  2 +-
 libs/wire-api/src/Wire/API/Call/Config.hs     |  2 +-
 services/brig/test/integration/API/Calling.hs | 11 ++++++-----
 3 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/libs/types-common/src/Data/Misc.hs b/libs/types-common/src/Data/Misc.hs
index b2fe9456421..019e3395f03 100644
--- a/libs/types-common/src/Data/Misc.hs
+++ b/libs/types-common/src/Data/Misc.hs
@@ -236,7 +236,7 @@ instance Cql Milliseconds where
 newtype HttpsUrl = HttpsUrl
   { httpsUrl :: URIRef Absolute
   }
-  deriving stock (Eq, Generic)
+  deriving stock (Eq, Ord, Generic)
 
 mkHttpsUrl :: URIRef Absolute -> Either String HttpsUrl
 mkHttpsUrl uri =
diff --git a/libs/wire-api/src/Wire/API/Call/Config.hs b/libs/wire-api/src/Wire/API/Call/Config.hs
index 21e361df45a..018b90620c0 100644
--- a/libs/wire-api/src/Wire/API/Call/Config.hs
+++ b/libs/wire-api/src/Wire/API/Call/Config.hs
@@ -141,7 +141,7 @@ instance FromJSON RTCConfiguration where
 newtype SFTServer = SFTServer
   { _sftURL :: HttpsUrl
   }
-  deriving stock (Eq, Show, Generic)
+  deriving stock (Eq, Show, Ord, Generic)
   deriving (Arbitrary) via (GenericUniform SFTServer) --TODO is this correct?
 
 instance ToJSON SFTServer where
diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs
index 8fee17ed692..c6028b6c3c7 100644
--- a/services/brig/test/integration/API/Calling.hs
+++ b/services/brig/test/integration/API/Calling.hs
@@ -29,10 +29,11 @@ import Data.ByteString.Conversion
 import qualified Data.ByteString.Lazy as LB
 import Data.Id
 import Data.List ((\\))
-import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NonEmpty
 import Data.List1 (List1)
 import qualified Data.List1 as List1
 import Data.Misc (Port, mkHttpsUrl)
+import qualified Data.Set as Set
 import Imports
 import Network.HTTP.Client (Manager)
 import System.FilePath ((</>))
@@ -92,15 +93,15 @@ testSFT b opts = do
       "when SFT discovery is not enabled, sft_servers shouldn't be returned"
       Nothing
       (cfg ^. rtcConfSftServers)
-  withSettingsOverrides (opts & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing) $ do
-    cfg1 <- retryWhileN 10 (isJust . view rtcConfSftServers) (getTurnConfigurationV2 uid b)
+  withSettingsOverrides (opts & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing (Just 0.001)) $ do
+    cfg1 <- retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationV2 uid b)
     let Right server1 = mkHttpsUrl [uri|https://sft01.integration-tests.zinfra.io:443|]
     let Right server2 = mkHttpsUrl [uri|https://sft02.integration-tests.zinfra.io:8443|]
     liftIO $
       assertEqual
         "when SFT discovery is enabled, sft_servers should be returned"
-        (Just (sftServer server1 :| [sftServer server2]))
-        (cfg1 ^. rtcConfSftServers)
+        (Set.fromList [sftServer server1, sftServer server2])
+        (Set.fromList $ maybe [] NonEmpty.toList $ cfg1 ^. rtcConfSftServers)
 
 modifyAndAssert ::
   Brig ->

From 1b1a85fcbda2fc7a731fdf88f6e310ff0e51210c Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Wed, 29 Jul 2020 11:44:14 +0200
Subject: [PATCH 20/48] Give up on avoiding Embed IO for threadDelay

We can create another effect for this and make the tests faster (and
deterministic), but later.
---
 services/brig/src/Brig/Calling.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs
index ba9e87db8ff..0f589cdbbed 100644
--- a/services/brig/src/Brig/Calling.hs
+++ b/services/brig/src/Brig/Calling.hs
@@ -52,8 +52,8 @@ discoverSFTServers domain =
 mkSFTDomain :: SFTOptions -> DNS.Domain
 mkSFTDomain SFTOptions {..} = DNS.normalize $ maybe "_sft" ("_" <>) sftSRVServiceName <> "._tcp." <> sftBaseDomain
 
--- TODO: How can I remove the Embed IO? Even if I cannot, this is better than
--- just IO () as I can still mock DNSLookup
+-- FUTUREWORK: Remove Embed IO from here and put threadDelay into another
+-- effect. This will also make tests for this faster and deterministic
 sftDiscoveryLoop :: Members [DNSLookup, Embed IO] r => SFTEnv -> Sem r ()
 sftDiscoveryLoop SFTEnv {..} = forever $ do
   servers <- discoverSFTServers sftDomain

From b51205f099f98217d8d3314ea41ee037534a29f8 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Wed, 29 Jul 2020 12:18:40 +0200
Subject: [PATCH 21/48] Add comment to explain integration-test dns names

---
 services/brig/test/integration/API/Calling.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs
index c6028b6c3c7..dec20a9982c 100644
--- a/services/brig/test/integration/API/Calling.hs
+++ b/services/brig/test/integration/API/Calling.hs
@@ -95,6 +95,7 @@ testSFT b opts = do
       (cfg ^. rtcConfSftServers)
   withSettingsOverrides (opts & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing (Just 0.001)) $ do
     cfg1 <- retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationV2 uid b)
+    -- These values are controlled by https://github.com/zinfra/cailleach/tree/77ca2d23cf2959aa183dd945d0a0b13537a8950d/environments/dns-integration-tests
     let Right server1 = mkHttpsUrl [uri|https://sft01.integration-tests.zinfra.io:443|]
     let Right server2 = mkHttpsUrl [uri|https://sft02.integration-tests.zinfra.io:8443|]
     liftIO $

From a4e51da13f9f946472d471d70287ed367325e3f2 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Wed, 29 Jul 2020 12:28:33 +0200
Subject: [PATCH 22/48] WIP: Move orderSrvEntry to dns-util

---
 libs/dns-util/src/Wire/Network/DNS/SRV.hs     | 47 ++++++++++++-
 .../test/Test/Wire/Network/DNS/SRVSpec.hs     | 70 ++++++++++++++-----
 2 files changed, 98 insertions(+), 19 deletions(-)

diff --git a/libs/dns-util/src/Wire/Network/DNS/SRV.hs b/libs/dns-util/src/Wire/Network/DNS/SRV.hs
index b20ea43659f..e92613d6b30 100644
--- a/libs/dns-util/src/Wire/Network/DNS/SRV.hs
+++ b/libs/dns-util/src/Wire/Network/DNS/SRV.hs
@@ -48,6 +48,49 @@ interpretResponse = \case
   Right [] -> SrvNotAvailable
   Right [(_, _, _, ".")] -> SrvNotAvailable -- According to RFC2782
   Right (r : rs) -> SrvAvailable $ fmap toSrvEntry (r :| rs)
+
+toSrvEntry :: (Word16, Word16, Word16, Domain) -> SrvEntry
+toSrvEntry (prio, weight, port, domain) = SrvEntry prio weight (SrvTarget domain port)
+
+-- FUTUREWORK: maybe improve sorting algorithm here? (with respect to performance and code style)
+--
+-- This function orders the SRV result in accordance with RFC
+-- 2782. It sorts the SRV results in order of priority, and then
+-- uses a random process to order the records with the same
+-- priority based on their weight.
+--
+-- Taken from http://hackage.haskell.org/package/pontarius-xmpp (BSD3 licence) and refactored.
+orderSrvResult :: [SrvEntry] -> IO [SrvEntry]
+orderSrvResult =
+  -- Order the result set by priority.
+  sortBy (comparing srvPriority)
+    -- Group elements in sublists based on their priority.
+    -- The result type is `[[(Word16, Word16, Word16, Domain)]]' (nested list).
+    >>> groupBy ((==) `on` srvPriority)
+    -- For each sublist, put records with a weight of zero first.
+    >>> map (uncurry (++) . partition ((== 0) . srvWeight))
+    -- Order each sublist.
+    >>> mapM orderSublist
+    -- Concatenate the results.
+    >>> fmap concat
   where
-    toSrvEntry :: (Word16, Word16, Word16, Domain) -> SrvEntry
-    toSrvEntry (prio, weight, port, domain) = SrvEntry prio weight (SrvTarget domain port)
+    orderSublist :: [SrvEntry] -> IO [SrvEntry]
+    orderSublist [] = return []
+    orderSublist sublist = do
+      -- Compute the running sum, as well as the total sum of the sublist.
+      -- Add the running sum to the SRV tuples.
+      let (total, sublistWithRunning) =
+            mapAccumL (\acc srv -> let acc' = acc + srvWeight srv in (acc', (srv, acc'))) 0 sublist
+      -- Choose a random number between 0 and the total sum (inclusive).
+      randomNumber <- randomRIO (0, total)
+      -- Select the first record with its running sum greater
+      -- than or equal to the random number.
+      let (beginning, (firstSrv, _), end) =
+            case break (\(_, running) -> randomNumber <= running) sublistWithRunning of
+              (b, (c : e)) -> (b, c, e)
+              _ -> error "orderSrvResult: no record with running sum greater than random number"
+      -- Remove the running total number from the remaining elements.
+      let remainingSrvs = map (\(srv, _) -> srv) (concat [beginning, end])
+      -- Repeat the ordering procedure on the remaining elements.
+      rest <- orderSublist remainingSrvs
+      return $ firstSrv : rest
diff --git a/libs/dns-util/test/Test/Wire/Network/DNS/SRVSpec.hs b/libs/dns-util/test/Test/Wire/Network/DNS/SRVSpec.hs
index 9de3190ccb3..c752c7c249f 100644
--- a/libs/dns-util/test/Test/Wire/Network/DNS/SRVSpec.hs
+++ b/libs/dns-util/test/Test/Wire/Network/DNS/SRVSpec.hs
@@ -24,24 +24,60 @@ import Test.Hspec
 import Wire.Network.DNS.SRV
 
 spec :: Spec
-spec = describe "interpretResponse" $ do
-  it "should interpret error correctly" $
-    interpretResponse (Left DNS.UnknownDNSError) `shouldBe` SrvResponseError DNS.UnknownDNSError
+spec = do
+  describe "interpretResponse" $ do
+    it "should interpret error correctly" $
+      interpretResponse (Left DNS.UnknownDNSError) `shouldBe` SrvResponseError DNS.UnknownDNSError
 
-  it "should interpret empty response as SrvNotAvailable" $
-    interpretResponse (Right []) `shouldBe` SrvNotAvailable
+    it "should interpret empty response as SrvNotAvailable" $
+      interpretResponse (Right []) `shouldBe` SrvNotAvailable
 
-  it "should interpret explicitly not available response as SrvNotAvailable" $
-    interpretResponse (Right [(0, 0, 0, ".")]) `shouldBe` SrvNotAvailable
+    it "should interpret explicitly not available response as SrvNotAvailable" $
+      interpretResponse (Right [(0, 0, 0, ".")]) `shouldBe` SrvNotAvailable
 
-  it "should interpret an available service correctly" $ do
-    let input =
-          [ (0, 1, 443, "service01.example.com."),
-            (10, 20, 8443, "service02.example.com.")
+    it "should interpret an available service correctly" $ do
+      let input =
+            [ (0, 1, 443, "service01.example.com."),
+              (10, 20, 8443, "service02.example.com.")
+            ]
+      let expectedOutput =
+            SrvAvailable
+              ( SrvEntry 0 1 (SrvTarget "service01.example.com." 443)
+                  :| [SrvEntry 10 20 (SrvTarget "service02.example.com." 8443)]
+              )
+      interpretResponse (Right input) `shouldBe` expectedOutput
+  describe "orderSrvResult" $ do
+    it "orders records according to ascending priority" $ do
+      actual <-
+        orderSrvResult . map toSrvEntry $
+          [ -- priority, weight, port, domain
+            (0, 0, 443, "offline.com"),
+            (15, 10, 443, "main.com"),
+            (0, 5, 443, "backup.com"),
+            (2, 10, 443, "main.com"),
+            (2, 20, 443, "main.com"),
+            (3, 5, 443, "main.com"),
+            (0, 0, 443, "backup.com")
           ]
-    let expectedOutput =
-          SrvAvailable
-            ( SrvEntry 0 1 (SrvTarget "service01.example.com." 443)
-                :| [SrvEntry 10 20 (SrvTarget "service02.example.com." 8443)]
-            )
-    interpretResponse (Right input) `shouldBe` expectedOutput
+      (srvPriority <$> actual) `shouldBe` [0, 0, 0, 2, 2, 3, 15]
+    it "orders records with the same priority according to weight with certain probability" $ do
+      let raw =
+            map toSrvEntry $
+              [ (2, 10, 443, "server1.com"),
+                (2, 20, 443, "server2.com"),
+                (2, 0, 443, "dontuseoften.com")
+              ]
+      -- order the list 50 times
+      actuals <- replicateM 50 (orderSrvResult raw)
+      let weightLists = fmap (fmap srvWeight) actuals
+      let x = filter ((== 20) . head) weightLists
+      let y = filter ((== 10) . head) weightLists
+      -- we may have e.g.
+      -- the server with weight 20 first in the list 30 times,
+      -- the server with weight 10 15 times
+      -- and the server with weight 0 5 times.
+      -- We only check that there is *some* distribution
+      length x `shouldSatisfy` (> 0)
+      length x `shouldSatisfy` (< 49)
+      length y `shouldSatisfy` (> 0)
+      length y `shouldSatisfy` (< 49)

From f4d528285d40b746b8dac5361e3c50aaaa40a35b Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Wed, 29 Jul 2020 12:58:57 +0200
Subject: [PATCH 23/48] finish copying to dns-util

---
 libs/dns-util/src/Wire/Network/DNS/Effect.hs  |  1 +
 libs/dns-util/src/Wire/Network/DNS/SRV.hs     | 48 +++++++++++++++++--
 .../test/Test/Wire/Network/DNS/SRVSpec.hs     |  2 +-
 3 files changed, 47 insertions(+), 4 deletions(-)

diff --git a/libs/dns-util/src/Wire/Network/DNS/Effect.hs b/libs/dns-util/src/Wire/Network/DNS/Effect.hs
index 79611b42e9c..ff3e50bae57 100644
--- a/libs/dns-util/src/Wire/Network/DNS/Effect.hs
+++ b/libs/dns-util/src/Wire/Network/DNS/Effect.hs
@@ -36,6 +36,7 @@ runDNSLookupDefault =
       case l of
         LookupSRV domain -> interpretResponse <$> DNS.lookupSRV resolver domain
 
+-- TODO: remove comment?
 -- class Monad m => MonadDNSLookup m where
 --   monadLookupSRV :: Domain -> m SrvResponse
 -- I don't know how to make this choice at runtime
diff --git a/libs/dns-util/src/Wire/Network/DNS/SRV.hs b/libs/dns-util/src/Wire/Network/DNS/SRV.hs
index e92613d6b30..27105010929 100644
--- a/libs/dns-util/src/Wire/Network/DNS/SRV.hs
+++ b/libs/dns-util/src/Wire/Network/DNS/SRV.hs
@@ -15,11 +15,53 @@
 -- 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/>.
 
+-- Parts of this code, namely functions interpretResponse and orderSrvResult,
+-- which were taken from http://hackage.haskell.org/package/pontarius-xmpp
+-- are also licensed under the three-clause BSD license:
+--
+-- Copyright © 2005-2011 Dmitry Astapov
+-- Copyright © 2005-2011 Pierre Kovalev
+-- Copyright © 2010-2011 Mahdi Abdinejadi
+-- Copyright © 2010-2013 Jon Kristensen
+-- Copyright © 2011      IETF Trust
+-- Copyright © 2012-2013 Philipp Balzarek
+--
+-- All rights reserved.
+--
+-- Pontarius XMPP is licensed under the three-clause BSD license.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are met:
+--
+-- - Redistributions of source code must retain the above copyright notice, this
+--   list of conditions and the following disclaimer.
+--
+-- - Redistributions in binary form must reproduce the above copyright notice,
+--   this list of conditions and the following disclaimer in the documentation
+--   and/or other materials provided with the distribution.
+--
+-- - Neither the name of the Pontarius project nor the names of its contributors
+--   may be used to endorse or promote products derived from this software without
+--   specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+-- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR THE PONTARIUS PROJECT BE
+-- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+-- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+-- GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
+-- OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
 module Wire.Network.DNS.SRV where
 
-import Data.List.NonEmpty
+import Control.Category ((>>>))
+import Data.List.NonEmpty (NonEmpty (..))
 import Imports
 import Network.DNS (DNSError, Domain)
+import System.Random (randomRIO)
 
 data SrvEntry = SrvEntry
   { srvPriority :: !Word16,
@@ -63,7 +105,7 @@ toSrvEntry (prio, weight, port, domain) = SrvEntry prio weight (SrvTarget domain
 orderSrvResult :: [SrvEntry] -> IO [SrvEntry]
 orderSrvResult =
   -- Order the result set by priority.
-  sortBy (comparing srvPriority)
+  sortOn srvPriority
     -- Group elements in sublists based on their priority.
     -- The result type is `[[(Word16, Word16, Word16, Domain)]]' (nested list).
     >>> groupBy ((==) `on` srvPriority)
@@ -90,7 +132,7 @@ orderSrvResult =
               (b, (c : e)) -> (b, c, e)
               _ -> error "orderSrvResult: no record with running sum greater than random number"
       -- Remove the running total number from the remaining elements.
-      let remainingSrvs = map (\(srv, _) -> srv) (concat [beginning, end])
+      let remainingSrvs = map fst (concat [beginning, end])
       -- Repeat the ordering procedure on the remaining elements.
       rest <- orderSublist remainingSrvs
       return $ firstSrv : rest
diff --git a/libs/dns-util/test/Test/Wire/Network/DNS/SRVSpec.hs b/libs/dns-util/test/Test/Wire/Network/DNS/SRVSpec.hs
index c752c7c249f..39c67a1ee2b 100644
--- a/libs/dns-util/test/Test/Wire/Network/DNS/SRVSpec.hs
+++ b/libs/dns-util/test/Test/Wire/Network/DNS/SRVSpec.hs
@@ -17,7 +17,7 @@
 
 module Test.Wire.Network.DNS.SRVSpec where
 
-import Data.List.NonEmpty
+import Data.List.NonEmpty (NonEmpty (..))
 import Imports
 import qualified Network.DNS as DNS
 import Test.Hspec

From 3327d9ffe2379c397e2a53d573e471c6499ba1a8 Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Wed, 29 Jul 2020 12:59:28 +0200
Subject: [PATCH 24/48] remove federation-util

---
 libs/federation-util/.ghcid                   |   1 -
 libs/federation-util/LICENSE                  | 661 ------------------
 libs/federation-util/federation-util.cabal    |  85 ---
 libs/federation-util/package.yaml             |  45 --
 .../src/Network/Federation/Util.hs            |  23 -
 .../src/Network/Federation/Util/DNS.hs        |  45 --
 .../src/Network/Federation/Util/Internal.hs   | 154 ----
 libs/federation-util/test/Spec.hs             |  18 -
 libs/federation-util/test/Test/DNSSpec.hs     |  87 ---
 stack.yaml                                    |   1 -
 10 files changed, 1120 deletions(-)
 delete mode 100644 libs/federation-util/.ghcid
 delete mode 100644 libs/federation-util/LICENSE
 delete mode 100644 libs/federation-util/federation-util.cabal
 delete mode 100644 libs/federation-util/package.yaml
 delete mode 100644 libs/federation-util/src/Network/Federation/Util.hs
 delete mode 100644 libs/federation-util/src/Network/Federation/Util/DNS.hs
 delete mode 100644 libs/federation-util/src/Network/Federation/Util/Internal.hs
 delete mode 100644 libs/federation-util/test/Spec.hs
 delete mode 100644 libs/federation-util/test/Test/DNSSpec.hs

diff --git a/libs/federation-util/.ghcid b/libs/federation-util/.ghcid
deleted file mode 100644
index fdd66810c9b..00000000000
--- a/libs/federation-util/.ghcid
+++ /dev/null
@@ -1 +0,0 @@
---command "stack ghci federation-util --test"
diff --git a/libs/federation-util/LICENSE b/libs/federation-util/LICENSE
deleted file mode 100644
index dba13ed2ddf..00000000000
--- a/libs/federation-util/LICENSE
+++ /dev/null
@@ -1,661 +0,0 @@
-                    GNU AFFERO GENERAL PUBLIC LICENSE
-                       Version 3, 19 November 2007
-
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
-                            Preamble
-
-  The GNU Affero General Public License is a free, copyleft license for
-software and other kinds of works, specifically designed to ensure
-cooperation with the community in the case of network server software.
-
-  The licenses for most software and other practical works are designed
-to take away your freedom to share and change the works.  By contrast,
-our General Public Licenses are intended to guarantee your freedom to
-share and change all versions of a program--to make sure it remains free
-software for all its users.
-
-  When we speak of free software, we are referring to freedom, not
-price.  Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-them if you wish), that you receive source code or can get it if you
-want it, that you can change the software or use pieces of it in new
-free programs, and that you know you can do these things.
-
-  Developers that use our General Public Licenses protect your rights
-with two steps: (1) assert copyright on the software, and (2) offer
-you this License which gives you legal permission to copy, distribute
-and/or modify the software.
-
-  A secondary benefit of defending all users' freedom is that
-improvements made in alternate versions of the program, if they
-receive widespread use, become available for other developers to
-incorporate.  Many developers of free software are heartened and
-encouraged by the resulting cooperation.  However, in the case of
-software used on network servers, this result may fail to come about.
-The GNU General Public License permits making a modified version and
-letting the public access it on a server without ever releasing its
-source code to the public.
-
-  The GNU Affero General Public License is designed specifically to
-ensure that, in such cases, the modified source code becomes available
-to the community.  It requires the operator of a network server to
-provide the source code of the modified version running there to the
-users of that server.  Therefore, public use of a modified version, on
-a publicly accessible server, gives the public access to the source
-code of the modified version.
-
-  An older license, called the Affero General Public License and
-published by Affero, was designed to accomplish similar goals.  This is
-a different license, not a version of the Affero GPL, but Affero has
-released a new version of the Affero GPL which permits relicensing under
-this license.
-
-  The precise terms and conditions for copying, distribution and
-modification follow.
-
-                       TERMS AND CONDITIONS
-
-  0. Definitions.
-
-  "This License" refers to version 3 of the GNU Affero General Public License.
-
-  "Copyright" also means copyright-like laws that apply to other kinds of
-works, such as semiconductor masks.
-
-  "The Program" refers to any copyrightable work licensed under this
-License.  Each licensee is addressed as "you".  "Licensees" and
-"recipients" may be individuals or organizations.
-
-  To "modify" a work means to copy from or adapt all or part of the work
-in a fashion requiring copyright permission, other than the making of an
-exact copy.  The resulting work is called a "modified version" of the
-earlier work or a work "based on" the earlier work.
-
-  A "covered work" means either the unmodified Program or a work based
-on the Program.
-
-  To "propagate" a work means to do anything with it that, without
-permission, would make you directly or secondarily liable for
-infringement under applicable copyright law, except executing it on a
-computer or modifying a private copy.  Propagation includes copying,
-distribution (with or without modification), making available to the
-public, and in some countries other activities as well.
-
-  To "convey" a work means any kind of propagation that enables other
-parties to make or receive copies.  Mere interaction with a user through
-a computer network, with no transfer of a copy, is not conveying.
-
-  An interactive user interface displays "Appropriate Legal Notices"
-to the extent that it includes a convenient and prominently visible
-feature that (1) displays an appropriate copyright notice, and (2)
-tells the user that there is no warranty for the work (except to the
-extent that warranties are provided), that licensees may convey the
-work under this License, and how to view a copy of this License.  If
-the interface presents a list of user commands or options, such as a
-menu, a prominent item in the list meets this criterion.
-
-  1. Source Code.
-
-  The "source code" for a work means the preferred form of the work
-for making modifications to it.  "Object code" means any non-source
-form of a work.
-
-  A "Standard Interface" means an interface that either is an official
-standard defined by a recognized standards body, or, in the case of
-interfaces specified for a particular programming language, one that
-is widely used among developers working in that language.
-
-  The "System Libraries" of an executable work include anything, other
-than the work as a whole, that (a) is included in the normal form of
-packaging a Major Component, but which is not part of that Major
-Component, and (b) serves only to enable use of the work with that
-Major Component, or to implement a Standard Interface for which an
-implementation is available to the public in source code form.  A
-"Major Component", in this context, means a major essential component
-(kernel, window system, and so on) of the specific operating system
-(if any) on which the executable work runs, or a compiler used to
-produce the work, or an object code interpreter used to run it.
-
-  The "Corresponding Source" for a work in object code form means all
-the source code needed to generate, install, and (for an executable
-work) run the object code and to modify the work, including scripts to
-control those activities.  However, it does not include the work's
-System Libraries, or general-purpose tools or generally available free
-programs which are used unmodified in performing those activities but
-which are not part of the work.  For example, Corresponding Source
-includes interface definition files associated with source files for
-the work, and the source code for shared libraries and dynamically
-linked subprograms that the work is specifically designed to require,
-such as by intimate data communication or control flow between those
-subprograms and other parts of the work.
-
-  The Corresponding Source need not include anything that users
-can regenerate automatically from other parts of the Corresponding
-Source.
-
-  The Corresponding Source for a work in source code form is that
-same work.
-
-  2. Basic Permissions.
-
-  All rights granted under this License are granted for the term of
-copyright on the Program, and are irrevocable provided the stated
-conditions are met.  This License explicitly affirms your unlimited
-permission to run the unmodified Program.  The output from running a
-covered work is covered by this License only if the output, given its
-content, constitutes a covered work.  This License acknowledges your
-rights of fair use or other equivalent, as provided by copyright law.
-
-  You may make, run and propagate covered works that you do not
-convey, without conditions so long as your license otherwise remains
-in force.  You may convey covered works to others for the sole purpose
-of having them make modifications exclusively for you, or provide you
-with facilities for running those works, provided that you comply with
-the terms of this License in conveying all material for which you do
-not control copyright.  Those thus making or running the covered works
-for you must do so exclusively on your behalf, under your direction
-and control, on terms that prohibit them from making any copies of
-your copyrighted material outside their relationship with you.
-
-  Conveying under any other circumstances is permitted solely under
-the conditions stated below.  Sublicensing is not allowed; section 10
-makes it unnecessary.
-
-  3. Protecting Users' Legal Rights From Anti-Circumvention Law.
-
-  No covered work shall be deemed part of an effective technological
-measure under any applicable law fulfilling obligations under article
-11 of the WIPO copyright treaty adopted on 20 December 1996, or
-similar laws prohibiting or restricting circumvention of such
-measures.
-
-  When you convey a covered work, you waive any legal power to forbid
-circumvention of technological measures to the extent such circumvention
-is effected by exercising rights under this License with respect to
-the covered work, and you disclaim any intention to limit operation or
-modification of the work as a means of enforcing, against the work's
-users, your or third parties' legal rights to forbid circumvention of
-technological measures.
-
-  4. Conveying Verbatim Copies.
-
-  You may convey verbatim copies of the Program's source code as you
-receive it, in any medium, provided that you conspicuously and
-appropriately publish on each copy an appropriate copyright notice;
-keep intact all notices stating that this License and any
-non-permissive terms added in accord with section 7 apply to the code;
-keep intact all notices of the absence of any warranty; and give all
-recipients a copy of this License along with the Program.
-
-  You may charge any price or no price for each copy that you convey,
-and you may offer support or warranty protection for a fee.
-
-  5. Conveying Modified Source Versions.
-
-  You may convey a work based on the Program, or the modifications to
-produce it from the Program, in the form of source code under the
-terms of section 4, provided that you also meet all of these conditions:
-
-    a) The work must carry prominent notices stating that you modified
-    it, and giving a relevant date.
-
-    b) The work must carry prominent notices stating that it is
-    released under this License and any conditions added under section
-    7.  This requirement modifies the requirement in section 4 to
-    "keep intact all notices".
-
-    c) You must license the entire work, as a whole, under this
-    License to anyone who comes into possession of a copy.  This
-    License will therefore apply, along with any applicable section 7
-    additional terms, to the whole of the work, and all its parts,
-    regardless of how they are packaged.  This License gives no
-    permission to license the work in any other way, but it does not
-    invalidate such permission if you have separately received it.
-
-    d) If the work has interactive user interfaces, each must display
-    Appropriate Legal Notices; however, if the Program has interactive
-    interfaces that do not display Appropriate Legal Notices, your
-    work need not make them do so.
-
-  A compilation of a covered work with other separate and independent
-works, which are not by their nature extensions of the covered work,
-and which are not combined with it such as to form a larger program,
-in or on a volume of a storage or distribution medium, is called an
-"aggregate" if the compilation and its resulting copyright are not
-used to limit the access or legal rights of the compilation's users
-beyond what the individual works permit.  Inclusion of a covered work
-in an aggregate does not cause this License to apply to the other
-parts of the aggregate.
-
-  6. Conveying Non-Source Forms.
-
-  You may convey a covered work in object code form under the terms
-of sections 4 and 5, provided that you also convey the
-machine-readable Corresponding Source under the terms of this License,
-in one of these ways:
-
-    a) Convey the object code in, or embodied in, a physical product
-    (including a physical distribution medium), accompanied by the
-    Corresponding Source fixed on a durable physical medium
-    customarily used for software interchange.
-
-    b) Convey the object code in, or embodied in, a physical product
-    (including a physical distribution medium), accompanied by a
-    written offer, valid for at least three years and valid for as
-    long as you offer spare parts or customer support for that product
-    model, to give anyone who possesses the object code either (1) a
-    copy of the Corresponding Source for all the software in the
-    product that is covered by this License, on a durable physical
-    medium customarily used for software interchange, for a price no
-    more than your reasonable cost of physically performing this
-    conveying of source, or (2) access to copy the
-    Corresponding Source from a network server at no charge.
-
-    c) Convey individual copies of the object code with a copy of the
-    written offer to provide the Corresponding Source.  This
-    alternative is allowed only occasionally and noncommercially, and
-    only if you received the object code with such an offer, in accord
-    with subsection 6b.
-
-    d) Convey the object code by offering access from a designated
-    place (gratis or for a charge), and offer equivalent access to the
-    Corresponding Source in the same way through the same place at no
-    further charge.  You need not require recipients to copy the
-    Corresponding Source along with the object code.  If the place to
-    copy the object code is a network server, the Corresponding Source
-    may be on a different server (operated by you or a third party)
-    that supports equivalent copying facilities, provided you maintain
-    clear directions next to the object code saying where to find the
-    Corresponding Source.  Regardless of what server hosts the
-    Corresponding Source, you remain obligated to ensure that it is
-    available for as long as needed to satisfy these requirements.
-
-    e) Convey the object code using peer-to-peer transmission, provided
-    you inform other peers where the object code and Corresponding
-    Source of the work are being offered to the general public at no
-    charge under subsection 6d.
-
-  A separable portion of the object code, whose source code is excluded
-from the Corresponding Source as a System Library, need not be
-included in conveying the object code work.
-
-  A "User Product" is either (1) a "consumer product", which means any
-tangible personal property which is normally used for personal, family,
-or household purposes, or (2) anything designed or sold for incorporation
-into a dwelling.  In determining whether a product is a consumer product,
-doubtful cases shall be resolved in favor of coverage.  For a particular
-product received by a particular user, "normally used" refers to a
-typical or common use of that class of product, regardless of the status
-of the particular user or of the way in which the particular user
-actually uses, or expects or is expected to use, the product.  A product
-is a consumer product regardless of whether the product has substantial
-commercial, industrial or non-consumer uses, unless such uses represent
-the only significant mode of use of the product.
-
-  "Installation Information" for a User Product means any methods,
-procedures, authorization keys, or other information required to install
-and execute modified versions of a covered work in that User Product from
-a modified version of its Corresponding Source.  The information must
-suffice to ensure that the continued functioning of the modified object
-code is in no case prevented or interfered with solely because
-modification has been made.
-
-  If you convey an object code work under this section in, or with, or
-specifically for use in, a User Product, and the conveying occurs as
-part of a transaction in which the right of possession and use of the
-User Product is transferred to the recipient in perpetuity or for a
-fixed term (regardless of how the transaction is characterized), the
-Corresponding Source conveyed under this section must be accompanied
-by the Installation Information.  But this requirement does not apply
-if neither you nor any third party retains the ability to install
-modified object code on the User Product (for example, the work has
-been installed in ROM).
-
-  The requirement to provide Installation Information does not include a
-requirement to continue to provide support service, warranty, or updates
-for a work that has been modified or installed by the recipient, or for
-the User Product in which it has been modified or installed.  Access to a
-network may be denied when the modification itself materially and
-adversely affects the operation of the network or violates the rules and
-protocols for communication across the network.
-
-  Corresponding Source conveyed, and Installation Information provided,
-in accord with this section must be in a format that is publicly
-documented (and with an implementation available to the public in
-source code form), and must require no special password or key for
-unpacking, reading or copying.
-
-  7. Additional Terms.
-
-  "Additional permissions" are terms that supplement the terms of this
-License by making exceptions from one or more of its conditions.
-Additional permissions that are applicable to the entire Program shall
-be treated as though they were included in this License, to the extent
-that they are valid under applicable law.  If additional permissions
-apply only to part of the Program, that part may be used separately
-under those permissions, but the entire Program remains governed by
-this License without regard to the additional permissions.
-
-  When you convey a copy of a covered work, you may at your option
-remove any additional permissions from that copy, or from any part of
-it.  (Additional permissions may be written to require their own
-removal in certain cases when you modify the work.)  You may place
-additional permissions on material, added by you to a covered work,
-for which you have or can give appropriate copyright permission.
-
-  Notwithstanding any other provision of this License, for material you
-add to a covered work, you may (if authorized by the copyright holders of
-that material) supplement the terms of this License with terms:
-
-    a) Disclaiming warranty or limiting liability differently from the
-    terms of sections 15 and 16 of this License; or
-
-    b) Requiring preservation of specified reasonable legal notices or
-    author attributions in that material or in the Appropriate Legal
-    Notices displayed by works containing it; or
-
-    c) Prohibiting misrepresentation of the origin of that material, or
-    requiring that modified versions of such material be marked in
-    reasonable ways as different from the original version; or
-
-    d) Limiting the use for publicity purposes of names of licensors or
-    authors of the material; or
-
-    e) Declining to grant rights under trademark law for use of some
-    trade names, trademarks, or service marks; or
-
-    f) Requiring indemnification of licensors and authors of that
-    material by anyone who conveys the material (or modified versions of
-    it) with contractual assumptions of liability to the recipient, for
-    any liability that these contractual assumptions directly impose on
-    those licensors and authors.
-
-  All other non-permissive additional terms are considered "further
-restrictions" within the meaning of section 10.  If the Program as you
-received it, or any part of it, contains a notice stating that it is
-governed by this License along with a term that is a further
-restriction, you may remove that term.  If a license document contains
-a further restriction but permits relicensing or conveying under this
-License, you may add to a covered work material governed by the terms
-of that license document, provided that the further restriction does
-not survive such relicensing or conveying.
-
-  If you add terms to a covered work in accord with this section, you
-must place, in the relevant source files, a statement of the
-additional terms that apply to those files, or a notice indicating
-where to find the applicable terms.
-
-  Additional terms, permissive or non-permissive, may be stated in the
-form of a separately written license, or stated as exceptions;
-the above requirements apply either way.
-
-  8. Termination.
-
-  You may not propagate or modify a covered work except as expressly
-provided under this License.  Any attempt otherwise to propagate or
-modify it is void, and will automatically terminate your rights under
-this License (including any patent licenses granted under the third
-paragraph of section 11).
-
-  However, if you cease all violation of this License, then your
-license from a particular copyright holder is reinstated (a)
-provisionally, unless and until the copyright holder explicitly and
-finally terminates your license, and (b) permanently, if the copyright
-holder fails to notify you of the violation by some reasonable means
-prior to 60 days after the cessation.
-
-  Moreover, your license from a particular copyright holder is
-reinstated permanently if the copyright holder notifies you of the
-violation by some reasonable means, this is the first time you have
-received notice of violation of this License (for any work) from that
-copyright holder, and you cure the violation prior to 30 days after
-your receipt of the notice.
-
-  Termination of your rights under this section does not terminate the
-licenses of parties who have received copies or rights from you under
-this License.  If your rights have been terminated and not permanently
-reinstated, you do not qualify to receive new licenses for the same
-material under section 10.
-
-  9. Acceptance Not Required for Having Copies.
-
-  You are not required to accept this License in order to receive or
-run a copy of the Program.  Ancillary propagation of a covered work
-occurring solely as a consequence of using peer-to-peer transmission
-to receive a copy likewise does not require acceptance.  However,
-nothing other than this License grants you permission to propagate or
-modify any covered work.  These actions infringe copyright if you do
-not accept this License.  Therefore, by modifying or propagating a
-covered work, you indicate your acceptance of this License to do so.
-
-  10. Automatic Licensing of Downstream Recipients.
-
-  Each time you convey a covered work, the recipient automatically
-receives a license from the original licensors, to run, modify and
-propagate that work, subject to this License.  You are not responsible
-for enforcing compliance by third parties with this License.
-
-  An "entity transaction" is a transaction transferring control of an
-organization, or substantially all assets of one, or subdividing an
-organization, or merging organizations.  If propagation of a covered
-work results from an entity transaction, each party to that
-transaction who receives a copy of the work also receives whatever
-licenses to the work the party's predecessor in interest had or could
-give under the previous paragraph, plus a right to possession of the
-Corresponding Source of the work from the predecessor in interest, if
-the predecessor has it or can get it with reasonable efforts.
-
-  You may not impose any further restrictions on the exercise of the
-rights granted or affirmed under this License.  For example, you may
-not impose a license fee, royalty, or other charge for exercise of
-rights granted under this License, and you may not initiate litigation
-(including a cross-claim or counterclaim in a lawsuit) alleging that
-any patent claim is infringed by making, using, selling, offering for
-sale, or importing the Program or any portion of it.
-
-  11. Patents.
-
-  A "contributor" is a copyright holder who authorizes use under this
-License of the Program or a work on which the Program is based.  The
-work thus licensed is called the contributor's "contributor version".
-
-  A contributor's "essential patent claims" are all patent claims
-owned or controlled by the contributor, whether already acquired or
-hereafter acquired, that would be infringed by some manner, permitted
-by this License, of making, using, or selling its contributor version,
-but do not include claims that would be infringed only as a
-consequence of further modification of the contributor version.  For
-purposes of this definition, "control" includes the right to grant
-patent sublicenses in a manner consistent with the requirements of
-this License.
-
-  Each contributor grants you a non-exclusive, worldwide, royalty-free
-patent license under the contributor's essential patent claims, to
-make, use, sell, offer for sale, import and otherwise run, modify and
-propagate the contents of its contributor version.
-
-  In the following three paragraphs, a "patent license" is any express
-agreement or commitment, however denominated, not to enforce a patent
-(such as an express permission to practice a patent or covenant not to
-sue for patent infringement).  To "grant" such a patent license to a
-party means to make such an agreement or commitment not to enforce a
-patent against the party.
-
-  If you convey a covered work, knowingly relying on a patent license,
-and the Corresponding Source of the work is not available for anyone
-to copy, free of charge and under the terms of this License, through a
-publicly available network server or other readily accessible means,
-then you must either (1) cause the Corresponding Source to be so
-available, or (2) arrange to deprive yourself of the benefit of the
-patent license for this particular work, or (3) arrange, in a manner
-consistent with the requirements of this License, to extend the patent
-license to downstream recipients.  "Knowingly relying" means you have
-actual knowledge that, but for the patent license, your conveying the
-covered work in a country, or your recipient's use of the covered work
-in a country, would infringe one or more identifiable patents in that
-country that you have reason to believe are valid.
-
-  If, pursuant to or in connection with a single transaction or
-arrangement, you convey, or propagate by procuring conveyance of, a
-covered work, and grant a patent license to some of the parties
-receiving the covered work authorizing them to use, propagate, modify
-or convey a specific copy of the covered work, then the patent license
-you grant is automatically extended to all recipients of the covered
-work and works based on it.
-
-  A patent license is "discriminatory" if it does not include within
-the scope of its coverage, prohibits the exercise of, or is
-conditioned on the non-exercise of one or more of the rights that are
-specifically granted under this License.  You may not convey a covered
-work if you are a party to an arrangement with a third party that is
-in the business of distributing software, under which you make payment
-to the third party based on the extent of your activity of conveying
-the work, and under which the third party grants, to any of the
-parties who would receive the covered work from you, a discriminatory
-patent license (a) in connection with copies of the covered work
-conveyed by you (or copies made from those copies), or (b) primarily
-for and in connection with specific products or compilations that
-contain the covered work, unless you entered into that arrangement,
-or that patent license was granted, prior to 28 March 2007.
-
-  Nothing in this License shall be construed as excluding or limiting
-any implied license or other defenses to infringement that may
-otherwise be available to you under applicable patent law.
-
-  12. No Surrender of Others' Freedom.
-
-  If conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License.  If you cannot convey a
-covered work so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you may
-not convey it at all.  For example, if you agree to terms that obligate you
-to collect a royalty for further conveying from those to whom you convey
-the Program, the only way you could satisfy both those terms and this
-License would be to refrain entirely from conveying the Program.
-
-  13. Remote Network Interaction; Use with the GNU General Public License.
-
-  Notwithstanding any other provision of this License, if you modify the
-Program, your modified version must prominently offer all users
-interacting with it remotely through a computer network (if your version
-supports such interaction) an opportunity to receive the Corresponding
-Source of your version by providing access to the Corresponding Source
-from a network server at no charge, through some standard or customary
-means of facilitating copying of software.  This Corresponding Source
-shall include the Corresponding Source for any work covered by version 3
-of the GNU General Public License that is incorporated pursuant to the
-following paragraph.
-
-  Notwithstanding any other provision of this License, you have
-permission to link or combine any covered work with a work licensed
-under version 3 of the GNU General Public License into a single
-combined work, and to convey the resulting work.  The terms of this
-License will continue to apply to the part which is the covered work,
-but the work with which it is combined will remain governed by version
-3 of the GNU General Public License.
-
-  14. Revised Versions of this License.
-
-  The Free Software Foundation may publish revised and/or new versions of
-the GNU Affero General Public License from time to time.  Such new versions
-will be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-  Each version is given a distinguishing version number.  If the
-Program specifies that a certain numbered version of the GNU Affero General
-Public License "or any later version" applies to it, you have the
-option of following the terms and conditions either of that numbered
-version or of any later version published by the Free Software
-Foundation.  If the Program does not specify a version number of the
-GNU Affero General Public License, you may choose any version ever published
-by the Free Software Foundation.
-
-  If the Program specifies that a proxy can decide which future
-versions of the GNU Affero General Public License can be used, that proxy's
-public statement of acceptance of a version permanently authorizes you
-to choose that version for the Program.
-
-  Later license versions may give you additional or different
-permissions.  However, no additional obligations are imposed on any
-author or copyright holder as a result of your choosing to follow a
-later version.
-
-  15. Disclaimer of Warranty.
-
-  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
-APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
-HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
-OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
-THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
-IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
-ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
-  16. Limitation of Liability.
-
-  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
-THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
-GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
-USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
-DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
-PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
-EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGES.
-
-  17. Interpretation of Sections 15 and 16.
-
-  If the disclaimer of warranty and limitation of liability provided
-above cannot be given local legal effect according to their terms,
-reviewing courts shall apply local law that most closely approximates
-an absolute waiver of all civil liability in connection with the
-Program, unless a warranty or assumption of liability accompanies a
-copy of the Program in return for a fee.
-
-                     END OF TERMS AND CONDITIONS
-
-            How to Apply These Terms to Your New Programs
-
-  If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
-  To do so, attach the following notices to the program.  It is safest
-to attach them to the start of each source file to most effectively
-state the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
-    <one line to give the program's name and a brief idea of what it does.>
-    Copyright (C) <year>  <name of author>
-
-    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 <http://www.gnu.org/licenses/>.
-
-Also add information on how to contact you by electronic and paper mail.
-
-  If your software can interact with users remotely through a computer
-network, you should also make sure that it provides a way for users to
-get its source.  For example, if your program is a web application, its
-interface could display a "Source" link that leads users to an archive
-of the code.  There are many ways you could offer source, and different
-solutions will be better for different programs; see section 13 for the
-specific requirements.
-
-  You should also get your employer (if you work as a programmer) or school,
-if any, to sign a "copyright disclaimer" for the program, if necessary.
-For more information on this, and how to apply and follow the GNU AGPL, see
-<http://www.gnu.org/licenses/>.
diff --git a/libs/federation-util/federation-util.cabal b/libs/federation-util/federation-util.cabal
deleted file mode 100644
index 8f9d28983e7..00000000000
--- a/libs/federation-util/federation-util.cabal
+++ /dev/null
@@ -1,85 +0,0 @@
-cabal-version: 1.12
-
--- This file has been generated from package.yaml by hpack version 0.31.2.
---
--- see: https://github.com/sol/hpack
---
--- hash: d327ef72460d5f79332d80fa4a70516b7351472f50c17a8c491d28c65ec0f024
-
-name:           federation-util
-version:        0.1.0
-synopsis:       Various helpers for federation
-description:    Small helper functions useful when federating.
-category:       Web
-author:         Wire Swiss GmbH
-maintainer:     Wire Swiss GmbH <backend@wire.com>
-copyright:      (c) 2020 Wire Swiss GmbH
-license:        AGPL-3
-license-file:   LICENSE
-build-type:     Simple
-
-library
-  exposed-modules:
-      Network.Federation.Util
-      Network.Federation.Util.DNS
-      Network.Federation.Util.Internal
-  other-modules:
-      Paths_federation_util
-  hs-source-dirs:
-      src
-  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
-  build-depends:
-      async >=2.0
-    , base >=4.6 && <5.0
-    , bytestring >=0.10
-    , bytestring-conversion >=0.3
-    , containers >=0.5
-    , dns
-    , errors >=2.0
-    , exceptions >=0.6
-    , http-types >=0.8
-    , imports
-    , random
-    , stm
-    , streaming-commons >=0.1
-    , string-conversions
-    , text >=0.11
-    , tinylog >=0.8
-    , transformers >=0.3
-  default-language: Haskell2010
-
-test-suite spec
-  type: exitcode-stdio-1.0
-  main-is: Spec.hs
-  other-modules:
-      Test.DNSSpec
-      Paths_federation_util
-  hs-source-dirs:
-      test
-  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 -rtsopts -with-rtsopts=-N
-  build-depends:
-      QuickCheck
-    , async >=2.0
-    , base >=4.6 && <5.0
-    , bytestring >=0.10
-    , bytestring-conversion >=0.3
-    , containers >=0.5
-    , dns
-    , errors >=2.0
-    , exceptions >=0.6
-    , federation-util
-    , hspec
-    , hspec-discover
-    , http-types >=0.8
-    , imports
-    , random
-    , stm
-    , streaming-commons >=0.1
-    , string-conversions
-    , text >=0.11
-    , tinylog >=0.8
-    , transformers >=0.3
-    , uri-bytestring
-  default-language: Haskell2010
diff --git a/libs/federation-util/package.yaml b/libs/federation-util/package.yaml
deleted file mode 100644
index ea89acc6bc6..00000000000
--- a/libs/federation-util/package.yaml
+++ /dev/null
@@ -1,45 +0,0 @@
-defaults:
-  local: ../../package-defaults.yaml
-name: federation-util
-version: '0.1.0'
-synopsis: Various helpers for federation
-description: Small helper functions useful when federating.
-category: Web
-author: Wire Swiss GmbH
-maintainer: Wire Swiss GmbH <backend@wire.com>
-copyright: (c) 2020 Wire Swiss GmbH
-license: AGPL-3
-dependencies:
-- async >=2.0
-- base >=4.6 && <5.0
-- bytestring >=0.10
-- bytestring-conversion >=0.3
-- containers >=0.5
-- errors >=2.0
-- exceptions >=0.6
-- http-types >=0.8
-- imports
-- dns
-- random
-- streaming-commons >=0.1
-- string-conversions
-- stm
-- text >=0.11
-- transformers >=0.3
-- tinylog >=0.8
-library:
-  source-dirs: src
-
-tests:
-  spec:
-    main: Spec.hs
-    source-dirs:
-      - test
-    ghc-options: -threaded -rtsopts -with-rtsopts=-N
-    dependencies:
-      - hspec
-      - hspec-discover
-      - QuickCheck
-      - federation-util
-      - uri-bytestring
-
diff --git a/libs/federation-util/src/Network/Federation/Util.hs b/libs/federation-util/src/Network/Federation/Util.hs
deleted file mode 100644
index bd9a191b618..00000000000
--- a/libs/federation-util/src/Network/Federation/Util.hs
+++ /dev/null
@@ -1,23 +0,0 @@
--- 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/>.
-
-module Network.Federation.Util
-  ( module Network.Federation.Util.DNS,
-  )
-where
-
-import Network.Federation.Util.DNS
diff --git a/libs/federation-util/src/Network/Federation/Util/DNS.hs b/libs/federation-util/src/Network/Federation/Util/DNS.hs
deleted file mode 100644
index 14ac4db02b4..00000000000
--- a/libs/federation-util/src/Network/Federation/Util/DNS.hs
+++ /dev/null
@@ -1,45 +0,0 @@
--- 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/>.
-
-module Network.Federation.Util.DNS
-  ( srvLookup,
-    SrvTarget (..),
-  )
-where
-
-import Imports
-import Network.DNS
-import Network.Federation.Util.Internal
-
--- | Looks up a SRV record given a domain, returning A(AAA) records with their
--- ports (ordered by priority and weight according to RFC 2782). Connection
--- attempts should be made to the returned result list in order.
---
--- Example:
---
--- > import Network.DNS.Resolver
--- > import Network.Federation.Util
--- >
--- > main :: IO ()
--- > main = do
--- >   rs <- makeResolvSeed defaultResolvConf
--- >   x <- srvLookup "staging.zinfra.io" rs
-srvLookup :: Text -> ResolvSeed -> IO (Maybe [SrvTarget])
-srvLookup = srvLookup' srvDefaultPrefix
-
-srvDefaultPrefix :: Text
-srvDefaultPrefix = "_wire-server"
diff --git a/libs/federation-util/src/Network/Federation/Util/Internal.hs b/libs/federation-util/src/Network/Federation/Util/Internal.hs
deleted file mode 100644
index 26d2160175b..00000000000
--- a/libs/federation-util/src/Network/Federation/Util/Internal.hs
+++ /dev/null
@@ -1,154 +0,0 @@
--- 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/>.
-
--- Parts of this code, namely functions srvLookup'' and orderSrvResult,
--- which were taken from http://hackage.haskell.org/package/pontarius-xmpp
--- are also licensed under the three-clause BSD license:
---
--- Copyright © 2005-2011 Dmitry Astapov
--- Copyright © 2005-2011 Pierre Kovalev
--- Copyright © 2010-2011 Mahdi Abdinejadi
--- Copyright © 2010-2013 Jon Kristensen
--- Copyright © 2011      IETF Trust
--- Copyright © 2012-2013 Philipp Balzarek
---
--- All rights reserved.
---
--- Pontarius XMPP is licensed under the three-clause BSD license.
---
--- Redistribution and use in source and binary forms, with or without
--- modification, are permitted provided that the following conditions are met:
---
--- - Redistributions of source code must retain the above copyright notice, this
---   list of conditions and the following disclaimer.
---
--- - Redistributions in binary form must reproduce the above copyright notice,
---   this list of conditions and the following disclaimer in the documentation
---   and/or other materials provided with the distribution.
---
--- - Neither the name of the Pontarius project nor the names of its contributors
---   may be used to endorse or promote products derived from this software without
---   specific prior written permission.
---
--- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
--- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
--- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
--- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR THE PONTARIUS PROJECT BE
--- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
--- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
--- GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
--- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
--- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
--- OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-module Network.Federation.Util.Internal where
-
-import Control.Category ((>>>))
-import Data.Text.Encoding (encodeUtf8)
-import Imports
-import Network.DNS (DNSError, Domain, ResolvSeed, Resolver, lookupSRV, withResolver)
-import System.Random (randomRIO)
-
-data SrvEntry = SrvEntry
-  { srvPriority :: !Word16,
-    srvWeight :: !Word16,
-    srvTarget :: !SrvTarget
-  }
-  deriving (Eq, Show)
-
-data SrvTarget = SrvTarget
-  { -- | the hostname on which the service is offered
-    srvTargetDomain :: !Domain,
-    -- | the port on which the service is offered
-    srvTargetPort :: !Word16
-  }
-  deriving (Eq, Show)
-
-toSrvEntry :: (Word16, Word16, Word16, Domain) -> SrvEntry
-toSrvEntry (prio, weight, port, domain) = SrvEntry prio weight (SrvTarget domain port)
-
--- Given a prefix (e.g. _wire-server) and a domain (e.g. wire.com),
--- provides a list of A(AAA) names and port numbers upon a successful
--- DNS-SRV request, or `Nothing' if the DNS-SRV request failed.
--- Modified version inspired from http://hackage.haskell.org/package/pontarius-xmpp
-srvLookup' :: Text -> Text -> ResolvSeed -> IO (Maybe [SrvTarget])
-srvLookup' = srvLookup'' lookupSRV
-
--- internal version for testing
---
--- FUTUREWORK: return more precise errors than 'Nothing'?
-srvLookup'' ::
-  (Resolver -> Domain -> IO (Either DNSError [(Word16, Word16, Word16, Domain)])) ->
-  Text ->
-  Text ->
-  ResolvSeed ->
-  IO (Maybe [SrvTarget])
-srvLookup'' lookupF prefix realm resolvSeed = withResolver resolvSeed $ \resolver -> do
-  srvResult <- lookupF resolver $ encodeUtf8 $ prefix <> "._tcp." <> realm <> "."
-  case srvResult of
-    -- The service is not available at this domain.
-    Left _ -> return Nothing
-    Right [] -> return Nothing
-    Right [(_, _, _, ".")] -> return Nothing -- "not available" as in RFC2782
-    Right srvResult' -> do
-      let srvEntries = toSrvEntry <$> srvResult'
-      -- Get [(Domain, PortNumber)] of SRV request, if any.
-      -- Sorts the records based on the priority value.
-      Just . fmap srvTarget <$> orderSrvResult srvEntries
-
--- FUTUREWORK: maybe improve sorting algorithm here? (with respect to performance and code style)
---
--- This function orders the SRV result in accordance with RFC
--- 2782. It sorts the SRV results in order of priority, and then
--- uses a random process to order the records with the same
--- priority based on their weight.
---
--- Taken from http://hackage.haskell.org/package/pontarius-xmpp (BSD3 licence) and refactored.
-orderSrvResult :: [SrvEntry] -> IO [SrvEntry]
-orderSrvResult =
-  -- Order the result set by priority.
-  sortBy (comparing srvPriority)
-    -- Group elements in sublists based on their priority.
-    -- The result type is `[[(Word16, Word16, Word16, Domain)]]' (nested list).
-    >>> groupBy ((==) `on` srvPriority)
-    -- For each sublist, put records with a weight of zero first.
-    >>> map (uncurry (++) . partition ((== 0) . srvWeight))
-    -- Order each sublist.
-    >>> mapM orderSublist
-    -- Concatenate the results.
-    >>> fmap concat
-  where
-    orderSublist :: [SrvEntry] -> IO [SrvEntry]
-    orderSublist [] = return []
-    orderSublist sublist = do
-      -- Compute the running sum, as well as the total sum of the sublist.
-      -- Add the running sum to the SRV tuples.
-      let (total, sublistWithRunning) =
-            mapAccumL (\acc srv -> let acc' = acc + srvWeight srv in (acc', (srv, acc'))) 0 sublist
-      -- Choose a random number between 0 and the total sum (inclusive).
-      randomNumber <- randomRIO (0, total)
-      -- Select the first record with its running sum greater
-      -- than or equal to the random number.
-      let (beginning, (firstSrv, _), end) =
-            case break (\(_, running) -> randomNumber <= running) sublistWithRunning of
-              (b, (c : e)) -> (b, c, e)
-              _ -> error "orderSrvResult: no record with running sum greater than random number"
-      -- Remove the running total number from the remaining elements.
-      let remainingSrvs = map (\(srv, _) -> srv) (concat [beginning, end])
-      -- Repeat the ordering procedure on the remaining elements.
-      rest <- orderSublist remainingSrvs
-      return $ firstSrv : rest
diff --git a/libs/federation-util/test/Spec.hs b/libs/federation-util/test/Spec.hs
deleted file mode 100644
index 7b57431c0d0..00000000000
--- a/libs/federation-util/test/Spec.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
-
--- 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/>.
diff --git a/libs/federation-util/test/Test/DNSSpec.hs b/libs/federation-util/test/Test/DNSSpec.hs
deleted file mode 100644
index f559f4a0dda..00000000000
--- a/libs/federation-util/test/Test/DNSSpec.hs
+++ /dev/null
@@ -1,87 +0,0 @@
--- 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/>.
-
-module Test.DNSSpec where
-
-import Imports
-import Network.DNS
-import Network.Federation.Util.Internal
-import Test.Hspec
-
-spec :: Spec
-spec = do
-  describe "order" $ do
-    it "orders records according to ascending priority" $ do
-      actual <-
-        orderSrvResult . map toSrvEntry $
-          [ -- priority, weight, port, domain
-            (0, 0, 443, "offline.com"),
-            (15, 10, 443, "main.com"),
-            (0, 5, 443, "backup.com"),
-            (2, 10, 443, "main.com"),
-            (2, 20, 443, "main.com"),
-            (3, 5, 443, "main.com"),
-            (0, 0, 443, "backup.com")
-          ]
-      (srvPriority <$> actual) `shouldBe` [0, 0, 0, 2, 2, 3, 15]
-    it "orders records with the same priority according to weight with certain probability" $ do
-      let raw =
-            map toSrvEntry $
-              [ (2, 10, 443, "server1.com"),
-                (2, 20, 443, "server2.com"),
-                (2, 0, 443, "dontuseoften.com")
-              ]
-      -- order the list 50 times
-      actuals <- replicateM 50 (orderSrvResult raw)
-      let weightLists = fmap (fmap srvWeight) actuals
-      let x = filter ((== 20) . head) weightLists
-      let y = filter ((== 10) . head) weightLists
-      -- we may have e.g.
-      -- the server with weight 20 first in the list 30 times,
-      -- the server with weight 10 15 times
-      -- and the server with weight 0 5 times.
-      -- We only check that there is *some* distribution
-      length x `shouldSatisfy` (> 0)
-      length x `shouldSatisfy` (< 49)
-      length y `shouldSatisfy` (> 0)
-      length y `shouldSatisfy` (< 49)
-  describe "srvLookup" $ do
-    it "returns the expected result for wire.com" $ do
-      rs <- makeResolvSeed defaultResolvConf
-      wire <- srvLookup'' mockLookupSRV "_wire-server" "wire.com" rs
-      wire `shouldBe` Just [SrvTarget "wire.com" 443]
-    it "filters out single '.' results" $ do
-      rs <- makeResolvSeed defaultResolvConf
-      exampleDotCom <- srvLookup'' mockLookupSRV "_wire-server" "example.com" rs
-      exampleDotCom `shouldBe` Nothing
-    it "can return multiple results" $ do
-      rs <- makeResolvSeed defaultResolvConf
-      zinfra <- srvLookup'' mockLookupSRV "_wire-server" "zinfra.io" rs
-      (length <$> zinfra) `shouldBe` Just 2
-    it "returns Nothing if there is no DNS record" $ do
-      rs <- makeResolvSeed defaultResolvConf
-      noRecord <- srvLookup'' mockLookupSRV "_wire-server" "no-record-here" rs
-      noRecord `shouldBe` Nothing
-
--- mock function matching Network.DNS's 'lookupSRV' types
-mockLookupSRV :: Resolver -> Domain -> IO (Either DNSError [(Word16, Word16, Word16, Domain)])
-mockLookupSRV _ domain = do
-  case domain of
-    "_wire-server._tcp.wire.com." -> return $ Right [(0, 0, 443, "wire.com")]
-    "_wire-server._tcp.zinfra.io." -> return $ Right [(0, 0, 443, "server1.zinfra.io"), (0, 0, 443, "server2.zinfra.io")]
-    "_wire-server._tcp.example.com." -> return $ Right [(0, 0, 443, ".")]
-    _ -> return $ Right []
diff --git a/stack.yaml b/stack.yaml
index 85d9040a1b8..6c6808e7dbf 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -8,7 +8,6 @@ packages:
 - libs/cargohold-types
 - libs/cassandra-util
 - libs/extended
-- libs/federation-util
 - libs/dns-util
 - libs/galley-types
 - libs/gundeck-types

From c7a81502d18abf8600c9ca5ae3e80b6c81713435 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Wed, 29 Jul 2020 13:41:44 +0200
Subject: [PATCH 25/48] dns-util: remove unnecessary comment

---
 libs/dns-util/src/Wire/Network/DNS/Effect.hs | 5 -----
 1 file changed, 5 deletions(-)

diff --git a/libs/dns-util/src/Wire/Network/DNS/Effect.hs b/libs/dns-util/src/Wire/Network/DNS/Effect.hs
index ff3e50bae57..757355e3368 100644
--- a/libs/dns-util/src/Wire/Network/DNS/Effect.hs
+++ b/libs/dns-util/src/Wire/Network/DNS/Effect.hs
@@ -35,8 +35,3 @@ runDNSLookupDefault =
     embed $ DNS.withResolver rs $ \resolver ->
       case l of
         LookupSRV domain -> interpretResponse <$> DNS.lookupSRV resolver domain
-
--- TODO: remove comment?
--- class Monad m => MonadDNSLookup m where
---   monadLookupSRV :: Domain -> m SrvResponse
--- I don't know how to make this choice at runtime

From bbe9458699f480462453af18fe3b925fa35d7d48 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Wed, 29 Jul 2020 14:49:09 +0200
Subject: [PATCH 26/48] Abandon QQ because stack does something bad

It causes this issue when building on alpine:
https://github.com/commercialhaskell/stack/issues/4141
---
 services/brig/test/integration/API/Calling.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs
index dec20a9982c..8844275f817 100644
--- a/services/brig/test/integration/API/Calling.hs
+++ b/services/brig/test/integration/API/Calling.hs
@@ -25,6 +25,7 @@ import qualified Brig.Options as Opts
 import Brig.Types
 import Control.Lens ((?~), (^.), view)
 import Control.Monad.Catch (MonadCatch, MonadThrow)
+import Data.Bifunctor (Bifunctor (first))
 import Data.ByteString.Conversion
 import qualified Data.ByteString.Lazy as LB
 import Data.Id
@@ -39,7 +40,7 @@ import Network.HTTP.Client (Manager)
 import System.FilePath ((</>))
 import Test.Tasty
 import Test.Tasty.HUnit
-import URI.ByteString.QQ (uri)
+import URI.ByteString (laxURIParserOptions, parseURI)
 import UnliftIO.Exception (finally)
 import qualified UnliftIO.Temporary as Temp
 import Util
@@ -96,8 +97,8 @@ testSFT b opts = do
   withSettingsOverrides (opts & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing (Just 0.001)) $ do
     cfg1 <- retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationV2 uid b)
     -- These values are controlled by https://github.com/zinfra/cailleach/tree/77ca2d23cf2959aa183dd945d0a0b13537a8950d/environments/dns-integration-tests
-    let Right server1 = mkHttpsUrl [uri|https://sft01.integration-tests.zinfra.io:443|]
-    let Right server2 = mkHttpsUrl [uri|https://sft02.integration-tests.zinfra.io:8443|]
+    let Right server1 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft01.integration-tests.zinfra.io:443")
+    let Right server2 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft02.integration-tests.zinfra.io:8443")
     liftIO $
       assertEqual
         "when SFT discovery is enabled, sft_servers should be returned"

From 096a8e5ac25f8903c6ac675090dd64a0e928281c Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Wed, 29 Jul 2020 15:18:27 +0200
Subject: [PATCH 27/48] add LICENSE file that was forgotten when moving

---
 libs/dns-util/LICENSE        | 661 +++++++++++++++++++++++++++++++++++
 libs/dns-util/dns-util.cabal |   3 +-
 2 files changed, 663 insertions(+), 1 deletion(-)
 create mode 100644 libs/dns-util/LICENSE

diff --git a/libs/dns-util/LICENSE b/libs/dns-util/LICENSE
new file mode 100644
index 00000000000..dba13ed2ddf
--- /dev/null
+++ b/libs/dns-util/LICENSE
@@ -0,0 +1,661 @@
+                    GNU AFFERO GENERAL PUBLIC LICENSE
+                       Version 3, 19 November 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+                            Preamble
+
+  The GNU Affero General Public License is a free, copyleft license for
+software and other kinds of works, specifically designed to ensure
+cooperation with the community in the case of network server software.
+
+  The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works.  By contrast,
+our General Public Licenses are intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+  Developers that use our General Public Licenses protect your rights
+with two steps: (1) assert copyright on the software, and (2) offer
+you this License which gives you legal permission to copy, distribute
+and/or modify the software.
+
+  A secondary benefit of defending all users' freedom is that
+improvements made in alternate versions of the program, if they
+receive widespread use, become available for other developers to
+incorporate.  Many developers of free software are heartened and
+encouraged by the resulting cooperation.  However, in the case of
+software used on network servers, this result may fail to come about.
+The GNU General Public License permits making a modified version and
+letting the public access it on a server without ever releasing its
+source code to the public.
+
+  The GNU Affero General Public License is designed specifically to
+ensure that, in such cases, the modified source code becomes available
+to the community.  It requires the operator of a network server to
+provide the source code of the modified version running there to the
+users of that server.  Therefore, public use of a modified version, on
+a publicly accessible server, gives the public access to the source
+code of the modified version.
+
+  An older license, called the Affero General Public License and
+published by Affero, was designed to accomplish similar goals.  This is
+a different license, not a version of the Affero GPL, but Affero has
+released a new version of the Affero GPL which permits relicensing under
+this license.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+                       TERMS AND CONDITIONS
+
+  0. Definitions.
+
+  "This License" refers to version 3 of the GNU Affero General Public License.
+
+  "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+  "The Program" refers to any copyrightable work licensed under this
+License.  Each licensee is addressed as "you".  "Licensees" and
+"recipients" may be individuals or organizations.
+
+  To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy.  The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+  A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+  To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy.  Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+  To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies.  Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+  An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License.  If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+  1. Source Code.
+
+  The "source code" for a work means the preferred form of the work
+for making modifications to it.  "Object code" means any non-source
+form of a work.
+
+  A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+  The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form.  A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+  The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities.  However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work.  For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+  The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+  The Corresponding Source for a work in source code form is that
+same work.
+
+  2. Basic Permissions.
+
+  All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met.  This License explicitly affirms your unlimited
+permission to run the unmodified Program.  The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work.  This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+  You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force.  You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright.  Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+  Conveying under any other circumstances is permitted solely under
+the conditions stated below.  Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+  3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+  No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+  When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+  4. Conveying Verbatim Copies.
+
+  You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+  You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+  5. Conveying Modified Source Versions.
+
+  You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+    a) The work must carry prominent notices stating that you modified
+    it, and giving a relevant date.
+
+    b) The work must carry prominent notices stating that it is
+    released under this License and any conditions added under section
+    7.  This requirement modifies the requirement in section 4 to
+    "keep intact all notices".
+
+    c) You must license the entire work, as a whole, under this
+    License to anyone who comes into possession of a copy.  This
+    License will therefore apply, along with any applicable section 7
+    additional terms, to the whole of the work, and all its parts,
+    regardless of how they are packaged.  This License gives no
+    permission to license the work in any other way, but it does not
+    invalidate such permission if you have separately received it.
+
+    d) If the work has interactive user interfaces, each must display
+    Appropriate Legal Notices; however, if the Program has interactive
+    interfaces that do not display Appropriate Legal Notices, your
+    work need not make them do so.
+
+  A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit.  Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+  6. Conveying Non-Source Forms.
+
+  You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+    a) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by the
+    Corresponding Source fixed on a durable physical medium
+    customarily used for software interchange.
+
+    b) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by a
+    written offer, valid for at least three years and valid for as
+    long as you offer spare parts or customer support for that product
+    model, to give anyone who possesses the object code either (1) a
+    copy of the Corresponding Source for all the software in the
+    product that is covered by this License, on a durable physical
+    medium customarily used for software interchange, for a price no
+    more than your reasonable cost of physically performing this
+    conveying of source, or (2) access to copy the
+    Corresponding Source from a network server at no charge.
+
+    c) Convey individual copies of the object code with a copy of the
+    written offer to provide the Corresponding Source.  This
+    alternative is allowed only occasionally and noncommercially, and
+    only if you received the object code with such an offer, in accord
+    with subsection 6b.
+
+    d) Convey the object code by offering access from a designated
+    place (gratis or for a charge), and offer equivalent access to the
+    Corresponding Source in the same way through the same place at no
+    further charge.  You need not require recipients to copy the
+    Corresponding Source along with the object code.  If the place to
+    copy the object code is a network server, the Corresponding Source
+    may be on a different server (operated by you or a third party)
+    that supports equivalent copying facilities, provided you maintain
+    clear directions next to the object code saying where to find the
+    Corresponding Source.  Regardless of what server hosts the
+    Corresponding Source, you remain obligated to ensure that it is
+    available for as long as needed to satisfy these requirements.
+
+    e) Convey the object code using peer-to-peer transmission, provided
+    you inform other peers where the object code and Corresponding
+    Source of the work are being offered to the general public at no
+    charge under subsection 6d.
+
+  A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+  A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling.  In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage.  For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product.  A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+  "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source.  The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+  If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information.  But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+  The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed.  Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+  Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+  7. Additional Terms.
+
+  "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law.  If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+  When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it.  (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.)  You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+  Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+    a) Disclaiming warranty or limiting liability differently from the
+    terms of sections 15 and 16 of this License; or
+
+    b) Requiring preservation of specified reasonable legal notices or
+    author attributions in that material or in the Appropriate Legal
+    Notices displayed by works containing it; or
+
+    c) Prohibiting misrepresentation of the origin of that material, or
+    requiring that modified versions of such material be marked in
+    reasonable ways as different from the original version; or
+
+    d) Limiting the use for publicity purposes of names of licensors or
+    authors of the material; or
+
+    e) Declining to grant rights under trademark law for use of some
+    trade names, trademarks, or service marks; or
+
+    f) Requiring indemnification of licensors and authors of that
+    material by anyone who conveys the material (or modified versions of
+    it) with contractual assumptions of liability to the recipient, for
+    any liability that these contractual assumptions directly impose on
+    those licensors and authors.
+
+  All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10.  If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term.  If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+  If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+  Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+  8. Termination.
+
+  You may not propagate or modify a covered work except as expressly
+provided under this License.  Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+  However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+  Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+  Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License.  If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+  9. Acceptance Not Required for Having Copies.
+
+  You are not required to accept this License in order to receive or
+run a copy of the Program.  Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance.  However,
+nothing other than this License grants you permission to propagate or
+modify any covered work.  These actions infringe copyright if you do
+not accept this License.  Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+  10. Automatic Licensing of Downstream Recipients.
+
+  Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License.  You are not responsible
+for enforcing compliance by third parties with this License.
+
+  An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations.  If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+  You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License.  For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+  11. Patents.
+
+  A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based.  The
+work thus licensed is called the contributor's "contributor version".
+
+  A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version.  For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+  Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+  In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement).  To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+  If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients.  "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+  If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+  A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License.  You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+  Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+  12. No Surrender of Others' Freedom.
+
+  If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all.  For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+  13. Remote Network Interaction; Use with the GNU General Public License.
+
+  Notwithstanding any other provision of this License, if you modify the
+Program, your modified version must prominently offer all users
+interacting with it remotely through a computer network (if your version
+supports such interaction) an opportunity to receive the Corresponding
+Source of your version by providing access to the Corresponding Source
+from a network server at no charge, through some standard or customary
+means of facilitating copying of software.  This Corresponding Source
+shall include the Corresponding Source for any work covered by version 3
+of the GNU General Public License that is incorporated pursuant to the
+following paragraph.
+
+  Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU General Public License into a single
+combined work, and to convey the resulting work.  The terms of this
+License will continue to apply to the part which is the covered work,
+but the work with which it is combined will remain governed by version
+3 of the GNU General Public License.
+
+  14. Revised Versions of this License.
+
+  The Free Software Foundation may publish revised and/or new versions of
+the GNU Affero General Public License from time to time.  Such new versions
+will be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+  Each version is given a distinguishing version number.  If the
+Program specifies that a certain numbered version of the GNU Affero General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation.  If the Program does not specify a version number of the
+GNU Affero General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+  If the Program specifies that a proxy can decide which future
+versions of the GNU Affero General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+  Later license versions may give you additional or different
+permissions.  However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+  15. Disclaimer of Warranty.
+
+  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. Limitation of Liability.
+
+  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+  17. Interpretation of Sections 15 and 16.
+
+  If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+                     END OF TERMS AND CONDITIONS
+
+            How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    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 <http://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+  If your software can interact with users remotely through a computer
+network, you should also make sure that it provides a way for users to
+get its source.  For example, if your program is a web application, its
+interface could display a "Source" link that leads users to an archive
+of the code.  There are many ways you could offer source, and different
+solutions will be better for different programs; see section 13 for the
+specific requirements.
+
+  You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU AGPL, see
+<http://www.gnu.org/licenses/>.
diff --git a/libs/dns-util/dns-util.cabal b/libs/dns-util/dns-util.cabal
index dcca0c83f34..5f48111b480 100644
--- a/libs/dns-util/dns-util.cabal
+++ b/libs/dns-util/dns-util.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 0af5ccb9df7c6ce9225b19b4bf037e5c8813c7a2a1741cd44855366c1ef1928a
+-- hash: 82f20a0525faea5f899c0a68fdc8a82623913d8b063f34a6cd4c6e32aa6acf54
 
 name:           dns-util
 version:        0.1.0
@@ -15,6 +15,7 @@ author:         Wire Swiss GmbH
 maintainer:     Wire Swiss GmbH <backend@wire.com>
 copyright:      (c) 2020 Wire Swiss GmbH
 license:        AGPL-3
+license-file:   LICENSE
 build-type:     Simple
 
 library

From 271f648e206f5c5212c69db4c0c4c2c3e12ecb5a Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Wed, 29 Jul 2020 15:21:14 +0200
Subject: [PATCH 28/48] remove unnecessary comment

---
 libs/wire-api/src/Wire/API/Call/Config.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/libs/wire-api/src/Wire/API/Call/Config.hs b/libs/wire-api/src/Wire/API/Call/Config.hs
index 018b90620c0..6a921f6c1dd 100644
--- a/libs/wire-api/src/Wire/API/Call/Config.hs
+++ b/libs/wire-api/src/Wire/API/Call/Config.hs
@@ -142,7 +142,7 @@ newtype SFTServer = SFTServer
   { _sftURL :: HttpsUrl
   }
   deriving stock (Eq, Show, Ord, Generic)
-  deriving (Arbitrary) via (GenericUniform SFTServer) --TODO is this correct?
+  deriving (Arbitrary) via (GenericUniform SFTServer)
 
 instance ToJSON SFTServer where
   toJSON (SFTServer url) =

From 42d65849ae88af4845c1e8bde2c4725a07d86a98 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Wed, 29 Jul 2020 17:29:30 +0200
Subject: [PATCH 29/48] Log whenever sft service discovery fails or returns
 empty

---
 services/brig/brig.cabal                     |  4 +-
 services/brig/package.yaml                   |  1 +
 services/brig/src/Brig/Calling.hs            | 20 +++--
 services/brig/src/Brig/Run.hs                |  2 +-
 services/brig/test/integration/Util.hs       |  4 +-
 services/brig/test/unit/Test/Brig/Calling.hs | 94 ++++++++++++++++----
 6 files changed, 96 insertions(+), 29 deletions(-)

diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal
index f0377d6543c..11f5b3a6223 100644
--- a/services/brig/brig.cabal
+++ b/services/brig/brig.cabal
@@ -4,7 +4,7 @@ cabal-version: 2.0
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 96200db468bfe0719ac1316ddc3667540214310c093f5a1fa30776c32d6dba11
+-- hash: 49345fd7c41cab0441ba95bd4fdd01b1f64b6053e348ec991695254be96ed5d4
 
 name:           brig
 version:        1.35.0
@@ -62,6 +62,7 @@ library
       Brig.Options
       Brig.Password
       Brig.Phone
+      Brig.PolyLog
       Brig.Provider.API
       Brig.Provider.DB
       Brig.Provider.Email
@@ -487,6 +488,7 @@ test-suite brig-tests
     , retry
     , tasty
     , tasty-hunit
+    , tinylog
     , types-common
     , unliftio
     , uri-bytestring
diff --git a/services/brig/package.yaml b/services/brig/package.yaml
index b2ebb8beb34..6394ec964d7 100644
--- a/services/brig/package.yaml
+++ b/services/brig/package.yaml
@@ -173,6 +173,7 @@ tests:
     - retry
     - tasty
     - tasty-hunit
+    - tinylog
     - types-common
     - unliftio
     - uri-bytestring
diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs
index 0f589cdbbed..ad88de59c47 100644
--- a/services/brig/src/Brig/Calling.hs
+++ b/services/brig/src/Brig/Calling.hs
@@ -21,6 +21,7 @@ module Brig.Calling where
 
 import Brig.Options (SFTOptions (..))
 import qualified Brig.Options as Opts
+import Brig.PolyLog
 import Brig.Types (TurnURI)
 import Control.Lens
 import Data.List.NonEmpty
@@ -30,6 +31,7 @@ import Imports
 import qualified Network.DNS as DNS
 import OpenSSL.EVP.Digest (Digest)
 import Polysemy
+import qualified System.Logger as Log
 import System.Random.MWC (GenIO, createSystemRandom)
 import Wire.Network.DNS.Effect
 import Wire.Network.DNS.SRV
@@ -42,19 +44,23 @@ data SFTEnv = SFTEnv
   }
 
 -- TODO: Log stuff here (and test it?)
-discoverSFTServers :: Member DNSLookup r => DNS.Domain -> Sem r (Maybe (NonEmpty SrvEntry))
+discoverSFTServers :: Members [DNSLookup, PolyLog] r => DNS.Domain -> Sem r (Maybe (NonEmpty SrvEntry))
 discoverSFTServers domain =
   lookupSRV domain >>= \case
     SrvAvailable es -> pure $ Just es
-    SrvNotAvailable -> pure Nothing
-    SrvResponseError _ -> pure Nothing
+    SrvNotAvailable -> do
+      polyLog Log.Warn (Log.msg ("No SFT servers available" :: ByteString))
+      pure Nothing
+    SrvResponseError e -> do
+      polyLog Log.Error (Log.msg ("DNS Lookup failed for SFT Discovery" :: ByteString) . Log.field "Error" (show e))
+      pure Nothing
 
 mkSFTDomain :: SFTOptions -> DNS.Domain
 mkSFTDomain SFTOptions {..} = DNS.normalize $ maybe "_sft" ("_" <>) sftSRVServiceName <> "._tcp." <> sftBaseDomain
 
 -- FUTUREWORK: Remove Embed IO from here and put threadDelay into another
 -- effect. This will also make tests for this faster and deterministic
-sftDiscoveryLoop :: Members [DNSLookup, Embed IO] r => SFTEnv -> Sem r ()
+sftDiscoveryLoop :: Members [DNSLookup, PolyLog, Embed IO] r => SFTEnv -> Sem r ()
 sftDiscoveryLoop SFTEnv {..} = forever $ do
   servers <- discoverSFTServers sftDomain
   case servers of
@@ -73,9 +79,9 @@ mkSFTEnv opts =
 defaultDiscoveryInterval :: Int
 defaultDiscoveryInterval = 10000000
 
-startSFTServiceDiscovery :: SFTEnv -> IO ()
-startSFTServiceDiscovery =
-  runM . runDNSLookupDefault . sftDiscoveryLoop
+startSFTServiceDiscovery :: Log.Logger -> SFTEnv -> IO ()
+startSFTServiceDiscovery logger =
+  runM . runPolyLog logger . runDNSLookupDefault . sftDiscoveryLoop
 
 -- | >>> diffTimeToMicroseconds 1
 -- 1000000
diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs
index 25a05c4244b..4c9564df37f 100644
--- a/services/brig/src/Brig/Run.hs
+++ b/services/brig/src/Brig/Run.hs
@@ -62,7 +62,7 @@ run o = do
       $ AWS.listen throttleMillis q (runAppT e . SesNotification.onEvent)
   sftDiscovery <- case e ^. sftEnv of
     Nothing -> Async.async (pure ()) -- TODO: This looks fishy
-    Just sftEnv' -> Async.async $ Calling.startSFTServiceDiscovery sftEnv'
+    Just sftEnv' -> Async.async $ Calling.startSFTServiceDiscovery (e ^. applog) sftEnv'
   runSettingsWithShutdown s app 5 `finally` do
     mapM_ Async.cancel emailListener
     Async.cancel internalEventListener
diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs
index 3370547480d..dad89067774 100644
--- a/services/brig/test/integration/Util.hs
+++ b/services/brig/test/integration/Util.hs
@@ -25,7 +25,7 @@ import Bilge
 import Bilge.Assert
 import qualified Brig.AWS as AWS
 import Brig.AWS.Types
-import Brig.App (sftEnv)
+import Brig.App (applog, sftEnv)
 import Brig.Calling as Calling
 import qualified Brig.Options as Opts
 import qualified Brig.Run as Run
@@ -714,7 +714,7 @@ withSettingsOverrides opts action = liftIO $ do
   (brigApp, env) <- Run.mkApp opts
   asyncDiscovery <- case env ^. sftEnv of
     Nothing -> Async.async (pure ()) --TODO: This looks fishy
-    Just e -> Async.async $ Calling.startSFTServiceDiscovery e
+    Just e -> Async.async $ Calling.startSFTServiceDiscovery (env ^. applog) e
   res <- WaiTest.runSession action brigApp
   Async.cancel asyncDiscovery
   pure res
diff --git a/services/brig/test/unit/Test/Brig/Calling.hs b/services/brig/test/unit/Test/Brig/Calling.hs
index 1f1e6e1868f..23d588d4b63 100644
--- a/services/brig/test/unit/Test/Brig/Calling.hs
+++ b/services/brig/test/unit/Test/Brig/Calling.hs
@@ -21,11 +21,13 @@ module Test.Brig.Calling where
 
 import Brig.Calling
 import Brig.Options
+import Brig.PolyLog
 import Control.Retry
 import Data.List.NonEmpty (NonEmpty (..))
 import Imports
 import Network.DNS
 import Polysemy
+import qualified System.Logger as Log
 import Test.Tasty
 import Test.Tasty.HUnit
 import qualified UnliftIO.Async as Async
@@ -47,6 +49,18 @@ runFakeDNSLookup FakeDNSEnv {..} = interpret $ \case
     modifyIORef' fakeLookupCalls (++ [domain])
     pure $ fakeLookupFn domain
 
+newtype LogRecorder = LogRecorder {recordedLogs :: IORef [(Log.Level, LByteString)]}
+
+newLogRecorder :: IO LogRecorder
+newLogRecorder = LogRecorder <$> newIORef []
+
+recordLogs :: Member (Embed IO) r => LogRecorder -> Sem (PolyLog ': r) a -> Sem r a
+recordLogs LogRecorder {..} = interpret $ \(PolyLog lvl msg) ->
+  modifyIORef' recordedLogs (++ [(lvl, Log.render (Log.renderDefault ", ") msg)])
+
+ignoreLogs :: Sem (PolyLog ': r) a -> Sem r a
+ignoreLogs = interpret $ \(PolyLog _ _) -> pure ()
+
 tests :: TestTree
 tests =
   testGroup "Calling" $
@@ -63,15 +77,20 @@ tests =
               (mkSFTDomain (SFTOptions "example.com" Nothing Nothing))
         ],
       testGroup "sftDiscoveryLoop" $
-        [ testCase "when service can be discovered" $ void testDiscoveryWhenSuccessful,
-          testCase "when service can be discovered and the URLs change" testDiscoveryWhenURLsChange,
-          testCase "when service cannot be discovered" testDiscoveryWhenUnsuccessful,
-          testCase "when service cannot be discovered after a successful discovery" testDiscoveryWhenUnsuccessfulAfterSuccess
+        [ testCase "when service can be discovered" $ void testDiscoveryLoopWhenSuccessful,
+          testCase "when service can be discovered and the URLs change" testDiscoveryLoopWhenURLsChange,
+          testCase "when service cannot be discovered" testDiscoveryLoopWhenUnsuccessful,
+          testCase "when service cannot be discovered after a successful discovery" testDiscoveryLoopWhenUnsuccessfulAfterSuccess
+        ],
+      testGroup "discoverSFTServers" $
+        [ testCase "when service is available" testSFTDiscoverWhenAvailable,
+          testCase "when service is not available" testSFTDiscoverWhenNotAvailable,
+          testCase "when dns lookup fails" testSFTDiscoverWhenDNSFails
         ]
     ]
 
-testDiscoveryWhenSuccessful :: IO SFTEnv
-testDiscoveryWhenSuccessful = do
+testDiscoveryLoopWhenSuccessful :: IO SFTEnv
+testDiscoveryLoopWhenSuccessful = do
   let entry1 = SrvEntry 0 0 (SrvTarget "sft1.foo.example.com." 443)
       entry2 = SrvEntry 0 0 (SrvTarget "sft2.foo.example.com." 443)
       entry3 = SrvEntry 0 0 (SrvTarget "sft3.foo.example.com." 443)
@@ -79,7 +98,7 @@ testDiscoveryWhenSuccessful = do
   fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvAvailable returnedEntries)
   sftEnv <- mkSFTEnv (SFTOptions "foo.example.com" Nothing (Just 0.001))
 
-  discoveryLoop <- Async.async $ runM . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
+  discoveryLoop <- Async.async $ runM . ignoreLogs . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
   void $ retryEvery10MicrosWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
   -- We don't want to stop the loop before it has written to the sftServers IORef
   void $ retryEvery10MicrosWhileN 2000 (isNothing) (readIORef (sftServers sftEnv))
@@ -89,12 +108,12 @@ testDiscoveryWhenSuccessful = do
   assertEqual "servers should be the ones read from DNS" (Just returnedEntries) actualServers
   pure sftEnv
 
-testDiscoveryWhenUnsuccessful :: IO ()
-testDiscoveryWhenUnsuccessful = do
+testDiscoveryLoopWhenUnsuccessful :: IO ()
+testDiscoveryLoopWhenUnsuccessful = do
   fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvNotAvailable)
   sftEnv <- mkSFTEnv (SFTOptions "foo.example.com" Nothing (Just 0.001))
 
-  discoveryLoop <- Async.async $ runM . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
+  discoveryLoop <- Async.async $ runM . ignoreLogs . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
   -- We wait for at least two lookups to be sure that the lookup loop looped at
   -- least once
   void $ retryEvery10MicrosWhileN 2000 (<= 1) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
@@ -103,15 +122,15 @@ testDiscoveryWhenUnsuccessful = do
   actualServers <- readIORef (sftServers sftEnv)
   assertEqual "servers should be the ones read from DNS" Nothing actualServers
 
-testDiscoveryWhenUnsuccessfulAfterSuccess :: IO ()
-testDiscoveryWhenUnsuccessfulAfterSuccess = do
-  sftEnv <- testDiscoveryWhenSuccessful
+testDiscoveryLoopWhenUnsuccessfulAfterSuccess :: IO ()
+testDiscoveryLoopWhenUnsuccessfulAfterSuccess = do
+  sftEnv <- testDiscoveryLoopWhenSuccessful
   previousEntries <- readIORef (sftServers sftEnv)
 
   -- In the following lines we re-use the 'sftEnv' from a successful lookup to
   -- replicate what will happen when a dns lookup fails after success
   failingFakeDNSEnv <- newFakeDNSEnv (\_ -> SrvNotAvailable)
-  discoveryLoop <- Async.async $ runM . runFakeDNSLookup failingFakeDNSEnv $ sftDiscoveryLoop sftEnv
+  discoveryLoop <- Async.async $ runM . ignoreLogs . runFakeDNSLookup failingFakeDNSEnv $ sftDiscoveryLoop sftEnv
   -- We wait for at least two lookups to be sure that the lookup loop looped at
   -- least once
   void $ retryEvery10MicrosWhileN 2000 (<= 1) (length <$> readIORef (fakeLookupCalls failingFakeDNSEnv))
@@ -120,9 +139,9 @@ testDiscoveryWhenUnsuccessfulAfterSuccess = do
   actualServers <- readIORef (sftServers sftEnv)
   assertEqual "servers shouldn't get overwriten" previousEntries actualServers
 
-testDiscoveryWhenURLsChange :: IO ()
-testDiscoveryWhenURLsChange = do
-  sftEnv <- testDiscoveryWhenSuccessful
+testDiscoveryLoopWhenURLsChange :: IO ()
+testDiscoveryLoopWhenURLsChange = do
+  sftEnv <- testDiscoveryLoopWhenSuccessful
 
   -- In the following lines we re-use the 'sftEnv' from a successful lookup to
   -- replicate what will happen when a dns lookup returns new URLs
@@ -131,7 +150,7 @@ testDiscoveryWhenURLsChange = do
       newEntries = (entry1 :| [entry2])
 
   fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvAvailable newEntries)
-  discoveryLoop <- Async.async $ runM . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
+  discoveryLoop <- Async.async $ runM . ignoreLogs . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
   void $ retryEvery10MicrosWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
   -- We don't want to stop the loop before it has written to the sftServers IORef
   void $ retryEvery10MicrosWhileN 2000 (== Just newEntries) (readIORef (sftServers sftEnv))
@@ -140,6 +159,45 @@ testDiscoveryWhenURLsChange = do
   actualServers <- readIORef (sftServers sftEnv)
   assertEqual "servers should get overwritten" (Just newEntries) actualServers
 
+testSFTDiscoverWhenAvailable :: IO ()
+testSFTDiscoverWhenAvailable = do
+  logRecorder <- newLogRecorder
+  let entry1 = SrvEntry 0 0 (SrvTarget "sft7.foo.example.com." 443)
+      entry2 = SrvEntry 0 0 (SrvTarget "sft8.foo.example.com." 8843)
+      returnedEntries = (entry1 :| [entry2])
+  fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvAvailable returnedEntries)
+
+  assertEqual "discovered servers should be returned" (Just returnedEntries)
+    =<< ( runM . recordLogs logRecorder . runFakeDNSLookup fakeDNSEnv $
+            discoverSFTServers "_sft._tcp.foo.example.com"
+        )
+  assertEqual "nothing should be logged" []
+    =<< readIORef (recordedLogs logRecorder)
+
+testSFTDiscoverWhenNotAvailable :: IO ()
+testSFTDiscoverWhenNotAvailable = do
+  logRecorder <- newLogRecorder
+  fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvNotAvailable)
+
+  assertEqual "discovered servers should be returned" Nothing
+    =<< ( runM . recordLogs logRecorder . runFakeDNSLookup fakeDNSEnv $
+            discoverSFTServers "_sft._tcp.foo.example.com"
+        )
+  assertEqual "should warn about it in the logs" [(Log.Warn, "No SFT servers available\n")]
+    =<< readIORef (recordedLogs logRecorder)
+
+testSFTDiscoverWhenDNSFails :: IO ()
+testSFTDiscoverWhenDNSFails = do
+  logRecorder <- newLogRecorder
+  fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvResponseError IllegalDomain)
+
+  assertEqual "discovered servers should be returned" Nothing
+    =<< ( runM . recordLogs logRecorder . runFakeDNSLookup fakeDNSEnv $
+            discoverSFTServers "_sft._tcp.foo.example.com"
+        )
+  assertEqual "should warn about it in the logs" [(Log.Error, "DNS Lookup failed for SFT Discovery, Error=IllegalDomain\n")]
+    =<< readIORef (recordedLogs logRecorder)
+
 retryEvery10MicrosWhileN :: (MonadIO m) => Int -> (a -> Bool) -> m a -> m a
 retryEvery10MicrosWhileN n f m =
   retrying

From fde677111beaecd2d77b63a86e024cbe62ca79a8 Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Wed, 29 Jul 2020 18:08:40 +0200
Subject: [PATCH 30/48] move defaults to Options.hs

---
 services/brig/src/Brig/Calling.hs | 10 +++-------
 services/brig/src/Brig/Options.hs | 10 ++++++++--
 2 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs
index ad88de59c47..30635a97189 100644
--- a/services/brig/src/Brig/Calling.hs
+++ b/services/brig/src/Brig/Calling.hs
@@ -19,7 +19,7 @@
 
 module Brig.Calling where
 
-import Brig.Options (SFTOptions (..))
+import Brig.Options (SFTOptions (..), defSftDiscoveryIntervalSeconds, defSftServiceName)
 import qualified Brig.Options as Opts
 import Brig.PolyLog
 import Brig.Types (TurnURI)
@@ -56,7 +56,7 @@ discoverSFTServers domain =
       pure Nothing
 
 mkSFTDomain :: SFTOptions -> DNS.Domain
-mkSFTDomain SFTOptions {..} = DNS.normalize $ maybe "_sft" ("_" <>) sftSRVServiceName <> "._tcp." <> sftBaseDomain
+mkSFTDomain SFTOptions {..} = DNS.normalize $ maybe defSftServiceName ("_" <>) sftSRVServiceName <> "._tcp." <> sftBaseDomain
 
 -- FUTUREWORK: Remove Embed IO from here and put threadDelay into another
 -- effect. This will also make tests for this faster and deterministic
@@ -73,11 +73,7 @@ mkSFTEnv opts =
   SFTEnv
     <$> newIORef Nothing
     <*> pure (mkSFTDomain opts)
-    <*> pure (maybe defaultDiscoveryInterval diffTimeToMicroseconds (Opts.sftDiscoveryIntervalSeconds opts))
-
--- | 10 seconds
-defaultDiscoveryInterval :: Int
-defaultDiscoveryInterval = 10000000
+    <*> pure (diffTimeToMicroseconds (maybe defSftDiscoveryIntervalSeconds (Opts.sftDiscoveryIntervalSeconds opts)))
 
 startSFTServiceDiscovery :: Log.Logger -> SFTEnv -> IO ()
 startSFTServiceDiscovery logger =
diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs
index c02db992528..2e8ac3370d2 100644
--- a/services/brig/src/Brig/Options.hs
+++ b/services/brig/src/Brig/Options.hs
@@ -526,8 +526,8 @@ newtype DomainsBlockedForRegistration = DomainsBlockedForRegistration [Domain]
 
 data SFTOptions = SFTOptions
   { sftBaseDomain :: !DNS.Domain,
-    sftSRVServiceName :: !(Maybe ByteString),
-    sftDiscoveryIntervalSeconds :: !(Maybe DiffTime)
+    sftSRVServiceName :: !(Maybe ByteString), -- defaults to defSftServiceName if unset
+    sftDiscoveryIntervalSeconds :: !(Maybe DiffTime) -- defaults to defSftDiscoveryIntervalSeconds
   }
   deriving (Show, Generic)
 
@@ -559,6 +559,12 @@ defSqsThrottleMillis = 500
 defUserMaxPermClients :: Int
 defUserMaxPermClients = 7
 
+defSftServiceName :: ByteString
+defSftServiceName = "_sft"
+
+defSftDiscoveryIntervalSeconds :: DiffTime
+defSftDiscoveryIntervalSeconds = secondsToDiffTime 10
+
 instance FromJSON Timeout where
   parseJSON (Y.Number n) =
     let defaultV = 3600

From 009961d852839e28bb5b6844a0399775025dbe64 Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Wed, 29 Jul 2020 18:19:01 +0200
Subject: [PATCH 31/48] randomize sft URLs

---
 services/brig/src/Brig/Calling/API.hs | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs
index 9ea5fdb12fe..0d7f25147f5 100644
--- a/services/brig/src/Brig/Calling/API.hs
+++ b/services/brig/src/Brig/Calling/API.hs
@@ -125,13 +125,15 @@ newConfig env mSftEnv limit = do
     pure $ Public.rtcIceServer (uri :| []) u (computeCred sha secret u)
   sftSrvEntries <- maybe (pure Nothing) (readIORef . sftServers) mSftEnv
   -- According to RFC2782, the SRV Entries are supposed to be tried in order of
-  -- priority and weight, but the clients try all of them concurrently, so there
-  -- is no point ordering these entries
-  pure $ Public.rtcConfiguration srvs (sftServerFromSrvTarget . srvTarget <$$> sftSrvEntries) cTTL
+  -- priority and weight, but we internally agreed to randomize the list of
+  -- available servers for poor man's "load balancing" purposes.
+  -- FUTUREWORK: be smarter about list orderding depending on how much capacity SFT servers have.
+  randomizedSftEntries <- liftIO $ randomize <$> sftSrvEntries
+  pure $ Public.rtcConfiguration srvs (sftServerFromSrvTarget . srvTarget <$$> randomizedSftSrvEntries) cTTL
   where
     -- NOTE: even though `shuffleM` works only for [a], input is List1 so it's
     --       safe to pattern match; ideally, we'd have `shuffleM` for `NonEmpty`
-    randomize :: (MonadRandom m, MonadFail m) => NonEmpty Public.TurnURI -> m (NonEmpty Public.TurnURI)
+    randomize :: (MonadRandom m, MonadFail m) => NonEmpty a -> m (NonEmpty a)
     randomize xs = NonEmpty.fromList <$> shuffleM (NonEmpty.toList xs)
     --
     limitedList :: NonEmpty Public.TurnURI -> Range 1 10 Int -> NonEmpty Public.TurnURI

From b554390cfe191ecbb97d9a48d6683b50a1fa839d Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Wed, 29 Jul 2020 19:10:23 +0200
Subject: [PATCH 32/48] Commit the forgotten Brig.PolyLog module

---
 services/brig/src/Brig/PolyLog.hs | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)
 create mode 100644 services/brig/src/Brig/PolyLog.hs

diff --git a/services/brig/src/Brig/PolyLog.hs b/services/brig/src/Brig/PolyLog.hs
new file mode 100644
index 00000000000..758e5283548
--- /dev/null
+++ b/services/brig/src/Brig/PolyLog.hs
@@ -0,0 +1,19 @@
+module Brig.PolyLog where
+
+import Imports
+import Polysemy
+import qualified System.Logger as Log
+
+-- | This effect will help us write tests for log messages
+--
+-- FUTUREWORK: Move this to a separate module if it is required
+--
+-- FUTUREWORK: Either write an orphan instance for MonadLogger or provide
+-- equivalent functions in System.Logger.Class
+data PolyLog m a where
+  PolyLog :: Log.Level -> (Log.Msg -> Log.Msg) -> PolyLog m ()
+
+makeSem 'PolyLog
+
+runPolyLog :: Member (Embed IO) r => Log.Logger -> Sem (PolyLog ': r) a -> Sem r a
+runPolyLog logger = interpret $ \(PolyLog lvl msg) -> Log.log logger lvl msg

From 75255030c81dee04ed507821c931f67f26d84ef7 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 30 Jul 2020 08:31:04 +0200
Subject: [PATCH 33/48] Fix compile errors

---
 services/brig/src/Brig/Calling.hs     | 2 +-
 services/brig/src/Brig/Calling/API.hs | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs
index 30635a97189..7e52c3b76d2 100644
--- a/services/brig/src/Brig/Calling.hs
+++ b/services/brig/src/Brig/Calling.hs
@@ -73,7 +73,7 @@ mkSFTEnv opts =
   SFTEnv
     <$> newIORef Nothing
     <*> pure (mkSFTDomain opts)
-    <*> pure (diffTimeToMicroseconds (maybe defSftDiscoveryIntervalSeconds (Opts.sftDiscoveryIntervalSeconds opts)))
+    <*> pure (diffTimeToMicroseconds (fromMaybe defSftDiscoveryIntervalSeconds (Opts.sftDiscoveryIntervalSeconds opts)))
 
 startSFTServiceDiscovery :: Log.Logger -> SFTEnv -> IO ()
 startSFTServiceDiscovery logger =
diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs
index 0d7f25147f5..96f59f372d2 100644
--- a/services/brig/src/Brig/Calling/API.hs
+++ b/services/brig/src/Brig/Calling/API.hs
@@ -128,8 +128,8 @@ newConfig env mSftEnv limit = do
   -- priority and weight, but we internally agreed to randomize the list of
   -- available servers for poor man's "load balancing" purposes.
   -- FUTUREWORK: be smarter about list orderding depending on how much capacity SFT servers have.
-  randomizedSftEntries <- liftIO $ randomize <$> sftSrvEntries
-  pure $ Public.rtcConfiguration srvs (sftServerFromSrvTarget . srvTarget <$$> randomizedSftSrvEntries) cTTL
+  randomizedSftEntries <- liftIO $ mapM randomize sftSrvEntries
+  pure $ Public.rtcConfiguration srvs (sftServerFromSrvTarget . srvTarget <$$> randomizedSftEntries) cTTL
   where
     -- NOTE: even though `shuffleM` works only for [a], input is List1 so it's
     --       safe to pattern match; ideally, we'd have `shuffleM` for `NonEmpty`

From 7edee6a92cdab70d1c92c226ce1b403669d8b3c9 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 30 Jul 2020 08:31:19 +0200
Subject: [PATCH 34/48] Simplify DNSLookup interpretation

---
 libs/dns-util/src/Wire/Network/DNS/Effect.hs | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/libs/dns-util/src/Wire/Network/DNS/Effect.hs b/libs/dns-util/src/Wire/Network/DNS/Effect.hs
index 757355e3368..c70cdafa2a5 100644
--- a/libs/dns-util/src/Wire/Network/DNS/Effect.hs
+++ b/libs/dns-util/src/Wire/Network/DNS/Effect.hs
@@ -30,8 +30,7 @@ makeSem ''DNSLookup
 
 runDNSLookupDefault :: Member (Embed IO) r => Sem (DNSLookup ': r) a -> Sem r a
 runDNSLookupDefault =
-  interpret $ \l -> do
-    rs <- embed $ DNS.makeResolvSeed DNS.defaultResolvConf
-    embed $ DNS.withResolver rs $ \resolver ->
-      case l of
-        LookupSRV domain -> interpretResponse <$> DNS.lookupSRV resolver domain
+  interpret $ \(LookupSRV domain) -> embed $ do
+    rs <- DNS.makeResolvSeed DNS.defaultResolvConf
+    DNS.withResolver rs $ \resolver ->
+      interpretResponse <$> DNS.lookupSRV resolver domain

From 959adfab72824d6e0653e29c84d1743388a308bf Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 30 Jul 2020 08:52:43 +0200
Subject: [PATCH 35/48] Cleanup async thread creation for SFT discovery

---
 services/brig/src/Brig/Run.hs          | 8 ++++----
 services/brig/test/integration/Util.hs | 8 ++++----
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs
index 4c9564df37f..9f467a31721 100644
--- a/services/brig/src/Brig/Run.hs
+++ b/services/brig/src/Brig/Run.hs
@@ -60,13 +60,13 @@ run o = do
     Async.async
       $ AWS.execute (e ^. awsEnv)
       $ AWS.listen throttleMillis q (runAppT e . SesNotification.onEvent)
-  sftDiscovery <- case e ^. sftEnv of
-    Nothing -> Async.async (pure ()) -- TODO: This looks fishy
-    Just sftEnv' -> Async.async $ Calling.startSFTServiceDiscovery (e ^. applog) sftEnv'
+  sftDiscovery <-
+    forM (e ^. sftEnv) $ \sftEnv' ->
+      Async.async $ Calling.startSFTServiceDiscovery (e ^. applog) sftEnv'
   runSettingsWithShutdown s app 5 `finally` do
     mapM_ Async.cancel emailListener
     Async.cancel internalEventListener
-    Async.cancel sftDiscovery
+    mapM_ Async.cancel sftDiscovery
     closeEnv e
   where
     endpoint = brig o
diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs
index dad89067774..2161b748019 100644
--- a/services/brig/test/integration/Util.hs
+++ b/services/brig/test/integration/Util.hs
@@ -712,11 +712,11 @@ retryWhileN n f m =
 withSettingsOverrides :: MonadIO m => Opts.Opts -> WaiTest.Session a -> m a
 withSettingsOverrides opts action = liftIO $ do
   (brigApp, env) <- Run.mkApp opts
-  asyncDiscovery <- case env ^. sftEnv of
-    Nothing -> Async.async (pure ()) --TODO: This looks fishy
-    Just e -> Async.async $ Calling.startSFTServiceDiscovery (env ^. applog) e
+  sftDiscovery <-
+    forM (env ^. sftEnv) $ \sftEnv' ->
+      Async.async $ Calling.startSFTServiceDiscovery (env ^. applog) sftEnv'
   res <- WaiTest.runSession action brigApp
-  Async.cancel asyncDiscovery
+  mapM_ Async.cancel sftDiscovery
   pure res
 
 -- | When we remove the customer-specific extension of domain blocking, this test will fail to

From a48689cb0cbdb02b460a51e1873f81d22cc881a1 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 30 Jul 2020 08:54:15 +0200
Subject: [PATCH 36/48] Remove leftover TODO comment

---
 services/brig/src/Brig/Calling.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs
index 7e52c3b76d2..19baa340657 100644
--- a/services/brig/src/Brig/Calling.hs
+++ b/services/brig/src/Brig/Calling.hs
@@ -43,7 +43,6 @@ data SFTEnv = SFTEnv
     sftDiscoveryInterval :: Int
   }
 
--- TODO: Log stuff here (and test it?)
 discoverSFTServers :: Members [DNSLookup, PolyLog] r => DNS.Domain -> Sem r (Maybe (NonEmpty SrvEntry))
 discoverSFTServers domain =
   lookupSRV domain >>= \case

From 7ec72b1b828c2fc4d2b22d24d73acac503a40e49 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 30 Jul 2020 09:13:10 +0200
Subject: [PATCH 37/48] Add a safe way to create `HttpsUrl`

---
 libs/types-common/src/Data/Misc.hs         | 6 +++++-
 services/brig/src/Brig/Calling/Internal.hs | 4 ++--
 2 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/libs/types-common/src/Data/Misc.hs b/libs/types-common/src/Data/Misc.hs
index 019e3395f03..2e3301fff8e 100644
--- a/libs/types-common/src/Data/Misc.hs
+++ b/libs/types-common/src/Data/Misc.hs
@@ -42,6 +42,7 @@ module Data.Misc
     -- * HttpsUrl
     HttpsUrl (..),
     mkHttpsUrl,
+    ensureHttpsUrl,
 
     -- * Fingerprint
     Fingerprint (..),
@@ -60,7 +61,7 @@ module Data.Misc
 where
 
 import Cassandra
-import Control.Lens ((^.), makeLenses)
+import Control.Lens ((.~), (^.), makeLenses)
 import Data.Aeson
 import qualified Data.Aeson.Types as Json
 import qualified Data.Attoparsec.ByteString.Char8 as Chars
@@ -244,6 +245,9 @@ mkHttpsUrl uri =
     then Right $ HttpsUrl uri
     else Left $ "Non-HTTPS URL: " ++ show uri
 
+ensureHttpsUrl :: URIRef Absolute -> HttpsUrl
+ensureHttpsUrl = HttpsUrl . (uriSchemeL . schemeBSL .~ "https")
+
 instance Show HttpsUrl where
   showsPrec i = showsPrec i . httpsUrl
 
diff --git a/services/brig/src/Brig/Calling/Internal.hs b/services/brig/src/Brig/Calling/Internal.hs
index badcb50dacd..93794fe04ec 100644
--- a/services/brig/src/Brig/Calling/Internal.hs
+++ b/services/brig/src/Brig/Calling/Internal.hs
@@ -19,7 +19,7 @@ module Brig.Calling.Internal where
 
 import Control.Lens ((?~))
 import qualified Data.ByteString.Char8 as BS
-import Data.Misc (mkHttpsUrl)
+import Data.Misc (ensureHttpsUrl)
 import Imports
 import qualified URI.ByteString as URI
 import qualified URI.ByteString.QQ as URI
@@ -32,7 +32,7 @@ sftServerFromSrvTarget (SrvTarget host port) =
       uri =
         [URI.uri|https://|]
           & URI.authorityL ?~ URI.Authority Nothing (URI.Host (dropTrailingDot host)) (Just uriPort)
-   in either (error "sftServerFromSrvTarget: invalid https URI") Public.sftServer (mkHttpsUrl uri)
+   in Public.sftServer (ensureHttpsUrl uri)
   where
     dropTrailingDot :: ByteString -> ByteString
     dropTrailingDot bs =

From c4a6a9a387a9dafd91aec72594e6436549349a7c Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 30 Jul 2020 09:48:10 +0200
Subject: [PATCH 38/48] Replace maybe with another type to clarify semantics of
 discovery

---
 services/brig/src/Brig/Calling.hs            | 19 ++++++++++++++++---
 services/brig/src/Brig/Calling/API.hs        |  2 +-
 services/brig/test/unit/Test/Brig/Calling.hs | 10 +++++-----
 3 files changed, 22 insertions(+), 9 deletions(-)

diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs
index 19baa340657..61fdf80e98f 100644
--- a/services/brig/src/Brig/Calling.hs
+++ b/services/brig/src/Brig/Calling.hs
@@ -37,12 +37,25 @@ import Wire.Network.DNS.Effect
 import Wire.Network.DNS.SRV
 
 data SFTEnv = SFTEnv
-  { sftServers :: IORef (Maybe (NonEmpty SrvEntry)),
+  { -- | Starts off as `NotDiscoveredYet`, once it has servers, it should never
+    -- go back to `NotDiscoveredYet` and continue having stale values if
+    -- subsequent discovries fail
+    sftServers :: IORef (Discovery (NonEmpty SrvEntry)),
     sftDomain :: DNS.Domain,
     -- | Microseconds, as expected by 'threadDelay'
     sftDiscoveryInterval :: Int
   }
 
+data Discovery a
+  = NotDiscoveredYet
+  | Discovered a
+  deriving (Show, Eq)
+
+discoveryToMaybe :: Discovery a -> Maybe a
+discoveryToMaybe = \case
+  NotDiscoveredYet -> Nothing
+  Discovered x -> Just x
+
 discoverSFTServers :: Members [DNSLookup, PolyLog] r => DNS.Domain -> Sem r (Maybe (NonEmpty SrvEntry))
 discoverSFTServers domain =
   lookupSRV domain >>= \case
@@ -64,13 +77,13 @@ sftDiscoveryLoop SFTEnv {..} = forever $ do
   servers <- discoverSFTServers sftDomain
   case servers of
     Nothing -> pure ()
-    es -> atomicWriteIORef sftServers es
+    Just es -> atomicWriteIORef sftServers (Discovered es)
   threadDelay sftDiscoveryInterval
 
 mkSFTEnv :: SFTOptions -> IO SFTEnv
 mkSFTEnv opts =
   SFTEnv
-    <$> newIORef Nothing
+    <$> newIORef NotDiscoveredYet
     <*> pure (mkSFTDomain opts)
     <*> pure (diffTimeToMicroseconds (fromMaybe defSftDiscoveryIntervalSeconds (Opts.sftDiscoveryIntervalSeconds opts)))
 
diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs
index 96f59f372d2..e991b91bb2f 100644
--- a/services/brig/src/Brig/Calling/API.hs
+++ b/services/brig/src/Brig/Calling/API.hs
@@ -123,7 +123,7 @@ newConfig env mSftEnv limit = do
   srvs <- for finalUris $ \uri -> do
     u <- liftIO $ genUsername tTTL prng
     pure $ Public.rtcIceServer (uri :| []) u (computeCred sha secret u)
-  sftSrvEntries <- maybe (pure Nothing) (readIORef . sftServers) mSftEnv
+  sftSrvEntries <- maybe (pure Nothing) ((fmap discoveryToMaybe) . readIORef . sftServers) mSftEnv
   -- According to RFC2782, the SRV Entries are supposed to be tried in order of
   -- priority and weight, but we internally agreed to randomize the list of
   -- available servers for poor man's "load balancing" purposes.
diff --git a/services/brig/test/unit/Test/Brig/Calling.hs b/services/brig/test/unit/Test/Brig/Calling.hs
index 23d588d4b63..02248bbef0b 100644
--- a/services/brig/test/unit/Test/Brig/Calling.hs
+++ b/services/brig/test/unit/Test/Brig/Calling.hs
@@ -101,11 +101,11 @@ testDiscoveryLoopWhenSuccessful = do
   discoveryLoop <- Async.async $ runM . ignoreLogs . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
   void $ retryEvery10MicrosWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
   -- We don't want to stop the loop before it has written to the sftServers IORef
-  void $ retryEvery10MicrosWhileN 2000 (isNothing) (readIORef (sftServers sftEnv))
+  void $ retryEvery10MicrosWhileN 2000 (== NotDiscoveredYet) (readIORef (sftServers sftEnv))
   Async.cancel discoveryLoop
 
   actualServers <- readIORef (sftServers sftEnv)
-  assertEqual "servers should be the ones read from DNS" (Just returnedEntries) actualServers
+  assertEqual "servers should be the ones read from DNS" (Discovered returnedEntries) actualServers
   pure sftEnv
 
 testDiscoveryLoopWhenUnsuccessful :: IO ()
@@ -120,7 +120,7 @@ testDiscoveryLoopWhenUnsuccessful = do
   Async.cancel discoveryLoop
 
   actualServers <- readIORef (sftServers sftEnv)
-  assertEqual "servers should be the ones read from DNS" Nothing actualServers
+  assertEqual "servers should be the ones read from DNS" NotDiscoveredYet actualServers
 
 testDiscoveryLoopWhenUnsuccessfulAfterSuccess :: IO ()
 testDiscoveryLoopWhenUnsuccessfulAfterSuccess = do
@@ -153,11 +153,11 @@ testDiscoveryLoopWhenURLsChange = do
   discoveryLoop <- Async.async $ runM . ignoreLogs . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
   void $ retryEvery10MicrosWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
   -- We don't want to stop the loop before it has written to the sftServers IORef
-  void $ retryEvery10MicrosWhileN 2000 (== Just newEntries) (readIORef (sftServers sftEnv))
+  void $ retryEvery10MicrosWhileN 2000 (== Discovered newEntries) (readIORef (sftServers sftEnv))
   Async.cancel discoveryLoop
 
   actualServers <- readIORef (sftServers sftEnv)
-  assertEqual "servers should get overwritten" (Just newEntries) actualServers
+  assertEqual "servers should get overwritten" (Discovered newEntries) actualServers
 
 testSFTDiscoverWhenAvailable :: IO ()
 testSFTDiscoverWhenAvailable = do

From 2f7c0fb901bd64157a308d8fbc41cbacc6740343 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 30 Jul 2020 11:18:12 +0200
Subject: [PATCH 39/48] Group TURN tests so they can be skipped by CI as they
 were

Code to skip: https://github.com/wireapp/wire-server-deploy/blob/f602fd47794da363394dcaf30550e2b6fa2177c6/charts/brig/templates/tests/brig-integration.yaml#L56
---
 services/brig/test/integration/API/Calling.hs | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs
index 8844275f817..b12a8e612b6 100644
--- a/services/brig/test/integration/API/Calling.hs
+++ b/services/brig/test/integration/API/Calling.hs
@@ -48,13 +48,14 @@ import Wire.API.Call.Config
 
 tests :: Manager -> Brig -> Opts.Opts -> FilePath -> FilePath -> IO TestTree
 tests m b opts turn turnV2 = do
-  return $
-    testGroup
-      "calling"
-      [ test m "basic /calls/config - 200" $ testCallsConfig b,
-        -- FIXME: requires tests to run on same host as brig
-        test m "multiple servers /calls/config - 200" . withTurnFile turn $ testCallsConfigMultiple b,
-        test m "multiple servers /calls/config/v2 - 200" . withTurnFile turnV2 $ testCallsConfigMultipleV2 b,
+  return
+    $ testGroup "calling"
+    $ [ testGroup "turn" $
+          [ test m "basic /calls/config - 200" $ testCallsConfig b,
+            -- FIXME: requires tests to run on same host as brig
+            test m "multiple servers /calls/config - 200" . withTurnFile turn $ testCallsConfigMultiple b,
+            test m "multiple servers /calls/config/v2 - 200" . withTurnFile turnV2 $ testCallsConfigMultipleV2 b
+          ],
         test m "SFT servers /calls/config/v2 - 200" $ testSFT b opts
       ]
 

From b5e26ae0e465987ae100061f1b241e0bdd5b21cb Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 30 Jul 2020 11:19:42 +0200
Subject: [PATCH 40/48] Put SFT test in a testGroup for symmetry

---
 services/brig/test/integration/API/Calling.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs
index b12a8e612b6..188292b7e09 100644
--- a/services/brig/test/integration/API/Calling.hs
+++ b/services/brig/test/integration/API/Calling.hs
@@ -56,7 +56,7 @@ tests m b opts turn turnV2 = do
             test m "multiple servers /calls/config - 200" . withTurnFile turn $ testCallsConfigMultiple b,
             test m "multiple servers /calls/config/v2 - 200" . withTurnFile turnV2 $ testCallsConfigMultipleV2 b
           ],
-        test m "SFT servers /calls/config/v2 - 200" $ testSFT b opts
+        testGroup "sft" $ [test m "SFT servers /calls/config/v2 - 200" $ testSFT b opts]
       ]
 
 testCallsConfig :: Brig -> Http ()

From 939c802033987d03e93b2725e8c3da5b91b8ef51 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 30 Jul 2020 15:13:12 +0200
Subject: [PATCH 41/48] brig/integration API.Calling: Slightly better
 formatting

---
 services/brig/test/integration/API/Calling.hs | 19 +++++++++----------
 1 file changed, 9 insertions(+), 10 deletions(-)

diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs
index 188292b7e09..d7ce6376feb 100644
--- a/services/brig/test/integration/API/Calling.hs
+++ b/services/brig/test/integration/API/Calling.hs
@@ -48,16 +48,15 @@ import Wire.API.Call.Config
 
 tests :: Manager -> Brig -> Opts.Opts -> FilePath -> FilePath -> IO TestTree
 tests m b opts turn turnV2 = do
-  return
-    $ testGroup "calling"
-    $ [ testGroup "turn" $
-          [ test m "basic /calls/config - 200" $ testCallsConfig b,
-            -- FIXME: requires tests to run on same host as brig
-            test m "multiple servers /calls/config - 200" . withTurnFile turn $ testCallsConfigMultiple b,
-            test m "multiple servers /calls/config/v2 - 200" . withTurnFile turnV2 $ testCallsConfigMultipleV2 b
-          ],
-        testGroup "sft" $ [test m "SFT servers /calls/config/v2 - 200" $ testSFT b opts]
-      ]
+  return $ testGroup "calling" $
+    [ testGroup "turn" $
+        [ test m "basic /calls/config - 200" $ testCallsConfig b,
+          -- FIXME: requires tests to run on same host as brig
+          test m "multiple servers /calls/config - 200" . withTurnFile turn $ testCallsConfigMultiple b,
+          test m "multiple servers /calls/config/v2 - 200" . withTurnFile turnV2 $ testCallsConfigMultipleV2 b
+        ],
+      testGroup "sft" $ [test m "SFT servers /calls/config/v2 - 200" $ testSFT b opts]
+    ]
 
 testCallsConfig :: Brig -> Http ()
 testCallsConfig b = do

From 2c3ef08d28ade8210ac308769ba7828d2c7eac32 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 30 Jul 2020 15:17:57 +0200
Subject: [PATCH 42/48] Add FUTUREWORK to extract a function

---
 services/brig/src/Brig/Calling/Internal.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/services/brig/src/Brig/Calling/Internal.hs b/services/brig/src/Brig/Calling/Internal.hs
index 93794fe04ec..bb3453cae23 100644
--- a/services/brig/src/Brig/Calling/Internal.hs
+++ b/services/brig/src/Brig/Calling/Internal.hs
@@ -26,6 +26,8 @@ import qualified URI.ByteString.QQ as URI
 import qualified Wire.API.Call.Config as Public
 import Wire.Network.DNS.SRV (SrvTarget (..))
 
+-- FUTUREWORK: Extract function to translate SrvTarget to HttpsUrl and use it
+-- wherever we use DNS for service discovery
 sftServerFromSrvTarget :: SrvTarget -> Public.SFTServer
 sftServerFromSrvTarget (SrvTarget host port) =
   let uriPort = URI.Port (fromIntegral port)

From f54e61197c6131e0d461f8c05395b2a4171b9408 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 30 Jul 2020 15:21:04 +0200
Subject: [PATCH 43/48] Add roundtrip test for Call.Config.SFTServer

---
 libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs
index e6b6514b379..faa9a6c9f6b 100644
--- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs
+++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs
@@ -92,6 +92,7 @@ tests =
       testRoundTrip @Call.Config.TurnUsername,
       testRoundTrip @Call.Config.RTCIceServer,
       testRoundTrip @Call.Config.RTCConfiguration,
+      testRoundTrip @Call.Config.SFTServer,
       testRoundTrip @Connection.ConnectionRequest,
       testRoundTrip @Connection.Relation,
       testRoundTrip @Connection.Message,

From 4f0d7d2f66b3158238dd7eb8f251256ffda1d8a4 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 30 Jul 2020 15:22:36 +0200
Subject: [PATCH 44/48] More accurate doc for SFTServer

---
 libs/wire-api/src/Wire/API/Call/Config.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/libs/wire-api/src/Wire/API/Call/Config.hs b/libs/wire-api/src/Wire/API/Call/Config.hs
index 6a921f6c1dd..6839bcd9110 100644
--- a/libs/wire-api/src/Wire/API/Call/Config.hs
+++ b/libs/wire-api/src/Wire/API/Call/Config.hs
@@ -163,7 +163,7 @@ modelRtcSftServer :: Doc.Model
 modelRtcSftServer = Doc.defineModel "RTC SFT Server" $ do
   Doc.description "Inspired by WebRTC 'RTCIceServer' object, contains details of SFT servers"
   Doc.property "urls" (Doc.array Doc.string') $
-    Doc.description "Array of SFT server addresses of the form 'https://<addr>:<port>'"
+    Doc.description "Array containing exactly one SFT server address of the form 'https://<addr>:<port>'"
 
 --------------------------------------------------------------------------------
 -- RTCIceServer

From b7b92d8388f3f7a82b6f5b59c6a1335a6f977bd8 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 30 Jul 2020 15:24:49 +0200
Subject: [PATCH 45/48] Add link to issue for FUTUREWORK

---
 services/brig/src/Brig/Run.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs
index 9f467a31721..7e7fe01b1b6 100644
--- a/services/brig/src/Brig/Run.hs
+++ b/services/brig/src/Brig/Run.hs
@@ -47,6 +47,7 @@ import Util.Options
 -- FUTUREWORK: If any of these async threads die, we will have no clue about it
 -- and brig could start misbehaving. We should ensure that brig dies whenever a
 -- thread terminates for any reason.
+-- https://github.com/zinfra/backend-issues/issues/1647
 run :: Opts -> IO ()
 run o = do
   (app, e) <- mkApp o

From 3929ea6fceb4c9877790d5fec8b38d3e032918fc Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 30 Jul 2020 15:25:00 +0200
Subject: [PATCH 46/48] Pointfree sft discovery async call

---
 services/brig/src/Brig/Run.hs | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs
index 7e7fe01b1b6..f4f25cc9da1 100644
--- a/services/brig/src/Brig/Run.hs
+++ b/services/brig/src/Brig/Run.hs
@@ -61,9 +61,7 @@ run o = do
     Async.async
       $ AWS.execute (e ^. awsEnv)
       $ AWS.listen throttleMillis q (runAppT e . SesNotification.onEvent)
-  sftDiscovery <-
-    forM (e ^. sftEnv) $ \sftEnv' ->
-      Async.async $ Calling.startSFTServiceDiscovery (e ^. applog) sftEnv'
+  sftDiscovery <- forM (e ^. sftEnv) $ Async.async . Calling.startSFTServiceDiscovery (e ^. applog)
   runSettingsWithShutdown s app 5 `finally` do
     mapM_ Async.cancel emailListener
     Async.cancel internalEventListener

From 1f176f4a7c7f0ed91f0d0e79757b91ac1047ab64 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 30 Jul 2020 15:28:51 +0200
Subject: [PATCH 47/48] Add deprecation notice to /calls/config swagger docs

---
 services/brig/src/Brig/Calling/API.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs
index e991b91bb2f..8ca7e279b93 100644
--- a/services/brig/src/Brig/Calling/API.hs
+++ b/services/brig/src/Brig/Calling/API.hs
@@ -61,6 +61,7 @@ routesPublic = do
       .&. header "Z-User"
       .&. header "Z-Connection"
   document "GET" "getCallsConfig" $ do
+    Doc.deprecated
     Doc.summary
       "Retrieve TURN server addresses and credentials for \
       \ IP addresses, scheme `turn` and transport `udp` only "

From 55cb7b0bd2862de5b4ba314d27ed2f9d545812d7 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Thu, 30 Jul 2020 15:36:29 +0200
Subject: [PATCH 48/48] Brig.Calling.Internal: Declutter sftServerFromSrvTarget

---
 services/brig/src/Brig/Calling/Internal.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/services/brig/src/Brig/Calling/Internal.hs b/services/brig/src/Brig/Calling/Internal.hs
index bb3453cae23..0ce1947b094 100644
--- a/services/brig/src/Brig/Calling/Internal.hs
+++ b/services/brig/src/Brig/Calling/Internal.hs
@@ -31,9 +31,8 @@ import Wire.Network.DNS.SRV (SrvTarget (..))
 sftServerFromSrvTarget :: SrvTarget -> Public.SFTServer
 sftServerFromSrvTarget (SrvTarget host port) =
   let uriPort = URI.Port (fromIntegral port)
-      uri =
-        [URI.uri|https://|]
-          & URI.authorityL ?~ URI.Authority Nothing (URI.Host (dropTrailingDot host)) (Just uriPort)
+      uriHost = URI.Host (dropTrailingDot host)
+      uri = [URI.uri|https://|] & URI.authorityL ?~ URI.Authority Nothing uriHost (Just uriPort)
    in Public.sftServer (ensureHttpsUrl uri)
   where
     dropTrailingDot :: ByteString -> ByteString