Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-26 02:11:53 +00:00
Code Issues Packages Projects Releases Wiki Activity

resolve PR feedback - add record type for package and dependency metadata

Browse Source
This commit is contained in:
Lucy Cifferello
2021-12-02 16:41:02 -07:00
committed by Keagan McClelland
parent 649f876692
commit d0b7b1f044
9 changed files with 153 additions and 132 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
README.md
View File

@@ -51,7 +51,7 @@ stack test --flag start9-registry:library-only --flag start9-registry:dev
## Builds ## Builds
`stack build --copy-bins --local-bin-path=dist` `make`
### Tests with HIE Setup ### Tests with HIE Setup
- install hspec-discover globally `cabal install hspec-discover` (requires cabal installation) - install hspec-discover globally `cabal install hspec-discover` (requires cabal installation)

14
src/Database/Marketplace.hs
View File

@@ -39,6 +39,13 @@ import Database.Persist.Postgresql
, selectSource , selectSource
, (||.) , (||.)
) )
import Handler.Types.Marketplace ( PackageDependencyMetadata
( PackageDependencyMetadata
, packageDependencyMetadataDepPkgRecord
, packageDependencyMetadataDepVersions
, packageDependencyMetadataPkgDependencyRecord
)
)
import Lib.Types.AppIndex ( PkgId ) import Lib.Types.AppIndex ( PkgId )
import Lib.Types.Category import Lib.Types.Category
import Lib.Types.Emver ( Version ) import Lib.Types.Emver ( Version )
@@ -143,14 +150,17 @@ zipVersions = awaitForever $ \pkg -> do
zipDependencyVersions :: (Monad m, MonadIO m) zipDependencyVersions :: (Monad m, MonadIO m)
=> (Entity PkgDependency, Entity PkgRecord) => (Entity PkgDependency, Entity PkgRecord)
-> ReaderT SqlBackend m (Entity PkgDependency, Entity PkgRecord, [Entity VersionRecord]) -> ReaderT SqlBackend m PackageDependencyMetadata
zipDependencyVersions (pkgDepRecord, depRecord) = do zipDependencyVersions (pkgDepRecord, depRecord) = do
let pkgDbId = entityKey $ depRecord let pkgDbId = entityKey $ depRecord
depVers <- select $ do depVers <- select $ do
v <- from $ table @VersionRecord v <- from $ table @VersionRecord
where_ $ v ^. VersionRecordPkgId ==. val pkgDbId where_ $ v ^. VersionRecordPkgId ==. val pkgDbId
pure v pure v
pure $ (pkgDepRecord, depRecord, depVers) pure $ PackageDependencyMetadata { packageDependencyMetadataPkgDependencyRecord = pkgDepRecord
, packageDependencyMetadataDepPkgRecord = depRecord
, packageDependencyMetadataDepVersions = depVers
}
fetchAllAppVersions :: MonadUnliftIO m => ConnectionPool -> PkgId -> m [VersionRecord] fetchAllAppVersions :: MonadUnliftIO m => ConnectionPool -> PkgId -> m [VersionRecord]
fetchAllAppVersions appConnPool appId = do fetchAllAppVersions appConnPool appId = do

24
src/Handler/Marketplace.hs
View File

