Harden the wootoken endpoints
This commit is contained in:
parent
33df90eb96
commit
f625373e2e
GPG key ID:
65122AD495A7F5B2
3 changed files with 137 additions and 63 deletions
|
|
@ -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 =
|
||||
|
|
|
|||
|
|
@ -673,8 +673,12 @@ routes pipe config = do
|
|||
else status noContent204
|
||||
-- Get the xeroaccount code
|
||||
get "/api/xeroaccount" $ do
|
||||
oAdd <- param "address"
|
||||
res <- liftAndCatchIO $ run (findToken oAdd)
|
||||
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
|
||||
|
|
@ -687,14 +691,27 @@ routes pipe config = do
|
|||
])
|
||||
-- Save the xeroaccount code
|
||||
post "/api/xeroaccount" $ do
|
||||
oAdd <- param "address"
|
||||
session <- param "session"
|
||||
c <- param "code"
|
||||
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))
|
||||
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
|
||||
|
|
@ -708,19 +725,26 @@ routes pipe config = do
|
|||
])
|
||||
post "/api/wootoken" $ do
|
||||
oid <- param "ownerid"
|
||||
session <- param "session"
|
||||
user <- liftAndCatchIO $ run (findUser session)
|
||||
case cast' . Doc =<< user of
|
||||
Nothing -> status unauthorized401
|
||||
Just u -> do
|
||||
res <- liftAndCatchIO $ run (findOwnerById oid)
|
||||
let o1 = cast' . Doc =<< res
|
||||
case o1 of
|
||||
Nothing -> status noContent204
|
||||
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"
|
||||
|
|
|
|||
92
test/Spec.hs
92
test/Spec.hs
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue