Harden the wootoken endpoints

This commit is contained in:
Rene Vergara 2023-06-09 10:51:42 -05:00
parent 33df90eb96
commit f625373e2e
Signed by: pitmutt
GPG Key ID: 65122AD495A7F5B2
3 changed files with 137 additions and 63 deletions

View File

@ -47,8 +47,11 @@ instance Val WooToken where
cast' _ = Nothing
-- Database actions
findWooToken :: ObjectId -> Action IO (Maybe Document)
findWooToken oid = findOne (select ["owner" =: oid] "wootokens")
findWooToken :: Maybe ObjectId -> Action IO (Maybe Document)
findWooToken oid =
case oid of
Nothing -> return Nothing
Just o -> findOne (select ["owner" =: o] "wootokens")
addUrl :: WooToken -> T.Text -> Action IO ()
addUrl t u =

View File

@ -673,54 +673,78 @@ routes pipe config = do
else status noContent204
-- Get the xeroaccount code
get "/api/xeroaccount" $ do
oAdd <- param "address"
res <- liftAndCatchIO $ run (findToken oAdd)
let c = cast' . Doc =<< res
case c of
Nothing -> status noContent204
Just c1 -> do
status ok200
Web.Scotty.json
(object
[ "message" .= ("Xero account code found" :: String)
, "code" .= t_code c1
])
session <- param "session"
user <- liftAndCatchIO $ run (findUser session)
case cast' . Doc =<< user of
Nothing -> status unauthorized401
Just u -> do
res <- liftAndCatchIO $ run (findToken $ uaddress u)
let c = cast' . Doc =<< res
case c of
Nothing -> status noContent204
Just c1 -> do
status ok200
Web.Scotty.json
(object
[ "message" .= ("Xero account code found" :: String)
, "code" .= t_code c1
])
-- Save the xeroaccount code
post "/api/xeroaccount" $ do
oAdd <- param "address"
session <- param "session"
c <- param "code"
liftAndCatchIO $ run (addAccCode oAdd c)
status accepted202
user <- liftAndCatchIO $ run (findUser session)
case cast' . Doc =<< user of
Nothing -> status unauthorized401
Just u -> do
let oAdd = uaddress u
liftAndCatchIO $ run (addAccCode oAdd c)
status accepted202
-- Get the WooCommerce token
get "/api/wootoken" $ do
oid <- param "ownerid"
res <- liftAndCatchIO $ run (findWooToken (read oid))
let t1 = cast' . Doc =<< res
case t1 of
Nothing -> status noContent204
Just t -> do
status ok200
Web.Scotty.json
(object
[ "ownerid" .= show (w_owner t)
, "token" .= w_token t
, "siteurl" .= w_url t
])
session <- param "session"
user <- liftAndCatchIO $ run (findUser session)
case cast' . Doc =<< user of
Nothing -> status unauthorized401
Just u -> do
owner <- liftAndCatchIO $ run (findOwner $ uaddress u)
case cast' . Doc =<< owner of
Nothing -> status internalServerError500
Just o -> do
res <- liftAndCatchIO $ run (findWooToken $ o_id o)
let t1 = cast' . Doc =<< res
case t1 of
Nothing -> status noContent204
Just t -> do
status ok200
Web.Scotty.json
(object
[ "ownerid" .= show (w_owner t)
, "token" .= w_token t
, "siteurl" .= w_url t
])
post "/api/wootoken" $ do
oid <- param "ownerid"
res <- liftAndCatchIO $ run (findOwnerById oid)
let o1 = cast' . Doc =<< res
case o1 of
Nothing -> status noContent204
Just o -> do
liftAndCatchIO $ run (generateWooToken o)
status accepted202
session <- param "session"
user <- liftAndCatchIO $ run (findUser session)
case cast' . Doc =<< user of
Nothing -> status unauthorized401
Just u -> do
res <- liftAndCatchIO $ run (findOwnerById oid)
case cast' . Doc =<< res of
Nothing -> status badRequest400
Just o -> do
if oaddress o == uaddress u
then do
liftAndCatchIO $ run (generateWooToken o)
status accepted202
else status forbidden403
-- Authenticate the WooCommerce plugin
get "/auth" $ do
oid <- param "ownerid"
t <- param "token"
siteurl <- param "siteurl"
res <- liftAndCatchIO $ run (findWooToken (read oid))
res <- liftAndCatchIO $ run (findWooToken $ Just (read oid))
let c1 = cast' . Doc =<< res
case c1 of
Nothing -> do
@ -776,7 +800,7 @@ routes pipe config = do
amount <- param "amount"
sUrl <- param "siteurl"
orderKey <- param "orderkey"
res <- liftAndCatchIO $ run (findWooToken (read oid))
res <- liftAndCatchIO $ run (findWooToken $ Just (read oid))
let c = cast' . Doc =<< res
case c of
Nothing -> do
@ -1409,7 +1433,8 @@ scanPayments config pipe = do
"WC" -> do
let wOwner = fst $ head sResult ! 2
wooT <-
access p master dbName $ findWooToken (read wOwner)
access p master dbName $
findWooToken $ Just (read wOwner)
let wT = wooT >>= (cast' . Doc)
case wT of
Nothing -> error "Failed to read WooCommerce token"

View File

@ -232,18 +232,32 @@ main = do
req <-
testGet
"/api/xeroaccount"
[ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
, ("address", Just "Zaddy")
]
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
res <- httpJSON req
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
it "returns 401 with invalid session" $ do
it "reading returns 401 with invalid session" $ do
req <-
testGet
"/api/xeroaccount"
[("session", Just "fnelrkgnlyebrlvns82949")]
res <- httpLBS req
getResponseStatus res `shouldBe` unauthorized401
it "setting returns 401 with invalid session" $ do
req <-
testPost
"/api/xeroaccount"
[("session", Just "fnelrkgnlyebrlvns82949")]
res <- httpLBS req
getResponseStatus res `shouldBe` unauthorized401
it "setting succeeds with valid session" $ do
req <-
testPost
"/api/xeroaccount"
[ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
, ("code", Just "ZEC")
]
res <- httpLBS req
getResponseStatus res `shouldBe` accepted202
describe "User endpoint" $ do
it "returns a user for a session" $ do
req <-
@ -289,7 +303,7 @@ main = do
testDelete
"/api/user/"
"6272a90f2b05a74cf1000003"
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdaa")]
res <- httpLBS req
getResponseStatus res `shouldBe` ok200
describe "Owner endpoint" $
@ -553,7 +567,25 @@ main = do
res <- httpLBS req
getResponseStatus res `shouldBe` ok200
describe "WooCommerce endpoints" $ do
it "generate token" $ do
it "generate token with invalid session gives 401" $ do
req <-
testPost
"/api/wootoken"
[ ("ownerid", Just "627ad3492b05a76be3000001")
, ("session", Just "35bfb9c2-9ad2-fake-adda-99d63b8dcdcd")
]
res <- httpLBS req
getResponseStatus res `shouldBe` unauthorized401
it "generate token with mismatched session gives 403" $ do
req <-
testPost
"/api/wootoken"
[ ("ownerid", Just "627ad3492b05a76be3000001")
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake")
]
res <- httpLBS req
getResponseStatus res `shouldBe` forbidden403
it "generate token with valid session succeeds" $ do
req <-
testPost
"/api/wootoken"
@ -741,7 +773,7 @@ main = do
let myOrder =
ZGoOrder
(Just (read "627ab3ea2b05a76be3000001"))
"Zaddy"
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
myTs
False
@ -769,25 +801,26 @@ main = do
Just o2 -> qpaid o2 `shouldBe` True
describe "Xero data" $ do
it "token is saved" $ \p -> do
let myToken =
XeroToken
Nothing
"Zaddy"
"superFakeToken123"
1800
"anotherSuperFakeToken"
(UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0))
(UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0))
""
_ <- access p master "test" $ upsertToken myToken
t <- access p master "test" $ findToken "Zaddy"
t <-
access p master "test" $
findToken
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
let t1 = (cast' . Doc) =<< t
case t1 of
Nothing -> True `shouldBe` False
Just t2 -> t_address t2 `shouldBe` "Zaddy"
Just t2 ->
t_address t2 `shouldBe`
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
it "code is saved" $ \p -> do
_ <- access p master "test" $ addAccCode "Zaddy" "ZEC"
t <- access p master "test" $ findToken "Zaddy"
_ <-
access p master "test" $
addAccCode
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
"ZEC"
t <-
access p master "test" $
findToken
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
let t1 = (cast' . Doc) =<< t
case t1 of
Nothing -> True `shouldBe` False
@ -1054,6 +1087,8 @@ startAPI config = do
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "users"))
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "items"))
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "orders"))
_ <-
access pipe master "test" (Database.MongoDB.delete (select [] "xerotokens"))
let myUser =
User
(Just (read "6272a90f2b05a74cf1000001" :: ObjectId))
@ -1066,7 +1101,7 @@ startAPI config = do
User
(Just (read "6272a90f2b05a74cf1000003" :: ObjectId))
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdaa"
1613487
"8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
True
@ -1156,6 +1191,17 @@ startAPI config = do
case proSessionTest of
Doc pS1 -> access pipe master "test" (insert_ "prosessions" pS1)
_ -> fail "Couldn't save test ZGoProSession in DB"
let myToken =
XeroToken
Nothing
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
"superFakeToken123"
1800
"anotherSuperFakeToken"
(UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0))
(UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0))
""
_ <- access pipe master "test" $ upsertToken myToken
--let myWooToken =
--WooToken
--Nothing