diff --git a/src/User.hs b/src/User.hs index a393dc5..e7eb241 100644 --- a/src/User.hs +++ b/src/User.hs @@ -69,6 +69,36 @@ instance FromJSON User where "" v +instance Val User where + cast' (Doc d) = do + i <- B.lookup "_id" d + a <- B.lookup "address" d + s <- B.lookup "session" d + b <- B.lookup "blocktime" d + p <- B.lookup "pin" d + v <- B.lookup "validated" d + Just $ User i a s b p v + cast' _ = Nothing + val (User i a s b p v) = + case i of + Just oid -> + Doc + [ "_id" =: oid + , "address" =: a + , "session" =: s + , "blocktime" =: b + , "pin" =: p + , "validated" =: v + ] + Nothing -> + Doc + [ "address" =: a + , "session" =: s + , "blocktime" =: b + , "pin" =: p + , "validated" =: v + ] + parseUserBson :: B.Document -> Maybe User parseUserBson d = do i <- B.lookup "_id" d @@ -84,6 +114,9 @@ parseUserBson d = do findUser :: T.Text -> Action IO (Maybe Document) findUser s = findOne (select ["session" =: s] "users") +findUserById :: String -> Action IO (Maybe Document) +findUserById i = findOne (select ["_id" =: (read i :: B.ObjectId)] "users") + -- | Function to delete user by ID deleteUser :: String -> Action IO () deleteUser i = deleteOne (select ["_id" =: (read i :: B.ObjectId)] "users") diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index 9c71ffa..d5e8485 100644 --- a/src/ZGoBackend.hs +++ b/src/ZGoBackend.hs @@ -893,12 +893,20 @@ routes pipe config = do --Delete user Web.Scotty.delete "/api/user/:id" $ do userId <- param "id" + session <- param "session" let r = mkRegex "^[a-f0-9]{24}$" if matchTest r userId then do - liftAndCatchIO $ run (deleteUser userId) - status ok200 - else status noContent204 + u <- liftAndCatchIO $ run (findUserById userId) + case cast' . Doc =<< u of + Nothing -> status badRequest400 + Just u' -> + if session == usession u' + then do + liftAndCatchIO $ run (deleteUser userId) + status ok200 + else status forbidden403 + else status badRequest400 --Get current blockheight from Zcash node get "/blockheight" $ do blockInfo <- diff --git a/test/Spec.hs b/test/Spec.hs index 929eec4..ca7d3ba 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -259,14 +259,39 @@ main = do [("session", Just "suchafak-euui-dican-eve-nbelieveitca")] res <- httpLBS req getResponseStatus res `shouldBe` unauthorized401 - it "deletes user by id" $ do - req <- - testDelete - "/api/user/" - "6272a90f2b05a74cf1000003" - [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] - res <- httpLBS req - getResponseStatus res `shouldBe` ok200 + describe "delete" $ do + it "returns 401 when session is invalid" $ do + req <- + testDelete + "/api/user/" + "6272a90f2b05a74cf1000005" + [("session", Just "suchafak-euui-dican-eve-nbelieveitca")] + res <- httpLBS req + getResponseStatus res `shouldBe` unauthorized401 + it "returns 403 when user and session don't match" $ do + req <- + testDelete + "/api/user/" + "6272a90f2b05a74cf1000005" + [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] + res <- httpLBS req + getResponseStatus res `shouldBe` forbidden403 + it "returns 400 when user is invalid" $ do + req <- + testDelete + "/api/user/" + "000000000000000000000000" + [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] + res <- httpLBS req + getResponseStatus res `shouldBe` badRequest400 + it "deletes user by id" $ do + req <- + testDelete + "/api/user/" + "6272a90f2b05a74cf1000003" + [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] + res <- httpLBS req + getResponseStatus res `shouldBe` ok200 describe "Owner endpoint" $ --prop "add owner" testOwnerAdd do @@ -872,6 +897,14 @@ closeDbConnection = close handleDb :: (Pipe -> Expectation) -> IO () handleDb = bracket openDbConnection closeDbConnection +filterDocs :: Value -> Bool +filterDocs (Doc v) = True +filterDocs _ = False + +unwrapDoc :: Value -> Document +unwrapDoc (Doc v) = v +unwrapDoc _ = [] + startAPI :: Config -> IO () startAPI config = do putStrLn "Starting test server ..." @@ -892,20 +925,6 @@ startAPI config = do 1613487 "8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162" False - _ <- - access - pipe - master - "test" - (insert_ - "users" - [ "address" =: uaddress myUser - , "_id" =: u_id myUser - , "session" =: usession myUser - , "blocktime" =: ublocktime myUser - , "pin" =: upin myUser - , "validated" =: uvalidated myUser - ]) let myUser1 = User (Just (read "6272a90f2b05a74cf1000003" :: ObjectId)) @@ -914,20 +933,45 @@ startAPI config = do 1613487 "8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162" True - _ <- - access - pipe - master - "test" - (insert_ - "users" - [ "address" =: uaddress myUser1 - , "_id" =: u_id myUser1 - , "session" =: usession myUser1 - , "blocktime" =: ublocktime myUser1 - , "pin" =: upin myUser1 - , "validated" =: uvalidated myUser1 - ]) + let myUser2 = + User + (Just (read "6272a90f2b05a74cf1000005" :: ObjectId)) + "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3fake" + "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake" + 1613487 + "8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162" + True + let userList = + map unwrapDoc $ filter filterDocs $ val <$> [myUser, myUser1, myUser2] + _ <- access pipe master "test" (insertAll_ "users" userList) + --_ <- + --access + --pipe + --master + --"test" + --(insert_ + --"users" + --[ "address" =: uaddress myUser + --, "_id" =: u_id myUser + --, "session" =: usession myUser + --, "blocktime" =: ublocktime myUser + --, "pin" =: upin myUser + --, "validated" =: uvalidated myUser + --]) + --_ <- + --access + --pipe + --master + --"test" + --(insert_ + --"users" + --[ "address" =: uaddress myUser1 + --, "_id" =: u_id myUser1 + --, "session" =: usession myUser1 + --, "blocktime" =: ublocktime myUser1 + --, "pin" =: upin myUser1 + --, "validated" =: uvalidated myUser1 + --]) let myOwner = Owner (Just (read "627ad3492b05a76be3000001"))