diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index b032f89..7e6aca1 100644 --- a/src/ZGoBackend.hs +++ b/src/ZGoBackend.hs @@ -1090,38 +1090,42 @@ routes pipe config = do ]) --Get all closed orders for the address get "/api/allorders" $ do - addr <- param "address" - myOrders <- liftAndCatchIO $ run (findAllOrders addr) - case myOrders of - [] -> status noContent204 - _ -> do - let pOrders = map (cast' . Doc) myOrders :: [Maybe ZGoOrder] - status ok200 - Web.Scotty.json - (object - [ "message" .= ("Orders found!" :: String) - , "orders" .= toJSON pOrders - ]) + session <- param "session" + user <- liftAndCatchIO $ run (findUser session) + case cast' . Doc =<< user of + Nothing -> status unauthorized401 + Just u -> do + myOrders <- liftAndCatchIO $ run (findAllOrders $ uaddress u) + case myOrders of + [] -> status noContent204 + _ -> do + let pOrders = map (cast' . Doc) myOrders :: [Maybe ZGoOrder] + status ok200 + Web.Scotty.json + (object + [ "message" .= ("Orders found!" :: String) + , "orders" .= toJSON pOrders + ]) --Get order by id for receipts get "/order/:id" $ do oId <- param "id" + token <- param "token" let r = mkRegex "^[a-f0-9]{24}$" if matchTest r oId then do myOrder <- liftAndCatchIO $ run (findOrderById oId) - case myOrder of + case cast' . Doc =<< myOrder of Nothing -> status noContent204 - Just o -> do - let o' = cast' (Doc o) - case o' of - Nothing -> status internalServerError500 - Just pOrder -> do + Just pOrder -> do + if qtoken pOrder == token + then do status ok200 Web.Scotty.json (object [ "message" .= ("Order found!" :: String) , "order" .= toJSON (pOrder :: ZGoOrder) ]) + else status forbidden403 else status badRequest400 --Get order by session get "/api/order" $ do @@ -1186,8 +1190,16 @@ routes pipe config = do --Delete order Web.Scotty.delete "/api/order/:id" $ do oId <- param "id" - liftAndCatchIO $ run (deleteOrder oId) - status ok200 + session <- param "session" + o <- liftAndCatchIO $ run (findOrderById oId) + case cast' . Doc =<< o of + Nothing -> status badRequest400 + Just order -> do + if qsession order == session + then do + liftAndCatchIO $ run (deleteOrder oId) + status ok200 + else status forbidden403 -- Get language for component get "/getmainlang" $ do lang <- param "lang" @@ -1599,6 +1611,6 @@ checkUser run s = do generateToken :: IO String generateToken = do rngState <- newCryptoRNGState - runCryptoRNGT rngState $ randomString 16 "abcdef0123456789" + runCryptoRNGT rngState $ randomString 24 "abcdef0123456789" debug = flip trace diff --git a/stack.yaml.lock b/stack.yaml.lock index 5a8e945..e7de262 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -31,7 +31,7 @@ packages: hackage: crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565 snapshots: - completed: - sha256: 42f77c84b34f68c30c2cd0bf8c349f617a0f428264362426290847a6a2019b64 - size: 649618 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/19.yaml - original: lts-20.19 + sha256: 4c972e067bae16b95961dbfdd12e07f1ee6c8fffabbfa05c3d65100b03f548b7 + size: 650253 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/23.yaml + original: lts-20.23 diff --git a/test/Spec.hs b/test/Spec.hs index 0aeb496..3bf47c9 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -346,6 +346,7 @@ main = do False "" "" + "testToken4321" req <- testPostJson "/api/order" $ A.object ["payload" A..= A.toJSON testOrder] @@ -372,6 +373,7 @@ main = do False "" "" + "testToken4321" req <- testPostJson "/api/order" $ A.object ["payload" A..= A.toJSON testOrder] @@ -398,6 +400,7 @@ main = do False "" "" + "testToken4321" req <- testPostJson "/api/order" $ A.object ["payload" A..= A.toJSON testOrder] @@ -422,48 +425,34 @@ main = do res <- httpLBS req getResponseStatus res `shouldBe` unauthorized401 it "get order by id" $ do - req <- testGet "/order/627ab3ea2b05a76be3000000" [] + req <- + testGet + "/order/627ab3ea2b05a76be3000000" + [("token", Just "testToken1234")] res <- httpJSON req getResponseStatus (res :: Response A.Value) `shouldBe` ok200 it "get order with invalid id fails with 400" $ do - req <- testGet "/order/6273hrb" [] + req <- testGet "/order/6273hrb" [("token", Just "testToken1234")] res <- httpLBS req getResponseStatus res `shouldBe` badRequest400 it "get order by id fails with bad token" $ do - req <- testGet "/order/627ab3ea2b05a76be3000000" [] + req <- + testGet + "/order/627ab3ea2b05a76be3000000" + [("token", Just "wrongToken1234")] res <- httpLBS req - getResponseStatus res `shouldBe` unauthorized401 + getResponseStatus res `shouldBe` forbidden403 it "get all orders for owner" $ do req <- testGet "/api/allorders" - [ ("address", Just "Zaddy") - , ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd") - ] + [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] res <- httpJSON req getResponseStatus (res :: Response A.Value) `shouldBe` ok200 it "get all orders for owner fails with bad session" $ do req <- testGet "/api/allorders" - [ ("address", Just "Zaddy") - , ("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd") - ] - res <- httpLBS req - getResponseStatus res `shouldBe` unauthorized401 - it "delete order by id" $ do - req <- - testDelete - "/api/order/" - "627ab3ea2b05a76be3000000" - [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] - res <- httpLBS req - getResponseStatus res `shouldBe` ok200 - it "delete order by id fails with bad session" $ do - req <- - testDelete - "/api/order/" - "627ab3ea2b05a76be3000000" [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")] res <- httpLBS req getResponseStatus res `shouldBe` unauthorized401 @@ -475,6 +464,22 @@ main = do [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake")] res <- httpLBS req getResponseStatus res `shouldBe` forbidden403 + it "delete order by id fails with bad session" $ do + req <- + testDelete + "/api/order/" + "627ab3ea2b05a76be3000000" + [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")] + res <- httpLBS req + getResponseStatus res `shouldBe` unauthorized401 + it "delete order by id" $ do + req <- + testDelete + "/api/order/" + "627ab3ea2b05a76be3000000" + [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] + res <- httpLBS req + getResponseStatus res `shouldBe` ok200 describe "Item endpoint" $ do it "adding item with bad session fails" $ do let item = @@ -748,6 +753,7 @@ main = do False "" "" + "testToken1234" let ordTest = val myOrder case ordTest of Doc oT -> access p master "test" (insert_ "orders" oT) @@ -1112,7 +1118,7 @@ startAPI config = do let myOrder = ZGoOrder (Just (read "627ab3ea2b05a76be3000000")) - "Zaddy" + "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd" myTs False @@ -1124,6 +1130,7 @@ startAPI config = do False "" "" + "testToken1234" let ordTest = val myOrder case ordTest of Doc oT -> access pipe master "test" (insert_ "orders" oT) @@ -1177,7 +1184,8 @@ instance Arbitrary ZGoOrder where l <- arbitrary pd <- arbitrary eI <- arbitrary - ZGoOrder i a s ts c cur p t tZ l pd eI <$> arbitrary + sc <- arbitrary + ZGoOrder i a s ts c cur p t tZ l pd eI sc <$> arbitrary instance Arbitrary LineItem where arbitrary = do