[chore] Weed out dead code.

changelog.d/5-internal/weed

@@ -0,0 +1 @@
+Started weeding out dead code.

integration/test/API/Brig.hs

@@ -123,14 +123,6 @@ getUser user target = do
       joinHttpPath ["users", domain, uid]
   submit "GET" req
 
-getUserByHandle :: (HasCallStack, MakesValue user, MakesValue domain) => user -> domain -> String -> App Response
-getUserByHandle user domain handle = do
-  domainStr <- asString domain
-  req <-
-    baseRequest user Brig Versioned $
-      joinHttpPath ["users", "by-handle", domainStr, handle]
-  submit "GET" req
-
 -- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_clients__client_
 getClient ::
   (HasCallStack, MakesValue user, MakesValue client) =>
@@ -476,9 +468,6 @@ getSwaggerPublicTOC = do
       joinHttpPath ["api", "swagger-ui"]
   submit "GET" req
 
-getSwaggerInternalTOC :: (HasCallStack) => App Response
-getSwaggerInternalTOC = error "FUTUREWORK: this API end-point does not exist."
-
 getSwaggerPublicAllUI :: (HasCallStack) => Int -> App Response
 getSwaggerPublicAllUI version = do
   req <-

integration/test/API/BrigInternal.hs

@@ -160,17 +160,6 @@ refreshIndex domain = do
   res <- submit "POST" req
   res.status `shouldMatchInt` 200
 
-connectWithRemoteUser :: (MakesValue userFrom, MakesValue userTo) => userFrom -> userTo -> App ()
-connectWithRemoteUser userFrom userTo = do
-  userFromId <- objId userFrom
-  qUserTo <- make userTo
-  let body = ["tag" .= "CreateConnectionForTest", "user" .= userFromId, "other" .= qUserTo]
-  req <-
-    baseRequest userFrom Brig Unversioned $
-      joinHttpPath ["i", "connections", "connection-update"]
-  res <- submit "PUT" (req & addJSONObject body)
-  res.status `shouldMatchInt` 200
-
 addFederationRemoteTeam :: (HasCallStack, MakesValue domain, MakesValue remoteDomain, MakesValue team) => domain -> remoteDomain -> team -> App ()
 addFederationRemoteTeam domain remoteDomain team = do
   void $ addFederationRemoteTeam' domain remoteDomain team >>= getBody 200

integration/test/API/Cargohold.hs

@@ -72,9 +72,6 @@ textPlainMime = MIME.Text $ T.pack "plain"
 multipartMixedMime :: String
 multipartMixedMime = "multipart/mixed; boundary=" <> multipartBoundary
 
-mimeTypeToString :: MIME.MIMEType -> String
-mimeTypeToString = T.unpack . MIME.showMIMEType
-
 buildUploadAssetRequestBody ::
   (HasCallStack, MakesValue assetRetention) =>
   Bool ->

integration/test/API/Common.hs

@@ -10,13 +10,6 @@ import qualified Data.Vector as Vector
 import System.Random (randomIO, randomRIO)
 import Testlib.Prelude
 
-teamRole :: String -> Int
-teamRole "partner" = 1025
-teamRole "member" = 1587
-teamRole "admin" = 5951
-teamRole "owner" = 8191
-teamRole bad = error $ "unknown team role: " <> bad
-
 -- | please don't use special shell characters like '!' here.  it makes writing shell lines
 -- that use test data a lot less straight-forward.
 defPassword :: String

integration/test/API/Galley.hs

@@ -614,6 +614,21 @@ disableLegalHold tid ownerid uid pw = do
   req <- baseRequest ownerid Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr])
   submit "DELETE" (addJSONObject ["password" .= pw] req)
 
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_teams__tid__legalhold_consent
+consentToLegalHold :: (HasCallStack, MakesValue tid, MakesValue zusr) => tid -> zusr -> String -> App Response
+consentToLegalHold tid zusr pwd = do
+  tidStr <- asString tid
+  req <- baseRequest zusr Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", "consent"])
+  submit "POST" (addJSONObject ["password" .= pwd] req)
+
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_teams__tid__legalhold__uid_
+getLegalHoldStatus :: (HasCallStack, MakesValue tid, MakesValue zusr) => tid -> zusr -> App Response
+getLegalHoldStatus tid zusr = do
+  tidStr <- asString tid
+  uidStr <- asString $ zusr %. "id"
+  req <- baseRequest zusr Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr])
+  submit "GET" req
+
 -- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_teams__tid__legalhold_settings
 postLegalHoldSettings :: (HasCallStack, MakesValue ownerid, MakesValue tid, MakesValue newService) => tid -> ownerid -> newService -> App Response
 postLegalHoldSettings tid owner newSettings =
