Implement tests for payment processing
This commit is contained in:
parent
5a0bf9aee4
commit
0e6c71174a
GPG key ID:
65122AD495A7F5B2
3 changed files with 99 additions and 38 deletions
|
|
@ -82,7 +82,7 @@ upsertPayment p = do
|
|||
(memo p)
|
||||
let payment = val payTx
|
||||
case payment of
|
||||
Doc d -> upsert (select ["tx" =: payTx] "payments") d
|
||||
Doc d -> upsert (select ["txid" =: txid p] "payments") d
|
||||
_ -> return ()
|
||||
|
||||
sessionCalc :: Double -> Integer
|
||||
|
|
|
|||
39
src/User.hs
39
src/User.hs
|
|
@ -19,7 +19,7 @@ import ZGoTx
|
|||
-- | Type to represent a ZGo User, i.e.: a specific device
|
||||
data User =
|
||||
User
|
||||
{ u_id :: String
|
||||
{ u_id :: Maybe ObjectId
|
||||
, uaddress :: T.Text
|
||||
, usession :: T.Text
|
||||
, ublocktime :: Integer
|
||||
|
|
@ -30,13 +30,23 @@ data User =
|
|||
|
||||
instance ToJSON User where
|
||||
toJSON (User i a s bt p v) =
|
||||
object
|
||||
[ "_id" .= i
|
||||
, "address" .= a
|
||||
, "session" .= s
|
||||
, "blocktime" .= bt
|
||||
, "validated" .= v
|
||||
]
|
||||
case i of
|
||||
Just oid ->
|
||||
object
|
||||
[ "_id" .= show oid
|
||||
, "address" .= a
|
||||
, "session" .= s
|
||||
, "blocktime" .= bt
|
||||
, "validated" .= v
|
||||
]
|
||||
Nothing ->
|
||||
object
|
||||
[ "_id" .= ("" :: String)
|
||||
, "address" .= a
|
||||
, "session" .= s
|
||||
, "blocktime" .= bt
|
||||
, "validated" .= v
|
||||
]
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON =
|
||||
|
|
@ -46,7 +56,16 @@ instance FromJSON User where
|
|||
s <- obj .: "session"
|
||||
bt <- obj .: "blocktime"
|
||||
v <- obj .: "validated"
|
||||
pure $ User i a s bt "" v
|
||||
pure $
|
||||
User
|
||||
(if not (null i)
|
||||
then Just (read i)
|
||||
else Nothing)
|
||||
a
|
||||
s
|
||||
bt
|
||||
""
|
||||
v
|
||||
|
||||
parseUserBson :: B.Document -> Maybe User
|
||||
parseUserBson d = do
|
||||
|
|
@ -56,7 +75,7 @@ parseUserBson d = do
|
|||
b <- B.lookup "blocktime" d
|
||||
p <- B.lookup "pin" d
|
||||
v <- B.lookup "validated" d
|
||||
pure $ User (show (i :: B.ObjectId)) a s b p v
|
||||
pure $ User i a s b p v
|
||||
|
||||
-- Database Actions
|
||||
-- | Function to query DB for unexpired user by session ID
|
||||
|
|
|
|||
96
test/Spec.hs
96
test/Spec.hs
|
|
@ -231,32 +231,23 @@ main =
|
|||
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
|
||||
let s = parseUserBson =<< t
|
||||
let userId = maybe Nothing u_id s
|
||||
let idString = maybe "" show userId
|
||||
_ <- access p master "test" $ deleteUser idString
|
||||
q <-
|
||||
access p master "test" $
|
||||
findOne (select ["_id" =: userId] "users")
|
||||
isNothing q `shouldBe` True
|
||||
describe "Zcash transactions" $ do
|
||||
it "logins are added to db" $ \p -> do
|
||||
_ <- access p master "test" (delete (select [] "txs"))
|
||||
_ <- scanZcash nodeAddress p "test"
|
||||
threadDelay 1000000
|
||||
t <- access p master "test" $ findOne (select [] "txs")
|
||||
case t of
|
||||
Nothing -> True `shouldBe` False
|
||||
Just r -> do
|
||||
let s = parseZGoTxBson r
|
||||
case s of
|
||||
Nothing -> True `shouldBe` False
|
||||
Just z -> confirmations z `shouldSatisfy` (> 0)
|
||||
let s = parseZGoTxBson =<< t
|
||||
let conf = maybe 0 confirmations s
|
||||
conf `shouldSatisfy` (> 0)
|
||||
it "payments are added to db" $ \p -> do
|
||||
_ <- access p master "test" (delete (select [] "payments"))
|
||||
_ <- scanZcash nodeAddress p "test"
|
||||
|
|
@ -265,7 +256,59 @@ main =
|
|||
let s = (cast' . Doc) =<< t
|
||||
let payDelta = maybe 0 pdelta s
|
||||
payDelta `shouldSatisfy` (> 0)
|
||||
xit "login txs are converted to users" $ \p -> do
|
||||
it "owners are marked as paid" $ \p -> do
|
||||
let myUser =
|
||||
User
|
||||
(Just (read "6272a90f2b05a74cf1000002" :: ObjectId))
|
||||
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
||||
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcb"
|
||||
1613487
|
||||
"1234567"
|
||||
True
|
||||
_ <-
|
||||
access
|
||||
p
|
||||
master
|
||||
"test"
|
||||
(insert_
|
||||
"users"
|
||||
[ "address" =: uaddress myUser
|
||||
, "_id" =: u_id myUser
|
||||
, "session" =: usession myUser
|
||||
, "blocktime" =: ublocktime myUser
|
||||
, "pin" =: upin myUser
|
||||
, "validated" =: uvalidated myUser
|
||||
])
|
||||
let myPay =
|
||||
Payment
|
||||
Nothing
|
||||
86400
|
||||
False
|
||||
""
|
||||
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcb"
|
||||
1652811930
|
||||
0.005
|
||||
"myrandom123tx464id"
|
||||
"coolest memo ever!"
|
||||
let parsedPay = val myPay
|
||||
case parsedPay of
|
||||
Doc d -> do
|
||||
_ <- access p master "test" (insert_ "payments" d)
|
||||
_ <- checkPayments p "test"
|
||||
threadDelay 1000000
|
||||
t <-
|
||||
access p master "test" $
|
||||
findOne
|
||||
(select
|
||||
[ "address" =:
|
||||
("zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" :: T.Text)
|
||||
]
|
||||
"owners")
|
||||
let s = (cast' . Doc) =<< t
|
||||
let ownerPaid = maybe False opaid s
|
||||
ownerPaid `shouldBe` True
|
||||
_ -> True `shouldBe` False `debug` "Failed parsing payment"
|
||||
it "login txs are converted to users" $ \p -> do
|
||||
let myTx =
|
||||
ZGoTx
|
||||
Nothing
|
||||
|
|
@ -378,7 +421,7 @@ startAPI = do
|
|||
_ <- forkIO (app pipe "test" passkey nodeAddress)
|
||||
let myUser =
|
||||
User
|
||||
"6272a90f2b05a74cf1000001"
|
||||
(Just (read "6272a90f2b05a74cf1000001" :: ObjectId))
|
||||
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
||||
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
||||
1613487
|
||||
|
|
@ -392,13 +435,12 @@ startAPI = do
|
|||
(insert_
|
||||
"users"
|
||||
[ "address" =: uaddress myUser
|
||||
, "_id" =: (read (u_id myUser) :: ObjectId)
|
||||
, "_id" =: u_id myUser
|
||||
, "session" =: usession myUser
|
||||
, "blocktime" =: ublocktime myUser
|
||||
, "pin" =: upin myUser
|
||||
, "validated" =: uvalidated myUser
|
||||
])
|
||||
myTstamp <- getCurrentTime
|
||||
let myOwner =
|
||||
Owner
|
||||
(Just (read "627ad3492b05a76be3000001"))
|
||||
|
|
@ -422,7 +464,7 @@ startAPI = do
|
|||
False
|
||||
False
|
||||
False
|
||||
(UTCTime (fromGregorian 2022 5 16) (secondsToDiffTime 0))
|
||||
(UTCTime (fromGregorian 2022 4 16) (secondsToDiffTime 0))
|
||||
_ <- access pipe master "test" (delete (select [] "owners"))
|
||||
let o = val myOwner
|
||||
case o of
|
||||
|
|
@ -506,8 +548,8 @@ instance Arbitrary Owner where
|
|||
paid <- arbitrary
|
||||
zats <- arbitrary
|
||||
inv <- arbitrary
|
||||
exp <- arbitrary
|
||||
pure $ Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv exp
|
||||
--exp <- arbitrary
|
||||
Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv <$> arbitrary
|
||||
|
||||
instance Arbitrary Item where
|
||||
arbitrary = do
|
||||
|
|
|
|||
Loading…
Reference in a new issue