src/ZGoBackend.hs

@@ -634,8 +634,8 @@ routes pipe config = do
                  , "xeroConfig" .= toJSON (c :: Xero)
                  ])
   get "/api/xerotoken" $ do
-    code <- formParam "code"
-    session <- formParam "session"
+    code <- queryParam "code"
+    session <- queryParam "session"
     user <- liftIO $ run (findUser session)
     xeroConfig <- liftIO $ run findXero
     case cast' . Doc =<< xeroConfig of
@@ -850,7 +850,7 @@ routes pipe config = do
                      ])
   -- Get the xeroaccount code
   get "/api/xeroaccount" $ do
-    session <- formParam "session"
+    session <- queryParam "session"
     user <- liftIO $ run (findUser session)
     case cast' . Doc =<< user of
       Nothing -> status unauthorized401
@@ -868,8 +868,8 @@ routes pipe config = do
                  ])
   -- Save the xeroaccount code
   post "/api/xeroaccount" $ do
-    session <- formParam "session"
-    c <- formParam "code"
+    session <- queryParam "session"
+    c <- queryParam "code"
     user <- liftIO $ run (findUser session)
     case cast' . Doc =<< user of
       Nothing -> status unauthorized401
@@ -879,7 +879,7 @@ routes pipe config = do
         status accepted202
   -- Get the WooCommerce token
   get "/api/wootoken" $ do
-    session <- formParam "session"
+    session <- queryParam "session"
     user <- liftIO $ run (findUser session)
     case cast' . Doc =<< user of
       Nothing -> status unauthorized401
@@ -901,8 +901,8 @@ routes pipe config = do
                      , "siteurl" .= w_url t
                      ])
   post "/api/wootoken" $ do
-    oid <- formParam "ownerid"
-    session <- formParam "session"
+    oid <- queryParam "ownerid"
+    session <- queryParam "session"
     user <- liftIO $ run (findUser session)
     case cast' . Doc =<< user of
       Nothing -> status unauthorized401
@@ -1061,7 +1061,7 @@ routes pipe config = do
             Web.Scotty.json
               (object ["message" .= ("Incorrect plugin config" :: String)])
   get "/checkuser" $ do
-    sess <- formParam "session"
+    sess <- queryParam "session"
     user <- liftIO $ run (findUser sess)
     case parseUserBson =<< user of
       Nothing -> status noContent204
@@ -1070,7 +1070,7 @@ routes pipe config = do
         Web.Scotty.json (object ["validated" .= uvalidated u])
   --Get user associated with session
   get "/api/user" $ do
-    sess <- formParam "session"
+    sess <- queryParam "session"
     user <- liftIO $ run (findUser sess)
     case user of
       Nothing -> status noContent204
@@ -1083,8 +1083,8 @@ routes pipe config = do
              ])
     --Validate user, updating record
   post "/validateuser" $ do
-    providedPin <- formParam "pin"
-    sess <- formParam "session"
+    providedPin <- queryParam "pin"
+    sess <- queryParam "session"
     let pinHash =
           BLK.hash
             Nothing
@@ -1092,11 +1092,11 @@ routes pipe config = do
             ]
     user <- liftIO $ run (findUser sess)
     case user of
-      Nothing -> status noContent204 --`debug` "No user match"
+      Nothing -> status noContent204 `debug` "No user match"
       Just u -> do
         let parsedUser = parseUserBson u
         case parsedUser of
-          Nothing -> status noContent204 --`debug` "Couldn't parse user"
+          Nothing -> status noContent204 `debug` "Couldn't parse user"
           Just pUser -> do
             let ans =
                   upin pUser ==
@@ -1106,11 +1106,13 @@ routes pipe config = do
               then do
                 liftIO $ run (validateUser sess)
                 status accepted202
-              else status noContent204 --`debug` ("Pins didn't match: " ++ providedPin ++ " " ++ T.unpack (upin pUser))
+              else status noContent204 `debug`
+                   ("Pins didn't match: " ++
+                    T.unpack providedPin ++ " " ++ T.unpack (upin pUser))
     --Delete user
   Web.Scotty.delete "/api/user/:id" $ do
     userId <- captureParam "id"