@@ -653,21 +668,6 @@ approveLegalHoldDevice' tid uid forUid pwd = do
   req <- baseRequest uid Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr, "approve"])
   submit "PUT" (addJSONObject ["password" .= pwd] req)
 
--- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_teams__tid__legalhold_consent
-consentToLegalHold :: (HasCallStack, MakesValue tid, MakesValue zusr) => tid -> zusr -> String -> App Response
-consentToLegalHold tid zusr pwd = do
-  tidStr <- asString tid
-  req <- baseRequest zusr Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", "consent"])
-  submit "POST" (addJSONObject ["password" .= pwd] req)
-
--- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_teams__tid__legalhold__uid_
-getLegalHoldStatus :: (HasCallStack, MakesValue tid, MakesValue zusr) => tid -> zusr -> App Response
-getLegalHoldStatus tid zusr = do
-  tidStr <- asString tid
-  uidStr <- asString $ zusr %. "id"
-  req <- baseRequest zusr Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr])
-  submit "GET" req
-
 -- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/put_teams__tid__features_legalhold
 putLegalholdStatus ::
   (HasCallStack, MakesValue tid, MakesValue usr) =>

integration/test/MLS/Util.hs

@@ -755,17 +755,6 @@ createApplicationMessage cid messageContent = do
 setMLSCiphersuite :: Ciphersuite -> App ()
 setMLSCiphersuite suite = modifyMLSState $ \mls -> mls {ciphersuite = suite}
 
-withCiphersuite :: (HasCallStack) => Ciphersuite -> App a -> App a
-withCiphersuite suite action = do
-  suite0 <- (.ciphersuite) <$> getMLSState
-  setMLSCiphersuiteIO <- appToIOKleisli setMLSCiphersuite
-  actionIO <- appToIO action
-  liftIO $
-    bracket
-      (setMLSCiphersuiteIO suite)
-      (const (setMLSCiphersuiteIO suite0))
-      (const actionIO)
-
 leaveCurrentConv ::
   (HasCallStack) =>
   ClientIdentity ->

integration/test/Test/Cargohold/API/Util.hs

@@ -98,16 +98,6 @@ header :: String -> String -> Request -> Request
 header name value req =
   req {requestHeaders = (mk $ cs name, cs value) : requestHeaders req}
 
-downloadAssetWithAssetKey ::
-  (HasCallStack, MakesValue user) =>
-  (HTTP.Request -> HTTP.Request) ->
-  user ->
-  String ->
-  App Response
-downloadAssetWithAssetKey r user tok = do
-  req <- baseRequest user Cargohold (ExplicitVersion 1) $ "assets/v3/" <> tok
-  submit "GET" $ r $ req & tokenParam tok
-
 class IsAssetToken tok where
   tokenParam :: tok -> Request -> Request
 

integration/test/Test/LegalHold.hs

@@ -593,24 +593,6 @@ testLHGetMembersIncludesStatus = do
     -- bob has accepted the legalhold device
     statusShouldBe "enabled"
 
-type TB s = TaggedBool s
-
-enableLH :: (MakesValue tid, MakesValue teamAdmin, MakesValue targetUser, HasCallStack) => tid -> teamAdmin -> targetUser -> Bool -> App (Maybe String)
-enableLH tid teamAdmin targetUser approveLH = do
-  -- alice requests a legalhold device for herself
-  requestLegalHoldDevice tid teamAdmin targetUser
-    >>= assertStatus 201
-
-  when approveLH do
-    approveLegalHoldDevice tid targetUser defPassword
-      >>= assertStatus 200
-  legalholdUserStatus tid targetUser targetUser `bindResponse` \resp -> do
-    resp.status `shouldMatchInt` 200
-    resp.json %. "status" `shouldMatch` if approveLH then "enabled" else "pending"
-  if approveLH
-    then Just <$> lhDeviceIdOf targetUser
-    else pure Nothing
-
 testLHConnectionsWithNonConsentingUsers :: App ()
 testLHConnectionsWithNonConsentingUsers = do
   (alice, tid, []) <- createTeam OwnDomain 1

integration/test/Testlib/Certs.hs

@@ -32,10 +32,6 @@ privateKeyToString = toPem . keyToPEM PKCS8Format . PrivKeyRSA
 publicKeyToString :: RSA.PublicKey -> String
 publicKeyToString = toPem . pubKeyToPEM . PubKeyRSA
 
--- | order: publickey, private key
-keyPairToString :: RSAKeyPair -> (String, String)
-keyPairToString = bimap publicKeyToString privateKeyToString
-
 -- | the minimum key size is hard coded to be 256 bytes (= 2048 bits)
 mkKeyPair :: (HasCallStack) => (Integer, Integer) -> App RSAKeyPair
 mkKeyPair primes =
