Updates for new versions of libraries
mongoDB Scotty
This commit is contained in:
parent
f9eb0e78f0
commit
f19aa99ca9
3 changed files with 43 additions and 39 deletions
|
@ -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
19
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)
|
||||
_ <-
|
||||
|
|
|
@ -163,6 +163,7 @@ test-suite zgo-backend-test
|
|||
, hspec-expectations-json
|
||||
, hspec-wai
|
||||
, http-conduit
|
||||
, HUnit
|
||||
, http-types
|
||||
, megaparsec
|
||||
, mongoDB
|
||||
|
|
Loading…
Reference in a new issue