From a0e24d9742bec4e129c59054359811b4ba87ddf5 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Wed, 4 May 2022 13:58:50 -0500 Subject: [PATCH] Add user validation and deletion Tests included --- src/ZGoBackend.hs | 100 +++++++++++++++++++++++++++++++++------------- test/Spec.hs | 90 ++++++++++++++++++++++++++++++++++++++--- 2 files changed, 157 insertions(+), 33 deletions(-) diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index 48e28d7..a210a8e 100644 --- a/src/ZGoBackend.hs +++ b/src/ZGoBackend.hs @@ -196,7 +196,27 @@ data User = , upin :: T.Text , uvalidated :: Bool } - deriving (Eq, Show, Generic, ToJSON) + deriving (Eq, Show, Generic) + +instance ToJSON User where + toJSON (User i a s bt p v) = + object + [ "_id" .= i + , "address" .= a + , "session" .= s + , "blocktime" .= bt + , "validated" .= v + ] + +instance FromJSON User where + parseJSON = + withObject "User" $ \obj -> do + i <- obj .: "_id" + a <- obj .: "address" + s <- obj .: "session" + bt <- obj .: "blocktime" + v <- obj .: "validated" + pure $ User i a s bt "" v parseUserBson :: B.Document -> Maybe User parseUserBson d = do @@ -320,19 +340,34 @@ addUser :: Pipe -> T.Text -> T.Text -> Maybe ZGoTx -> Action IO () addUser _ _ _ Nothing = return () --`debug` "addUser got Nothing" addUser p db node (Just tx) = do isNew <- liftIO $ isUserNew p db tx - if isNew - then do - let newPin = unsafePerformIO generatePin - _ <- sendPin node (address tx) newPin - insert_ - "users" - [ "address" =: address tx - , "session" =: session tx - , "blocktime" =: blocktime tx - , "pin" =: newPin - , "validated" =: False - ] - else return () + when isNew $ do + let newPin = unsafePerformIO generatePin + _ <- sendPin node (address tx) newPin + insert_ + "users" + [ "address" =: address tx + , "session" =: session tx + , "blocktime" =: blocktime tx + , "pin" =: newPin + , "validated" =: False + ] + +-- | Function to delete user by ID +deleteUser :: String -> Action IO () +deleteUser i = deleteOne (select ["_id" =: (read i :: B.ObjectId)] "users") + +-- | Function to verify if the given ZGoTx represents an already existing User +isUserNew :: Pipe -> T.Text -> ZGoTx -> IO Bool +isUserNew p db tx = + isNothing <$> + access p master db (findOne (select ["session" =: session tx] "users")) + +-- | Function to mark user as validated +validateUser :: T.Text -> Action IO () +validateUser session = + modify + (select ["session" =: session] "users") + ["$set" =: ["validated" =: True]] sendPin :: T.Text -> T.Text -> T.Text -> Action IO String sendPin nodeAddress addr pin = do @@ -343,7 +378,7 @@ sendPin nodeAddress addr pin = do [ object [ "address" .= addr , "amount" .= (0.00000001 :: Double) - , "memo" .= encodeHexText ("ZGo PIN: " ++ T.unpack (pin)) + , "memo" .= encodeHexText ("ZGo PIN: " ++ T.unpack pin) ] ]) ] @@ -398,8 +433,6 @@ app pipe db passkey nodeAddress = do case countries of [] -> do status noContent204 - Web.Scotty.json - (object ["message" .= ("No countries available" :: String)]) _ -> do Web.Scotty.json (object @@ -418,10 +451,29 @@ app pipe db passkey nodeAddress = do [ "message" .= ("User found" :: String) , "user" .= toJSON (parseUserBson u) ]) - --Add user - post "/api/user" $ do text "Added that guy" + --Validate user, updating record + post "/api/validateuser" $ do + providedPin <- param "pin" + session <- param "session" + user <- liftIO $ run (findUser session) + case user of + Nothing -> status noContent204 + Just u -> do + let parsedUser = parseUserBson u + case parsedUser of + Nothing -> status noContent204 + Just pUser -> do + let result = upin pUser == providedPin + if result + then do + liftIO $ run (validateUser session) + status accepted202 + else status noContent204 --Delete user - Web.Scotty.delete "/api/user/:id" $ do text "Deleted that guy!" + Web.Scotty.delete "/api/user/:id" $ do + userId <- param "id" + liftIO $ run (deleteUser userId) + status ok200 --Get txs from DB that have less than 10 confirmations get "/api/pending" $ do session <- param "session" @@ -449,8 +501,6 @@ app pipe db passkey nodeAddress = do get "/api/owner" $ do text "Here's an owner for you" --Upsert owner to DB post "/api/owner" $ do text "I added an owner for you" - --Validate user, updating record - post "/api/validateuser" $ do text "Marked user as validated" --Get items associated with the given address get "/api/items" $ do text "Here are your items" --Upsert item @@ -554,10 +604,4 @@ updateLogins addr pipe db = do mapM_ (access pipe master db . ZGoBackend.addUser pipe db addr) parsed putStrLn "Updated logins!" -isUserNew :: Pipe -> T.Text -> ZGoTx -> IO Bool -isUserNew p db tx = do - res <- - (access p master db (findOne (select ["session" =: (session tx)] "users"))) - return $ isNothing res - debug = flip trace diff --git a/test/Spec.hs b/test/Spec.hs index 7799624..afd418c 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -9,6 +9,7 @@ import qualified Data.Aeson as A import qualified Data.ByteString as B import Data.Char (isAscii) import Data.Either +import Data.Maybe import Data.SecureMem import qualified Data.Text as T import Database.MongoDB @@ -97,11 +98,33 @@ main = describe "unconfirmed Zcash txs" $ do it "returns txs with less than 2 confirmations" $ do pending describe "User endpoint" $ do - it "adds a user" $ do pending - it "returns a user for a session" $ do pending - it "returns 204 when no user" $ do pending - it "marks user as validated" $ do pending - it "deletes user by id" $ do pending + it "returns a user for a session" $ do + req <- + testGet + "/api/user" + [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdca")] + res <- httpJSON req + getResponseStatus (res :: Response A.Value) `shouldBe` ok200 + it "returns 204 when no user" $ do + req <- + testGet + "/api/user" + [("session", Just "suchafak-euui-dican-eve-nbelieveitca")] + res <- httpLBS req + getResponseStatus res `shouldBe` noContent204 + it "validate with correct pin" $ do + req <- + testPost + "/api/validateuser/" + [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdca") + , ("pin", Just "5989845") + ] + res <- httpLBS req + getResponseStatus res `shouldBe` accepted202 + it "deletes user by id" $ do + req <- testDelete "/api/user/" "6272a90f2b05a74cf1000001" + res <- httpLBS req + getResponseStatus res `shouldBe` ok200 describe "Owner endpoint" $ do it "add owner" $ do pending it "return owner" $ do pending @@ -189,6 +212,41 @@ main = case s of Nothing -> True `shouldBe` False Just z -> length (T.unpack (usession z)) `shouldSatisfy` (> 0) + describe "user is" $ do + it "validated" $ \p -> do + t <- + access p master "test" $ + findOne (select ["validated" =: False] "users") + case t of + Nothing -> True `shouldBe` False + Just r -> do + let s = parseUserBson r + case s of + Nothing -> True `shouldBe` False + Just z -> do + _ <- access p master "test" $ validateUser (usession z) + q <- + access p master "test" $ + findOne + (select + ["validated" =: True, "session" =: usession z] + "users") + isNothing q `shouldBe` False + it "deleted" $ \p -> do + t <- access p master "test" $ findOne (select [] "users") + case t of + Nothing -> True `shouldBe` False + Just r -> do + let s = parseUserBson r + case s of + Nothing -> True `shouldBe` False + Just z -> do + _ <- access p master "test" $ deleteUser (u_id z) + q <- + access p master "test" $ + findOne + (select ["_id" =: (read (u_id z) :: ObjectId)] "users") + isNothing q `shouldBe` True testGet :: B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> IO Request testGet endpoint body = do @@ -201,6 +259,28 @@ testGet endpoint body = do setRequestMethod "GET" $ setRequestPath endpoint defaultRequest return testRequest +testPost :: B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> IO Request +testPost endpoint body = do + let user = "user" + let pwd = "superSecret" + let testRequest = + setRequestQueryString body $ + setRequestPort 4000 $ + setRequestBasicAuth user pwd $ + setRequestMethod "POST" $ setRequestPath endpoint defaultRequest + return testRequest + +testDelete :: B.ByteString -> B.ByteString -> IO Request +testDelete endpoint par = do + let user = "user" + let pwd = "superSecret" + let testRequest = + setRequestPort 4000 $ + setRequestBasicAuth user pwd $ + setRequestMethod "DELETE" $ + setRequestPath (B.append endpoint par) defaultRequest + return testRequest + -- | Open the MongoDB connection openDbConnection :: IO Pipe openDbConnection = do