@@ -57,21 +53,6 @@ primesB =
     1030843359898456423663521323846594342599509001361505950190458094255790543792826808869649005832755187592625111972154015489882697017782849415061917844274039201990123282710414810809677284498651901967728601289390435426055251344683598043635553930587608961202440578033000424009931449958127951542294372025522185552538021557179009278446615246891375299863655746951224012338422185000952023195927317706092311999889180603374149659663869483313116251085191329801800565556652256960650364631610748235925879940728370511827034946814052737660926604082837303885143652256413187183052924192977324527952882600246973965189570970469037044568259408811931440525775822585332497163319841870179534838043708793539688804501356153704884928847627798172061867373042270416202913078776299057112318300845218218100606684092792088779583532324019862407866255929320869554565576301069075336647916168479092314004711778618335406757602974282533765740790546167166172626995630463716394043281720388344899550856555259477489548509996409954619324524195894460510128676025203769176155038527250084664954695197534485529595784255553806751541708069739004260117122700058054443774458724994738753921481706985581116480802534320353367271370286704034867136678539759260831996400891886615914808935283451835347282009482924185619896114631919985205238905153951336432886954324618000593140640843908517786951586431386674557882396487935889471856924185568502767114186884930347618747984770073080480895996031031971187681573023398782756925726725786964170460286504569090697402674905089317540771910375616350312239688178277204391962835159620450731320465816254229575392846112372636483958055913716148919092913102176828552932292829256960875180097808893909460952573027221089128208000054670526724565994184754244760290009957352237133054978847493874379201323517903544742831961755055100216728931496213920467911320372016970509300894067675803619448926461034580033818298648457643287641768005986812455071220244863874301028965665847375769473444088940776224643189987541019987285740411119351744972645543429351630677554481991322726604779330104110295967482897278840078926508970545806499140537364387530291523697762079684955475417383069988065253583073257131193644210418873929829417895241230927769637328283865111435730810586338426336027745629520975220163350734423915441885289661065494424704587153904031874537230782548938379423349488654701140981815973723582107593419642780372301171156324514852331126462907486017679770773972513376077318418003532168673261819818236071249
   )
 
--- | create a root certificate authority CertificateBundle
-createRootCA ::
-  (HasCallStack) =>
-  -- | the root CA's name
-  String ->
-  -- | the root CA's keymaterial
-  RSAKeyPair ->
-  SignedCert
-createRootCA caName (pubKey, privKey) =
-  mkSignedCert
-    pubKey
-    privKey
-    caName
-    caName
-
 -- | sign an intermediate/ leaf certificate by signing with an intermediate/ root CA's key
 intermediateCert ::
   (HasCallStack) =>

integration/test/Testlib/Env.hs

@@ -11,8 +11,6 @@ import Data.Functor
 import Data.IORef
 import qualified Data.Map as Map
 import Data.Maybe (fromMaybe)
-import Data.Set (Set)
-import qualified Data.Set as Set
 import Data.Traversable (for)
 import qualified Data.Yaml as Yaml
 import qualified Database.CQL.IO as Cassandra
@@ -161,18 +159,6 @@ mkEnv ge = do
           timeOutSeconds = ge.gTimeOutSeconds
         }
 
-destroy :: IORef (Set BackendResource) -> BackendResource -> IO ()
-destroy ioRef = modifyIORef' ioRef . Set.insert
-
-create :: IORef (Set.Set BackendResource) -> IO BackendResource
-create ioRef =
-  atomicModifyIORef
-    ioRef
-    $ \s ->
-      case Set.minView s of
-        Nothing -> error "No resources available"
-        Just (r, s') -> (s', r)
-
 allCiphersuites :: [Ciphersuite]
 -- FUTUREWORK: add 0x0005 to this list once openmls supports it
 allCiphersuites = map Ciphersuite ["0x0001", "0xf031", "0x0002", "0x0007"]

integration/test/Testlib/HTTP.hs

@@ -78,9 +78,6 @@ addQueryParams :: [(String, String)] -> HTTP.Request -> HTTP.Request
 addQueryParams params req =
   HTTP.setQueryString (map (\(k, v) -> (cs k, Just (cs v))) params) req
 
-contentTypeJSON :: HTTP.Request -> HTTP.Request
-contentTypeJSON = addHeader "Content-Type" "application/json"
-
 contentTypeMixed :: HTTP.Request -> HTTP.Request
 contentTypeMixed = addHeader "Content-Type" "multipart/mixed"
 

integration/test/Testlib/Prelude.hs

@@ -52,15 +52,6 @@ module Testlib.Prelude
     putStr,
     putStrLn,
     print,
-    getChar,
-    getLine,
-    getContents,
-    interact,
-    readFile,
-    writeFile,
-    appendFile,
-    readIO,
-    readLn,
     liftIO,
 
     -- * Functor
