Implement tests for payment processing

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

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,8 +30,18 @@ data User =
 
 instance ToJSON User where
   toJSON (User i a s bt p v) =
+    case i of
+      Just oid ->
         object
-      [ "_id" .= i
+          [ "_id" .= show oid
+          , "address" .= a
+          , "session" .= s
+          , "blocktime" .= bt
+          , "validated" .= v
+          ]
+      Nothing ->
+        object
+          [ "_id" .= ("" :: String)
           , "address" .= a
           , "session" .= s
           , "blocktime" .= bt
@@ -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

test/Spec.hs

@@ -231,18 +231,13 @@ main =
                     isNothing q `shouldBe` False
           it "deleted" $ \p -> do
             t <- access p master "test" $ findOne (select [] "users")
-            case t of
+            let s = parseUserBson =<< t
-              Nothing -> True `shouldBe` False
+            let userId = maybe Nothing u_id s
-              Just r -> do
+            let idString = maybe "" show userId
-                let s = parseUserBson r
+            _ <- access p master "test" $ deleteUser idString
-                case s of
-                  Nothing -> True `shouldBe` False
-                  Just z -> do
-                    _ <- access p master "test" $ deleteUser (u_id z)
             q <-
               access p master "test" $
-                      findOne
+              findOne (select ["_id" =: userId] "users")
-                        (select ["_id" =: (read (u_id z) :: ObjectId)] "users")
             isNothing q `shouldBe` True
         describe "Zcash transactions" $ do
           it "logins are added to db" $ \p -> do
@@ -250,13 +245,9 @@ main =
             _ <- scanZcash nodeAddress p "test"
             threadDelay 1000000
             t <- access p master "test" $ findOne (select [] "txs")
-            case t of
+            let s = parseZGoTxBson =<< t
-              Nothing -> True `shouldBe` False
+            let conf = maybe 0 confirmations s
-              Just r -> do
+            conf `shouldSatisfy` (> 0)
-                let s = parseZGoTxBson r
-                case s of
-                  Nothing -> True `shouldBe` False
-                  Just z -> confirmations z `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
+    --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
+    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