diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index 29f62ef..ef88e2e 100644 --- a/src/ZGoBackend.hs +++ b/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 diff --git a/test/Spec.hs b/test/Spec.hs index 61742db..c8fa585 100644 --- a/test/Spec.hs +++ b/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) _ <- diff --git a/zgo-backend.cabal b/zgo-backend.cabal index 91293f4..416f405 100644 --- a/zgo-backend.cabal +++ b/zgo-backend.cabal @@ -163,6 +163,7 @@ test-suite zgo-backend-test , hspec-expectations-json , hspec-wai , http-conduit + , HUnit , http-types , megaparsec , mongoDB