mass clean up of warnings, hints, errors

This commit is contained in:
Keagan McClelland
2022-05-26 18:26:16 -06:00
parent 3d8b4057df
commit 2105c58182
27 changed files with 681 additions and 386 deletions

View File

@@ -1,140 +0,0 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuasiQuotes #-}
module Handler.AppSpec
( spec
) where
import Data.Maybe
import Database.Persist.Sql
import Startlude
import Data.Aeson
import Data.Aeson.Types ( parseEither )
import Data.String.Interpolate.IsString
( i )
import Handler.Types.Marketplace ( PackageRes(packageResDependencies, packageResManifest) )
import Lib.Types.AppIndex
import Model
import Seed
import TestImport
spec :: Spec
spec = do
describe "GET /package/index" $ withApp $ it "returns list of packages" $ do
_ <- seedBitcoinLndStack
request $ do
setMethod "GET"
setUrl ("/package/index" :: Text)
statusIs 200
(res :: [PackageRes]) <- 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 :: [PackageRes]) <- requireJSONResponse
assertEq "response should have one package" (length res) 1
let pkg = fromJust $ head res
(manifest :: PackageManifest) <- either (\e -> panic [i|failed to parse package manifest: #{e}|])
pure
(parseEither parseJSON $ packageResManifest pkg)
assertEq "manifest id should be bitcoind" (packageManifestId manifest) "bitcoind"
describe "GET /package/index?ids"
$ withApp
$ it "returns list of packages and dependencies at specified version"
$ do
_ <- seedBitcoinLndStack
request $ do
setMethod "GET"
setUrl ("/package/index?ids=[{\"id\":\"lnd\",\"version\":\"=0.13.3.1\"}]" :: Text)
statusIs 200
(res :: [PackageRes]) <- requireJSONResponse
assertEq "response should have one package" (length res) 1
let pkg = fromJust $ head res
assertEq "package dependency metadata should not be empty" (null $ packageResDependencies 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 :: [PackageRes]) <- requireJSONResponse
assertEq "response should have one package" (length res) 1
let pkg = fromJust $ head res
(manifest :: PackageManifest) <- either (\e -> panic [i|failed to parse package manifest: #{e}|])
pure
(parseEither parseJSON $ packageResManifest pkg)
assertEq "manifest version should be 0.21.1.1" (packageManifestVersion 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 :: [PackageRes]) <- requireJSONResponse
assertEq "response should have one package" (length res) 1
let pkg = fromJust $ head res
(manifest :: PackageManifest) <- either (\e -> panic [i|failed to parse package manifest: #{e}|])
pure
(parseEither parseJSON $ packageResManifest pkg)
assertEq "manifest version should be 0.21.1.2" (packageManifestVersion 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 :: [PackageRes]) <- requireJSONResponse
assertEq "response should have one package" (length res) 1
let pkg = fromJust $ head res
(manifest :: PackageManifest) <- either (\e -> panic [i|failed to parse package manifest: #{e}|])
pure
(parseEither parseJSON $ packageResManifest pkg)
assertEq "manifest version should be 0.21.1.2" (packageManifestVersion 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
describe "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/: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/bitcoind.s9pk?spec==0.21.1.2" :: Text)
statusIs 200
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/:pkgId with existing version spec for lnd" $ withApp $ it "creates metric records" $ do
_ <- seedBitcoinLndStack
request $ do
setMethod "GET"
setUrl ("/package/lnd.s9pk?spec=>=0.13.3.0" :: Text)
statusIs 200
metrics <- runDBtest $ selectList [MetricPkgId ==. PkgRecordKey "lnd"] []
assertEq "metric should exist" (length metrics) 1

View File

@@ -1,55 +0,0 @@
{-# LANGUAGE TypeFamilies #-}
module Handler.MarketplaceSpec
( spec
)
where
import Data.Maybe
import Database.Persist.Sql
import Startlude hiding ( Any )
import Conduit ( (.|)
, runConduit
, sinkList
)
import Database.Marketplace
import Lib.Types.Category
import Model
import TestImport
import Seed
spec :: Spec
spec = do
describe "searchServices with category" $ withApp $ it "should filter services with featured category" $ do
_ <- 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
_ <- 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 and no category"
$ do
_ <- seedBitcoinLndStack
packages <- runDBtest $ runConduit $ searchServices Nothing "lightning" .| sinkList
assertEq "should exist" (length packages) 1
let pkg = fromJust $ head packages
assertEq "package should be lnd" (entityKey pkg) (PkgRecordKey "lnd")
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
assertEq "package should be lnc" (entityKey pkg) (PkgRecordKey "btc-rpc-proxy")
describe "searchServices with any category" $ withApp $ it "runs search service for any category" $ do
_ <- seedBitcoinLndStack
packages <- runDBtest $ runConduit $ searchServices Nothing "" .| sinkList
assertEq "should exist" (length packages) 3

View File

@@ -1,55 +0,0 @@
module Seed where
import Database.Persist.Sql ( PersistStoreWrite(insert, insertKey, insert_) )
import Model ( Category(Category)
, Key(PkgRecordKey)
, PkgCategory(PkgCategory)
, PkgDependency(PkgDependency)
, PkgRecord(PkgRecord)
, VersionRecord(VersionRecord)
)
import Startlude ( ($)
, Applicative(pure)
, Maybe(Just, Nothing)
, MonadIO(liftIO)
, getCurrentTime
)
import Lib.Types.Category ( CategoryTitle(BITCOIN, FEATURED, LIGHTNING) )
import Prelude ( read )
import TestImport ( RegistryCtx
, SIO
, YesodExampleData
, runDBtest
)
seedBitcoinLndStack :: SIO (YesodExampleData RegistryCtx) ()
seedBitcoinLndStack = runDBtest $ do
time <- liftIO getCurrentTime
insertKey (PkgRecordKey "bitcoind")
$ PkgRecord time (Just time) "Bitcoin Core" "short desc bitcoin" "long desc bitcoin" "png"
_ <- insert $ VersionRecord time (Just time) (PkgRecordKey "bitcoind") "0.21.1.2" "notes" "0.3.0" Nothing
_ <- insert $ VersionRecord time (Just time) (PkgRecordKey "bitcoind") "0.21.1.1" "notes" "0.3.0" Nothing
_ <- insertKey (PkgRecordKey "lnd")
$ PkgRecord time (Just time) "Lightning Network Daemon" "short desc lnd" "long desc lnd" "png"
_ <- insert $ VersionRecord time (Just time) (PkgRecordKey "lnd") "0.13.3.0" "notes" "0.3.0" Nothing
_ <- insert $ VersionRecord time (Just time) (PkgRecordKey "lnd") "0.13.3.1" "notes" "0.3.0" Nothing
_ <- insertKey (PkgRecordKey "btc-rpc-proxy")
$ PkgRecord time (Just time) "BTC RPC Proxy" "short desc btc-rpc-proxy" "long desc btc-rpc-proxy" "png"
_ <- insert $ VersionRecord time (Just time) (PkgRecordKey "btc-rpc-proxy") "0.3.2.1" "notes" "0.3.0" Nothing
featuredCat <- insert $ Category time FEATURED Nothing "desc" 0
btcCat <- insert $ Category time BITCOIN Nothing "desc" 0
lnCat <- insert $ Category time LIGHTNING Nothing "desc" 0
_ <- insert_ $ PkgCategory time (PkgRecordKey "bitcoind") featuredCat
_ <- insert_ $ PkgCategory time (PkgRecordKey "lnd") lnCat
_ <- insert_ $ PkgCategory time (PkgRecordKey "lnd") btcCat
_ <- insert_ $ PkgCategory time (PkgRecordKey "bitcoind") btcCat
_ <- insert_ $ PkgCategory time (PkgRecordKey "btc-rpc-proxy") btcCat
_ <- insert_
$ PkgDependency time (PkgRecordKey "lnd") "0.13.3.1" (PkgRecordKey "bitcoind") (read ">=0.21.1.2 <0.22.0")
_ <- insert_ $ PkgDependency time
(PkgRecordKey "lnd")
"0.13.3.1"
(PkgRecordKey "btc-rpc-proxy")
(read ">=0.3.2.1 <0.4.0")
pure ()