Add user validation and deletion
Tests included
This commit is contained in:
parent
71450efc2e
commit
a0e24d9742
GPG key ID:
65122AD495A7F5B2
2 changed files with 157 additions and 33 deletions
|
|
@ -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
|
||||
|
|
|
|||
90
test/Spec.hs
90
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
|
||||
|
|
|
|||
Loading…
Reference in a new issue