[SQSERVICES-1931] wire server allow backend to enforce stronger password restrictions when setting a password

changelog.d/2-features/pr-3137

@@ -0,0 +1 @@
+Enforce a minimum length of 8 characters when setting a new password

libs/api-bot/src/Network/Wire/Bot/Cache.hs

@@ -45,7 +45,7 @@ import System.Random.MWC.Distributions (uniformShuffle)
 
 newtype Cache = Cache {cache :: IORef [CachedUser]}
 
-data CachedUser = CachedUser !PlainTextPassword !User
+data CachedUser = CachedUser !PlainTextPassword6 !User
 
 -- | Load users out of a file in the following format:
 --
@@ -77,7 +77,7 @@ put c a = liftIO . atomicModifyIORef (cache c) $ \u -> (a : u, ())
 
 toUser :: HasCallStack => Logger -> Domain -> [CachedUser] -> [LText] -> IO [CachedUser]
 toUser _ domain acc [i, e, p] = do
-  let pw = PlainTextPassword . Text.toStrict $ Text.strip p
+  let pw = plainTextPassword6Unsafe . Text.toStrict $ Text.strip p
   let iu = error "Cache.toUser: invalid user"
   let ie = error "Cache.toUser: invalid email"
   let ui = fromMaybe iu . fromByteString . encodeUtf8 . Text.toStrict . Text.strip $ i

libs/api-bot/src/Network/Wire/Bot/Monad.hs

@@ -104,7 +104,7 @@ import qualified Data.HashMap.Strict as HashMap
 import Data.Id
 import Data.Metrics (Metrics)
 import qualified Data.Metrics as Metrics
-import Data.Misc (PlainTextPassword (..))
+import Data.Misc
 import Data.Qualified (Local, toLocalUnsafe)
 import Data.Text (pack, unpack)
 import Data.Time.Clock
@@ -345,7 +345,7 @@ data Bot = Bot
     botMetrics :: BotMetrics,
     -- END TODO
     botClients :: TVar [BotClient], -- TODO: IORef?
-    botPassphrase :: PlainTextPassword
+    botPassphrase :: PlainTextPassword6
   }
 
 instance Show Bot where
@@ -452,7 +452,7 @@ newBot tag = liftBotNet $ do
   keys <- liftIO $ awaitActivationMail mbox folders sndr email
   log Info $ botLogFields (userId user) tag . msg (val "Activate user")
   forM_ keys (uncurry activateKey >=> flip assertTrue "Activation failed.")
-  bot <- mkBot tag user pw
+  bot <- mkBot tag user (plainTextPassword8To6 pw)
   -- TODO: addBotClient?
   incrBotsCreatedNew
   pure bot
@@ -689,7 +689,7 @@ try ma = do
 -------------------------------------------------------------------------------
 -- Internal Bot Lifecycle
 
-mkBot :: BotTag -> User -> PlainTextPassword -> BotNet Bot
+mkBot :: BotTag -> User -> PlainTextPassword6 -> BotNet Bot
 mkBot tag user pw = do
   log Info $ botLogFields (userId user) tag . msg (val "Login")
   let ident = fromMaybe (error "No email") (userEmail user)
@@ -978,12 +978,12 @@ botLogFields u t = field "Bot" (show u) . field "Tag" (unTag t)
 -------------------------------------------------------------------------------
 -- Randomness
 
-randUser :: Email -> BotTag -> IO (NewUser, PlainTextPassword)
+randUser :: Email -> BotTag -> IO (NewUser, PlainTextPassword8)
 randUser (Email loc dom) (BotTag tag) = do
   uuid <- nextRandom
   pwdUuid <- nextRandom
   let email = Email (loc <> "+" <> tag <> "-" <> pack (toString uuid)) dom
