diff --git a/CHANGELOG.md b/CHANGELOG.md index 9c81a3d..164d3b7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,17 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [1.5.0] + +### Added + +- `isUserValid` function +- New middleware to validated requests come from an existing user + +### Changed + +- Modified API tests to use `session` parameter. + ## [1.4.1] - 2023-05-02 ### Fixed diff --git a/package.yaml b/package.yaml index 354f8ff..ca1e131 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: zgo-backend -version: 1.4.1 +version: 1.5.0 git: "https://git.vergara.tech/Vergara_Tech/zgo-backend" license: BOSL author: "Rene Vergara" diff --git a/src/User.hs b/src/User.hs index f455f1c..a393dc5 100644 --- a/src/User.hs +++ b/src/User.hs @@ -94,6 +94,16 @@ isUserNew p db tx = isNothing <$> access p master db (findOne (select ["session" =: session tx] "users")) +-- | Function to verify if the given session has a valid user +isUserValid :: Pipe -> T.Text -> T.Text -> IO Bool +isUserValid p db s = + isJust <$> + access + p + master + db + (findOne (select ["session" =: s, "validated" =: True] "users")) + -- | Function to mark user as validated validateUser :: T.Text -> Action IO () validateUser session = @@ -106,11 +116,3 @@ generatePin = do rngState <- newCryptoRNGState runCryptoRNGT rngState $ randomString 7 ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'] - --- | Helper function to pad a string to a given length -padLeft :: String -> Char -> Int -> String -padLeft s c m = - let isBaseLarger = length s > m - padder st ch m False = [ch | _ <- [1 .. (m - length st)]] ++ s - padder st _ _ True = st - in padder s c m isBaseLarger diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index 188a7c5..44f7bbb 100644 --- a/src/ZGoBackend.hs +++ b/src/ZGoBackend.hs @@ -44,7 +44,7 @@ import Item import LangComponent import Network.HTTP.Simple import Network.HTTP.Types.Status -import Network.Wai (Request, pathInfo) +import Network.Wai (Application, Middleware, Request(..), pathInfo, responseLBS) import Network.Wai.Middleware.Cors import Network.Wai.Middleware.HttpAuth import Numeric @@ -545,6 +545,32 @@ needsAuth req = "api":_ -> True _ -> False +zgoAuth :: Pipe -> T.Text -> Middleware +zgoAuth pipe dbName app req respond = do + let q = filter findSessionParam $ queryString req + isFenced <- needsAuth req + if isFenced + then do + if length q == 1 + then do + isOk <- checkSession pipe dbName $ head q + if isOk + then app req respond + else respond $ + responseLBS unauthorized401 [] "ZGo API access denied!" + else respond $ responseLBS unauthorized401 [] "ZGo API access denied!" + else app req respond + where + findSessionParam :: QueryItem -> Bool + findSessionParam (i, val) = i == "session" + checkSession :: + Pipe -> T.Text -> (BS.ByteString, Maybe BS.ByteString) -> IO Bool + checkSession p db (k, v) = + case v of + Just sessionId -> + isUserValid p db $ E.decodeUtf8With lenientDecode sessionId + Nothing -> return False + -- | Main API routes routes :: Pipe -> Config -> ScottyM () routes pipe config = do @@ -566,6 +592,7 @@ routes pipe config = do basicAuth (\u p -> return $ u == "user" && secureMemFromByteString p == passkey) authSettings + middleware $ zgoAuth pipe $ c_dbName config --Get list of countries for UI get "/api/countries" $ do countries <- liftAndCatchIO $ run listCountries @@ -830,7 +857,7 @@ routes pipe config = do , "user" .= toJSON (parseUserBson u) ]) --Validate user, updating record - post "/api/validateuser" $ do + post "/validateuser" $ do providedPin <- param "pin" sess <- param "session" let pinHash = @@ -1073,12 +1100,12 @@ routes pipe config = do Just tP -> do status ok200 Web.Scotty.json $ toJSON (tP :: LangComponent) - post "/api/setlang" $ do - langComp <- jsonData - _ <- - liftAndCatchIO $ - mapM (run . loadLangComponent) (langComp :: [LangComponent]) - status created201 + {-post "/api/setlang" $ do-} + {-langComp <- jsonData-} + {-_ <--} + {-liftAndCatchIO $-} + {-mapM (run . loadLangComponent) (langComp :: [LangComponent])-} + {-status created201-} -- | Make a Zcash RPC call makeZcashCall :: diff --git a/stack.yaml b/stack.yaml index 442eff8..aff10dc 100644 --- a/stack.yaml +++ b/stack.yaml @@ -17,7 +17,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml -resolver: lts-20.17 +resolver: lts-20.19 #url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml # User packages to be built. diff --git a/stack.yaml.lock b/stack.yaml.lock index 358549d..5a8e945 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: 14ca51a9a597c32dd7804c10d079feea3d0ae40c5fbbb346cbd67b3ae49f6d01 - size: 649598 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/17.yaml - original: lts-20.17 + sha256: 42f77c84b34f68c30c2cd0bf8c349f617a0f428264362426290847a6a2019b64 + size: 649618 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/19.yaml + original: lts-20.19 diff --git a/test/Spec.hs b/test/Spec.hs index 4527b03..cbee780 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -144,35 +144,99 @@ main = do length pin `shouldBe` 7 describe "API endpoints" $ do beforeAll_ (startAPI loadedConfig) $ do + describe "Validate user session" $ do + it "validate with correct pin" $ do + req <- + testPost + "/validateuser" + [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd") + , ("pin", Just "1234567") + ] + res <- httpLBS req + getResponseStatus res `shouldBe` accepted202 describe "Price endpoint" $ do it "returns a price for an existing currency" $ do - req <- testGet "/api/price" [("currency", Just "usd")] + req <- + testGet + "/api/price" + [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd") + , ("currency", Just "usd") + ] res <- httpJSON req getResponseStatus (res :: Response A.Value) `shouldBe` ok200 it "returns 204 when the currency is not supported" $ do - req <- testGet "/api/price" [("currency", Just "jpy")] + req <- + testGet + "/api/price" + [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd") + , ("currency", Just "jpy") + ] res <- httpLBS req getResponseStatus res `shouldBe` noContent204 + it "returs 401 when the session is not valid" $ do + req <- + testGet + "/api/price" + [ ("session", Just "th7s1sa-fake-6u1d-7h47-1m4deuph3r3") + , ("currency", Just "usd") + ] + res <- httpLBS req + getResponseStatus res `shouldBe` unauthorized401 describe "Countries endpoint" $ do it "returns a list of countries" $ do - req <- testGet "/api/countries" [] + req <- + testGet + "/api/countries" + [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] res <- httpJSON req getResponseStatus (res :: Response A.Value) `shouldBe` ok200 + it "returns 401 with invalid session" $ do + req <- + testGet + "/api/countries" + [("session", Just "fake-id-string-283that0")] + res <- httpLBS req + getResponseStatus res `shouldBe` unauthorized401 describe "blockheight endpoint" $ do it "returns a block number" $ do - req <- testGet "/api/blockheight" [] + req <- + testGet + "/api/blockheight" + [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] res <- httpJSON req height (getResponseBody (res :: Response Block)) `shouldSatisfy` \x -> x > 1600000 - describe "xero config endpoint" $ do - it "returns the config" $ do - req <- testGet "/api/xero" [] - res <- httpJSON req - getResponseStatus (res :: Response A.Value) `shouldBe` ok200 - it "returns the account code" $ do - req <- testGet "/api/xeroaccount" [("address", Just "Zaddy")] - res <- httpJSON req - getResponseStatus (res :: Response A.Value) `shouldBe` ok200 + describe "Xero endpoints" $ do + describe "xero" $ do + it "returns the xero config" $ do + req <- + testGet + "/api/xero" + [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] + res <- httpJSON req + getResponseStatus (res :: Response A.Value) `shouldBe` ok200 + it "returns 401 with invalid session" $ do + req <- + testGet "/api/xero" [("session", Just "fnelrkgnlyebrlvns82949")] + res <- httpLBS req + getResponseStatus res `shouldBe` unauthorized401 + describe "xeroaccount" $ do + it "returns the account code" $ do + req <- + testGet + "/api/xeroaccount" + [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd") + , ("address", Just "Zaddy") + ] + res <- httpJSON req + getResponseStatus (res :: Response A.Value) `shouldBe` ok200 + it "returns 401 with invalid session" $ do + req <- + testGet + "/api/xeroaccount" + [("session", Just "fnelrkgnlyebrlvns82949")] + res <- httpLBS req + getResponseStatus res `shouldBe` unauthorized401 describe "User endpoint" $ do it "returns a user for a session" $ do req <- @@ -181,28 +245,24 @@ main = do [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] res <- httpJSON req getResponseStatus (res :: Response A.Value) `shouldBe` ok200 - it "returns 204 when no user" $ do + it "returns 401 when user doesn't exist" $ do req <- testGet "/api/user" [("session", Just "suchafak-euui-dican-eve-nbelieveitca")] res <- httpLBS req - getResponseStatus res `shouldBe` noContent204 - it "validate with correct pin" $ do - req <- - testPost - "/api/validateuser" - [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd") - , ("pin", Just "1234567") - ] - res <- httpLBS req - getResponseStatus res `shouldBe` accepted202 + getResponseStatus res `shouldBe` unauthorized401 it "deletes user by id" $ do - req <- testDelete "/api/user/" "6272a90f2b05a74cf1000001" + req <- + testDelete + "/api/user/" + "6272a90f2b05a74cf1000003" + [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] res <- httpLBS req getResponseStatus res `shouldBe` ok200 - describe "Owner endpoint" $ do - prop "add owner" testOwnerAdd + describe "Owner endpoint" $ + --prop "add owner" testOwnerAdd + do it "return owner by address" $ do req <- testGet @@ -210,15 +270,31 @@ main = do [ ( "address" , Just "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e") + , ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd") ] res <- httpJSON req getResponseStatus (res :: Response A.Value) `shouldBe` ok200 + it "owner by address returns 401 with bad session" $ do + req <- + testGet + "/api/owner" + [ ( "address" + , Just + "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e") + , ("session", Just "3fake94j-rbal-jeber-nvlke-4bal8dcdcd") + ] + res <- httpLBS req + getResponseStatus res `shouldBe` unauthorized401 it "return owner by id" $ do req <- - testGet "/api/ownerid" [("id", Just "627ad3492b05a76be3000001")] + testGet + "/api/ownerid" + [ ("id", Just "627ad3492b05a76be3000001") + , ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd") + ] res <- httpLBS req getResponseStatus res `shouldBe` ok200 - describe "Order endpoint" $ do + describe "Order endpoints" $ do prop "upsert order" testOrderAdd it "get order by session" $ do req <- @@ -227,30 +303,85 @@ main = do [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] res <- httpJSON req getResponseStatus (res :: Response A.Value) `shouldBe` ok200 + it "get order by session fails when invalid" $ do + req <- + testGet + "/api/order" + [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")] + res <- httpLBS req + getResponseStatus res `shouldBe` unauthorized401 it "get order by id" $ do - req <- testGet "/api/order/627ab3ea2b05a76be3000000" [] + req <- + testGet + "/api/order/627ab3ea2b05a76be3000000" + [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] res <- httpJSON req getResponseStatus (res :: Response A.Value) `shouldBe` ok200 it "get order with wrong id" $ do - req <- testGet "/api/order/6273hrb" [] + req <- + testGet + "/api/order/6273hrb" + [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] res <- httpLBS req getResponseStatus res `shouldBe` noContent204 + it "get order by id fails with bad session" $ do + req <- + testGet + "/api/order/627ab3ea2b05a76be3000000" + [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")] + res <- httpLBS req + getResponseStatus res `shouldBe` unauthorized401 it "get all orders for owner" $ do - req <- testGet "/api/allorders" [("address", Just "Zaddy")] + req <- + testGet + "/api/allorders" + [ ("address", Just "Zaddy") + , ("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" + 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 describe "Item endpoint" $ do prop "add item" testItemAdd it "get items" $ do - req <- testGet "/api/items" [("address", Just "Zaddy")] + req <- + testGet + "/api/items" + [ ("address", Just "Zaddy") + , ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd") + ] res <- httpJSON req getResponseStatus (res :: Response A.Value) `shouldBe` ok200 it "delete item" $ do - req <- testDelete "/api/item/" "627d7ba92b05a76be3000003" + req <- + testDelete + "/api/item/" + "627d7ba92b05a76be3000003" + [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] res <- httpLBS req getResponseStatus res `shouldBe` ok200 describe "WooCommerce endpoints" $ do @@ -258,7 +389,9 @@ main = do req <- testPost "/api/wootoken" - [("ownerid", Just "627ad3492b05a76be3000001")] + [ ("ownerid", Just "627ad3492b05a76be3000001") + , ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd") + ] res <- httpLBS req getResponseStatus res `shouldBe` accepted202 it "authenticate with incorrect owner" $ do @@ -329,21 +462,40 @@ main = do req <- testGet "/api/getlang" - [("lang", Just "en-US"), ("component", Just "login")] + [ ("lang", Just "en-US") + , ("component", Just "login") + , ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd") + ] res <- httpJSON req getResponseStatus (res :: Response A.Value) `shouldBe` ok200 + it "existing component with bad session" $ do + req <- + testGet + "/api/getlang" + [ ("lang", Just "en-US") + , ("component", Just "login") + , ("session", Just "35bfb9c2-fake-4fe5-adda-99d63b8dcdcd") + ] + res <- httpLBS req + getResponseStatus res `shouldBe` unauthorized401 it "wrong component" $ do req <- testGet "/api/getlang" - [("lang", Just "en-US"), ("component", Just "test")] + [ ("lang", Just "en-US") + , ("component", Just "test") + , ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd") + ] res <- httpLBS req getResponseStatus res `shouldBe` noContent204 it "wrong language" $ do req <- testGet "/api/getlang" - [("lang", Just "fr-FR"), ("component", Just "login")] + [ ("lang", Just "fr-FR") + , ("component", Just "login") + , ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd") + ] res <- httpLBS req getResponseStatus res `shouldBe` noContent204 around handleDb $ @@ -632,11 +784,16 @@ testPostJson endpoint body = do setRequestMethod "POST" $ setRequestPath endpoint defaultRequest return testRequest -testDelete :: B.ByteString -> B.ByteString -> IO Request -testDelete endpoint par = do +testDelete :: + B.ByteString + -> B.ByteString + -> [(B.ByteString, Maybe B.ByteString)] + -> IO Request +testDelete endpoint par body = do let user = "user" let pwd = "superSecret" let testRequest = + setRequestQueryString body $ setRequestPort 3000 $ setRequestBasicAuth user pwd $ setRequestMethod "DELETE" $ @@ -658,14 +815,22 @@ testOrderAdd o = monadicIO $ do req <- run $ testPostJson "/api/order" (A.object ["payload" A..= A.toJSON o]) - res <- httpLBS req + res <- + httpLBS $ + setRequestQueryString + [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] + req assert $ getResponseStatus res == created201 testItemAdd :: Item -> Property testItemAdd i = do monadicIO $ do req <- run $ testPostJson "/api/item" (A.object ["payload" A..= A.toJSON i]) - res <- httpLBS req + res <- + httpLBS $ + setRequestQueryString + [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] + req assert $ getResponseStatus res == created201 -- | Open the MongoDB connection @@ -692,6 +857,9 @@ startAPI config = do _ <- forkIO (scotty 3000 appRoutes) _ <- access pipe master "test" (Database.MongoDB.delete (select [] "wootokens")) + _ <- 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")) let myUser = User (Just (read "6272a90f2b05a74cf1000001" :: ObjectId)) @@ -714,6 +882,28 @@ startAPI config = do , "pin" =: upin myUser , "validated" =: uvalidated myUser ]) + let myUser1 = + User + (Just (read "6272a90f2b05a74cf1000003" :: ObjectId)) + "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" + "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd" + 1613487 + "8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162" + True + _ <- + access + pipe + master + "test" + (insert_ + "users" + [ "address" =: uaddress myUser1 + , "_id" =: u_id myUser1 + , "session" =: usession myUser1 + , "blocktime" =: ublocktime myUser1 + , "pin" =: upin myUser1 + , "validated" =: uvalidated myUser1 + ]) let myOwner = Owner (Just (read "627ad3492b05a76be3000001")) diff --git a/zgo-backend.cabal b/zgo-backend.cabal index fee2033..1450cc8 100644 --- a/zgo-backend.cabal +++ b/zgo-backend.cabal @@ -5,7 +5,7 @@ cabal-version: 1.12 -- see: https://github.com/sol/hpack name: zgo-backend -version: 1.4.1 +version: 1.5.0 synopsis: Haskell Back-end for the ZGo point-of-sale application description: Please see the README at category: Web