[chore] Weed out dead code (part 2)

integration/test/API/Galley.hs

@@ -592,13 +592,6 @@ legalholdUserStatus tid ownerid user = do
   req <- baseRequest ownerid Galley Versioned (joinHttpPath ["teams", tidS, "legalhold", uid])
   submit "GET" req
 
--- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_teams__tid__legalhold_settings
-enableLegalHold :: (HasCallStack, MakesValue tid, MakesValue ownerid) => tid -> ownerid -> App Response
-enableLegalHold tid ownerid = do
-  tidStr <- asString tid
-  req <- baseRequest ownerid Galley Versioned (joinHttpPath ["teams", tidStr, "features", "legalhold"])
-  submit "PUT" (addJSONObject ["status" .= "enabled", "ttl" .= "unlimited"] req)
-
 -- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/delete_teams__tid__legalhold__uid_
 disableLegalHold ::
   (HasCallStack, MakesValue tid, MakesValue ownerid, MakesValue uid) =>

integration/test/Testlib/Assertions.hs

@@ -84,21 +84,6 @@ shouldMatchWithMsg msg a b = do
         else pure ""
     assertFailure $ (maybe "" (<> "\n") msg) <> "Actual:\n" <> pa <> "\nExpected:\n" <> pb <> diff
 
--- | apply some canonicalization transformations that *usually* do not change semantics before
--- comparing.
-shouldMatchLeniently :: (MakesValue a, MakesValue b, HasCallStack) => a -> b -> App ()
-shouldMatchLeniently = shouldMatchWithRules [EmptyArrayIsNull, RemoveNullFieldsFromObjects] (const $ pure Nothing)
-
--- | apply *all* canonicalization transformations before comparing.  some of these may not be
--- valid on your input, see 'LenientMatchRule' for details.
-shouldMatchSloppily :: (MakesValue a, MakesValue b, HasCallStack) => a -> b -> App ()
-shouldMatchSloppily = shouldMatchWithRules [minBound ..] (const $ pure Nothing)
-
--- | apply *all* canonicalization transformations before comparing.  some of these may not be
--- valid on your input, see 'LenientMatchRule' for details.
-shouldMatchALittle :: (MakesValue a, MakesValue b, HasCallStack) => (Aeson.Value -> App (Maybe Aeson.Value)) -> a -> b -> App ()
-shouldMatchALittle = shouldMatchWithRules [minBound ..]
-
 data LenientMatchRule
   = EmptyArrayIsNull
   | ArraysAreSets

libs/extended/src/Data/Time/Clock/DiffTime.hs

@@ -11,7 +11,7 @@ where
 import Data.Time
 import Imports
 
--- we really should be doing all this with https://hackage.haskell.org/package/units...
+-- FUTUREWORK: we really should be doing all this with https://hackage.haskell.org/package/units...
 millisecondsToDiffTime :: Integer -> DiffTime
 millisecondsToDiffTime = picosecondsToDiffTime . (e9 *)
 

libs/galley-types/src/Galley/Types/Teams.hs

@@ -245,7 +245,6 @@ findTeamMember u = find ((u ==) . view userId)
 isTeamOwner :: TeamMemberOptPerms -> Bool
 isTeamOwner tm = optionalPermissions tm == Just fullPermissions
 
--- | Use this to construct the condition expected by 'teamMemberJson', 'teamMemberListJson'
 canSeePermsOf :: TeamMember -> TeamMember -> Bool
 canSeePermsOf seeer seeee =
   seeer `hasPermission` GetMemberPermissions || seeer == seeee

libs/hscim/src/Web/Scim/Client.hs

@@ -31,7 +31,6 @@ module Web.Scim.Client
     getUsers,
     getUser,
     postUser,
-    putUser,
     patchUser,
     deleteUser,
 
@@ -134,15 +133,6 @@ postUser ::
   IO (StoredUser tag)
 postUser env tok = case users (scimClients env) tok of ((_ :<|> (_ :<|> r)) :<|> (_ :<|> (_ :<|> _))) -> r
 
-putUser ::
-  (HasScimClient tag) =>
-  ClientEnv ->
-  Maybe (AuthData tag) ->
-  UserId tag ->
-  User tag ->
-  IO (StoredUser tag)
-putUser env tok = case users (scimClients env) tok of ((_ :<|> (_ :<|> _)) :<|> (r :<|> (_ :<|> _))) -> r
-
 patchUser ::
   (HasScimClient tag) =>
   ClientEnv ->