-    session <- captureParam "session"
+    session <- queryParam "session"
     let r = mkRegex "^[a-f0-9]{24}$"
     if matchTest r userId
       then do
@@ -1138,7 +1140,7 @@ routes pipe config = do
   get "/getaddr" $ do Web.Scotty.json (object ["addr" .= nodeAddress])
   --Get owner by address
   get "/api/owner" $ do
-    session <- formParam "session"
+    session <- queryParam "session"
     user <- liftIO $ run (findUser session)
     case parseUserBson =<< user of
       Nothing -> status noContent204
@@ -1154,7 +1156,7 @@ routes pipe config = do
                  , "owner" .= getOwnerSettings o
                  ])
   get "/ownerid" $ do
-    id <- formParam "id"
+    id <- queryParam "id"
     owner <- liftIO $ run (findOwnerById id)
     case owner of
       Nothing -> status noContent204
@@ -1171,7 +1173,7 @@ routes pipe config = do
                  ])
   --Upsert owner to DB
   post "/api/owner" $ do
-    s <- formParam "session"
+    s <- queryParam "session"
     u <- liftIO $ run (findUser s)
     o <- jsonData
     now <- liftIO getCurrentTime
@@ -1211,7 +1213,7 @@ routes pipe config = do
             False
         status accepted202
   post "/api/ownersettings" $ do
-    s <- formParam "session"
+    s <- queryParam "session"
     u <- liftIO $ run (findUser s)
     o <- jsonData
     now <- liftIO getCurrentTime
@@ -1225,7 +1227,7 @@ routes pipe config = do
             status accepted202
           else status noContent204
   post "/api/ownervk" $ do
-    s <- formParam "session"
+    s <- queryParam "session"
     u <- liftIO $ run (findUser s)
     o <- jsonData
     let q = payload (o :: Payload String)
@@ -1285,7 +1287,7 @@ routes pipe config = do
                              else status forbidden403
     --Get items associated with the given address
   get "/api/items" $ do
-    session <- formParam "session"
+    session <- queryParam "session"
     user <- liftIO $ run (findUser session)
     case cast' . Doc =<< user of
       Nothing -> status forbidden403
@@ -1304,7 +1306,7 @@ routes pipe config = do
     --Upsert item
   post "/api/item" $ do
     i <- jsonData
-    session <- formParam "session"
+    session <- queryParam "session"
     user <- liftIO $ run (findUser session)
     case cast' . Doc =<< user of
       Nothing -> status forbidden403
@@ -1317,7 +1319,7 @@ routes pipe config = do
           else status forbidden403
     --Delete item
   Web.Scotty.delete "/api/item/:id" $ do
-    session <- formParam "session"
+    session <- queryParam "session"
     oId <- captureParam "id"
     u' <- liftIO $ checkUser run session
     case u' of
@@ -1334,7 +1336,7 @@ routes pipe config = do
               else status forbidden403
     --Get price for Zcash
   get "/price" $ do
-    curr <- formParam "currency"
+    curr <- queryParam "currency"
     pr <- liftIO $ run (findPrice curr)
     case parseZGoPrice =<< pr of
       Nothing -> do
@@ -1344,7 +1346,7 @@ routes pipe config = do
           (object ["message" .= ("Price found!" :: String), "price" .= toJSON p])
     --Get all closed orders for the address
   get "/api/allorders" $ do
-    session <- formParam "session"
+    session <- queryParam "session"
     user <- liftIO $ run (findUser session)
     case cast' . Doc =<< user of
       Nothing -> status unauthorized401
@@ -1363,7 +1365,7 @@ routes pipe config = do
     --Get order by id for receipts
   get "/order/:id" $ do
     oId <- captureParam "id"
-    token <- formParam "token"
+    token <- queryParam "token"
     let r = mkRegex "^[a-f0-9]{24}$"
     if matchTest r oId
       then do
@@ -1388,7 +1390,7 @@ routes pipe config = do
       else status badRequest400
     --Get order by session
   get "/api/order" $ do
-    sess <- formParam "session"
+    sess <- queryParam "session"
     myOrder <- liftIO $ run (findOrder sess)
     case myOrder of
       Nothing -> status noContent204
