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

Updates for new versions of libraries 

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)
])
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

19
test/Spec.hs
View File

@ -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)
_ <-

1
zgo-backend.cabal
View File

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