From 1ae32a5a8e8ef906835f2cf9689378fc8aa0aa41 Mon Sep 17 00:00:00 2001 From: Lucy Cifferello <12953208+elvece@users.noreply.github.com> Date: Sun, 21 Nov 2021 14:21:01 -0700 Subject: [PATCH] refactor test suite for model and api changes, adding tests for fetched versions via index endpoint --- test/Handler/AppSpec.hs | 134 ++++++++++++++++++++++---------- test/Handler/MarketplaceSpec.hs | 133 +++++++------------------------ test/Seed.hs | 76 ++++++++++++++++++ 3 files changed, 198 insertions(+), 145 deletions(-) create mode 100644 test/Seed.hs diff --git a/test/Handler/AppSpec.hs b/test/Handler/AppSpec.hs index 893afd2..ac619f0 100644 --- a/test/Handler/AppSpec.hs +++ b/test/Handler/AppSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ScopedTypeVariables #-} module Handler.AppSpec ( spec @@ -11,68 +12,119 @@ import Data.Maybe import TestImport import Model - +import Handler.Marketplace +import Seed +import Lib.Types.AppIndex +import Data.Aeson +import Data.Either.Extra spec :: Spec spec = do - describe "GET /package/index" $ withApp $ it "returns list of apps" $ do + describe "GET /package/index" $ withApp $ it "returns list of packages" $ do + _ <- seedBitcoinLndStack request $ do setMethod "GET" setUrl ("/package/index" :: Text) - bodyContains "embassy-pages" - bodyContains "version: 0.1.3" statusIs 200 - describe "GET /package/:appId with unknown version spec for embassy-pages" + (res :: [ServiceRes]) <- requireJSONResponse + assertEq "response should have two packages" (length res) 3 + describe "GET /package/index?ids" $ withApp $ it "returns list of packages at specified version" $ do + _ <- seedBitcoinLndStack + request $ do + setMethod "GET" + setUrl ("/package/index?ids=[{\"id\":\"bitcoind\",\"version\":\"=0.21.1.2\"}]" :: Text) + statusIs 200 + (res :: [ServiceRes]) <- requireJSONResponse + assertEq "response should have one package" (length res) 1 + let pkg = fromJust $ head res + let (manifest :: ServiceManifest) = fromRight' $ eitherDecode $ encode $ serviceResManifest pkg + assertEq "manifest id should be bitcoind" (serviceManifestId manifest) "bitcoind" + xdescribe "GET /package/index?ids" $ withApp - $ it "fails to get unknown app" + $ it "returns list of packages and dependencies at specified version" $ do + _ <- seedBitcoinLndStack request $ do setMethod "GET" - setUrl ("/package/embassy-pages.s9pk?spec=0.1.4" :: Text) - statusIs 404 - describe "GET /package/:appId with unknown app" $ withApp $ it "fails to get an unregistered app" $ do + setUrl ("/package/index?ids=[{\"id\":\"lnd\",\"version\":\"=0.13.3.1\"}]" :: Text) + statusIs 200 + (res :: [ServiceRes]) <- requireJSONResponse + assertEq "response should have one package" (length res) 1 + let pkg = fromJust $ head res + printBody + assertEq "package dependency metadata should not be empty" (null $ serviceResDependencyInfo pkg) False + describe "GET /package/index?ids" $ withApp $ it "returns list of packages at exactly specified version" $ do + _ <- seedBitcoinLndStack + request $ do + setMethod "GET" + setUrl ("/package/index?ids=[{\"id\":\"bitcoind\",\"version\":\"=0.21.1.1\"}]" :: Text) + statusIs 200 + (res :: [ServiceRes]) <- requireJSONResponse + assertEq "response should have one package" (length res) 1 + let pkg = fromJust $ head res + let (manifest :: ServiceManifest) = fromRight' $ eitherDecode $ encode $ serviceResManifest pkg + assertEq "manifest version should be 0.21.1.1" (serviceManifestVersion manifest) "0.21.1.1" + describe "GET /package/index?ids" $ withApp $ it "returns list of packages at specified version or greater" $ do + _ <- seedBitcoinLndStack + request $ do + setMethod "GET" + setUrl ("/package/index?ids=[{\"id\":\"bitcoind\",\"version\":\">=0.21.1.1\"}]" :: Text) + statusIs 200 + (res :: [ServiceRes]) <- requireJSONResponse + assertEq "response should have one package" (length res) 1 + let pkg = fromJust $ head res + let (manifest :: ServiceManifest) = fromRight' $ eitherDecode $ encode $ serviceResManifest pkg + assertEq "manifest version should be 0.21.1.2" (serviceManifestVersion manifest) "0.21.1.2" + describe "GET /package/index?ids" $ withApp $ it "returns list of packages at specified version or greater" $ do + _ <- seedBitcoinLndStack + request $ do + setMethod "GET" + setUrl ("/package/index?ids=[{\"id\":\"bitcoind\",\"version\":\">=0.21.1.2\"}]" :: Text) + statusIs 200 + (res :: [ServiceRes]) <- requireJSONResponse + assertEq "response should have one package" (length res) 1 + let pkg = fromJust $ head res + let (manifest :: ServiceManifest) = fromRight' $ eitherDecode $ encode $ serviceResManifest pkg + assertEq "manifest version should be 0.21.1.2" (serviceManifestVersion manifest) "0.21.1.2" + describe "GET /package/:pkgId with unknown version spec for bitcoind" $ withApp $ it "fails to get unknown app" $ do + _ <- seedBitcoinLndStack + request $ do + setMethod "GET" + setUrl ("/package/bitcoind.s9pk?spec==0.20.0" :: Text) + statusIs 404 + xdescribe "GET /package/:pkgId with unknown package" $ withApp $ it "fails to get an unregistered app" $ do + _ <- seedBitcoinLndStack request $ do setMethod "GET" setUrl ("/package/tempapp.s9pk?spec=0.0.1" :: Text) statusIs 404 - describe "GET /package/:appId with existing version spec for embassy-pages" + xdescribe "GET /package/:pkgId with package at unknown version" + $ withApp + $ it "fails to get an unregistered app" + $ do + _ <- seedBitcoinLndStack + request $ do + setMethod "GET" + setUrl ("/package/lightning.s9pk?spec==0.0.1" :: Text) + statusIs 404 + describe "GET /package/:pkgId with existing version spec for bitcoind" $ withApp $ it "creates app and metric records" $ do + _ <- seedBitcoinLndStack request $ do setMethod "GET" - setUrl ("/package/embassy-pages.s9pk?spec==0.1.3" :: Text) + setUrl ("/package/bitcoind.s9pk?spec==0.21.1.2" :: Text) statusIs 200 - apps <- runDBtest $ selectList [SAppAppId ==. "embassy-pages"] [] - assertEq "app should exist" (length apps) 1 - let app = fromJust $ head apps - metrics <- runDBtest $ selectList [MetricAppId ==. entityKey app] [] + packages <- runDBtest $ selectList [PkgRecordId ==. PkgRecordKey "bitcoind"] [] + assertEq "app should exist" (length packages) 1 + let app = fromJust $ head packages + metrics <- runDBtest $ selectList [MetricPkgId ==. entityKey app] [] assertEq "metric should exist" (length metrics) 1 - describe "GET /package/:appId with existing version spec for filebrowser" - $ withApp - $ it "creates app and metric records" - $ do - request $ do - setMethod "GET" - setUrl ("/package/filebrowser.s9pk?spec==2.14.1.1" :: Text) - statusIs 200 - apps <- runDBtest $ selectList [SAppAppId ==. "filebrowser"] [] - assertEq "app should exist" (length apps) 1 - let app = fromJust $ head apps - metrics <- runDBtest $ selectList [MetricAppId ==. entityKey app] [] - assertEq "metric should exist" (length metrics) 1 - version <- runDBtest $ selectList [SVersionAppId ==. entityKey app] [] - assertEq "version should exist" (length version) 1 - describe "GET /sys/proxy.pac" $ withApp $ it "does not record metric but request successful" $ do + describe "GET /package/:pkgId with existing version spec for lnd" $ withApp $ it "creates metric records" $ do + _ <- seedBitcoinLndStack request $ do setMethod "GET" - setUrl ("/sys/proxy.pac?spec=0.1.0" :: Text) + setUrl ("/package/lnd.s9pk?spec=>=0.13.3.0" :: Text) statusIs 200 - apps <- runDBtest $ selectList ([] :: [Filter SApp]) [] - assertEq "no apps should exist" (length apps) 0 - describe "GET /sys/:sysId" $ withApp $ it "does not record metric but request successful" $ do - request $ do - setMethod "GET" - setUrl ("/sys/appmgr?spec=0.0.0" :: Text) - statusIs 200 - apps <- runDBtest $ selectList ([] :: [Filter SApp]) [] - assertEq "no apps should exist" (length apps) 0 + metrics <- runDBtest $ selectList [MetricPkgId ==. PkgRecordKey "lnd"] [] + assertEq "metric should exist" (length metrics) 1 diff --git a/test/Handler/MarketplaceSpec.hs b/test/Handler/MarketplaceSpec.hs index 2430fcc..f6f6e99 100644 --- a/test/Handler/MarketplaceSpec.hs +++ b/test/Handler/MarketplaceSpec.hs @@ -2,7 +2,8 @@ module Handler.MarketplaceSpec ( spec - ) where + ) +where import Data.Maybe import Database.Persist.Sql @@ -14,117 +15,41 @@ import Conduit ( (.|) ) import Database.Marketplace import Lib.Types.Category -import Lib.Types.Emver import Model import TestImport +import Seed spec :: Spec spec = do describe "searchServices with category" $ withApp $ it "should filter services with featured category" $ do - time <- liftIO getCurrentTime - btc <- runDBtest $ insert $ SApp time - (Just time) - "Bitcoin Core" - "bitcoind" - "short desc bitcoin" - "long desc bitcoin" - "png" - lnd <- runDBtest $ insert $ SApp time - (Just time) - "Lightning Network Daemon" - "lnd" - "short desc lnd" - "long desc lnd" - "png" - featuredCat <- runDBtest $ insert $ Category time FEATURED Nothing "desc" 0 - btcCat <- runDBtest $ insert $ Category time BITCOIN Nothing "desc" 0 - lnCat <- runDBtest $ insert $ Category time LIGHTNING Nothing "desc" 0 - _ <- runDBtest $ insert_ $ ServiceCategory time btc featuredCat "bitcoin" FEATURED Nothing - _ <- runDBtest $ insert_ $ ServiceCategory time lnd lnCat "lnd" LIGHTNING Nothing - _ <- runDBtest $ insert_ $ ServiceCategory time lnd btcCat "lnd" BITCOIN Nothing - _ <- runDBtest $ insert_ $ ServiceCategory time btc btcCat "bitcon" BITCOIN Nothing - apps <- runDBtest $ runConduit $ searchServices (Just FEATURED) "" .| sinkList - assertEq "should exist" (length apps) 1 - let app' = fromJust $ head apps - assertEq "should be bitcoin" (sAppTitle $ entityVal app') "Bitcoin Core" + _ <- seedBitcoinLndStack + packages <- runDBtest $ runConduit $ searchServices (Just FEATURED) "" .| sinkList + assertEq "should exist" (length packages) 1 + let pkg = fromJust $ head packages + assertEq "should be bitcoin" (pkgRecordTitle $ entityVal pkg) "Bitcoin Core" describe "searchServices with category" $ withApp $ it "should filter services with bitcoin category" $ do - time <- liftIO getCurrentTime - btc <- runDBtest $ insert $ SApp time - (Just time) - "Bitcoin Core" - "bitcoind" - "short desc bitcoin" - "long desc bitcoin" - "png" - lnd <- runDBtest $ insert $ SApp time - (Just time) - "Lightning Network Daemon" - "lnd" - "short desc lnd" - "long desc lnd" - "png" - featuredCat <- runDBtest $ insert $ Category time FEATURED Nothing "desc" 0 - btcCat <- runDBtest $ insert $ Category time BITCOIN Nothing "desc" 0 - lnCat <- runDBtest $ insert $ Category time LIGHTNING Nothing "desc" 0 - _ <- runDBtest $ insert_ $ ServiceCategory time btc featuredCat "bitcoind" FEATURED Nothing - _ <- runDBtest $ insert_ $ ServiceCategory time lnd lnCat "lnd" LIGHTNING Nothing - _ <- runDBtest $ insert_ $ ServiceCategory time lnd btcCat "lnd" BITCOIN Nothing - _ <- runDBtest $ insert_ $ ServiceCategory time btc btcCat "bitcoind" BITCOIN Nothing - apps <- runDBtest $ runConduit $ searchServices (Just BITCOIN) "" .| sinkList - assertEq "should exist" (length apps) 2 + _ <- seedBitcoinLndStack + packages <- runDBtest $ runConduit $ searchServices (Just BITCOIN) "" .| sinkList + assertEq "should exist" (length packages) 3 describe "searchServices with fuzzy query" $ withApp - $ it "runs search service with fuzzy text in long description" + $ it "runs search service with fuzzy text in long description and no category" $ do - time <- liftIO getCurrentTime - app1 <- runDBtest $ insert $ SApp time - (Just time) - "Bitcoin Core" - "bitcoind" - "short desc" - "long desc" - "png" - app2 <- runDBtest $ insert $ SApp time - (Just time) - "Lightning Network Daemon" - "lnd" - "short desc" - "lightning long desc" - "png" - cate <- runDBtest $ insert $ Category time FEATURED Nothing "desc" 0 - _ <- runDBtest $ insert_ $ ServiceCategory time app1 cate "bitcoind" FEATURED Nothing - _ <- runDBtest $ insert_ $ ServiceCategory time app2 cate "lnd" FEATURED Nothing - apps <- runDBtest $ runConduit $ searchServices (Just FEATURED) "lightning" .| sinkList - assertEq "should exist" (length apps) 1 - let app' = fromJust $ head apps - print app' + _ <- seedBitcoinLndStack + packages <- runDBtest $ runConduit $ searchServices Nothing "lightning" .| sinkList + assertEq "should exist" (length packages) 1 + let pkg = fromJust $ head packages + print pkg + describe "searchServices with fuzzy query" + $ withApp + $ it "runs search service with fuzzy text in long description and bitcoin category" + $ do + _ <- seedBitcoinLndStack + packages <- runDBtest $ runConduit $ searchServices (Just BITCOIN) "proxy" .| sinkList + assertEq "should exist" (length packages) 1 + let pkg = fromJust $ head packages + print pkg describe "searchServices with any category" $ withApp $ it "runs search service for any category" $ do - time <- liftIO getCurrentTime - btc <- runDBtest $ insert $ SApp time - (Just time) - "Bitcoin Core" - "bitcoind" - "short desc bitcoin" - "long desc bitcoin" - "png" - print btc - _ <- runDBtest $ insert $ SVersion time (Just time) btc "0.19.0" "notes" Any Any Nothing - _ <- runDBtest $ insert $ SVersion time (Just time) btc "0.20.0" "notes" Any Any Nothing - lnd <- runDBtest $ insert $ SApp time - (Just time) - "Lightning Network Daemon" - "lnd" - "short desc lnd" - "long desc lnd" - "png" - _ <- runDBtest $ insert $ SVersion time (Just time) lnd "0.18.0" "notes" Any Any Nothing - _ <- runDBtest $ insert $ SVersion time (Just time) lnd "0.17.0" "notes" Any Any Nothing - featuredCat <- runDBtest $ insert $ Category time FEATURED Nothing "desc" 0 - btcCat <- runDBtest $ insert $ Category time BITCOIN Nothing "desc" 0 - lnCat <- runDBtest $ insert $ Category time LIGHTNING Nothing "desc" 0 - _ <- runDBtest $ insert_ $ ServiceCategory time btc featuredCat "bitcoin" FEATURED Nothing - _ <- runDBtest $ insert_ $ ServiceCategory time lnd lnCat "lnd" LIGHTNING Nothing - _ <- runDBtest $ insert_ $ ServiceCategory time lnd btcCat "lnd" BITCOIN Nothing - _ <- runDBtest $ insert_ $ ServiceCategory time btc btcCat "bitcon" BITCOIN Nothing - apps <- runDBtest $ runConduit $ searchServices Nothing "" .| sinkList - assertEq "should exist" (length apps) 2 + _ <- seedBitcoinLndStack + packages <- runDBtest $ runConduit $ searchServices Nothing "" .| sinkList + assertEq "should exist" (length packages) 3 diff --git a/test/Seed.hs b/test/Seed.hs new file mode 100644 index 0000000..ee831f9 --- /dev/null +++ b/test/Seed.hs @@ -0,0 +1,76 @@ +module Seed where + +import Startlude ( ($) + , Applicative(pure) + , Maybe(Nothing, Just) + , getCurrentTime + , MonadIO(liftIO) + ) +import Database.Persist.Sql ( PersistStoreWrite(insert_, insertKey, insert) ) +import Model ( Key(PkgRecordKey) + , PkgRecord(PkgRecord) + , Category(Category) + , PkgCategory(PkgCategory) + , VersionRecord(VersionRecord) + ) + +import TestImport ( runDBtest + , RegistryCtx + , SIO + , YesodExampleData + ) +import Lib.Types.Category ( CategoryTitle(LIGHTNING, FEATURED, BITCOIN) ) + +seedBitcoinLndStack :: SIO (YesodExampleData RegistryCtx) () +seedBitcoinLndStack = do + time <- liftIO getCurrentTime + _ <- runDBtest $ insertKey (PkgRecordKey "bitcoind") $ PkgRecord time + (Just time) + "Bitcoin Core" + "short desc bitcoin" + "long desc bitcoin" + "png" + _ <- runDBtest $ insert $ VersionRecord time + (Just time) + (PkgRecordKey "bitcoind") + "0.21.1.2" + "notes" + "0.3.0" + Nothing + _ <- runDBtest $ insert $ VersionRecord time + (Just time) + (PkgRecordKey "bitcoind") + "0.21.1.1" + "notes" + "0.3.0" + Nothing + _ <- runDBtest $ insertKey (PkgRecordKey "lnd") $ PkgRecord time + (Just time) + "Lightning Network Daemon" + "short desc lnd" + "long desc lnd" + "png" + _ <- runDBtest $ insert $ VersionRecord time (Just time) (PkgRecordKey "lnd") "0.13.3.0" "notes" "0.3.0" Nothing + _ <- runDBtest $ insert $ VersionRecord time (Just time) (PkgRecordKey "lnd") "0.13.3.1" "notes" "0.3.0" Nothing + _ <- runDBtest $ insertKey (PkgRecordKey "btc-rpc-proxy") $ PkgRecord time + (Just time) + "BTC RPC Proxy" + "short desc btc-rpc-proxy" + "long desc btc-rpc-proxy" + "png" + _ <- runDBtest $ insert $ VersionRecord time + (Just time) + (PkgRecordKey "btc-rpc-proxy") + "0.3.2.1" + "notes" + "0.3.0" + Nothing + featuredCat <- runDBtest $ insert $ Category time FEATURED Nothing "desc" 0 + btcCat <- runDBtest $ insert $ Category time BITCOIN Nothing "desc" 0 + lnCat <- runDBtest $ insert $ Category time LIGHTNING Nothing "desc" 0 + _ <- runDBtest $ insert_ $ PkgCategory time (PkgRecordKey "bitcoind") featuredCat + _ <- runDBtest $ insert_ $ PkgCategory time (PkgRecordKey "lnd") lnCat + _ <- runDBtest $ insert_ $ PkgCategory time (PkgRecordKey "lnd") btcCat + _ <- runDBtest $ insert_ $ PkgCategory time (PkgRecordKey "bitcoind") btcCat + _ <- runDBtest $ insert_ $ PkgCategory time (PkgRecordKey "btc-rpc-proxy") btcCat + pure ()