@@ -20,7 +20,6 @@ import Startlude hiding ( Any
import Conduit ( (.|) import Conduit ( (.|)
, awaitForever , awaitForever
, dropC , dropC
, mapC
, runConduit , runConduit
, sinkList , sinkList
, sourceFile , sourceFile
@@ -81,10 +80,9 @@ import Lib.Types.AppIndex ( PkgId(PkgId)
import Lib.Types.AppIndex ( ) import Lib.Types.AppIndex ( )
import Lib.Types.Category ( CategoryTitle(..) ) import Lib.Types.Category ( CategoryTitle(..) )
import Lib.Types.Emver ( Version import Lib.Types.Emver ( Version
, VersionRange(Any)
, parseRange , parseRange
, parseVersion , parseVersion
, satisfies , satisfies, VersionRange
) )
import Model ( Category(..) import Model ( Category(..)
, EntityField(..) , EntityField(..)
@@ -167,7 +165,7 @@ getReleaseNotesR = do
where where
constructReleaseNotesApiRes :: [VersionRecord] -> ReleaseNotes constructReleaseNotesApiRes :: [VersionRecord] -> ReleaseNotes
constructReleaseNotesApiRes vers = do constructReleaseNotesApiRes vers = do
ReleaseNotes $ HM.fromList $ sortOn (Down) $ (versionRecordNumber &&& versionRecordReleaseNotes) <$> vers ReleaseNotes $ HM.fromList $ sortOn Down $ (versionRecordNumber &&& versionRecordReleaseNotes) <$> vers
getEosR :: Handler TypedContent getEosR :: Handler TypedContent
getEosR = do getEosR = do
@@ -237,9 +235,8 @@ getPackageListR = do
$ searchServices category query $ searchServices category query
.| zipVersions .| zipVersions
.| zipCategories .| zipCategories
-- if no packages are specified, the VersionRange is implicitly `*` -- empty list since there are no requested packages in this case
.| mapC (\(a, vs, cats) -> (a, vs, cats,Any)) .| filterLatestVersionFromSpec []
.| filterLatestVersionFromSpec
.| filterPkgOsCompatible osPredicate .| filterPkgOsCompatible osPredicate
-- pages start at 1 for some reason. TODO: make pages start at 0 -- pages start at 1 for some reason. TODO: make pages start at 0
.| (dropC (limit' * (page - 1)) *> takeC limit') .| (dropC (limit' * (page - 1)) *> takeC limit')
@@ -253,11 +250,7 @@ getPackageListR = do
$ getPkgData (packageReqId <$> packages') $ getPkgData (packageReqId <$> packages')
.| zipVersions .| zipVersions
.| zipCategories .| zipCategories
.| mapC (\(a, vs, cats) -> do .| filterLatestVersionFromSpec vMap
let spec = fromMaybe Any $ lookup (unPkgRecordKey $ entityKey a) vMap
(a, vs, cats, spec)
)
.| filterLatestVersionFromSpec
.| filterPkgOsCompatible osPredicate .| filterPkgOsCompatible osPredicate
.| sinkList .| sinkList
-- NOTE: if a package's dependencies do not meet the system requirements, it is currently omitted from the list -- NOTE: if a package's dependencies do not meet the system requirements, it is currently omitted from the list
@@ -318,8 +311,8 @@ getPackageListR = do
$logWarn (show e) $logWarn (show e)
sendResponseStatus status400 e sendResponseStatus status400 e
Right v -> pure $ Just v Right v -> pure $ Just v
getPackageDependencies :: (MonadIO m, MonadLogger m) => (Version -> Bool) -> (Entity PkgRecord, [Entity VersionRecord], [Entity Category], Version) -> ReaderT SqlBackend m (Key PkgRecord, [Category], [Version], Version, [(Key PkgRecord, Text, Version)]) getPackageDependencies :: (MonadIO m, MonadLogger m) => (Version -> Bool) -> PackageMetadata -> ReaderT SqlBackend m (Key PkgRecord, [Category], [Version], Version, [(Key PkgRecord, Text, Version)])
getPackageDependencies osPredicate (pkg, pkgVersions, pkgCategories, pkgVersion) = do getPackageDependencies osPredicate PackageMetadata { packageMetadataPkgRecord = pkg, packageMetadataPkgVersionRecords = pkgVersions, packageMetadataPkgCategories = pkgCategories, packageMetadataPkgVersion = pkgVersion} = do
let pkgId = entityKey pkg let pkgId = entityKey pkg
let pkgVersions' = versionRecordNumber . entityVal <$> pkgVersions let pkgVersions' = versionRecordNumber . entityVal <$> pkgVersions
let pkgCategories' = entityVal <$> pkgCategories let pkgCategories' = entityVal <$> pkgCategories
@@ -328,7 +321,7 @@ getPackageListR = do
let compatiblePkgDepInfo = fmap (filterDependencyOsCompatible osPredicate) pkgDepInfoWithVersions let compatiblePkgDepInfo = fmap (filterDependencyOsCompatible osPredicate) pkgDepInfoWithVersions
res <- catMaybes <$> traverse filterDependencyBestVersion compatiblePkgDepInfo res <- catMaybes <$> traverse filterDependencyBestVersion compatiblePkgDepInfo
pure $ (pkgId, pkgCategories', pkgVersions', pkgVersion, res) pure $ (pkgId, pkgCategories', pkgVersions', pkgVersion, res)
constructPackageListApiRes :: (Monad m, MonadResource m, MonadReader r m, Has AppSettings r) => (Key PkgRecord, [Category], [Version], Version, [(Key PkgRecord, Text, Version)]) -> m PackageRes constructPackageListApiRes :: (MonadResource m, MonadReader r m, Has AppSettings r) => (Key PkgRecord, [Category], [Version], Version, [(Key PkgRecord, Text, Version)]) -> m PackageRes
constructPackageListApiRes (pkgKey, pkgCategories, pkgVersions, pkgVersion, dependencies) = do constructPackageListApiRes (pkgKey, pkgCategories, pkgVersions, pkgVersion, dependencies) = do
settings <- ask settings <- ask
let pkgId = unPkgRecordKey pkgKey let pkgId = unPkgRecordKey pkgKey
@@ -350,4 +343,3 @@ getPackageListR = do
constructDependenciesApiRes domain deps = fmap (\(depKey, depTitle, depVersion) -> do constructDependenciesApiRes domain deps = fmap (\(depKey, depTitle, depVersion) -> do
let depId = unPkgRecordKey depKey let depId = unPkgRecordKey depKey
(depId, DependencyRes { dependencyResTitle = depTitle, dependencyResIcon = [i|https://#{domain}/package/icon/#{depId}?spec==#{depVersion}|]})) deps (depId, DependencyRes { dependencyResTitle = depTitle, dependencyResIcon = [i|https://#{domain}/package/icon/#{depId}?spec==#{depVersion}|]})) deps

18
src/Handler/Types/Marketplace.hs
View File

@@ -9,6 +9,11 @@ import Lib.Types.Category ( CategoryTitle )
import Lib.Types.Emver ( Version import Lib.Types.Emver ( Version
, VersionRange , VersionRange
) )
import Model ( Category
, PkgDependency
, PkgRecord
, VersionRecord
)
import Startlude import Startlude
import Yesod import Yesod
@@ -121,3 +126,16 @@ instance FromJSON PackageReq where
packageReqId <- o .: "id" packageReqId <- o .: "id"
packageReqVersion <- o .: "version" packageReqVersion <- o .: "version"
pure PackageReq { .. } pure PackageReq { .. }
data PackageMetadata = PackageMetadata
{ packageMetadataPkgRecord :: Entity PkgRecord
, packageMetadataPkgVersionRecords :: [Entity VersionRecord]
, packageMetadataPkgCategories :: [Entity Category]
, packageMetadataPkgVersion :: Version
}
deriving (Eq, Show)
data PackageDependencyMetadata = PackageDependencyMetadata
{ packageDependencyMetadataPkgDependencyRecord :: Entity PkgDependency
, packageDependencyMetadataDepPkgRecord :: Entity PkgRecord
, packageDependencyMetadataDepVersions :: [Entity VersionRecord]
}
deriving (Eq, Show)

8
src/Lib/PkgRepository.hs
View File

@@ -76,7 +76,6 @@ import Startlude ( ($)
, MonadReader , MonadReader
, Show , Show
, SomeException(..) , SomeException(..)
, Traversable(traverse)
, filter , filter
, find , find
, first , first
@@ -167,7 +166,8 @@ loadPkgDependencies appConnPool manifest = do
let deps = packageManifestDependencies manifest let deps = packageManifestDependencies manifest
time <- liftIO getCurrentTime time <- liftIO getCurrentTime
let deps' = first PkgRecordKey <$> HM.toList deps let deps' = first PkgRecordKey <$> HM.toList deps
_ <- traverse for_
deps'
(\d -> (\d ->
(runSqlPool (runSqlPool
( insertUnique ( insertUnique
@@ -176,8 +176,6 @@ loadPkgDependencies appConnPool manifest = do
appConnPool appConnPool
) )
) )
deps'
pure ()
-- extract all package assets into their own respective files -- extract all package assets into their own respective files
extractPkg :: (MonadUnliftIO m, MonadReader r m, Has PkgRepo r, MonadLoggerIO m) => ConnectionPool -> FilePath -> m () extractPkg :: (MonadUnliftIO m, MonadReader r m, Has PkgRepo r, MonadLoggerIO m) => ConnectionPool -> FilePath -> m ()
@@ -231,7 +229,7 @@ watchPkgRepoRoot pool = do
let pkg = eventPath evt let pkg = eventPath evt
-- TODO: validate that package path is an actual s9pk and is in a correctly conforming path. -- TODO: validate that package path is an actual s9pk and is in a correctly conforming path.
void . forkIO $ runInIO $ do void . forkIO $ runInIO $ do
(extractPkg pool pkg) extractPkg pool pkg
takeMVar box takeMVar box
stop stop
pure $ tryPutMVar box () pure $ tryPutMVar box ()

102
src/Util/Shared.hs
View File

@@ -4,7 +4,8 @@
module Util.Shared where module Util.Shared where
import Startlude hiding ( Handler import Startlude hiding ( Any
, Handler
, yield , yield
) )
@@ -29,12 +30,28 @@ import Database.Esqueleto.Experimental
, entityVal , entityVal
) )
import Foundation import Foundation
import GHC.List ( lookup )
import Handler.Types.Marketplace ( PackageDependencyMetadata
( PackageDependencyMetadata
, packageDependencyMetadataDepPkgRecord
, packageDependencyMetadataDepVersions
, packageDependencyMetadataPkgDependencyRecord
)
, PackageMetadata
( PackageMetadata
, packageMetadataPkgCategories
, packageMetadataPkgRecord
, packageMetadataPkgVersion
, packageMetadataPkgVersionRecords
)
)
import Lib.PkgRepository ( PkgRepo import Lib.PkgRepository ( PkgRepo
, getHash , getHash
) )
import Lib.Types.AppIndex ( PkgId ) import Lib.Types.AppIndex ( PkgId )
import Lib.Types.Emver import Lib.Types.Emver
import Model ( Category import Model ( Category
, Key(unPkgRecordKey)
, PkgDependency(pkgDependencyDepId, pkgDependencyDepVersionRange) , PkgDependency(pkgDependencyDepId, pkgDependencyDepVersionRange)
, PkgRecord(pkgRecordTitle) , PkgRecord(pkgRecordTitle)
, VersionRecord(versionRecordNumber, versionRecordOsVersion) , VersionRecord(versionRecordNumber, versionRecordOsVersion)
@@ -59,51 +76,60 @@ orThrow action other = action >>= \case
Just x -> pure x Just x -> pure x
filterPkgOsCompatible :: Monad m filterPkgOsCompatible :: Monad m => (Version -> Bool) -> ConduitT PackageMetadata PackageMetadata m ()
=> (Version -> Bool) filterPkgOsCompatible p =
-> ConduitT awaitForever
(Entity PkgRecord, [Entity VersionRecord], [Entity Category], Version) $ \PackageMetadata { packageMetadataPkgRecord = pkg, packageMetadataPkgVersionRecords = versions, packageMetadataPkgCategories = cats, packageMetadataPkgVersion = requestedVersion } ->
(Entity PkgRecord, [Entity VersionRecord], [Entity Category], Version) do
m let compatible = filter (p . versionRecordOsVersion . entityVal) versions
() when (not $ null compatible) $ yield PackageMetadata { packageMetadataPkgRecord = pkg
filterPkgOsCompatible p = awaitForever $ \(app, versions, cats, requestedVersion) -> do , packageMetadataPkgVersionRecords = compatible
let compatible = filter (p . versionRecordOsVersion . entityVal) versions , packageMetadataPkgCategories = cats
when (not $ null compatible) $ yield (app, compatible, cats, requestedVersion) , packageMetadataPkgVersion = requestedVersion
}
filterDependencyOsCompatible :: (Version -> Bool) filterDependencyOsCompatible :: (Version -> Bool) -> PackageDependencyMetadata -> PackageDependencyMetadata
-> (Entity PkgDependency, Entity PkgRecord, [Entity VersionRecord]) filterDependencyOsCompatible p PackageDependencyMetadata { packageDependencyMetadataPkgDependencyRecord = pkgDeps, packageDependencyMetadataDepPkgRecord = pkg, packageDependencyMetadataDepVersions = depVersions }
-> (Entity PkgDependency, Entity PkgRecord, [Entity VersionRecord]) = do
filterDependencyOsCompatible p (pkgDeps, pkg, versions) = do let compatible = filter (p . versionRecordOsVersion . entityVal) depVersions
let compatible = filter (p . versionRecordOsVersion . entityVal) versions PackageDependencyMetadata { packageDependencyMetadataPkgDependencyRecord = pkgDeps
(pkgDeps, pkg, compatible) , packageDependencyMetadataDepPkgRecord = pkg
, packageDependencyMetadataDepVersions = compatible
}
filterLatestVersionFromSpec :: (Monad m, MonadLogger m) filterLatestVersionFromSpec :: (Monad m, MonadLogger m)
=> ConduitT => [(PkgId, VersionRange)]
(Entity PkgRecord, [Entity VersionRecord], [Entity Category], VersionRange) -> ConduitT
(Entity PkgRecord, [Entity VersionRecord], [Entity Category], Version) (Entity PkgRecord, [Entity VersionRecord], [Entity Category])
PackageMetadata
m m
() ()
filterLatestVersionFromSpec = awaitForever $ \(a, vs, cats, spec) -> do filterLatestVersionFromSpec versionMap = awaitForever $ \(a, vs, cats) -> do
let pkgId = entityKey a let pkgId = entityKey a
-- if no packages are specified, the VersionRange is implicitly `*`
let spec = fromMaybe Any $ lookup (unPkgRecordKey $ entityKey a) versionMap
case headMay . sortOn Down $ filter (`satisfies` spec) $ fmap (versionRecordNumber . entityVal) vs of case headMay . sortOn Down $ filter (`satisfies` spec) $ fmap (versionRecordNumber . entityVal) vs of
Nothing -> $logInfo [i|No version for #{pkgId} satisfying #{spec}|] Nothing -> $logInfo [i|No version for #{pkgId} satisfying #{spec}|]
Just v -> yield $ (,,,) a vs cats v Just v -> yield $ PackageMetadata { packageMetadataPkgRecord = a
, packageMetadataPkgVersionRecords = vs
, packageMetadataPkgCategories = cats
, packageMetadataPkgVersion = v
}
-- get best version of the dependency based on what is specified in the db (ie. what is specified in the manifest for the package) -- get best version of the dependency based on what is specified in the db (ie. what is specified in the manifest for the package)
filterDependencyBestVersion :: MonadLogger m filterDependencyBestVersion :: MonadLogger m => PackageDependencyMetadata -> m (Maybe (Key PkgRecord, Text, Version))
=> (Entity PkgDependency, Entity PkgRecord, [Entity VersionRecord]) filterDependencyBestVersion PackageDependencyMetadata { packageDependencyMetadataPkgDependencyRecord = pkgDepRecord, packageDependencyMetadataDepPkgRecord = depRecord, packageDependencyMetadataDepVersions = depVersions }
-> m (Maybe (Key PkgRecord, Text, Version)) = do
filterDependencyBestVersion (pkgDepRecord, depPkgRecord, depVersions) = do
-- get best version from VersionRange of dependency -- get best version from VersionRange of dependency
let pkgId = pkgDependencyPkgId $ entityVal pkgDepRecord let pkgId = pkgDependencyPkgId $ entityVal pkgDepRecord
let depId = pkgDependencyDepId $ entityVal pkgDepRecord let depId = pkgDependencyDepId $ entityVal pkgDepRecord
let depTitle = pkgRecordTitle $ entityVal depPkgRecord let depTitle = pkgRecordTitle $ entityVal depRecord
let satisfactory = filter (<|| (pkgDependencyDepVersionRange $ entityVal pkgDepRecord)) let satisfactory = filter (<|| (pkgDependencyDepVersionRange $ entityVal pkgDepRecord))
(versionRecordNumber . entityVal <$> depVersions) (versionRecordNumber . entityVal <$> depVersions)
case getMax <$> foldMap (Just . Max) satisfactory of case getMax <$> foldMap (Just . Max) satisfactory of
-- QUESTION is this an acceptable transformation here? These are the only values that we care about after this filter. -- QUESTION is this an acceptable transformation here? These are the only values that we care about after this filter.
Just bestVersion -> pure $ Just (depId, depTitle, bestVersion) Just bestVersion -> pure $ Just (depId, depTitle, bestVersion)
Nothing -> do Nothing -> do
$logInfo [i|No satisfactory version of #{depId} for dependent package #{pkgId}|] $logInfo [i|No satisfactory version of #{depId} for dependent package #{pkgId}|]
-- TODO it would be better if we could return the requirements for display -- TODO it would be better if we could return the requirements for display
pure Nothing pure Nothing

1
stack.yaml
View File

@@ -44,7 +44,6 @@ extra-deps:
- esqueleto-3.5.1.0 - esqueleto-3.5.1.0
- monad-logger-extras-0.1.1.1 - monad-logger-extras-0.1.1.1
- wai-request-spec-0.10.2.4 - wai-request-spec-0.10.2.4
- data-tree-print-0.1.0.2
# Override default flag values for local packages and extra-deps # Override default flag values for local packages and extra-deps
# flags: {} # flags: {}

29
test/Handler/AppSpec.hs
View File

@@ -1,5 +1,6 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuasiQuotes #-}
module Handler.AppSpec module Handler.AppSpec
( spec ( spec
@@ -10,7 +11,9 @@ import Database.Persist.Sql
import Startlude import Startlude
import Data.Aeson import Data.Aeson
import Data.Either.Extra import Data.Aeson.Types ( parseEither )
import Data.String.Interpolate.IsString
( i )
import Handler.Types.Marketplace ( PackageRes(packageResDependencies, packageResManifest) ) import Handler.Types.Marketplace ( PackageRes(packageResDependencies, packageResManifest) )
import Lib.Types.AppIndex import Lib.Types.AppIndex
import Model import Model
@@ -35,8 +38,10 @@ spec = do
statusIs 200 statusIs 200
(res :: [PackageRes]) <- requireJSONResponse (res :: [PackageRes]) <- requireJSONResponse
assertEq "response should have one package" (length res) 1 assertEq "response should have one package" (length res) 1
let pkg = fromJust $ head res let pkg = fromJust $ head res
let (manifest :: PackageManifest) = fromRight' $ eitherDecode $ encode $ packageResManifest pkg (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" assertEq "manifest id should be bitcoind" (packageManifestId manifest) "bitcoind"
describe "GET /package/index?ids" describe "GET /package/index?ids"
$ withApp $ withApp
@@ -59,8 +64,10 @@ spec = do
statusIs 200 statusIs 200
(res :: [PackageRes]) <- requireJSONResponse (res :: [PackageRes]) <- requireJSONResponse
assertEq "response should have one package" (length res) 1 assertEq "response should have one package" (length res) 1
let pkg = fromJust $ head res let pkg = fromJust $ head res
let (manifest :: PackageManifest) = fromRight' $ eitherDecode $ encode $ packageResManifest pkg (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" 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 describe "GET /package/index?ids" $ withApp $ it "returns list of packages at specified version or greater" $ do
_ <- seedBitcoinLndStack _ <- seedBitcoinLndStack
@@ -70,8 +77,10 @@ spec = do
statusIs 200 statusIs 200
(res :: [PackageRes]) <- requireJSONResponse (res :: [PackageRes]) <- requireJSONResponse
assertEq "response should have one package" (length res) 1 assertEq "response should have one package" (length res) 1
let pkg = fromJust $ head res let pkg = fromJust $ head res
let (manifest :: PackageManifest) = fromRight' $ eitherDecode $ encode $ packageResManifest pkg (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" 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 describe "GET /package/index?ids" $ withApp $ it "returns list of packages at specified version or greater" $ do
_ <- seedBitcoinLndStack _ <- seedBitcoinLndStack
@@ -81,8 +90,10 @@ spec = do
statusIs 200 statusIs 200
(res :: [PackageRes]) <- requireJSONResponse (res :: [PackageRes]) <- requireJSONResponse
assertEq "response should have one package" (length res) 1 assertEq "response should have one package" (length res) 1
let pkg = fromJust $ head res let pkg = fromJust $ head res
let (manifest :: PackageManifest) = fromRight' $ eitherDecode $ encode $ packageResManifest pkg (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" 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 describe "GET /package/:pkgId with unknown version spec for bitcoind" $ withApp $ it "fails to get unknown app" $ do
_ <- seedBitcoinLndStack _ <- seedBitcoinLndStack

87
test/Seed.hs
View File

@@ -24,65 +24,32 @@ import TestImport ( RegistryCtx
) )
seedBitcoinLndStack :: SIO (YesodExampleData RegistryCtx) () seedBitcoinLndStack :: SIO (YesodExampleData RegistryCtx) ()
seedBitcoinLndStack = do seedBitcoinLndStack = runDBtest $ do
time <- liftIO getCurrentTime time <- liftIO getCurrentTime
_ <- runDBtest $ insertKey (PkgRecordKey "bitcoind") $ PkgRecord time insertKey (PkgRecordKey "bitcoind")
(Just time) $ PkgRecord time (Just time) "Bitcoin Core" "short desc bitcoin" "long desc bitcoin" "png"
"Bitcoin Core" _ <- insert $ VersionRecord time (Just time) (PkgRecordKey "bitcoind") "0.21.1.2" "notes" "0.3.0" Nothing
"short desc bitcoin" _ <- insert $ VersionRecord time (Just time) (PkgRecordKey "bitcoind") "0.21.1.1" "notes" "0.3.0" Nothing
"long desc bitcoin" _ <- insertKey (PkgRecordKey "lnd")
"png" $ PkgRecord time (Just time) "Lightning Network Daemon" "short desc lnd" "long desc lnd" "png"
_ <- runDBtest $ insert $ VersionRecord time _ <- insert $ VersionRecord time (Just time) (PkgRecordKey "lnd") "0.13.3.0" "notes" "0.3.0" Nothing
(Just time) _ <- insert $ VersionRecord time (Just time) (PkgRecordKey "lnd") "0.13.3.1" "notes" "0.3.0" Nothing
(PkgRecordKey "bitcoind") _ <- insertKey (PkgRecordKey "btc-rpc-proxy")
"0.21.1.2" $ PkgRecord time (Just time) "BTC RPC Proxy" "short desc btc-rpc-proxy" "long desc btc-rpc-proxy" "png"
"notes" _ <- insert $ VersionRecord time (Just time) (PkgRecordKey "btc-rpc-proxy") "0.3.2.1" "notes" "0.3.0" Nothing
"0.3.0" featuredCat <- insert $ Category time FEATURED Nothing "desc" 0
Nothing btcCat <- insert $ Category time BITCOIN Nothing "desc" 0
_ <- runDBtest $ insert $ VersionRecord time lnCat <- insert $ Category time LIGHTNING Nothing "desc" 0
(Just time) _ <- insert_ $ PkgCategory time (PkgRecordKey "bitcoind") featuredCat
(PkgRecordKey "bitcoind") _ <- insert_ $ PkgCategory time (PkgRecordKey "lnd") lnCat
"0.21.1.1" _ <- insert_ $ PkgCategory time (PkgRecordKey "lnd") btcCat
"notes" _ <- insert_ $ PkgCategory time (PkgRecordKey "bitcoind") btcCat
"0.3.0" _ <- insert_ $ PkgCategory time (PkgRecordKey "btc-rpc-proxy") btcCat
Nothing _ <- insert_
_ <- runDBtest $ insertKey (PkgRecordKey "lnd") $ PkgRecord time $ PkgDependency time (PkgRecordKey "lnd") "0.13.3.1" (PkgRecordKey "bitcoind") (read ">=0.21.1.2 <0.22.0")
(Just time) _ <- insert_ $ PkgDependency time
"Lightning Network Daemon" (PkgRecordKey "lnd")
"short desc lnd" "0.13.3.1"
"long desc lnd" (PkgRecordKey "btc-rpc-proxy")
"png" (read ">=0.3.2.1 <0.4.0")
_ <- 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
_ <- runDBtest $ insert_ $ PkgDependency time
(PkgRecordKey "lnd")
"0.13.3.1"
(PkgRecordKey "bitcoind")
(read ">=0.21.1.2 <0.22.0")
_ <- runDBtest $ insert_ $ PkgDependency time
(PkgRecordKey "lnd")
"0.13.3.1"
(PkgRecordKey "btc-rpc-proxy")
(read ">=0.3.2.1 <0.4.0")
pure () pure ()