-  let passw = PlainTextPassword (pack (toString pwdUuid))
+  let passw = plainTextPassword8Unsafe (pack (toString pwdUuid))
   pure
     ( NewUser
         { newUserDisplayName = Name (tag <> "-Wirebot-" <> pack (toString uuid)),

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

@@ -25,7 +25,7 @@ where
 
 import Data.Aeson
 import Data.Id (UserId)
-import Data.Misc (PlainTextPassword (..))
+import Data.Misc (PlainTextPassword6)
 import Imports
 import Wire.API.User.Auth
 
@@ -37,7 +37,7 @@ data SsoLogin
 -- This kind of login returns restricted 'LegalHoldUserToken's instead of regular
 -- tokens.
 data LegalHoldLogin
-  = LegalHoldLogin !UserId !(Maybe PlainTextPassword) !(Maybe CookieLabel)
+  = LegalHoldLogin !UserId !(Maybe PlainTextPassword6) !(Maybe CookieLabel)
 
 instance FromJSON SsoLogin where
   parseJSON = withObject "SsoLogin" $ \o ->

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

@@ -49,8 +49,16 @@ module Data.Misc
     Fingerprint (..),
     Rsa,
 
-    -- * PlainTextPassword
-    PlainTextPassword (..),
+    -- * PlainTextPassword6
+    PlainTextPassword' (..),
+    PlainTextPassword6,
+    PlainTextPassword8,
+    plainTextPassword6,
+    plainTextPassword8,
+    fromPlainTextPassword,
+    plainTextPassword8Unsafe,
+    plainTextPassword6Unsafe,
+    plainTextPassword8To6,
 
     -- * Typesafe FUTUREWORKS
     FutureWork (..),
@@ -75,6 +83,8 @@ import Data.String.Conversions (cs)
 import qualified Data.Swagger as S
 import qualified Data.Text as Text
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import GHC.TypeLits (Nat)
+import GHC.TypeNats (KnownNat)
 import Imports
 import Servant (FromHttpApiData (..))
 import Test.QuickCheck (Arbitrary (arbitrary), chooseInteger)
@@ -338,23 +348,47 @@ instance Arbitrary (Fingerprint Rsa) where
 --------------------------------------------------------------------------------
 -- Password
 
-newtype PlainTextPassword = PlainTextPassword
-  {fromPlainTextPassword :: Text}
+type PlainTextPassword6 = PlainTextPassword' (6 :: Nat)
+
+type PlainTextPassword8 = PlainTextPassword' (8 :: Nat)
+
+plainTextPassword6 :: Text -> Maybe PlainTextPassword6
+plainTextPassword6 = fmap PlainTextPassword' . checked
+
+plainTextPassword6Unsafe :: Text -> PlainTextPassword6
+plainTextPassword6Unsafe = PlainTextPassword' . unsafeRange
+
+plainTextPassword8 :: Text -> Maybe PlainTextPassword8
+plainTextPassword8 = fmap PlainTextPassword' . checked
+
+plainTextPassword8Unsafe :: Text -> PlainTextPassword8
+plainTextPassword8Unsafe = PlainTextPassword' . unsafeRange
+
+fromPlainTextPassword :: PlainTextPassword' t -> Text
+fromPlainTextPassword = fromRange . fromPlainTextPassword'
+
+-- | Convert a 'PlainTextPassword8' to a legacy 'PlainTextPassword'.
+plainTextPassword8To6 :: PlainTextPassword8 -> PlainTextPassword6
+plainTextPassword8To6 = PlainTextPassword' . unsafeRange . fromPlainTextPassword
+
+newtype PlainTextPassword' (minLen :: Nat) = PlainTextPassword'
+  {fromPlainTextPassword' :: Range minLen (1024 :: Nat) Text}
   deriving stock (Eq, Generic)
-  deriving (FromJSON, ToJSON, S.ToSchema) via Schema PlainTextPassword
 
-instance Show PlainTextPassword where
-  show _ = "PlainTextPassword <hidden>"
+deriving via (Schema (PlainTextPassword' tag)) instance ToSchema (PlainTextPassword' tag) => FromJSON (PlainTextPassword' tag)
 
-instance ToSchema PlainTextPassword where
-  schema =
-    PlainTextPassword
-      <$> fromPlainTextPassword
-        .= untypedRangedSchema 6 1024 schema
+deriving via (Schema (PlainTextPassword' tag)) instance ToSchema (PlainTextPassword' tag) => ToJSON (PlainTextPassword' tag)
+
+deriving via (Schema (PlainTextPassword' tag)) instance ToSchema (PlainTextPassword' tag) => S.ToSchema (PlainTextPassword' tag)
+
+instance Show (PlainTextPassword' minLen) where
+  show _ = "PlainTextPassword' <hidden>"
+
+instance (KnownNat (n :: Nat), Within Text n 1024) => ToSchema (PlainTextPassword' n) where
+  schema = PlainTextPassword' <$> fromPlainTextPassword' .= schema
 
-instance Arbitrary PlainTextPassword where
-  -- TODO: why 6..1024? For tests we might want invalid passwords as well, e.g. 3 chars
-  arbitrary = PlainTextPassword . fromRange <$> genRangeText @6 @1024 arbitrary
+instance (KnownNat (n :: Nat), Within Text n 1024) => Arbitrary (PlainTextPassword' n) where
+  arbitrary = PlainTextPassword' <$> arbitrary
 
 -- | Usage:
 -- 1. Use this type in patterns to mark FUTUREWORKS.

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

@@ -56,7 +56,7 @@ import Data.Aeson
 import Data.Aeson.TH
 import Data.Id
 import Data.Json.Util
-import Data.Misc (HttpsUrl (..), PlainTextPassword (..))
+import Data.Misc (HttpsUrl (..), PlainTextPassword6, PlainTextPassword8)
 import Data.Range
 import Imports
 import Wire.API.Conversation.Code as Code
@@ -116,7 +116,7 @@ data NewProvider = NewProvider
     newProviderUrl :: HttpsUrl,
     newProviderDescr :: Range 1 1024 Text,
     -- | If none provided, a password is generated.
-    newProviderPassword :: Maybe PlainTextPassword
+    newProviderPassword :: Maybe PlainTextPassword6
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform NewProvider)
@@ -145,7 +145,7 @@ data NewProviderResponse = NewProviderResponse
   { rsNewProviderId :: ProviderId,
     -- | The generated password, if none was provided
     -- in the 'NewProvider' request.
-    rsNewProviderPassword :: Maybe PlainTextPassword
+    rsNewProviderPassword :: Maybe PlainTextPassword8
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform NewProviderResponse)
@@ -214,7 +214,7 @@ instance FromJSON ProviderActivationResponse where
 -- | Input data for a provider login request.
 data ProviderLogin = ProviderLogin
   { providerLoginEmail :: Email,
-    providerLoginPassword :: PlainTextPassword
+    providerLoginPassword :: PlainTextPassword6
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform ProviderLogin)
@@ -237,7 +237,7 @@ instance FromJSON ProviderLogin where
 
 -- | Input data for a provider deletion request.
 newtype DeleteProvider = DeleteProvider
-  {deleteProviderPassword :: PlainTextPassword}
+  {deleteProviderPassword :: PlainTextPassword6}
   deriving stock (Eq, Show)
   deriving newtype (Arbitrary)
 
@@ -265,7 +265,7 @@ deriveJSON toJSONFieldName ''PasswordReset
 data CompletePasswordReset = CompletePasswordReset
   { cpwrKey :: Code.Key,
     cpwrCode :: Code.Value,
-    cpwrPassword :: PlainTextPassword
+    cpwrPassword :: PlainTextPassword6
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform CompletePasswordReset)
@@ -274,8 +274,8 @@ deriveJSON toJSONFieldName ''CompletePasswordReset
 
 -- | The payload for changing a password.
 data PasswordChange = PasswordChange
-  { cpOldPassword :: PlainTextPassword,
-    cpNewPassword :: PlainTextPassword
+  { cpOldPassword :: PlainTextPassword6,
+    cpNewPassword :: PlainTextPassword6
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform PasswordChange)

libs/wire-api/src/Wire/API/Provider/Service.hs

@@ -60,7 +60,7 @@ import Data.ByteString.Conversion
 import Data.Id
 import Data.Json.Util ((#))
 import Data.List1 (List1)
-import Data.Misc (HttpsUrl (..), PlainTextPassword (..))
+import Data.Misc (HttpsUrl (..), PlainTextPassword6)
 import Data.PEM (PEM, pemParseBS, pemWriteLBS)
 import Data.Proxy
 import Data.Range (Range)
@@ -419,7 +419,7 @@ instance FromJSON UpdateService where
 -- | Update service connection information.
 -- This operation requires re-authentication via password.
 data UpdateServiceConn = UpdateServiceConn
-  { updateServiceConnPassword :: PlainTextPassword,
+  { updateServiceConnPassword :: PlainTextPassword6,
     updateServiceConnUrl :: Maybe HttpsUrl,
     updateServiceConnKeys :: Maybe (Range 1 2 [ServiceKeyPEM]),
     updateServiceConnTokens :: Maybe (Range 1 2 [ServiceToken]),
@@ -428,7 +428,7 @@ data UpdateServiceConn = UpdateServiceConn
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform UpdateServiceConn)
 
-mkUpdateServiceConn :: PlainTextPassword -> UpdateServiceConn
+mkUpdateServiceConn :: PlainTextPassword6 -> UpdateServiceConn
 mkUpdateServiceConn pw = UpdateServiceConn pw Nothing Nothing Nothing Nothing
 
 instance ToJSON UpdateServiceConn where
@@ -455,7 +455,7 @@ instance FromJSON UpdateServiceConn where
 
 -- | Input data for a service deletion request.
 newtype DeleteService = DeleteService
-  {deleteServicePassword :: PlainTextPassword}
+  {deleteServicePassword :: PlainTextPassword6}
   deriving stock (Eq, Show)
   deriving newtype (Arbitrary)
 

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

@@ -75,7 +75,7 @@ import Data.Attoparsec.Combinator (choice)
 import Data.ByteString.Conversion
 import qualified Data.Code as Code
 import Data.Id (TeamId, UserId)
-import Data.Misc (PlainTextPassword (..))
+import Data.Misc (PlainTextPassword6)
 import Data.Range
 import Data.Schema
 import qualified Data.Swagger as S
@@ -290,7 +290,7 @@ instance ToSchema TeamUpdateData where
 -- TeamDeleteData
 
 data TeamDeleteData = TeamDeleteData
-  { _tdAuthPassword :: Maybe PlainTextPassword,
+  { _tdAuthPassword :: Maybe PlainTextPassword6,
     _tdVerificationCode :: Maybe Code.Value
   }
   deriving stock (Eq, Show)
@@ -299,10 +299,10 @@ data TeamDeleteData = TeamDeleteData
 instance Arbitrary TeamDeleteData where
   arbitrary = TeamDeleteData <$> arbitrary <*> arbitrary
 
-newTeamDeleteData :: Maybe PlainTextPassword -> TeamDeleteData
+newTeamDeleteData :: Maybe PlainTextPassword6 -> TeamDeleteData
 newTeamDeleteData = flip TeamDeleteData Nothing
 
-newTeamDeleteDataWithCode :: Maybe PlainTextPassword -> Maybe Code.Value -> TeamDeleteData
+newTeamDeleteDataWithCode :: Maybe PlainTextPassword6 -> Maybe Code.Value -> TeamDeleteData
 newTeamDeleteDataWithCode = TeamDeleteData
 
 instance ToSchema TeamDeleteData where

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

@@ -165,7 +165,7 @@ instance ToSchema UserLegalHoldStatusResponse where
 -- RemoveLegalHoldSettingsRequest
 
 data RemoveLegalHoldSettingsRequest = RemoveLegalHoldSettingsRequest
-  { rmlhsrPassword :: Maybe PlainTextPassword
+  { rmlhsrPassword :: Maybe PlainTextPassword6
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform RemoveLegalHoldSettingsRequest)
@@ -181,7 +181,7 @@ instance ToSchema RemoveLegalHoldSettingsRequest where
 -- DisableLegalHoldForUserRequest
 
 data DisableLegalHoldForUserRequest = DisableLegalHoldForUserRequest
-  { dlhfuPassword :: Maybe PlainTextPassword
+  { dlhfuPassword :: Maybe PlainTextPassword6
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform DisableLegalHoldForUserRequest)
@@ -197,7 +197,7 @@ instance ToSchema DisableLegalHoldForUserRequest where
 -- ApproveLegalHoldForUserRequest
 
 data ApproveLegalHoldForUserRequest = ApproveLegalHoldForUserRequest
-  { alhfuPassword :: Maybe PlainTextPassword
+  { alhfuPassword :: Maybe PlainTextPassword6
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform ApproveLegalHoldForUserRequest)

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

@@ -73,7 +73,7 @@ import Data.Id (UserId)
 import Data.Json.Util
 import Data.Kind
 import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus)
-import Data.Misc (PlainTextPassword (..))
+import Data.Misc (PlainTextPassword6)
 import Data.Proxy
 import Data.Schema
 import Data.Swagger (ToParamSchema (..))
@@ -390,7 +390,7 @@ instance ToSchema NewTeamMember where
 -- TeamMemberDeleteData
 
 newtype TeamMemberDeleteData = TeamMemberDeleteData
-  { _tmdAuthPassword :: Maybe PlainTextPassword
+  { _tmdAuthPassword :: Maybe PlainTextPassword6
   }
   deriving stock (Eq, Show)
   deriving newtype (Arbitrary)
@@ -401,7 +401,7 @@ instance ToSchema TeamMemberDeleteData where
     objectWithDocModifier "TeamMemberDeleteData" (description ?~ "Data for a team member deletion request in case of binding teams.") $
       TeamMemberDeleteData <$> _tmdAuthPassword .= optFieldWithDocModifier "password" (description ?~ "The account password to authorise the deletion.") (maybeWithDefault Null schema)
 
-newTeamMemberDeleteData :: Maybe PlainTextPassword -> TeamMemberDeleteData
+newTeamMemberDeleteData :: Maybe PlainTextPassword6 -> TeamMemberDeleteData
 newTeamMemberDeleteData = TeamMemberDeleteData
 
 makeLenses ''TeamMember'