[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

@@ -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 = plainTextPasswordLegacyUnsafe . 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
@@ -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 (toLegacy pw)
   -- TODO: addBotClient?
   incrBotsCreatedNew
   pure bot
@@ -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, PlainTextPasswordMinLength8)
 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 = plainTextPasswordUnsafe (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 (PlainTextPassword)
 import Imports
 import Wire.API.User.Auth
 

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

@@ -50,7 +50,15 @@ module Data.Misc
     Rsa,
 
     -- * PlainTextPassword
-    PlainTextPassword (..),
+    PlainTextPassword' (..),
+    PlainTextPassword,
+    PlainTextPasswordMinLength8,
+    plainTextPasswordLegacy,
+    plainTextPassword,
+    fromPlainTextPassword,
+    plainTextPasswordUnsafe,
+    plainTextPasswordLegacyUnsafe,
+    toLegacy,
 
     -- * Typesafe FUTUREWORKS
     FutureWork (..),
@@ -75,6 +83,7 @@ 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 Imports
 import Servant (FromHttpApiData (..))
 import Test.QuickCheck (Arbitrary (arbitrary), chooseInteger)
@@ -338,23 +347,54 @@ instance Arbitrary (Fingerprint Rsa) where
 --------------------------------------------------------------------------------
 -- Password
 
-newtype PlainTextPassword = PlainTextPassword
-  {fromPlainTextPassword :: Text}
+type PlainTextPassword = PlainTextPassword' (6 :: Nat)
+
+type PlainTextPasswordMinLength8 = PlainTextPassword' (8 :: Nat)
+
+plainTextPasswordLegacy :: Text -> Maybe PlainTextPassword
+plainTextPasswordLegacy = fmap PlainTextPassword' . checked
+
+plainTextPasswordLegacyUnsafe :: Text -> PlainTextPassword
+plainTextPasswordLegacyUnsafe = PlainTextPassword' . unsafeRange
+
+plainTextPassword :: Text -> Maybe PlainTextPasswordMinLength8
+plainTextPassword = fmap PlainTextPassword' . checked
+
+plainTextPasswordUnsafe :: Text -> PlainTextPasswordMinLength8
+plainTextPasswordUnsafe = PlainTextPassword' . unsafeRange
+
+fromPlainTextPassword :: PlainTextPassword' t -> Text
+fromPlainTextPassword = fromRange . fromPlainTextPassword'
+
+-- | Convert a 'PlainTextPasswordMinLength8' to a legacy 'PlainTextPassword'.
+toLegacy :: PlainTextPasswordMinLength8 -> PlainTextPassword
+toLegacy = 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 ToSchema (PlainTextPassword' (6 :: Nat)) where
+  schema = PlainTextPassword' <$> fromPlainTextPassword' .= schema
+
+instance ToSchema (PlainTextPassword' (8 :: Nat)) where
+  schema = PlainTextPassword' <$> fromPlainTextPassword' .= schema
+
+instance Arbitrary (PlainTextPassword' (6 :: Nat)) where
+  arbitrary = PlainTextPassword' <$> arbitrary
 
-instance Arbitrary PlainTextPassword where
+instance Arbitrary (PlainTextPassword' (8 :: Nat)) 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
+  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 (..), PlainTextPassword, PlainTextPasswordMinLength8)
 import Data.Range
 import Imports
 import Wire.API.Conversation.Code as Code
@@ -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 PlainTextPasswordMinLength8
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform NewProviderResponse)

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 (..), PlainTextPassword)
 import Data.PEM (PEM, pemParseBS, pemWriteLBS)
 import Data.Proxy
 import Data.Range (Range)

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 (PlainTextPassword)
 import Data.Range
 import Data.Schema
 import qualified Data.Swagger as S

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 (PlainTextPassword)
 import Data.Proxy
 import Data.Schema
 import Data.Swagger (ToParamSchema (..))

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

@@ -130,7 +130,7 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
 import Data.Id
 import Data.Json.Util (UTCTimeMillis, (#))
 import Data.LegalHold (UserLegalHoldStatus)
-import Data.Misc (PlainTextPassword (..))
+import Data.Misc (PlainTextPassword, PlainTextPasswordMinLength8)
 import Data.Qualified
 import Data.Range
 import Data.SOP
@@ -711,7 +711,7 @@ data NewUser = NewUser
     newUserOrigin :: Maybe NewUserOrigin,
     newUserLabel :: Maybe CookieLabel,
     newUserLocale :: Maybe Locale,
-    newUserPassword :: Maybe PlainTextPassword,
+    newUserPassword :: Maybe PlainTextPasswordMinLength8,
     newUserExpiresIn :: Maybe ExpiresIn,
     newUserManagedBy :: Maybe ManagedBy
   }
@@ -759,7 +759,7 @@ data NewUserRaw = NewUserRaw
     newUserRawTeamId :: Maybe TeamId,
     newUserRawLabel :: Maybe CookieLabel,
     newUserRawLocale :: Maybe Locale,
-    newUserRawPassword :: Maybe PlainTextPassword,
+    newUserRawPassword :: Maybe PlainTextPasswordMinLength8,
     newUserRawExpiresIn :: Maybe ExpiresIn,
     newUserRawManagedBy :: Maybe ManagedBy
   }
@@ -1131,7 +1131,7 @@ instance (res ~ PutSelfResponses) => AsUnion res (Maybe UpdateProfileError) wher
 -- | The payload for setting or changing a password.
 data PasswordChange = PasswordChange
   { cpOldPassword :: Maybe PlainTextPassword,
-    cpNewPassword :: PlainTextPassword
+    cpNewPassword :: PlainTextPasswordMinLength8
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform PasswordChange)

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

@@ -70,7 +70,7 @@ import Data.Code as Code
 import Data.Handle (Handle)
 import Data.Id
 import Data.Json.Util
-import Data.Misc (PlainTextPassword (..))
+import Data.Misc (PlainTextPassword)
 import Data.SOP
 import Data.Schema
 import qualified Data.Swagger as S

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

@@ -80,7 +80,7 @@ import Data.Domain (Domain)
 import Data.Id
 import Data.Json.Util
 import qualified Data.Map.Strict as Map
-import Data.Misc (Latitude (..), Location, Longitude (..), PlainTextPassword (..), latitude, location, longitude)
+import Data.Misc (Latitude (..), Location, Longitude (..), PlainTextPassword, latitude, location, longitude)
 import Data.Qualified
 import Data.Schema
 import qualified Data.Set as Set

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

@@ -35,7 +35,7 @@ import Control.Lens ((?~))
 import qualified Data.Aeson as A
 import Data.Aeson.Types (Parser)
 import Data.ByteString.Conversion
-import Data.Misc (PlainTextPassword (..))
+import Data.Misc (PlainTextPasswordMinLength8)
 import Data.Proxy (Proxy (Proxy))
 import Data.Range (Ranged (..))
 import Data.Schema as Schema
@@ -103,7 +103,7 @@ instance ToSchema NewPasswordReset where
 data CompletePasswordReset = CompletePasswordReset
   { cpwrIdent :: PasswordResetIdentity,
     cpwrCode :: PasswordResetCode,
-    cpwrPassword :: PlainTextPassword
+    cpwrPassword :: PlainTextPasswordMinLength8
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform CompletePasswordReset)
@@ -195,7 +195,7 @@ newtype PasswordResetCode = PasswordResetCode
 
 data PasswordReset = PasswordReset
   { pwrCode :: PasswordResetCode,
-    pwrPassword :: PlainTextPassword
+    pwrPassword :: PlainTextPasswordMinLength8
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform PasswordReset)