Fix reauth without password (#497)

* Fix: re-authentication for password-less users.

* Fix: names.

* Add a roundtrip unit test.

* Fix: integration test behavior has changed.

* Add galley integration tests for password-less users.

* Add brig integration tests for password-less users.

Author: fisx

libs/brig-types/src/Brig/Types/Intra.hs

@@ -121,11 +121,12 @@ instance ToJSON UserSet where
 -- | Certain operations might require reauth of the user. These are available
 -- only for users that have already set a password.
 newtype ReAuthUser = ReAuthUser
-    { reAuthPassword :: PlainTextPassword }
+    { reAuthPassword :: Maybe PlainTextPassword }
+  deriving (Eq, Show)
 
 instance FromJSON ReAuthUser where
     parseJSON = withObject "reauth-user" $ \o ->
-        ReAuthUser <$> o .: "password"
+        ReAuthUser <$> o .:? "password"
 
 instance ToJSON ReAuthUser where
     toJSON ru = object

libs/brig-types/test/unit/Test/Brig/Types/Arbitrary.hs

@@ -16,6 +16,7 @@ module Test.Brig.Types.Arbitrary where
 
 import Brig.Types.Activation
 import Brig.Types.Code
+import Brig.Types.Intra
 import Brig.Types.Provider (UpdateServiceWhitelist(..))
 import Brig.Types.TURN
 import Brig.Types.TURN.Internal
@@ -174,6 +175,9 @@ instance Arbitrary AsciiBase64Url where
 instance Arbitrary PlainTextPassword where
     arbitrary = PlainTextPassword . fromRange <$> genRangeText @6 @1024 arbitrary
 
+instance Arbitrary ReAuthUser where
+    arbitrary = ReAuthUser <$> arbitrary
+
 instance Arbitrary DeleteUser where
     arbitrary = DeleteUser <$> arbitrary
 

libs/brig-types/test/unit/Test/Brig/Types/User.hs

@@ -9,6 +9,7 @@
 module Test.Brig.Types.User where
 
 import Brig.Types.Activation
+import Brig.Types.Intra
 import Brig.Types.Provider (UpdateServiceWhitelist)
 import Brig.Types.User
 import Data.Aeson
@@ -76,14 +77,15 @@ roundtripTests =
     , run @HandleUpdate Proxy
     , run @LocaleUpdate Proxy
     , run @NewPasswordReset Proxy
-    , run @UserIdentity Proxy
     , run @NewUser Proxy
     , run @PasswordChange Proxy
     , run @PhoneRemove Proxy
     , run @PhoneUpdate Proxy
+    , run @ReAuthUser Proxy
     , run @SelfProfile Proxy
     , run @UpdateServiceWhitelist Proxy
     , run @UserHandleInfo Proxy
+    , run @UserIdentity Proxy
     , run @UserProfile Proxy
     , run @User Proxy
     , run @UserUpdate Proxy

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

@@ -247,11 +247,11 @@ newtype NewTeamMember = NewTeamMember
     }
 
 newtype TeamMemberDeleteData = TeamMemberDeleteData