libs/imports/src/Imports.hs

@@ -60,19 +60,13 @@ module Imports
     module UnliftIO.Directory,
 
     -- ** Prelude
-    putChar,
     putStr,
     putStrLn,
     print,
-    getChar,
     getLine,
-    getContents,
-    interact,
     readFile,
     writeFile,
     appendFile,
-    readIO,
-    readLn,
 
     -- ** Environment
     getArgs,
@@ -241,9 +235,6 @@ type LByteString = Data.ByteString.Lazy.ByteString
 ----------------------------------------------------------------------------
 -- Lifted functions from Prelude
 
-putChar :: (MonadIO m) => Char -> m ()
-putChar = liftIO . P.putChar
-
 putStr :: (MonadIO m) => String -> m ()
 putStr = liftIO . P.putStr
 
@@ -253,18 +244,9 @@ 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
 
@@ -274,12 +256,6 @@ 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/wire-api/src/Wire/API/Team/Conversation.hs

@@ -77,9 +77,7 @@ newTeamConversation = TeamConversation
 --------------------------------------------------------------------------------
 -- TeamConversationList
 
-newtype TeamConversationList = TeamConversationList
-  { _teamConversations :: [TeamConversation]
-  }
+newtype TeamConversationList = TeamConversationList {teamConversations :: [TeamConversation]}
   deriving (Generic)
   deriving stock (Eq, Show)
   deriving newtype (Arbitrary)
@@ -91,10 +89,9 @@ instance ToSchema TeamConversationList where
       "TeamConversationList"
       (description ?~ "Team conversation list")
       $ TeamConversationList
-        <$> _teamConversations .= field "conversations" (array schema)
+        <$> teamConversations .= field "conversations" (array schema)
 
 newTeamConversationList :: [TeamConversation] -> TeamConversationList
 newTeamConversationList = TeamConversationList
 
 makeLenses ''TeamConversation
-makeLenses ''TeamConversationList

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

@@ -39,7 +39,6 @@ module Wire.API.Team.Feature
     setTTL,
     setWsTTL,
     WithStatusPatch,
-    wsPatch,
     wspStatus,
     wspLockStatus,
     wspConfig,
@@ -53,7 +52,6 @@ module Wire.API.Team.Feature
     FeatureTTL' (..),
     FeatureTTLUnit (..),
     convertFeatureTTLDaysToSeconds,
-    convertFeatureTTLSecondsToDays,
     EnforceAppLock (..),
     defFeatureStatusNoLock,
     computeFeatureConfigForTeamUser,