@@ -186,33 +177,6 @@ putStrLn = liftIO . P.putStrLn
 print :: (Show a, MonadIO m) => a -> m ()
 print = liftIO . P.print
 
-getChar :: (MonadIO m) => m Char
-getChar = liftIO P.getChar
-
-getLine :: (MonadIO m) => m String
-getLine = liftIO P.getLine
-
-getContents :: (MonadIO m) => m String
-getContents = liftIO P.getContents
-
-interact :: (MonadIO m) => (String -> String) -> m ()
-interact = liftIO . P.interact
-
-readFile :: (MonadIO m) => FilePath -> m String
-readFile = liftIO . P.readFile
-
-writeFile :: (MonadIO m) => FilePath -> String -> m ()
-writeFile = fmap liftIO . P.writeFile
-
-appendFile :: (MonadIO m) => FilePath -> String -> m ()
-appendFile = fmap liftIO . P.appendFile
-
-readIO :: (Read a, MonadIO m) => String -> m a
-readIO = liftIO . P.readIO
-
-readLn :: (Read a, MonadIO m) => m a
-readLn = liftIO P.readLn
-
 ----------------------------------------------------------------------
 -- Functor
 

libs/bilge/src/Bilge/RPC.hs

@@ -23,7 +23,6 @@ module Bilge.RPC
     RPCException (..),
     rpc,
     rpc',
-    statusCheck,
     parseResponse,
     rpcExceptionMsg,
   )
@@ -34,7 +33,6 @@ import Bilge.Request
 import Bilge.Response
 import Control.Error hiding (err)
 import Control.Monad.Catch (MonadCatch, MonadThrow (..), try)
-import Control.Monad.Except
 import Data.Aeson (FromJSON, eitherDecode')
 import Data.CaseInsensitive (original)
 import Data.Text.Lazy (pack)
@@ -104,17 +102,6 @@ rpcExceptionMsg (RPCException sys req ex) =
     headers = foldr hdr id (HTTP.requestHeaders req)
     hdr (k, v) x = x ~~ original k .= v
 
-statusCheck ::
-  (MonadError e m) =>
-  Int ->
-  (LText -> e) ->
-  Response (Maybe LByteString) ->
-  m ()
-statusCheck c f r =
-  unless (statusCode r == c) $
-    throwError $
-      f ("unexpected status code: " <> pack (show $ statusCode r))
-
 parseResponse ::
   (Exception e, MonadThrow m, FromJSON a) =>
   (LText -> e) ->

libs/bilge/src/Bilge/TestSession.hs

@@ -40,6 +40,3 @@ liftSession session = SessionT $ do
   let resultInState = runReaderT session app
   let resultInIO = ST.evalStateT resultInState clientState
   liftIO resultInIO
-
-runSessionT :: (Monad m) => SessionT m a -> Wai.Application -> m a
-runSessionT session app = ST.evalStateT (runReaderT (unSessionT session) app) WaiTest.initState

libs/brig-types/brig-types.cabal

@@ -148,13 +148,12 @@ test-suite brig-types-tests
     -Wunused-packages
 
   build-depends:
-      aeson                  >=2.0.1.0
-    , base                   >=4       && <5
+      aeson             >=2.0.1.0
+    , base              >=4       && <5
     , brig-types
-    , bytestring-conversion  >=0.3.1
     , imports
     , openapi3
-    , QuickCheck             >=2.9
+    , QuickCheck        >=2.9
     , tasty
     , tasty-hunit
     , tasty-quickcheck

libs/brig-types/default.nix

@@ -43,7 +43,6 @@ mkDerivation {
   testHaskellDepends = [
     aeson
     base
-    bytestring-conversion
     imports
     openapi3
     QuickCheck

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

@@ -19,7 +19,6 @@ module Test.Brig.Roundtrip where
 
 import Data.Aeson (FromJSON, ToJSON, parseJSON, toJSON)
 import Data.Aeson.Types (parseEither)
-import Data.ByteString.Conversion
 import Data.OpenApi (ToSchema, validatePrettyToJSON)
 import Imports
 import Test.Tasty (TestTree)
@@ -56,14 +55,3 @@ testRoundTripWithSwagger = testProperty msg (trip .&&. scm)
             validatePrettyToJSON v
         )
         $ isNothing (validatePrettyToJSON v)
-
-testRoundTripByteString ::
-  forall a.
-  (Arbitrary a, Typeable a, ToByteString a, FromByteString a, Eq a, Show a) =>
-  TestTree
-testRoundTripByteString = testProperty msg trip
-  where
-    msg = show (typeRep @a)
-    trip (v :: a) =
-      counterexample (show $ toByteString' v) $
-        Just v === (fromByteString . toByteString') v