-    { _tmdAuthPassword :: PlainTextPassword
+    { _tmdAuthPassword :: Maybe PlainTextPassword
     }
 
 newtype TeamDeleteData = TeamDeleteData
-    { _tdAuthPassword :: PlainTextPassword
+    { _tdAuthPassword :: Maybe PlainTextPassword
     }
 
 -- This is the cassandra timestamp of writetime(binding)
@@ -289,10 +289,10 @@ newEvent typ tid tme = Event typ tid tme Nothing
 newTeamUpdateData :: TeamUpdateData
 newTeamUpdateData = TeamUpdateData Nothing Nothing Nothing
 
-newTeamMemberDeleteData :: PlainTextPassword -> TeamMemberDeleteData
+newTeamMemberDeleteData :: Maybe PlainTextPassword -> TeamMemberDeleteData
 newTeamMemberDeleteData = TeamMemberDeleteData
 
-newTeamDeleteData :: PlainTextPassword -> TeamDeleteData
+newTeamDeleteData :: Maybe PlainTextPassword -> TeamDeleteData
 newTeamDeleteData = TeamDeleteData
 
 makeLenses ''Team

services/brig/src/Brig/User/API/Auth.hs

@@ -177,7 +177,7 @@ getLoginCode (_ ::: phone) = do
 reAuthUser :: JSON ::: UserId ::: Request -> Handler Response
 reAuthUser (_ ::: uid ::: req) = do
     body <- parseJsonBody req
-    User.reauthenticate uid (Just $ reAuthPassword body) !>> reauthError
+    User.reauthenticate uid (reAuthPassword body) !>> reauthError
     return empty
 
 login :: Request ::: Bool ::: JSON ::: JSON -> Handler Response

services/brig/test/integration/API/Team.hs

@@ -562,9 +562,9 @@ testCreateUserInternalSSO brig galley = do
     let ssoid = UserSSOId "nil" "nil"
 
     -- creating users requires both sso_id and team_id
-    postUser' False "dummy" True False (Just ssoid) Nothing brig
+    postUser' True False "dummy" True False (Just ssoid) Nothing brig
         !!! const 400 === statusCode
-    postUser' False "dummy" True False Nothing (Just teamid) brig
+    postUser' True False "dummy" True False Nothing (Just teamid) brig
         !!! const 400 === statusCode
 
     -- creating user with sso_id, team_id is ok

services/brig/test/integration/API/Team/Util.hs

@@ -151,7 +151,7 @@ deleteTeam g tid u = do
            . paths ["teams", toByteString' tid]
            . zUser u
            . zConn "conn"
-           . lbytes (encode $ Team.newTeamDeleteData Util.defPassword)
+           . lbytes (encode $ Team.newTeamDeleteData $ Just Util.defPassword)
            ) !!! const 202 === statusCode
 
 getTeams :: UserId -> Galley -> Http Team.TeamList

services/brig/test/integration/API/User/Auth.hs

@@ -76,7 +76,7 @@ tests conf m z b = testGroup "auth"
             , test m "logout" (testLogout b)
             ]
         , testGroup "reauth"
-            [ test m "reauthorisation" (testReauthorisation b)
+            [ test m "reauthentication" (testReauthentication b)
             ]
         ]
 
@@ -514,24 +514,26 @@ testLogout b = do
     post (b . path "/access" . cookie c) !!!
         const 403 === statusCode
 
-testReauthorisation :: Brig -> Http ()
-testReauthorisation b = do
+testReauthentication :: Brig -> Http ()
+testReauthentication b = do
     u <- userId <$> randomUser b
 
     let js = Http.body . RequestBodyLBS . encode $ object ["foo" .= ("bar" :: Text) ]
     get (b . paths [ "/i/users", toByteString' u, "reauthenticate"] . contentJson . js) !!! do
-        const 400 === statusCode
+        const 403 === statusCode
+        -- it's ok to not give a password in the request body, but if the user has a password set,
+        -- response will be `forbidden`.
 
-    get (b . paths [ "/i/users", toByteString' u, "reauthenticate"] . contentJson . payload (PlainTextPassword "123456")) !!! do
+    get (b . paths [ "/i/users", toByteString' u, "reauthenticate"] . contentJson . payload (Just $ PlainTextPassword "123456")) !!! do
         const 403 === statusCode
         const (Just "invalid-credentials") === errorLabel
 
-    get (b . paths [ "/i/users", toByteString' u, "reauthenticate"] . contentJson . payload defPassword) !!! do
+    get (b . paths [ "/i/users", toByteString' u, "reauthenticate"] . contentJson . payload (Just defPassword)) !!! do
         const 200 === statusCode
 
     setStatus b u Suspended
 
-    get (b . paths [ "/i/users", toByteString' u, "reauthenticate"] . contentJson . payload defPassword) !!! do
+    get (b . paths [ "/i/users", toByteString' u, "reauthenticate"] . contentJson . payload (Just defPassword)) !!! do
         const 403 === statusCode
         const (Just "suspended") === errorLabel
   where

services/brig/test/integration/API/User/Client.hs

@@ -38,20 +38,22 @@ tests :: ConnectionLimit -> Opt.Timeout -> Maybe Opt.Opts -> Manager -> Brig ->
 tests _cl _at _conf p b c g = testGroup "client"
     [ test p "get /users/:user/prekeys - 200"         $ testGetUserPrekeys b
     , test p "get /users/:user/prekeys/:client - 200" $ testGetClientPrekey b
-    , test p "post /clients - 201"                    $ testAddGetClient b c
+    , test p "post /clients - 201 (pwd)"              $ testAddGetClient True b c
+    , test p "post /clients - 201 (no pwd)"           $ testAddGetClient False b c
     , test p "post /clients - 403"                    $ testClientReauthentication b
     , test p "get /clients - 200"                     $ testListClients b
     , test p "get /clients/:client/prekeys - 200"     $ testListPrekeyIds b
     , test p "post /clients - 400"                    $ testTooManyClients b
-    , test p "delete /clients/:client - 200"          $ testRemoveClient b c
+    , test p "delete /clients/:client - 200 (pwd)"    $ testRemoveClient True b c
+    , test p "delete /clients/:client - 200 (no pwd)" $ testRemoveClient False b c
     , test p "put /clients/:client - 200"             $ testUpdateClient b
     , test p "post /clients - 200 multiple temporary" $ testAddMultipleTemporary b g
     , test p "client/prekeys/race"                    $ testPreKeyRace b
     ]
 
-testAddGetClient :: Brig -> Cannon -> Http ()
-testAddGetClient brig cannon = do
-    uid <- userId <$> randomUser brig
+testAddGetClient :: Bool -> Brig -> Cannon -> Http ()
+testAddGetClient hasPwd brig cannon = do
+    uid <- userId <$> randomUser' hasPwd brig
     let rq = addClientReq brig uid (defNewClient TemporaryClient [somePrekeys !! 0] (someLastPrekeys !! 0))
            . header "X-Forwarded-For" "127.0.0.1" -- Fake IP to test IpAddr parsing.
     c <- WS.bracketR cannon uid $ \ws -> do
@@ -182,24 +184,28 @@ testTooManyClients brig = do
         const 403 === statusCode
         const (Just "too-many-clients") === fmap Error.label . decodeBody
 
-testRemoveClient :: Brig -> Cannon -> Http ()
-testRemoveClient brig cannon = do
-    u <- randomUser brig
+testRemoveClient :: Bool -> Brig -> Cannon -> Http ()
+testRemoveClient hasPwd brig cannon = do
+    u <- randomUser' hasPwd brig
     let uid = userId u
     let Just email = userEmail u
 
     -- Permanent client with attached cookie
-    login brig (defEmailLogin email) PersistentCookie
-        !!! const 200 === statusCode
-    numCookies <- countCookies brig uid defCookieLabel
-    liftIO $ Just 1 @=? numCookies
+    when hasPwd $ do
+        login brig (defEmailLogin email) PersistentCookie
+            !!! const 200 === statusCode
+        numCookies <- countCookies brig uid defCookieLabel
+        liftIO $ Just 1 @=? numCookies
+
     c <- decodeBody =<< addClient brig uid (client PermanentClient (someLastPrekeys !! 10))
-    -- Missing password
-    deleteClient brig uid (clientId c) Nothing !!! const 403 === statusCode
+
+    when hasPwd $ do
+        -- Missing password
+        deleteClient brig uid (clientId c) Nothing !!! const 403 === statusCode
 
     -- Success
     WS.bracketR cannon uid $ \ws -> do
-        deleteClient brig uid (clientId c) (Just defPassword)
+        deleteClient brig uid (clientId c) (if hasPwd then Just defPassword else Nothing)
             !!! const 200 === statusCode
         void . liftIO $ WS.assertMatch (5 # Second) ws $ \n -> do
             let j = Object $ List1.head (ntfPayload n)

services/brig/test/integration/Util.hs

@@ -90,19 +90,25 @@ test' :: AWS.Env -> Manager -> TestName -> Http a -> TestTree
 test' e m n h = testCase n $ void $ runHttpT m (liftIO (purgeJournalQueue e) >> h)
 
 randomUser :: HasCallStack => Brig -> Http User
-randomUser brig = do
+randomUser = randomUser' True
+
+randomUser' :: HasCallStack => Bool -> Brig -> Http User
+randomUser' hasPwd brig = do
     n <- fromName <$> randomName
-    createUser n brig
+    createUser' hasPwd n brig
 
 createUser :: HasCallStack => Text -> Brig -> Http User
-createUser name brig = do
-    r <- postUser name True False Nothing Nothing brig <!!
+createUser = createUser' True
+
+createUser' :: HasCallStack => Bool -> Text -> Brig -> Http User
+createUser' hasPwd name brig = do
+    r <- postUser' hasPwd True name True False Nothing Nothing brig <!!
            const 201 === statusCode
     decodeBody r
 
 createUserWithEmail :: HasCallStack => Text -> Email -> Brig -> Http User
 createUserWithEmail name email brig = do
-    r <- postUserWithEmail True name (Just email) False Nothing Nothing brig <!!
+    r <- postUserWithEmail True True name (Just email) False Nothing Nothing brig <!!
            const 201 === statusCode
     decodeBody r
 
@@ -164,32 +170,32 @@ getConnection brig from to = get $ brig
 
 -- | More flexible variant of 'createUser' (see above).
 postUser :: Text -> Bool -> Bool -> Maybe UserSSOId -> Maybe TeamId -> Brig -> Http ResponseLBS
-postUser = postUser' True
+postUser = postUser' True True
 
--- | Use @postUser' False@ instead of 'postUser' if you want to send broken bodies to test error
--- messages.
-postUser' :: Bool -> Text -> Bool -> Bool -> Maybe UserSSOId -> Maybe TeamId -> Brig -> Http ResponseLBS
-postUser' validateBody name haveEmail havePhone ssoid teamid brig = do
+-- | Use @postUser' True False@ instead of 'postUser' if you want to send broken bodies to test error
+-- messages.  Or @postUser' False True@ if you want to validate the body, but not set a password.
+postUser' :: Bool -> Bool -> Text -> Bool -> Bool -> Maybe UserSSOId -> Maybe TeamId -> Brig -> Http ResponseLBS
+postUser' hasPassword validateBody name haveEmail havePhone ssoid teamid brig = do
     email <- if haveEmail
         then Just <$> randomEmail
         else pure Nothing
-    postUserWithEmail validateBody name email havePhone ssoid teamid brig
+    postUserWithEmail hasPassword validateBody name email havePhone ssoid teamid brig
 
 -- | More flexible variant of 'createUserUntrustedEmail' (see above).
-postUserWithEmail :: Bool -> Text -> Maybe Email -> Bool -> Maybe UserSSOId -> Maybe TeamId -> Brig -> Http ResponseLBS
-postUserWithEmail validateBody name email havePhone ssoid teamid brig = do
+postUserWithEmail :: Bool -> Bool -> Text -> Maybe Email -> Bool -> Maybe UserSSOId -> Maybe TeamId -> Brig -> Http ResponseLBS
+postUserWithEmail hasPassword validateBody name email havePhone ssoid teamid brig = do
     phone <- if havePhone
         then Just <$> randomPhone
         else pure Nothing
-    let o = object
+    let o = object $
             [ "name"            .= name
             , "email"           .= (fromEmail <$> email)
             , "phone"           .= phone
-            , "password"        .= defPassword
             , "cookie"          .= defCookieLabel
             , "sso_id"          .= ssoid
             , "team_id"         .= teamid
-            ]
+            ] <>
+            [ "password"        .= defPassword | hasPassword ]
         p = case Aeson.parse parseJSON o of
               Aeson.Success (p_ :: NewUser) -> p_
               bad -> error $ show (bad, o)