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

organization refactor separating database actions, data transformations, and api type constructs into separate components

Browse Source
This commit is contained in:
Lucy Cifferello
2021-12-02 08:06:47 -07:00
parent 1610c8c9fd
commit 64d432f2c9
13 changed files with 304 additions and 283 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
src/Application.hs
View File

@@ -132,13 +132,14 @@ makeFoundation appSettings = do
mkFoundation (panic "connPool forced in tempFoundation") (panic "stopFsNotify forced in tempFoundation") mkFoundation (panic "connPool forced in tempFoundation") (panic "stopFsNotify forced in tempFoundation")
logFunc = messageLoggerSource tempFoundation appLogger logFunc = messageLoggerSource tempFoundation appLogger
stop <- runLoggingT (runReaderT watchPkgRepoRoot appSettings) logFunc
createDirectoryIfMissing True (errorLogRoot appSettings) createDirectoryIfMissing True (errorLogRoot appSettings)
-- Create the database connection pool -- Create the database connection pool
pool <- flip runLoggingT logFunc pool <- flip runLoggingT logFunc
$ createPostgresqlPool (pgConnStr $ appDatabaseConf appSettings) (pgPoolSize . appDatabaseConf $ appSettings) $ createPostgresqlPool (pgConnStr $ appDatabaseConf appSettings) (pgPoolSize . appDatabaseConf $ appSettings)
stop <- runLoggingT (runReaderT (watchPkgRepoRoot pool) appSettings) logFunc
-- Preform database migration using application logging settings -- Preform database migration using application logging settings
runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc

127
src/Database/Marketplace.hs
View File

@@ -14,6 +14,7 @@ import Database.Esqueleto.Experimental
( (%) ( (%)
, (&&.) , (&&.)
, (++.) , (++.)
, (:&)(..)
, (==.) , (==.)
, (^.) , (^.)
, desc , desc
@@ -25,37 +26,28 @@ import Database.Esqueleto.Experimental
, orderBy , orderBy
, select , select
, selectSource , selectSource
, table
, val , val
, valList , valList
, where_ , where_
, (||.) , (||.)
, Value(unValue)
) )
import Database.Esqueleto.Experimental import qualified Database.Persist as P
( (:&)(..) import Database.Persist.Postgresql
, table hiding ( (==.)
) , getJust
import Lib.Types.AppIndex ( VersionInfo(..) , selectSource
, PkgId , (||.)
) )
import Lib.Types.AppIndex ( PkgId )
import Lib.Types.Category import Lib.Types.Category
import Lib.Types.Emver ( Version import Lib.Types.Emver ( Version )
, VersionRange
)
import Model import Model
import Startlude hiding ( (%) import Startlude hiding ( (%)
, from , from
, on , on
, yield , yield
) )
import qualified Data.HashMap.Internal.Strict as HM
import Handler.Types.Marketplace ( ReleaseNotes(ReleaseNotes) )
import qualified Database.Persist as P
import Database.Persist.Postgresql
hiding ( (||.)
, selectSource
, (==.)
)
searchServices :: (MonadResource m, MonadIO m) searchServices :: (MonadResource m, MonadIO m)
=> Maybe CategoryTitle => Maybe CategoryTitle
@@ -101,46 +93,69 @@ getPkgData pkgs = selectSource $ do
where_ (pkgData ^. PkgRecordId `in_` valList (PkgRecordKey <$> pkgs)) where_ (pkgData ^. PkgRecordId `in_` valList (PkgRecordKey <$> pkgs))
pure pkgData pure pkgData
getPkgDependencyData :: MonadIO m
=> Key PkgRecord
-> Version
-> ReaderT SqlBackend m ([(Entity PkgDependency, Entity PkgRecord)])
getPkgDependencyData pkgId pkgVersion = select $ do
pd <- from
(do
(pkgDepRecord :& depPkgRecord) <-
from
$ table @PkgDependency
`innerJoin` table @PkgRecord
`on` (\(pdr :& dpr) -> dpr ^. PkgRecordId ==. pdr ^. PkgDependencyDepId)
where_ (pkgDepRecord ^. PkgDependencyPkgId ==. (val pkgId))
where_ (pkgDepRecord ^. PkgDependencyPkgVersion ==. val pkgVersion)
pure (pkgDepRecord, depPkgRecord)
)
pure pd
zipCategories :: MonadUnliftIO m
=> ConduitT
(Entity PkgRecord, [Entity VersionRecord])
(Entity PkgRecord, [Entity VersionRecord], [Entity Category])
(ReaderT SqlBackend m)
()
zipCategories = awaitForever $ \(pkg, vers) -> do
let pkgDbId = entityKey pkg
raw <- lift $ select $ do
(sc :& cat) <-
from
$ table @PkgCategory
`innerJoin` table @Category
`on` (\(sc :& cat) -> sc ^. PkgCategoryCategoryId ==. cat ^. CategoryId)
where_ (sc ^. PkgCategoryPkgId ==. val pkgDbId)
pure cat
yield (pkg, vers, raw)
zipVersions :: MonadUnliftIO m zipVersions :: MonadUnliftIO m
=> ConduitT (Entity PkgRecord) (Entity PkgRecord, [Entity VersionRecord]) (ReaderT SqlBackend m) () => ConduitT (Entity PkgRecord) (Entity PkgRecord, [Entity VersionRecord]) (ReaderT SqlBackend m) ()
zipVersions = awaitForever $ \i -> do zipVersions = awaitForever $ \pkg -> do
let appDbId = entityKey i let appDbId = entityKey pkg
res <- lift $ select $ do res <- lift $ select $ do
v <- from $ table @VersionRecord v <- from $ table @VersionRecord
where_ $ v ^. VersionRecordPkgId ==. val appDbId where_ $ v ^. VersionRecordPkgId ==. val appDbId
-- first value in list will be latest version
orderBy [desc (v ^. VersionRecordNumber)]
pure v pure v
yield (i, res) yield (pkg, res)
filterOsCompatible :: Monad m zipDependencyVersions :: (Monad m, MonadIO m)
=> (Version -> Bool) => (Entity PkgDependency, Entity PkgRecord)
-> ConduitT -> ReaderT SqlBackend m (Entity PkgDependency, Entity PkgRecord, [Entity VersionRecord])
(Entity PkgRecord, [Entity VersionRecord], VersionRange) zipDependencyVersions (pkgDepRecord, depRecord) = do
(Entity PkgRecord, [Entity VersionRecord], VersionRange) let pkgDbId = entityKey $ depRecord
m depVers <- select $ do
() v <- from $ table @VersionRecord
filterOsCompatible p = awaitForever $ \(app, versions, requestedVersion) -> do where_ $ v ^. VersionRecordPkgId ==. val pkgDbId
let compatible = filter (p . versionRecordOsVersion . entityVal) versions pure v
when (not $ null compatible) $ yield (app, compatible, requestedVersion) pure $ (pkgDepRecord, depRecord, depVers)
fetchAllAppVersions :: MonadUnliftIO m => ConnectionPool -> PkgId -> m [VersionRecord]
fetchAllAppVersions :: MonadUnliftIO m => ConnectionPool -> PkgId -> m ([VersionInfo], ReleaseNotes)
fetchAllAppVersions appConnPool appId = do fetchAllAppVersions appConnPool appId = do
entityAppVersions <- runSqlPool (P.selectList [VersionRecordPkgId P.==. PkgRecordKey appId] []) appConnPool entityAppVersions <- runSqlPool (P.selectList [VersionRecordPkgId P.==. PkgRecordKey appId] []) appConnPool
let vers = entityVal <$> entityAppVersions pure $ entityVal <$> entityAppVersions
let vv = mapSVersionToVersionInfo vers
let mappedVersions = ReleaseNotes $ HM.fromList $ (\v -> (versionInfoVersion v, versionInfoReleaseNotes v)) <$> vv
pure $ (sortOn (Down . versionInfoVersion) vv, mappedVersions)
where
mapSVersionToVersionInfo :: [VersionRecord] -> [VersionInfo]
mapSVersionToVersionInfo sv = do
(\v -> VersionInfo { versionInfoVersion = versionRecordNumber v
, versionInfoReleaseNotes = versionRecordReleaseNotes v
, versionInfoDependencies = HM.empty
, versionInfoOsVersion = versionRecordOsVersion v
, versionInfoInstallAlert = Nothing
}
)
<$> sv
fetchLatestApp :: MonadIO m => PkgId -> ReaderT SqlBackend m (Maybe (P.Entity PkgRecord, P.Entity VersionRecord)) fetchLatestApp :: MonadIO m => PkgId -> ReaderT SqlBackend m (Maybe (P.Entity PkgRecord, P.Entity VersionRecord))
fetchLatestApp appId = fmap headMay . sortResults . select $ do fetchLatestApp appId = fmap headMay . sortResults . select $ do
@@ -152,19 +167,3 @@ fetchLatestApp appId = fmap headMay . sortResults . select $ do
where_ (service ^. PkgRecordId ==. val (PkgRecordKey appId)) where_ (service ^. PkgRecordId ==. val (PkgRecordKey appId))
pure (service, version) pure (service, version)
where sortResults = fmap $ sortOn (Down . versionRecordNumber . entityVal . snd) where sortResults = fmap $ sortOn (Down . versionRecordNumber . entityVal . snd)
fetchAppCategories :: MonadIO m => [PkgId] -> ReaderT SqlBackend m (HM.HashMap PkgId [Category])
fetchAppCategories appIds = do
raw <- select $ do
(sc :& app :& cat) <-
from
$ table @PkgCategory
`innerJoin` table @PkgRecord
`on` (\(sc :& app) -> sc ^. PkgCategoryPkgId ==. app ^. PkgRecordId)
`innerJoin` table @Category
`on` (\(sc :& _ :& cat) -> sc ^. PkgCategoryCategoryId ==. cat ^. CategoryId)
where_ (sc ^. PkgCategoryPkgId `in_` valList (PkgRecordKey <$> appIds))
pure (app ^. PkgRecordId, cat)
let ls = fmap (first (unPkgRecordKey . unValue) . second (pure . entityVal)) raw
pure $ HM.fromListWith (++) ls

