diff --git a/src/Payment.hs b/src/Payment.hs index ed41bce..c836c39 100644 --- a/src/Payment.hs +++ b/src/Payment.hs @@ -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 diff --git a/src/User.hs b/src/User.hs index fd3cb83..da2ae10 100644 --- a/src/User.hs +++ b/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 diff --git a/test/Spec.hs b/test/Spec.hs index 744e414..62bbfb9 100644 --- a/test/Spec.hs +++ b/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