@@ -319,9 +317,6 @@ deriving via (Schema (WithStatusPatch cfg)) instance (ToSchema (WithStatusPatch
 
 deriving via (Schema (WithStatusPatch cfg)) instance (ToSchema (WithStatusPatch cfg), Typeable cfg) => S.ToSchema (WithStatusPatch cfg)
 
-wsPatch :: Maybe FeatureStatus -> Maybe LockStatus -> Maybe cfg -> Maybe FeatureTTL -> WithStatusPatch cfg
-wsPatch = WithStatusBase
-
 wspStatus :: WithStatusPatch cfg -> Maybe FeatureStatus
 wspStatus = wsbStatus
 
@@ -421,10 +416,6 @@ convertFeatureTTLDaysToSeconds :: FeatureTTLDays -> FeatureTTL
 convertFeatureTTLDaysToSeconds FeatureTTLUnlimited = FeatureTTLUnlimited
 convertFeatureTTLDaysToSeconds (FeatureTTLSeconds d) = FeatureTTLSeconds (d * (60 * 60 * 24))
 
-convertFeatureTTLSecondsToDays :: FeatureTTL -> FeatureTTLDays
-convertFeatureTTLSecondsToDays FeatureTTLUnlimited = FeatureTTLUnlimited
-convertFeatureTTLSecondsToDays (FeatureTTLSeconds d) = FeatureTTLSeconds (d `div` (60 * 60 * 24))
-
 instance Arbitrary FeatureTTL where
   arbitrary =
     (nonZero <$> arbitrary)

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

@@ -28,7 +28,6 @@ module Wire.API.Team.Member
     invitation,
     legalHoldStatus,
     ntmNewTeamMember,
-    teamMemberJson,
     setOptionalPerms,
     setOptionalPermsMany,
     teamMemberObjectSchema,
@@ -426,9 +425,6 @@ permissions = newTeamMember . nPermissions
 invitation :: Lens' TeamMember (Maybe (UserId, UTCTimeMillis))
 invitation = newTeamMember . nInvitation
 
-teamMemberJson :: (TeamMember -> Bool) -> TeamMember -> Value
-teamMemberJson withPerms = toJSON . setOptionalPerms withPerms
-
 setOptionalPerms :: (TeamMember -> Bool) -> TeamMember -> TeamMember' 'Optional
 setOptionalPerms withPerms m = m & permissions %~ setPerm (withPerms m)
 

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

@@ -62,7 +62,6 @@ module Wire.API.User
     urefToExternalIdUnsafe,
     urefToEmail,
     ExpiresIn,
-    newUserInvitationCode,
     newUserTeam,
     newUserEmail,
     newUserSSOId,
@@ -1169,11 +1168,6 @@ instance Arbitrary NewUser where
       genUserExpiresIn newUserIdentity =
         if isJust newUserIdentity then pure Nothing else arbitrary
 
-newUserInvitationCode :: NewUser -> Maybe InvitationCode
-newUserInvitationCode nu = case newUserOrigin nu of
-  Just (NewUserOriginInvitationCode ic) -> Just ic
-  _ -> Nothing
-
 newUserTeam :: NewUser -> Maybe NewTeamUser
 newUserTeam nu = case newUserOrigin nu of
   Just (NewUserOriginTeamUser tu) -> Just tu

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

@@ -21,7 +21,6 @@
 module Wire.API.User.Auth
   ( -- * Login
     Login (..),
-    loginLabel,
     LoginCode (..),
     LoginId (..),
     PendingLoginCode (..),
@@ -347,9 +346,6 @@ instance ToSchema Login where
         <*> lLabel .= optField "label" (maybeWithDefault A.Null schema)
         <*> lCode .= optField "verification_code" (maybeWithDefault A.Null schema)
 
-loginLabel :: Login -> Maybe CookieLabel
-loginLabel = lLabel
-
 --------------------------------------------------------------------------------
 -- RemoveCookies
 

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

@@ -36,7 +36,6 @@ module Wire.API.User.Client
     mkQualifiedUserClientPrekeyMap,
     qualifiedUserClientPrekeyMapFromList,
     UserClientsFull (..),
-    userClientsFullToUserClients,
     UserClients (..),
     mkUserClients,
     QualifiedUserClients (..),
@@ -394,9 +393,6 @@ instance FromJSON UserClientsFull where
 instance Arbitrary UserClientsFull where
   arbitrary = UserClientsFull <$> mapOf' arbitrary (setOf' arbitrary)
 
-userClientsFullToUserClients :: UserClientsFull -> UserClients
-userClientsFullToUserClients (UserClientsFull mp) = UserClients $ Set.map clientId <$> mp
-
 newtype UserClients = UserClients
   { userClients :: Map UserId (Set ClientId)
   }

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

@@ -44,7 +44,6 @@ module Wire.API.User.Identity
     -- * UserSSOId
     UserSSOId (..),
     emailFromSAML,
-    emailToSAML,
     emailToSAMLNameID,
     emailFromSAMLNameID,
     mkSampleUref,
@@ -421,9 +420,6 @@ lenientlyParseSAMLNameID (Just txt) = do
 emailFromSAML :: (HasCallStack) => SAMLEmail.Email -> Email
 emailFromSAML = fromJust . parseEmail . SAMLEmail.render
 
-emailToSAML :: (HasCallStack) => Email -> SAMLEmail.Email
-emailToSAML = CI.original . fromRight (error "emailToSAML") . SAMLEmail.validate . toByteString
-
 -- | FUTUREWORK(fisx): if saml2-web-sso exported the 'NameID' constructor, we could make this
 -- function total without all that praying and hoping.
 emailToSAMLNameID :: (HasCallStack) => Email -> SAML.NameID

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

@@ -132,13 +132,9 @@ instance Cql.Cql WireIdPAPIVersion where
 
 -- | A list of 'IdP's, returned by some endpoints. Wrapped into an object to
 -- allow extensibility later on.
-data IdPList = IdPList
-  { _providers :: [IdP]
-  }
+newtype IdPList = IdPList {providers :: [IdP]}
   deriving (Eq, Show, Generic)
 
-makeLenses ''IdPList
-
 -- Same as WireIdP, we want the lenses, so we have to drop a prefix
 deriveJSON (defaultOptsDropChar '_') ''IdPList
 

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

@@ -24,7 +24,6 @@
 -- for them.
 module Wire.API.User.Saml where
 
-import Control.Lens (makeLenses)
 import Control.Monad.Except
 import Data.Aeson hiding (fieldLabelModifier)
 import Data.Aeson.TH hiding (fieldLabelModifier)
@@ -62,8 +61,6 @@ data VerdictFormat
   | VerdictFormatMobile {_formatGrantedURI :: URI, _formatDeniedURI :: URI}
   deriving (Eq, Show, Generic)
 
-makeLenses ''VerdictFormat
-
 deriveJSON deriveJSONOptions ''VerdictFormat
 
 mkVerdictGrantedFormatMobile :: (MonadError String m) => URI -> SetCookie -> UserId -> m URI

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

@@ -382,13 +382,6 @@ veidUref = prism' UrefOnly $
     UrefOnly uref -> Just uref
     EmailOnly _ -> Nothing
 
-veidEmail :: Prism' ValidExternalId Email
-veidEmail = prism' EmailOnly $
-  \case
-    EmailAndUref em _ -> Just em
-    UrefOnly _ -> Nothing
-    EmailOnly em -> Just em
-
 makeLenses ''ValidScimUser
 makeLenses ''ValidExternalId
 

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

@@ -1,7 +1,6 @@
 {-# LANGUAGE ApplicativeDo #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StrictData #-}
-{-# LANGUAGE TemplateHaskell #-}
 
 -- This file is part of the Wire Server implementation.
 --
@@ -35,7 +34,7 @@ where
 
 import Cassandra qualified as C
 import Control.Error
-import Control.Lens (makePrisms, (?~))
+import Control.Lens ((?~))
 import Data.Aeson hiding (object, (.=))
 import Data.Aeson qualified as Aeson
 import Data.Attoparsec.ByteString (sepBy)
@@ -329,5 +328,3 @@ instance C.Cql FederatedUserSearchPolicy where
   fromCql (C.CqlInt 1) = pure ExactHandleSearch
   fromCql (C.CqlInt 2) = pure FullSearch
   fromCql n = Left $ "Unexpected SearchVisibilityInbound: " ++ show n
-
-makePrisms ''FederatedUserSearchPolicy

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

@@ -200,36 +200,6 @@ phoneUpdated :: UserId -> Phone -> UserEvent
 phoneUpdated u p =
   UserIdentityUpdated $ UserIdentityUpdatedData u Nothing (Just p)
 
-handleUpdated :: UserId -> Handle -> UserEvent
-handleUpdated u h =
-  UserUpdated $ (emptyUserUpdatedData u) {eupHandle = Just h}
-
-localeUpdate :: UserId -> Locale -> UserEvent
-localeUpdate u loc =
-  UserUpdated $ (emptyUserUpdatedData u) {eupLocale = Just loc}
-
-managedByUpdate :: UserId -> ManagedBy -> UserEvent
-managedByUpdate u mb =
-  UserUpdated $ (emptyUserUpdatedData u) {eupManagedBy = Just mb}
-
-supportedProtocolUpdate :: UserId -> Set BaseProtocolTag -> UserEvent
-supportedProtocolUpdate u prots =
-  UserUpdated $ (emptyUserUpdatedData u) {eupSupportedProtocols = Just prots}
-
-profileUpdated :: UserId -> UserUpdate -> UserEvent
-profileUpdated u UserUpdate {..} =
-  UserUpdated $
-    (emptyUserUpdatedData u)
-      { eupName = uupName,
-        eupTextStatus = uupTextStatus,
-        eupPict = uupPict,
-        eupAccentId = uupAccentId,
-        eupAssets = uupAssets
-      }
-
-emptyUpdate :: UserId -> UserEvent
-emptyUpdate = UserUpdated . emptyUserUpdatedData
-
 emptyUserUpdatedData :: UserId -> UserUpdatedData
 emptyUserUpdatedData u =
   UserUpdatedData