4
src/Foundation.hs
View File

@@ -7,6 +7,7 @@
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-orphans #-}
module Foundation where module Foundation where
import Startlude hiding ( Handler ) import Startlude hiding ( Handler )
@@ -75,9 +76,6 @@ instance Has AppSettings RegistryCtx where
extract = appSettings extract = appSettings
update f ctx = ctx { appSettings = f (appSettings ctx) } update f ctx = ctx { appSettings = f (appSettings ctx) }
setWebProcessThreadId :: (ThreadId, ThreadId) -> RegistryCtx -> IO () setWebProcessThreadId :: (ThreadId, ThreadId) -> RegistryCtx -> IO ()
setWebProcessThreadId tid a = putMVar (appWebServerThreadId a) $ tid setWebProcessThreadId tid a = putMVar (appWebServerThreadId a) $ tid

222
src/Handler/Marketplace.hs
View File

@@ -25,21 +25,11 @@ import Conduit ( (.|)
, sinkList , sinkList
, sourceFile , sourceFile
, takeC , takeC
, MonadUnliftIO
)
import Control.Monad.Except.CoHas ( liftEither )
import Control.Parallel.Strategies ( parMap
, rpar
) )
import Crypto.Hash ( SHA256 ) import Crypto.Hash ( SHA256 )
import Crypto.Hash.Conduit ( hashFile ) import Crypto.Hash.Conduit ( hashFile )
import Data.Aeson ( (.:) import Data.Aeson ( decode
, FromJSON(parseJSON)
, KeyValue((.=))
, ToJSON(toJSON)
, Value(String)
, decode
, eitherDecode , eitherDecode
, eitherDecodeStrict , eitherDecodeStrict
) )
@@ -54,7 +44,6 @@ import Data.List ( head
, lookup , lookup
, sortOn , sortOn
) )
import Data.Semigroup ( Max(Max, getMax) )
import Data.String.Interpolate.IsString import Data.String.Interpolate.IsString
( i ) ( i )
import qualified Data.Text as T import qualified Data.Text as T
@@ -68,15 +57,13 @@ import Database.Esqueleto.Experimental
, select , select
, table , table
) )
import Database.Marketplace ( filterOsCompatible import Database.Marketplace ( getPkgData
, getPkgData
, searchServices , searchServices
, zipVersions , zipVersions
, fetchAllAppVersions , fetchAllAppVersions
, fetchLatestApp , fetchLatestApp
, fetchAppCategories , getPkgDependencyData, zipDependencyVersions, zipCategories
) )
import qualified Database.Persist as P
import Database.Persist ( PersistUniqueRead(getBy) import Database.Persist ( PersistUniqueRead(getBy)
, insertUnique , insertUnique
) )
@@ -84,17 +71,16 @@ import Foundation ( Handler
, RegistryCtx(appSettings, appConnPool) , RegistryCtx(appSettings, appConnPool)
) )
import Lib.Error ( S9Error(..) import Lib.Error ( S9Error(..)
, toStatus
) )
import Lib.PkgRepository ( getManifest ) import Lib.PkgRepository ( getManifest )
import Lib.Types.AppIndex ( PkgId(PkgId) import Lib.Types.AppIndex ( PkgId(PkgId)
, PackageDependency(packageDependencyVersion)
, PackageManifest(packageManifestDependencies)
) )
import Lib.Types.AppIndex ( ) import Lib.Types.AppIndex ( )
import Lib.Types.Category ( CategoryTitle(..) ) import Lib.Types.Category ( CategoryTitle(..) )
import Lib.Types.Emver ( (<||) import Lib.Types.Emver ( Version
, Version
, VersionRange(Any) , VersionRange(Any)
, parseRange , parseRange
, parseVersion , parseVersion
@@ -103,7 +89,7 @@ import Lib.Types.Emver ( (<||)
import Model ( Category(..) import Model ( Category(..)
, EntityField(..) , EntityField(..)
, EosHash(EosHash, eosHashHash) , EosHash(EosHash, eosHashHash)
, Key(PkgRecordKey, unPkgRecordKey) , Key(unPkgRecordKey)
, OsVersion(..) , OsVersion(..)
, PkgRecord(..) , PkgRecord(..)
, Unique(UniqueVersion) , Unique(UniqueVersion)
@@ -120,7 +106,7 @@ import UnliftIO.Async ( concurrently
, mapConcurrently , mapConcurrently
) )
import UnliftIO.Directory ( listDirectory ) import UnliftIO.Directory ( listDirectory )
import Util.Shared ( getVersionSpecFromQuery ) import Util.Shared ( getVersionSpecFromQuery, filterLatestVersionFromSpec, filterPkgOsCompatible, filterDependencyOsCompatible, filterDependencyBestVersion )
import Yesod.Core ( MonadResource import Yesod.Core ( MonadResource
, TypedContent , TypedContent
, YesodRequest(..) , YesodRequest(..)
@@ -136,13 +122,7 @@ import Yesod.Core ( MonadResource
) )
import Yesod.Persist ( YesodDB ) import Yesod.Persist ( YesodDB )
import Yesod.Persist.Core ( YesodPersist(runDB) ) import Yesod.Persist.Core ( YesodPersist(runDB) )
import Data.Tuple.Extra hiding ( second
, first
, (&&&)
)
import Control.Monad.Logger import Control.Monad.Logger
import Database.Persist.Sql ( runSqlPool )
import Database.Persist.Postgresql ( ConnectionPool )
import Control.Monad.Reader.Has ( Has import Control.Monad.Reader.Has ( Has
, ask , ask
) )
@@ -182,8 +162,12 @@ getReleaseNotesR = do
Nothing -> sendResponseStatus status400 (InvalidParamsE "get:id" "<MISSING>") Nothing -> sendResponseStatus status400 (InvalidParamsE "get:id" "<MISSING>")
Just package -> do Just package -> do
appConnPool <- appConnPool <$> getYesod appConnPool <- appConnPool <$> getYesod
(_, notes) <- runDB $ fetchAllAppVersions appConnPool (PkgId package) versionRecords <- runDB $ fetchAllAppVersions appConnPool (PkgId package)
pure notes pure $ constructReleaseNotesApiRes versionRecords
where
constructReleaseNotesApiRes :: [VersionRecord] -> ReleaseNotes
constructReleaseNotesApiRes vers = do
ReleaseNotes $ HM.fromList $ sortOn (Down) $ (versionRecordNumber &&& versionRecordReleaseNotes) <$> vers
getEosR :: Handler TypedContent getEosR :: Handler TypedContent
getEosR = do getEosR = do
@@ -213,6 +197,7 @@ getEosR = do
void $ insertUnique (EosHash v t) -- lazily populate void $ insertUnique (EosHash v t) -- lazily populate
pure t pure t
-- TODO refactor with conduit
getVersionLatestR :: Handler VersionLatestRes getVersionLatestR :: Handler VersionLatestRes
getVersionLatestR = do getVersionLatestR = do
getParameters <- reqGetParams <$> getRequest getParameters <- reqGetParams <$> getRequest
@@ -240,13 +225,6 @@ getPackageListR = do
Nothing -> const True Nothing -> const True
Just v -> flip satisfies v Just v -> flip satisfies v
pkgIds <- getPkgIdsQuery pkgIds <- getPkgIdsQuery
-- deep info
-- generate data from db
-- filter os
-- filter from request
-- shallow info - generate get deps
-- transformations
-- assemble api response
filteredPackages <- case pkgIds of filteredPackages <- case pkgIds of
Nothing -> do Nothing -> do
-- query for all -- query for all
@@ -258,8 +236,11 @@ getPackageListR = do
$ runConduit $ runConduit
$ searchServices category query $ searchServices category query
.| zipVersions .| zipVersions
.| mapC (\(a, vs) -> (,,) a vs Any) .| zipCategories
.| filterOsCompatible osPredicate -- if no packages are specified, the VersionRange is implicitly `*`
.| mapC (\(a, vs, cats) -> (a, vs, cats,Any))
.| filterLatestVersionFromSpec
.| 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')
.| sinkList .| sinkList
@@ -267,26 +248,21 @@ getPackageListR = do
-- for each item in list get best available from version range -- for each item in list get best available from version range
let vMap = (packageReqId &&& packageReqVersion) <$> packages' let vMap = (packageReqId &&& packageReqVersion) <$> packages'
runDB runDB
-- TODO could probably be better with sequenceConduits
. runConduit . runConduit
$ getPkgData (packageReqId <$> packages') $ getPkgData (packageReqId <$> packages')
.| zipVersions .| zipVersions
.| mapC .| zipCategories
(\(a, vs) -> .| mapC (\(a, vs, cats) -> do
let spec = fromMaybe Any $ lookup (unPkgRecordKey $ entityKey a) vMap let spec = fromMaybe Any $ lookup (unPkgRecordKey $ entityKey a) vMap
in (a, filter ((<|| spec) . versionRecordNumber . entityVal) vs, spec) (a, vs, cats, spec)
) )
.| filterOsCompatible osPredicate .| filterLatestVersionFromSpec
.| filterPkgOsCompatible osPredicate
.| sinkList .| sinkList
(keys, packageMetadata) <- runDB $ createPackageMetadata filteredPackages -- NOTE: if a package's dependencies do not meet the system requirements, it is currently omitted from the list
appConnPool <- appConnPool <$> getYesod pkgsWithDependencies <- runDB $ mapConcurrently (getPackageDependencies osPredicate) filteredPackages
serviceDetailResult <- mapConcurrently (getServiceDetails osPredicate appConnPool packageMetadata) keys PackageListRes <$> mapConcurrently constructPackageListApiRes pkgsWithDependencies
let (errors, res) = partitionEithers serviceDetailResult
case errors of
x : xs -> do
-- log all errors but just throw first error until Validation implemented - TODO https://hackage.haskell.org/package/validation
for_ xs (\e -> $logWarn [i|Get package list errors: #{e}|])
sendResponseStatus (toStatus x) x
[] -> pure $ PackageListRes res
where where
defaults = PackageListDefaults { packageListOrder = DESC defaults = PackageListDefaults { packageListOrder = DESC
@@ -342,104 +318,36 @@ 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)])
mergeDupes :: ([Version], VersionRange) -> ([Version], VersionRange) -> ([Version], VersionRange) getPackageDependencies osPredicate (pkg, pkgVersions, pkgCategories, pkgVersion) = do
mergeDupes (vs, vr) (vs', _) = (,) ((++) vs vs') vr let pkgId = entityKey pkg
let pkgVersions' = versionRecordNumber . entityVal <$> pkgVersions
createPackageMetadata :: (MonadReader r m, MonadIO m) let pkgCategories' = entityVal <$> pkgCategories
=> [(Entity PkgRecord, [Entity VersionRecord], VersionRange)] pkgDepInfo <- getPkgDependencyData pkgId pkgVersion
-> ReaderT pkgDepInfoWithVersions <- traverse zipDependencyVersions pkgDepInfo
SqlBackend let compatiblePkgDepInfo = fmap (filterDependencyOsCompatible osPredicate) pkgDepInfoWithVersions
m res <- catMaybes <$> traverse filterDependencyBestVersion compatiblePkgDepInfo
([PkgId], HM.HashMap PkgId (([Version], VersionRange), [CategoryTitle])) pure $ (pkgId, pkgCategories', pkgVersions', pkgVersion, res)
createPackageMetadata pkgs = do constructPackageListApiRes :: (Monad m, MonadResource m, MonadReader r m, Has AppSettings r) => (Key PkgRecord, [Category], [Version], Version, [(Key PkgRecord, Text, Version)]) -> m PackageRes
let keys = unPkgRecordKey . entityKey . fst3 <$> pkgs constructPackageListApiRes (pkgKey, pkgCategories, pkgVersions, pkgVersion, dependencies) = do
cats <- fetchAppCategories keys settings <- ask
let vers = let pkgId = unPkgRecordKey pkgKey
pkgs let domain = registryHostname settings
<&> first3 (unPkgRecordKey . entityKey) manifest <- flip runReaderT settings $ (snd <$> getManifest pkgId pkgVersion) >>= \bs ->
<&> second3 (sortOn Down . fmap (versionRecordNumber . entityVal)) runConduit $ bs .| CL.foldMap BS.fromStrict
<&> (\(a, vs, vr) -> (,) a $ (,) vs vr) pure $ PackageRes { packageResIcon = [i|https://#{domain}/package/icon/#{pkgId}|]
& HM.fromListWith mergeDupes -- pass through raw JSON Value, we have checked its correct parsing above
pure $ (keys, HM.intersectionWith (,) vers (categoryName <<$>> cats)) , packageResManifest = unsafeFromJust . decode $ manifest
, packageResCategories = categoryName <$> pkgCategories
getServiceDetails :: (MonadResource m, MonadReader r m, MonadLogger m, Has AppSettings r, MonadUnliftIO m) , packageResInstructions = [i|https://#{domain}/package/instructions/#{pkgId}|]
=> (Version -> Bool) , packageResLicense = [i|https://#{domain}/package/license/#{pkgId}|]
-> ConnectionPool , packageResVersions = pkgVersions
-> (HM.HashMap PkgId (([Version], VersionRange), [CategoryTitle])) , packageResDependencies = HM.fromList $ constructDependenciesApiRes domain dependencies
-> PkgId
-> m (Either S9Error PackageRes)
getServiceDetails osPredicate appConnPool metadata pkg = runExceptT $ do
settings <- ask
packageMetadata <- case HM.lookup pkg metadata of
Nothing -> liftEither . Left $ NotFoundE [i|#{pkg} not found.|]
Just m -> pure m
let domain = registryHostname settings
let versionInfo = fst $ (HM.!) metadata pkg
version <- case snd versionInfo of
Any -> do
-- grab first value, which will be the latest version
case fst versionInfo of
[] -> liftEither . Left $ NotFoundE $ [i|No latest version found for #{pkg}|]
x : _ -> pure x
spec -> case headMay . sortOn Down $ filter (`satisfies` spec) $ fst versionInfo of
Nothing -> liftEither . Left $ NotFoundE [i|No version for #{pkg} satisfying #{spec}|]
Just v -> pure v
manifest <- flip runReaderT settings $ (snd <$> getManifest pkg version) >>= \bs ->
runConduit $ bs .| CL.foldMap BS.fromStrict
case eitherDecode manifest of
Left _ -> liftEither . Left $ AssetParseE [i|#{pkg}:manifest|] (decodeUtf8 $ BS.toStrict manifest)
Right m -> do
let depVerList = (fst &&& (packageDependencyVersion . snd)) <$> (HM.toList $ packageManifestDependencies m)
(_, depMetadata) <- lift $ runSqlPool (createPackageMetadata =<< getDependencies depVerList) appConnPool
let (errors, deps) = partitionEithers $ parMap
rpar
(mapDependencyMetadata domain $ (HM.union depMetadata metadata))
(HM.toList $ packageManifestDependencies m)
case errors of
_ : xs -> liftEither . Left $ DepMetadataE xs
[] -> pure $ PackageRes { packageResIcon = [i|https://#{domain}/package/icon/#{pkg}|]
-- pass through raw JSON Value, we have checked its correct parsing above
, packageResManifest = unsafeFromJust . decode $ manifest
, packageResCategories = snd packageMetadata
, packageResInstructions = [i|https://#{domain}/package/instructions/#{pkg}|]
, packageResLicense = [i|https://#{domain}/package/license/#{pkg}|]
, packageResVersions = fst . fst $ packageMetadata
, packageResDependencies = HM.fromList deps
}
where
getDependencies :: (MonadResource m, MonadUnliftIO m)
=> [(PkgId, VersionRange)]
-> ReaderT SqlBackend m [(Entity PkgRecord, [Entity VersionRecord], VersionRange)]
getDependencies deps =
runConduit
$ getPkgData (fst <$> deps)
.| zipVersions
.| mapC
(\(a, vs) ->
let spec = fromMaybe Any $ lookup (unPkgRecordKey $ entityKey a) deps
in (a, filter ((<|| spec) . versionRecordNumber . entityVal) vs, spec)
)
.| filterOsCompatible osPredicate
.| sinkList
mapDependencyMetadata :: Text
-> HM.HashMap PkgId (([Version], VersionRange), [CategoryTitle])
-> (PkgId, PackageDependency)
-> Either Text (PkgId, DependencyRes)
mapDependencyMetadata domain metadata (appId, depInfo) = do
depMetadata <- case HM.lookup appId metadata of
Nothing -> Left [i|dependency metadata for #{appId} not found.|]
Just m -> pure m
-- get best version from VersionRange of dependency
let satisfactory = filter (<|| packageDependencyVersion depInfo) (fst . fst $ depMetadata)
let best = getMax <$> foldMap (Just . Max) satisfactory
version <- case best of
Nothing -> Left [i|No satisfactory version for dependent package #{appId}|]
Just v -> pure v
pure
( appId
, DependencyRes { dependencyResTitle = appId
, dependencyResIcon = [i|https://#{domain}/package/icon/#{appId}?spec==#{version}|]
} }
) constructDependenciesApiRes :: Text
-> [(Key PkgRecord, Text, Version)]
-> [(PkgId, DependencyRes)]
constructDependenciesApiRes domain deps = fmap (\(depKey, depTitle, depVersion) -> do
let depId = unPkgRecordKey depKey
(depId, DependencyRes { dependencyResTitle = depTitle, dependencyResIcon = [i|https://#{domain}/package/icon/#{depId}?spec==#{depVersion}|]})) deps

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

@@ -1,15 +1,16 @@
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
module Handler.Types.Marketplace where module Handler.Types.Marketplace where
import Lib.Types.Category ( CategoryTitle )
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Internal.Strict as HM
import Lib.Types.AppIndex ( PkgId )
import Lib.Types.Category ( CategoryTitle )
import Lib.Types.Emver ( Version
, VersionRange
)
import Startlude import Startlude
import Yesod import Yesod
import qualified Data.HashMap.Internal.Strict as HM
import Lib.Types.Emver ( VersionRange
, Version
)
import Lib.Types.AppIndex ( PkgId )
type URL = Text type URL = Text
@@ -22,12 +23,12 @@ instance ToContent CategoryRes where
instance ToTypedContent CategoryRes where instance ToTypedContent CategoryRes where
toTypedContent = toTypedContent . toJSON toTypedContent = toTypedContent . toJSON
data PackageRes = PackageRes data PackageRes = PackageRes
{ packageResIcon :: URL { packageResIcon :: URL
, packageResManifest :: Data.Aeson.Value -- PackageManifest , packageResManifest :: Data.Aeson.Value -- PackageManifest
, packageResCategories :: [CategoryTitle] , packageResCategories :: [CategoryTitle]
, packageResInstructions :: URL , packageResInstructions :: URL
, packageResLicense :: URL , packageResLicense :: URL
, packageResVersions :: [Version] , packageResVersions :: [Version]
, packageResDependencies :: HM.HashMap PkgId DependencyRes , packageResDependencies :: HM.HashMap PkgId DependencyRes
} }
deriving (Show, Generic) deriving (Show, Generic)
@@ -60,7 +61,7 @@ instance FromJSON PackageRes where
packageResDependencies <- o .: "dependency-metadata" packageResDependencies <- o .: "dependency-metadata"
pure PackageRes { .. } pure PackageRes { .. }
data DependencyRes = DependencyRes data DependencyRes = DependencyRes
{ dependencyResTitle :: PkgId { dependencyResTitle :: Text -- TODO switch to `Text` to display actual title in Marketplace. Confirm with FE that this will not break loading. Perhaps return title and id?
, dependencyResIcon :: URL , dependencyResIcon :: URL
} }
deriving (Eq, Show) deriving (Eq, Show)

6
src/Lib/Error.hs
View File

@@ -8,7 +8,6 @@ import Startlude
import Data.String.Interpolate.IsString import Data.String.Interpolate.IsString
import Network.HTTP.Types import Network.HTTP.Types
import Yesod.Core import Yesod.Core
import qualified Data.Text as T
type S9ErrT m = ExceptT S9Error m type S9ErrT m = ExceptT S9Error m
@@ -18,7 +17,6 @@ data S9Error =
| NotFoundE Text | NotFoundE Text
| InvalidParamsE Text Text | InvalidParamsE Text Text
| AssetParseE Text Text | AssetParseE Text Text
| DepMetadataE [Text]
deriving (Show, Eq) deriving (Show, Eq)
instance Exception S9Error instance Exception S9Error
@@ -31,9 +29,6 @@ toError = \case
NotFoundE e -> Error NOT_FOUND [i|#{e}|] NotFoundE e -> Error NOT_FOUND [i|#{e}|]
InvalidParamsE e m -> Error INVALID_PARAMS [i|Could not parse request parameters #{e}: #{m}|] InvalidParamsE e m -> Error INVALID_PARAMS [i|Could not parse request parameters #{e}: #{m}|]
AssetParseE asset found -> Error PARSE_ERROR [i|Could not parse #{asset}: #{found}|] AssetParseE asset found -> Error PARSE_ERROR [i|Could not parse #{asset}: #{found}|]
DepMetadataE errs -> do
let errorText = T.concat errs
Error NOT_FOUND [i|#{errorText}|]
data ErrorCode = data ErrorCode =
DATABASE_ERROR DATABASE_ERROR
@@ -69,4 +64,3 @@ toStatus = \case
NotFoundE _ -> status404 NotFoundE _ -> status404
InvalidParamsE _ _ -> status400 InvalidParamsE _ _ -> status400
AssetParseE _ _ -> status500 AssetParseE _ _ -> status500
DepMetadataE _ -> status404

54
src/Lib/PkgRepository.hs
View File

@@ -31,19 +31,33 @@ import qualified Data.Attoparsec.Text as Atto
import Data.ByteString ( readFile import Data.ByteString ( readFile
, writeFile , writeFile
) )
import qualified Data.HashMap.Strict as HM
import Data.String.Interpolate.IsString import Data.String.Interpolate.IsString
( i ) ( i )
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time ( getCurrentTime )
import Database.Esqueleto.Experimental
( ConnectionPool
, insertUnique
, runSqlPool
)
import Lib.Error ( S9Error(NotFoundE) ) import Lib.Error ( S9Error(NotFoundE) )
import qualified Lib.External.AppMgr as AppMgr import qualified Lib.External.AppMgr as AppMgr
import Lib.Types.AppIndex ( PkgId(..) import Lib.Types.AppIndex ( PackageManifest
, PackageManifest(packageManifestIcon) ( packageManifestIcon
, packageManifestId
, packageManifestVersion
)
, PkgId(..)
, packageDependencyVersion
, packageManifestDependencies
) )
import Lib.Types.Emver ( Version import Lib.Types.Emver ( Version
, VersionRange , VersionRange
, parseVersion , parseVersion
, satisfies , satisfies
) )
import Model
import Startlude ( ($) import Startlude ( ($)
, (&&) , (&&)
, (.) , (.)
@@ -62,14 +76,18 @@ import Startlude ( ($)
, MonadReader , MonadReader
, Show , Show
, SomeException(..) , SomeException(..)
, Traversable(traverse)
, filter , filter
, find , find
, first
, for_ , for_
, fst
, headMay , headMay
, not , not
, partitionEithers , partitionEithers
, pure , pure
, show , show
, snd
, sortOn , sortOn
, throwIO , throwIO
, void , void
@@ -111,7 +129,6 @@ import Yesod.Core.Content ( typeGif
, typeSvg , typeSvg
) )
import Yesod.Core.Types ( ContentType ) import Yesod.Core.Types ( ContentType )
data ManifestParseException = ManifestParseException FilePath data ManifestParseException = ManifestParseException FilePath
deriving Show deriving Show
instance Exception ManifestParseException instance Exception ManifestParseException
@@ -143,10 +160,28 @@ getBestVersion :: (MonadIO m, MonadReader r m, Has PkgRepo r, MonadLogger m)
-> m (Maybe Version) -> m (Maybe Version)
getBestVersion pkg spec = headMay . sortOn Down <$> getViableVersions pkg spec getBestVersion pkg spec = headMay . sortOn Down <$> getViableVersions pkg spec
-- TODO add loadDependencies loadPkgDependencies :: MonadUnliftIO m => ConnectionPool -> PackageManifest -> m ()
loadPkgDependencies appConnPool manifest = do
let pkgId = packageManifestId manifest
let pkgVersion = packageManifestVersion manifest
let deps = packageManifestDependencies manifest
time <- liftIO getCurrentTime
let deps' = first PkgRecordKey <$> HM.toList deps
_ <- traverse
(\d ->
(runSqlPool
( insertUnique
$ PkgDependency time (PkgRecordKey pkgId) pkgVersion (fst d) (packageDependencyVersion . snd $ d)
)
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) => FilePath -> m () extractPkg :: (MonadUnliftIO m, MonadReader r m, Has PkgRepo r, MonadLoggerIO m) => ConnectionPool -> FilePath -> m ()
extractPkg fp = handle @_ @SomeException cleanup $ do extractPkg pool fp = handle @_ @SomeException cleanup $ do
$logInfo [i|Extracting package: #{fp}|] $logInfo [i|Extracting package: #{fp}|]
PkgRepo { pkgRepoAppMgrBin = appmgr } <- ask PkgRepo { pkgRepoAppMgrBin = appmgr } <- ask
let pkgRoot = takeDirectory fp let pkgRoot = takeDirectory fp
@@ -169,6 +204,7 @@ extractPkg fp = handle @_ @SomeException cleanup $ do
Just x -> case takeExtension (T.unpack x) of Just x -> case takeExtension (T.unpack x) of
"" -> "png" "" -> "png"
other -> other other -> other
loadPkgDependencies pool manifest
liftIO $ renameFile (pkgRoot </> "icon.tmp") (pkgRoot </> iconDest) liftIO $ renameFile (pkgRoot </> "icon.tmp") (pkgRoot </> iconDest)
hash <- wait pkgHashTask hash <- wait pkgHashTask
liftIO $ writeFile (pkgRoot </> "hash.bin") hash liftIO $ writeFile (pkgRoot </> "hash.bin") hash
@@ -184,8 +220,8 @@ extractPkg fp = handle @_ @SomeException cleanup $ do
mapConcurrently_ (removeFile . (pkgRoot </>)) toRemove mapConcurrently_ (removeFile . (pkgRoot </>)) toRemove
throwIO e throwIO e
watchPkgRepoRoot :: (MonadUnliftIO m, MonadReader r m, Has PkgRepo r, MonadLoggerIO m) => m (IO Bool) watchPkgRepoRoot :: (MonadUnliftIO m, MonadReader r m, Has PkgRepo r, MonadLoggerIO m) => ConnectionPool -> m (IO Bool)
watchPkgRepoRoot = do watchPkgRepoRoot pool = do
$logInfo "Starting FSNotify Watch Manager" $logInfo "Starting FSNotify Watch Manager"
root <- asks pkgRepoFileRoot root <- asks pkgRepoFileRoot
runInIO <- askRunInIO runInIO <- askRunInIO
@@ -195,7 +231,7 @@ watchPkgRepoRoot = 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 pkg) (extractPkg pool pkg)
takeMVar box takeMVar box
stop stop
pure $ tryPutMVar box () pure $ tryPutMVar box ()

2
src/Lib/Types/AppIndex.hs
View File

@@ -17,7 +17,6 @@ import Data.Aeson ( (.:)
, ToJSON(..) , ToJSON(..)
, ToJSONKey(..) , ToJSONKey(..)
, withObject , withObject
, eitherDecode
) )
import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy as BS
import Data.Functor.Contravariant ( contramap ) import Data.Functor.Contravariant ( contramap )
@@ -77,7 +76,6 @@ data VersionInfo = VersionInfo
} }
deriving (Eq, Show) deriving (Eq, Show)
-- TODO rename to PackageDependencyInfo
data PackageDependency = PackageDependency data PackageDependency = PackageDependency
{ packageDependencyOptional :: Maybe Text { packageDependencyOptional :: Maybe Text
, packageDependencyVersion :: VersionRange , packageDependencyVersion :: VersionRange

4
src/Model.hs
View File

@@ -17,7 +17,6 @@ import Lib.Types.Category
import Lib.Types.Emver import Lib.Types.Emver
import Orphans.Emver ( ) import Orphans.Emver ( )
import Startlude import Startlude
import Yesod.Persist ( PersistFilter(Eq) )
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
PkgRecord PkgRecord
@@ -92,13 +91,14 @@ ErrorLogRecord
message Text message Text
incidents Word32 incidents Word32
UniqueLogRecord epoch commitHash sourceFile line target level message UniqueLogRecord epoch commitHash sourceFile line target level message
PkgDependency PkgDependency
createdAt UTCTime createdAt UTCTime
pkgId PkgRecordId pkgId PkgRecordId
pkgVersion Version pkgVersion Version
depId PkgRecordId depId PkgRecordId
depVersionRange VersionRange depVersionRange VersionRange
UniquePkgVersion pkgId pkgVersion UniquePkgDepVersion pkgId pkgVersion depId
deriving Eq deriving Eq
deriving Show deriving Show
|] |]

77
src/Util/Shared.hs
View File

@@ -1,20 +1,45 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
module Util.Shared where module Util.Shared where
import Startlude hiding ( Handler ) import Startlude hiding ( Handler
, yield
)
import qualified Data.Text as T import qualified Data.Text as T
import Network.HTTP.Types import Network.HTTP.Types
import Yesod.Core import Yesod.Core
import Conduit ( ConduitT
, awaitForever
, yield
)
import Control.Monad.Reader.Has ( Has ) import Control.Monad.Reader.Has ( Has )
import Data.Semigroup ( Max(Max)
, getMax
)
import Data.String.Interpolate.IsString
( i )
import Database.Esqueleto.Experimental
( Entity
, Key
, entityKey
, entityVal
)
import Foundation import Foundation
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
, PkgDependency(pkgDependencyDepId, pkgDependencyDepVersionRange)
, PkgRecord(pkgRecordTitle)
, VersionRecord(versionRecordNumber, versionRecordOsVersion)
, pkgDependencyPkgId
)
getVersionSpecFromQuery :: Handler VersionRange getVersionSpecFromQuery :: Handler VersionRange
getVersionSpecFromQuery = do getVersionSpecFromQuery = do
@@ -32,3 +57,53 @@ orThrow :: MonadHandler m => m (Maybe a) -> m a -> m a
orThrow action other = action >>= \case orThrow action other = action >>= \case
Nothing -> other Nothing -> other
Just x -> pure x Just x -> pure x
filterPkgOsCompatible :: Monad m
=> (Version -> Bool)
-> ConduitT
(Entity PkgRecord, [Entity VersionRecord], [Entity Category], Version)
(Entity PkgRecord, [Entity VersionRecord], [Entity Category], Version)
m
()
filterPkgOsCompatible p = awaitForever $ \(app, versions, cats, requestedVersion) -> do
let compatible = filter (p . versionRecordOsVersion . entityVal) versions
when (not $ null compatible) $ yield (app, compatible, cats, requestedVersion)
filterDependencyOsCompatible :: (Version -> Bool)
-> (Entity PkgDependency, Entity PkgRecord, [Entity VersionRecord])
-> (Entity PkgDependency, Entity PkgRecord, [Entity VersionRecord])
filterDependencyOsCompatible p (pkgDeps, pkg, versions) = do
let compatible = filter (p . versionRecordOsVersion . entityVal) versions
(pkgDeps, pkg, compatible)
filterLatestVersionFromSpec :: (Monad m, MonadLogger m)
=> ConduitT
(Entity PkgRecord, [Entity VersionRecord], [Entity Category], VersionRange)
(Entity PkgRecord, [Entity VersionRecord], [Entity Category], Version)
m
()
filterLatestVersionFromSpec = awaitForever $ \(a, vs, cats, spec) -> do
let pkgId = entityKey a
case headMay . sortOn Down $ filter (`satisfies` spec) $ fmap (versionRecordNumber . entityVal) vs of
Nothing -> $logInfo [i|No version for #{pkgId} satisfying #{spec}|]
Just v -> yield $ (,,,) a vs cats 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)
filterDependencyBestVersion :: MonadLogger m
=> (Entity PkgDependency, Entity PkgRecord, [Entity VersionRecord])
-> m (Maybe (Key PkgRecord, Text, Version))
filterDependencyBestVersion (pkgDepRecord, depPkgRecord, depVersions) = do
-- get best version from VersionRange of dependency
let pkgId = pkgDependencyPkgId $ entityVal pkgDepRecord
let depId = pkgDependencyDepId $ entityVal pkgDepRecord
let depTitle = pkgRecordTitle $ entityVal depPkgRecord
let satisfactory = filter (<|| (pkgDependencyDepVersionRange $ entityVal pkgDepRecord))
(versionRecordNumber . entityVal <$> depVersions)
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.
Just bestVersion -> pure $ Just (depId, depTitle, bestVersion)
Nothing -> do
$logInfo [i|No satisfactory version of #{depId} for dependent package #{pkgId}|]
-- TODO it would be better if we could return the requirements for display
pure Nothing

1
stack.yaml
View File

@@ -44,6 +44,7 @@ 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: {}

22
test/Handler/AppSpec.hs
View File

@@ -3,21 +3,19 @@
module Handler.AppSpec module Handler.AppSpec
( spec ( spec
) ) where
where
import Startlude
import Database.Persist.Sql
import Data.Maybe import Data.Maybe
import Database.Persist.Sql
import Startlude
import TestImport
import Model
import Handler.Marketplace
import Seed
import Lib.Types.AppIndex
import Data.Aeson import Data.Aeson
import Data.Either.Extra import Data.Either.Extra
import Handler.Marketplace ( PackageRes ) import Handler.Types.Marketplace ( PackageRes(packageResDependencies, packageResManifest) )
import Lib.Types.AppIndex
import Model
import Seed
import TestImport
spec :: Spec spec :: Spec
spec = do spec = do
@@ -92,13 +90,13 @@ spec = do
setMethod "GET" setMethod "GET"
setUrl ("/package/bitcoind.s9pk?spec==0.20.0" :: Text) setUrl ("/package/bitcoind.s9pk?spec==0.20.0" :: Text)
statusIs 404 statusIs 404
xdescribe "GET /package/:pkgId with unknown package" $ withApp $ it "fails to get an unregistered app" $ do describe "GET /package/:pkgId with unknown package" $ withApp $ it "fails to get an unregistered app" $ do
_ <- seedBitcoinLndStack _ <- seedBitcoinLndStack
request $ do request $ do
setMethod "GET" setMethod "GET"
setUrl ("/package/tempapp.s9pk?spec=0.0.1" :: Text) setUrl ("/package/tempapp.s9pk?spec=0.0.1" :: Text)
statusIs 404 statusIs 404
xdescribe "GET /package/:pkgId with package at unknown version" describe "GET /package/:pkgId with package at unknown version"
$ withApp $ withApp
$ it "fails to get an unregistered app" $ it "fails to get an unregistered app"
$ do $ do

38
test/Seed.hs
View File

@@ -1,25 +1,27 @@
module Seed where module Seed where
import Startlude ( ($) import Database.Persist.Sql ( PersistStoreWrite(insert, insertKey, insert_) )
, Applicative(pure) import Model ( Category(Category)
, Maybe(Nothing, Just) , Key(PkgRecordKey)
, getCurrentTime
, MonadIO(liftIO)
)
import Database.Persist.Sql ( PersistStoreWrite(insert_, insertKey, insert) )
import Model ( Key(PkgRecordKey)
, PkgRecord(PkgRecord)
, Category(Category)
, PkgCategory(PkgCategory) , PkgCategory(PkgCategory)
, PkgDependency(PkgDependency)
, PkgRecord(PkgRecord)
, VersionRecord(VersionRecord) , VersionRecord(VersionRecord)
) )
import Startlude ( ($)
, Applicative(pure)
, Maybe(Just, Nothing)
, MonadIO(liftIO)
, getCurrentTime
)
import TestImport ( runDBtest import Lib.Types.Category ( CategoryTitle(BITCOIN, FEATURED, LIGHTNING) )
, RegistryCtx import Prelude ( read )
import TestImport ( RegistryCtx
, SIO , SIO
, YesodExampleData , YesodExampleData
, runDBtest
) )
import Lib.Types.Category ( CategoryTitle(LIGHTNING, FEATURED, BITCOIN) )
seedBitcoinLndStack :: SIO (YesodExampleData RegistryCtx) () seedBitcoinLndStack :: SIO (YesodExampleData RegistryCtx) ()
seedBitcoinLndStack = do seedBitcoinLndStack = do
@@ -73,4 +75,14 @@ seedBitcoinLndStack = do
_ <- runDBtest $ insert_ $ PkgCategory time (PkgRecordKey "lnd") btcCat _ <- runDBtest $ insert_ $ PkgCategory time (PkgRecordKey "lnd") btcCat
_ <- runDBtest $ insert_ $ PkgCategory time (PkgRecordKey "bitcoind") btcCat _ <- runDBtest $ insert_ $ PkgCategory time (PkgRecordKey "bitcoind") btcCat
_ <- runDBtest $ insert_ $ PkgCategory time (PkgRecordKey "btc-rpc-proxy") 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 ()