diff --git a/CHANGELOG.md b/CHANGELOG.md index 9c81a3d..03b9130 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,22 @@ 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 +- New endpoint for the language data of the login page +- New `OwnerData` to represent informational values +- New `OwnerSettings` to abstract configuration settings for owners + +### Changed + +- Modified API tests to use `session` parameter. +- Modified `api/owner` endpoint to use a specific data structure to create new owners +- Modified `api/owner` endpoint to use session as input + ## [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/Owner.hs b/src/Owner.hs index f426636..867f923 100644 --- a/src/Owner.hs +++ b/src/Owner.hs @@ -275,6 +275,120 @@ instance Val Owner where , "crmToken" =: cT ] +-- | Type to represent informational data for Owners from UI +data OwnerData = + OwnerData + { od_first :: T.Text + , od_last :: T.Text + , od_name :: T.Text + , od_street :: T.Text + , od_city :: T.Text + , od_state :: T.Text + , od_postal :: T.Text + , od_country :: T.Text + , od_email :: T.Text + , od_website :: T.Text + , od_phone :: T.Text + } + deriving (Eq, Show, Generic) + +instance FromJSON OwnerData where + parseJSON = + withObject "OwnerData" $ \obj -> do + f <- obj .: "first" + l <- obj .: "last" + n <- obj .: "name" + s <- obj .: "street" + c <- obj .: "city" + st <- obj .: "state" + p <- obj .: "postal" + co <- obj .: "country" + e <- obj .: "email" + w <- obj .: "website" + ph <- obj .: "phone" + pure $ OwnerData f l n s c st p co e w ph + +data OwnerSettings = + OwnerSettings + { os_id :: Maybe ObjectId + , os_address :: T.Text + , os_name :: T.Text + , os_currency :: T.Text + , os_tax :: Bool + , os_taxValue :: Double + , os_vat :: Bool + , os_vatValue :: Double + , os_paid :: Bool + , os_zats :: Bool + , os_invoices :: Bool + , os_expiration :: UTCTime + , os_payconf :: Bool + , os_crmToken :: T.Text + , os_viewKey :: T.Text + } + deriving (Eq, Show, Generic) + +instance FromJSON OwnerSettings where + parseJSON = + withObject "OwnerSettings" $ \obj -> do + i <- obj .:? "_id" + a <- obj .: "address" + n <- obj .: "name" + c <- obj .: "currency" + t <- obj .: "tax" + tV <- obj .: "taxValue" + v <- obj .: "vat" + vV <- obj .: "vatValue" + p <- obj .: "paid" + z <- obj .: "zats" + inv <- obj .: "invoices" + e <- obj .: "expiration" + pc <- obj .: "payconf" + cT <- obj .: "crmToken" + vK <- obj .: "viewkey" + pure $ + OwnerSettings ((Just . read) =<< i) a n c t tV v vV p z inv e pc cT vK + +instance ToJSON OwnerSettings where + toJSON (OwnerSettings i a n c t tV v vV p z inv e pc cT vK) = + object + [ "_id" .= maybe "" show i + , "address" .= a + , "name" .= n + , "currency" .= c + , "tax" .= t + , "taxValue" .= tV + , "vat" .= v + , "vatValue" .= vV + , "paid" .= p + , "zats" .= z + , "invoices" .= inv + , "expiration" .= e + , "payconf" .= pc + , "crmToken" .= cT + , "viewkey" .= (T.take 8 vK <> "...." <> T.takeEnd 8 vK) + ] + +-- Helper Functions +getOwnerSettings :: Owner -> OwnerSettings +getOwnerSettings o = + OwnerSettings + (o_id o) + (oaddress o) + (oname o) + (ocurrency o) + (otax o) + (otaxValue o) + (ovat o) + (ovatValue o) + (opaid o) + (ozats o) + (oinvoices o) + (oexpiration o) + (opayconf o) + (ocrmToken o) + (oviewkey o) + -- Database actions -- | Function to upsert an Owner upsertOwner :: Owner -> Action IO () @@ -306,6 +420,23 @@ removePro :: T.Text -> Action IO () removePro o = modify (select ["address" =: o] "owners") ["$set" =: ["invoices" =: False]] +updateOwnerSettings :: OwnerSettings -> Action IO () +updateOwnerSettings os = + modify + (select ["_id" =: os_id os] "owners") + [ "$set" =: + [ "name" =: os_name os + , "currency" =: os_currency os + , "tax" =: os_tax os + , "taxValue" =: os_taxValue os + , "vat" =: os_vat os + , "vatValue" =: os_vatValue os + , "zats" =: os_zats os + , "payconf" =: os_payconf os + , "crmToken" =: os_crmToken os + ] + ] + -- | Type for a pro session data ZGoProSession = ZGoProSession 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/Xero.hs b/src/Xero.hs index 52fe641..009caf2 100644 --- a/src/Xero.hs +++ b/src/Xero.hs @@ -30,8 +30,7 @@ data Xero = deriving (Eq, Show) instance ToJSON Xero where - toJSON (Xero i cI s) = - object ["_id" .= show i, "clientId" .= cI, "clientSecret" .= s] + toJSON (Xero i cI s) = object ["_id" .= show i, "clientId" .= cI] instance Val Xero where val (Xero i cI s) = Doc ["_id" =: i, "clientId" =: cI, "clientSecret" =: s] diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index 188a7c5..0243fb6 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 @@ -376,7 +376,7 @@ zToZGoTx' config pipe (ZcashTx t a aZ bh bt c conf m) = do if m_payment zM' then upsertPayment pipe (c_dbName config) tx else access pipe master (c_dbName config) $ upsertZGoTx "txs" tx - Left e -> error "Failed to parse ZGo memo" + Left e -> print $ "Failed to parse ZGo memo: " ++ show e -- |Type to model a price in the ZGo database data ZGoPrice = @@ -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 @@ -817,20 +844,29 @@ routes pipe config = do status accepted202 Web.Scotty.json (object ["message" .= ("Incorrect plugin config" :: String)]) + get "/checkuser" $ do + sess <- param "session" + user <- liftAndCatchIO $ run (findUser sess) + case parseUserBson =<< user of + Nothing -> status noContent204 + Just u -> do + status ok200 + Web.Scotty.json (object ["validated" .= uvalidated u]) --Get user associated with session get "/api/user" $ do sess <- param "session" user <- liftAndCatchIO $ run (findUser sess) case user of Nothing -> status noContent204 - Just u -> + Just u -> do + status ok200 Web.Scotty.json (object [ "message" .= ("User found" :: String) , "user" .= toJSON (parseUserBson u) ]) --Validate user, updating record - post "/api/validateuser" $ do + post "/validateuser" $ do providedPin <- param "pin" sess <- param "session" let pinHash = @@ -864,7 +900,7 @@ routes pipe config = do status ok200 else status noContent204 --Get current blockheight from Zcash node - get "/api/blockheight" $ do + get "/blockheight" $ do blockInfo <- liftAndCatchIO $ makeZcashCall nodeUser nodePwd "getblock" ["-1"] let content = getResponseBody blockInfo :: RpcResponse Block @@ -875,23 +911,23 @@ routes pipe config = do else do status internalServerError500 --Get the ZGo node's shielded address - get "/api/getaddr" $ do Web.Scotty.json (object ["addr" .= nodeAddress]) + get "/getaddr" $ do Web.Scotty.json (object ["addr" .= nodeAddress]) --Get owner by address get "/api/owner" $ do - addr <- param "address" - owner <- liftAndCatchIO $ run (findOwner addr) - case owner of + session <- param "session" + user <- liftAndCatchIO $ run (findUser session) + case parseUserBson =<< user of Nothing -> status noContent204 - Just o -> do - let pOwner = cast' (Doc o) - case pOwner of - Nothing -> status internalServerError500 - Just q -> do + Just u -> do + owner <- liftAndCatchIO $ run (findOwner $ uaddress u) + case cast' . Doc =<< owner of + Nothing -> status noContent204 + Just o -> do status ok200 Web.Scotty.json (object [ "message" .= ("Owner found!" :: String) - , "owner" .= toJSON (q :: Owner) + , "owner" .= getOwnerSettings o ]) get "/api/ownerid" $ do id <- param "id" @@ -907,37 +943,78 @@ routes pipe config = do Web.Scotty.json (object [ "message" .= ("Owner found!" :: String) - , "owner" .= toJSON (q :: Owner) + , "owner" .= + object + [ "_id" .= (maybe "" show $ o_id q :: String) + , "address" .= oaddress q + , "name" .= oname q + , "currency" .= ocurrency q + , "tax" .= otax q + , "taxValue" .= otaxValue q + , "vat" .= ovat q + , "vatValue" .= ovatValue q + , "paid" .= opaid q + , "zats" .= ozats q + , "invoices" .= oinvoices q + , "expiration" .= oexpiration q + , "payconf" .= opayconf q + , "crmToken" .= ocrmToken q + ] ]) --Upsert owner to DB post "/api/owner" $ do + s <- param "session" + u <- liftAndCatchIO $ run (findUser s) o <- jsonData - let q = payload (o :: Payload Owner) - if not (opayconf q) - then do - _ <- liftAndCatchIO $ run (upsertOwner q) - status created201 - else do - known <- liftAndCatchIO $ listAddresses nodeUser nodePwd - if oaddress q `elem` map addy known + now <- liftIO getCurrentTime + let q = payload (o :: Payload OwnerData) + case parseUserBson =<< u of + Nothing -> status internalServerError500 + Just u' -> do + liftAndCatchIO $ + run $ + upsertOwner $ + Owner + Nothing + (uaddress u') + (od_name q) + "usd" + False + 0 + False + 0 + (od_first q) + (od_last q) + (od_email q) + (od_street q) + (od_city q) + (od_state q) + (od_postal q) + (od_phone q) + (od_website q) + (od_country q) + False + False + False + now + False + "" + "" + status accepted202 + post "/api/ownersettings" $ do + s <- param "session" + u <- liftAndCatchIO $ run (findUser s) + o <- jsonData + now <- liftIO getCurrentTime + let q = payload (o :: Payload OwnerSettings) + case parseUserBson =<< u of + Nothing -> status internalServerError500 + Just u' -> do + if os_address q == uaddress u' then do - _ <- liftAndCatchIO $ run (upsertOwner q) - status created201 - else do - vkInfo <- - liftAndCatchIO $ - makeZcashCall - nodeUser - nodePwd - "z_importviewingkey" - [Data.Aeson.String (T.strip (oviewkey q)), "no"] - let content = getResponseBody vkInfo :: RpcResponse Object - if isNothing (err content) - then do - _ <- liftAndCatchIO $ run (upsertOwner q) - status created201 - else do - status internalServerError500 + liftAndCatchIO $ run $ updateOwnerSettings q + status accepted202 + else status noContent204 --Get items associated with the given address get "/api/items" $ do addr <- param "address" @@ -966,7 +1043,7 @@ routes pipe config = do status ok200 else status noContent204 --Get price for Zcash - get "/api/price" $ do + get "/price" $ do curr <- param "currency" pr <- liftAndCatchIO $ run (findPrice curr) case pr of @@ -1063,6 +1140,30 @@ routes pipe config = do liftAndCatchIO $ run (deleteOrder oId) status ok200 -- Get language for component + get "/getmainlang" $ do + lang <- param "lang" + txtPack' <- liftAndCatchIO $ run (findLangComponent lang "main") + case cast' . Doc =<< txtPack' of + Nothing -> status noContent204 + Just textPack -> do + status ok200 + Web.Scotty.json $ toJSON (textPack :: LangComponent) + get "/getscanlang" $ do + lang <- param "lang" + txtPack' <- liftAndCatchIO $ run (findLangComponent lang "scan") + case cast' . Doc =<< txtPack' of + Nothing -> status noContent204 + Just textPack -> do + status ok200 + Web.Scotty.json $ toJSON (textPack :: LangComponent) + get "/getloginlang" $ do + lang <- param "lang" + txtPack' <- liftAndCatchIO $ run (findLangComponent lang "login") + case cast' . Doc =<< txtPack' of + Nothing -> status noContent204 + Just textPack -> do + status ok200 + Web.Scotty.json $ toJSON (textPack :: LangComponent) get "/api/getlang" $ do component <- param "component" lang <- param "lang" @@ -1073,12 +1174,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/src/ZGoTx.hs b/src/ZGoTx.hs index 95278f8..9c95872 100644 --- a/src/ZGoTx.hs +++ b/src/ZGoTx.hs @@ -119,6 +119,7 @@ type Parser = Parsec Void T.Text pSession :: Parser MemoToken pSession = do + optional spaceChar string "ZGO" pay <- optional $ char 'p' string "::" @@ -142,9 +143,7 @@ pSaplingAddress = do pMsg :: Parser MemoToken pMsg = do Msg . T.pack <$> - some - (alphaNumChar <|> punctuationChar <|> symbolChar <|> - charCategory OtherSymbol) + some (alphaNumChar <|> punctuationChar <|> charCategory OtherSymbol) pMemo :: Parser MemoToken pMemo = do 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