@@ -1428,7 +1430,7 @@ routes pipe config = do
   post "/api/order" $ do
     newOrder <- jsonData
     let q = payload (newOrder :: Payload ZGoOrder)
-    session <- formParam "session"
+    session <- queryParam "session"
     user <- liftIO $ run (findUser session)
     case cast' . Doc =<< user of
       Nothing -> status unauthorized401
@@ -1501,7 +1503,7 @@ routes pipe config = do
   --Delete order
   Web.Scotty.delete "/api/order/:id" $ do
     oId <- captureParam "id"
-    session <- formParam "session"
+    session <- queryParam "session"
     o <- liftIO $ run (findOrderById oId)
     case cast' . Doc =<< o of
       Nothing -> status badRequest400

test/Spec.hs

@@ -28,6 +28,7 @@ import Order
 import Owner
 import Payment
 import System.IO.Unsafe
+import Test.HUnit hiding (assert)
 import Test.Hspec
 import Test.Hspec.Expectations.Json
 import Test.Hspec.QuickCheck
@@ -169,7 +170,7 @@ main = do
             res <- httpLBS req
             getResponseStatus res `shouldBe` unauthorized401
         describe "blockheight endpoint" $ do
-          it "returns a block number" $ do
+          xit "returns a block number" $ do
             req <-
               testGet
                 "/blockheight"
@@ -776,10 +777,10 @@ main = do
       describe "Database actions" $ do
         describe "authentication" $ do
           it "should succeed with good creds" $ \p -> do
-            r <- liftIO $ access p master "zgo" (auth "zgo" "zcashrules")
+            r <- liftIO $ access p master "test" (auth "zgo" "zcashrules")
             r `shouldBe` True
           it "should fail with bad creds" $ \p -> do
-            r <- liftIO $ access p master "zgo" (auth "user" "pwd")
+            r <- liftIO $ access p master "test" (auth "user" "pwd")
             r `shouldBe` False
         describe "ZGo Pro sessions" $ do
           it "find in DB" $ \p -> do
@@ -793,21 +794,21 @@ main = do
           it "should update" $ \p -> do
             doc <- access p master "test" $ findPrice "usd"
             case doc of
-              Nothing -> True `shouldBe` False
+              Nothing -> assertFailure "couldn't find price"
               Just d -> do
                 let q = parseZGoPrice d
                 case q of
-                  Nothing -> True `shouldBe` False
+                  Nothing -> assertFailure "couldn't parse price"
                   Just r -> do
                     let t1 = ZGoBackend.timestamp r
                     _ <- checkZcashPrices p "test"
                     doc2 <- access p master "test" $ findPrice "usd"
                     case doc2 of
-                      Nothing -> True `shouldBe` False
+                      Nothing -> assertFailure "couldn't find price"
                       Just d2 -> do
                         let q2 = parseZGoPrice d2
                         case q2 of
-                          Nothing -> True `shouldBe` False
+                          Nothing -> assertFailure "couldn't parse price"
                           Just r2 -> do
                             let t2 = ZGoBackend.timestamp r2
                             t2 `shouldSatisfy` (t1 <)
@@ -1133,7 +1134,7 @@ testItemAdd i = do
 openDbConnection :: IO Pipe
 openDbConnection = do
   pipe <- connect $ host "127.0.0.1"
-  access pipe master "zgo" (auth "zgo" "zcashrules")
+  access pipe master "test" (auth "zgo" "zcashrules")
   return pipe
 
 -- | Close the MongoDB pipe
@@ -1156,7 +1157,7 @@ startAPI :: Config -> IO ()
 startAPI config = do
   putStrLn "Starting test server ..."
   pipe <- connect $ host $ c_dbHost config
-  c <- access pipe master "zgo" (auth (c_dbUser config) (c_dbPassword config))
+  c <- access pipe master "test" (auth (c_dbUser config) (c_dbPassword config))
   let appRoutes = routes pipe config
   _ <- forkIO (scotty 3000 appRoutes)
   _ <-

zgo-backend.cabal

@@ -163,6 +163,7 @@ test-suite zgo-backend-test
     , hspec-expectations-json
     , hspec-wai
     , http-conduit
+    , HUnit
     , http-types
     , megaparsec
     , mongoDB