Vergara_Tech/zgo-backend
Vergara_Tech/zgo-backend
2
1
Fork 0
Code Issues Pull requests 1 Projects Releases 4 Packages Wiki Activity

Updates for new versions of libraries

Browse source 
mongoDB
Scotty
This commit is contained in:
Rene Vergara 2024-05-20 15:20:47 -05:00
parent f9eb0e78f0
commit f19aa99ca9
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
3 changed files with 43 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

62
src/ZGoBackend.hs
View file

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

19
test/Spec.hs
View file

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

1
zgo-backend.cabal
View file

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