diff --git a/src/WooCommerce.hs b/src/WooCommerce.hs index a7b16b4..212a874 100644 --- a/src/WooCommerce.hs +++ b/src/WooCommerce.hs @@ -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 = diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index 7e6aca1..e4702d7 100644 --- a/src/ZGoBackend.hs +++ b/src/ZGoBackend.hs @@ -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" diff --git a/test/Spec.hs b/test/Spec.hs index 3bf47c9..9feb956 100644 --- a/test/Spec.hs +++ b/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