mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-26 02:11:53 +00:00
adds index/deindex endpoints
This commit is contained in:
Keagan McClelland
7
cli/Main.hs
Normal file
7
cli/Main.hs
Normal file
@@ -0,0 +1,7 @@
|
||||
module Main where
|
||||
import Startlude ( IO
|
||||
, pure
|
||||
)
|
||||
|
||||
main :: IO ()
|
||||
main = pure ()
|
||||
15
package.yaml
15
package.yaml
@@ -43,6 +43,7 @@ dependencies:
|
||||
- memory
|
||||
- monad-logger
|
||||
- monad-logger-extras
|
||||
- monad-loops
|
||||
- parallel
|
||||
- persistent
|
||||
- persistent-postgresql
|
||||
@@ -102,7 +103,19 @@ executables:
|
||||
when:
|
||||
- condition: flag(library-only)
|
||||
buildable: false
|
||||
|
||||
embassy-publish:
|
||||
source-dirs: cli
|
||||
main: Main.hs
|
||||
ghc-options:
|
||||
- -threaded
|
||||
- -rtsopts
|
||||
- -with-rtsopts=-N
|
||||
- -fdefer-typed-holes
|
||||
dependencies:
|
||||
- start9-registry
|
||||
when:
|
||||
- condition: flag(library-only)
|
||||
buildable: false
|
||||
tests:
|
||||
start9-registry-test:
|
||||
source-dirs: test
|
||||
|
||||
@@ -9,8 +9,11 @@ import Conduit ( ConduitT
|
||||
, MonadResource
|
||||
, MonadUnliftIO
|
||||
, awaitForever
|
||||
, leftover
|
||||
, yield
|
||||
)
|
||||
import Control.Monad.Loops ( unfoldM )
|
||||
import Data.Conduit ( await )
|
||||
import Database.Esqueleto.Experimental
|
||||
( (%)
|
||||
, (&&.)
|
||||
@@ -90,10 +93,10 @@ searchServices (Just category) query = selectSource $ do
|
||||
orderBy [desc (services ^. VersionRecordUpdatedAt)]
|
||||
pure services
|
||||
|
||||
getPkgData :: (MonadResource m, MonadIO m) => [PkgId] -> ConduitT () (Entity PkgRecord) (ReaderT SqlBackend m) ()
|
||||
getPkgData :: (MonadResource m, MonadIO m) => [PkgId] -> ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) ()
|
||||
getPkgData pkgs = selectSource $ do
|
||||
pkgData <- from $ table @PkgRecord
|
||||
where_ (pkgData ^. PkgRecordId `in_` valList (PkgRecordKey <$> pkgs))
|
||||
pkgData <- from $ table @VersionRecord
|
||||
where_ (pkgData ^. VersionRecordPkgId `in_` valList (PkgRecordKey <$> pkgs))
|
||||
pure pkgData
|
||||
|
||||
getPkgDependencyData :: MonadIO m
|
||||
@@ -115,33 +118,34 @@ getPkgDependencyData pkgId pkgVersion = select $ do
|
||||
|
||||
zipCategories :: MonadUnliftIO m
|
||||
=> ConduitT
|
||||
(Entity PkgRecord, [Entity VersionRecord])
|
||||
(Entity PkgRecord, [Entity VersionRecord], [Entity Category])
|
||||
(PkgId, [Entity VersionRecord])
|
||||
(PkgId, [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)
|
||||
where_ (sc ^. PkgCategoryPkgId ==. val (PkgRecordKey pkg))
|
||||
pure cat
|
||||
yield (pkg, vers, raw)
|
||||
|
||||
zipVersions :: MonadUnliftIO m
|
||||
=> ConduitT (Entity PkgRecord) (Entity PkgRecord, [Entity VersionRecord]) (ReaderT SqlBackend m) ()
|
||||
zipVersions = awaitForever $ \pkg -> do
|
||||
let appDbId = entityKey pkg
|
||||
res <- lift $ select $ do
|
||||
v <- from $ table @VersionRecord
|
||||
where_ $ v ^. VersionRecordPkgId ==. val appDbId
|
||||
-- first value in list will be latest version
|
||||
orderBy [desc (v ^. VersionRecordNumber)]
|
||||
pure v
|
||||
yield (pkg, res)
|
||||
collateVersions :: MonadUnliftIO m
|
||||
=> ConduitT (Entity VersionRecord) (PkgId, [Entity VersionRecord]) (ReaderT SqlBackend m) ()
|
||||
collateVersions = awaitForever $ \v0 -> do
|
||||
let pkg = unPkgRecordKey . versionRecordPkgId $ entityVal v0
|
||||
let pull = do
|
||||
mvn <- await
|
||||
case mvn of
|
||||
Nothing -> pure Nothing
|
||||
Just vn -> do
|
||||
let pkg' = unPkgRecordKey . versionRecordPkgId $ entityVal vn
|
||||
if pkg == pkg' then pure (Just vn) else leftover vn $> Nothing
|
||||
ls <- unfoldM pull
|
||||
yield (pkg, v0 : ls)
|
||||
|
||||
zipDependencyVersions :: (Monad m, MonadIO m)
|
||||
=> (Entity PkgDependency, Entity PkgRecord)
|
||||
|
||||
@@ -1,6 +1,7 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Handler.Admin where
|
||||
|
||||
import Conduit ( (.|)
|
||||
|
||||
@@ -5,6 +5,8 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||
{-# HLINT ignore "Redundant <$>" #-}
|
||||
|
||||
module Handler.Marketplace where
|
||||
|
||||
@@ -66,14 +68,14 @@ import Database.Esqueleto.Experimental
|
||||
, select
|
||||
, table
|
||||
)
|
||||
import Database.Marketplace ( fetchAllAppVersions
|
||||
import Database.Marketplace ( collateVersions
|
||||
, fetchAllAppVersions
|
||||
, fetchLatestApp
|
||||
, getPkgData
|
||||
, getPkgDependencyData
|
||||
, searchServices
|
||||
, zipCategories
|
||||
, zipDependencyVersions
|
||||
, zipVersions
|
||||
)
|
||||
import Database.Persist ( PersistUniqueRead(getBy)
|
||||
, insertUnique
|
||||
@@ -98,7 +100,7 @@ import Lib.Types.Emver ( Version
|
||||
import Model ( Category(..)
|
||||
, EntityField(..)
|
||||
, EosHash(EosHash, eosHashHash)
|
||||
, Key(unPkgRecordKey)
|
||||
, Key(PkgRecordKey, unPkgRecordKey)
|
||||
, OsVersion(..)
|
||||
, PkgRecord(..)
|
||||
, Unique(UniqueVersion)
|
||||
@@ -194,7 +196,7 @@ getEosR = do
|
||||
spec <- getVersionSpecFromQuery
|
||||
root <- getsYesod $ (</> "eos") . resourcesDir . appSettings
|
||||
subdirs <- listDirectory root
|
||||
let (failures, successes) = partitionEithers $ (Atto.parseOnly parseVersion . T.pack) <$> subdirs
|
||||
let (failures, successes) = partitionEithers $ Atto.parseOnly parseVersion . T.pack <$> subdirs
|
||||
for_ failures $ \f -> $logWarn [i|Emver Parse Failure for EOS: #{f}|]
|
||||
let mVersion = headMay . sortOn Down . filter (`satisfies` spec) $ successes
|
||||
case mVersion of
|
||||
@@ -254,7 +256,7 @@ getPackageListR = do
|
||||
runDB
|
||||
$ runConduit
|
||||
$ searchServices category query
|
||||
.| zipVersions
|
||||
.| collateVersions
|
||||
.| zipCategories
|
||||
-- empty list since there are no requested packages in this case
|
||||
.| filterLatestVersionFromSpec []
|
||||
@@ -269,7 +271,7 @@ getPackageListR = do
|
||||
-- TODO could probably be better with sequenceConduits
|
||||
. runConduit
|
||||
$ getPkgData (packageReqId <$> packages')
|
||||
.| zipVersions
|
||||
.| collateVersions
|
||||
.| zipCategories
|
||||
.| filterLatestVersionFromSpec vMap
|
||||
.| filterPkgOsCompatible osPredicate
|
||||
@@ -343,16 +345,16 @@ getPackageListR = do
|
||||
, Version
|
||||
, [(Key PkgRecord, Text, Version)]
|
||||
)
|
||||
getPackageDependencies osPredicate PackageMetadata { packageMetadataPkgRecord = pkg, packageMetadataPkgVersionRecords = pkgVersions, packageMetadataPkgCategories = pkgCategories, packageMetadataPkgVersion = pkgVersion }
|
||||
getPackageDependencies osPredicate PackageMetadata { packageMetadataPkgId = pkg, packageMetadataPkgVersionRecords = pkgVersions, packageMetadataPkgCategories = pkgCategories, packageMetadataPkgVersion = pkgVersion }
|
||||
= do
|
||||
let pkgId = entityKey pkg
|
||||
let pkgId = PkgRecordKey pkg
|
||||
let pkgVersions' = versionRecordNumber . entityVal <$> pkgVersions
|
||||
let pkgCategories' = entityVal <$> pkgCategories
|
||||
pkgDepInfo <- getPkgDependencyData pkgId pkgVersion
|
||||
pkgDepInfoWithVersions <- traverse zipDependencyVersions pkgDepInfo
|
||||
let compatiblePkgDepInfo = fmap (filterDependencyOsCompatible osPredicate) pkgDepInfoWithVersions
|
||||
res <- catMaybes <$> traverse filterDependencyBestVersion compatiblePkgDepInfo
|
||||
pure $ (pkgId, pkgCategories', pkgVersions', pkgVersion, res)
|
||||
pure (pkgId, pkgCategories', pkgVersions', pkgVersion, res)
|
||||
constructPackageListApiRes :: (MonadResource m, MonadReader r m, Has AppSettings r, Has PkgRepo r)
|
||||
=> ( Key PkgRecord
|
||||
, [Category]
|
||||
@@ -392,4 +394,4 @@ getPackageListR = do
|
||||
runConduit $ src .| CL.foldMap id
|
||||
|
||||
basicRender :: RenderRoute a => Route a -> Text
|
||||
basicRender = TL.toStrict . TB.toLazyText . fold . fmap (mappend (TB.singleton '/') . TB.fromText) . fst . renderRoute
|
||||
basicRender = TL.toStrict . TB.toLazyText . foldMap (mappend (TB.singleton '/') . TB.fromText) . fst . renderRoute
|
||||
|
||||
@@ -129,7 +129,7 @@ instance FromJSON PackageReq where
|
||||
packageReqVersion <- o .: "version"
|
||||
pure PackageReq { .. }
|
||||
data PackageMetadata = PackageMetadata
|
||||
{ packageMetadataPkgRecord :: Entity PkgRecord
|
||||
{ packageMetadataPkgId :: PkgId
|
||||
, packageMetadataPkgVersionRecords :: [Entity VersionRecord]
|
||||
, packageMetadataPkgCategories :: [Entity Category]
|
||||
, packageMetadataPkgVersion :: Version
|
||||
|
||||
@@ -26,7 +26,6 @@ import Data.String.Interpolate.IsString
|
||||
import Database.Esqueleto.Experimental
|
||||
( Entity
|
||||
, Key
|
||||
, entityKey
|
||||
, entityVal
|
||||
)
|
||||
import Foundation
|
||||
@@ -40,7 +39,6 @@ import Lib.PkgRepository ( PkgRepo
|
||||
import Lib.Types.AppIndex ( PkgId )
|
||||
import Lib.Types.Emver
|
||||
import Model ( Category
|
||||
, Key(unPkgRecordKey)
|
||||
, PkgDependency(pkgDependencyDepId, pkgDependencyDepVersionRange)
|
||||
, PkgRecord
|
||||
, VersionRecord(..)
|
||||
@@ -99,10 +97,10 @@ orThrow action other = action >>= \case
|
||||
filterPkgOsCompatible :: Monad m => (Version -> Bool) -> ConduitT PackageMetadata PackageMetadata m ()
|
||||
filterPkgOsCompatible p =
|
||||
awaitForever
|
||||
$ \PackageMetadata { packageMetadataPkgRecord = pkg, packageMetadataPkgVersionRecords = versions, packageMetadataPkgCategories = cats, packageMetadataPkgVersion = requestedVersion } ->
|
||||
$ \PackageMetadata { packageMetadataPkgId = pkg, packageMetadataPkgVersionRecords = versions, packageMetadataPkgCategories = cats, packageMetadataPkgVersion = requestedVersion } ->
|
||||
do
|
||||
let compatible = filter (p . versionRecordOsVersion . entityVal) versions
|
||||
unless (null compatible) $ yield PackageMetadata { packageMetadataPkgRecord = pkg
|
||||
unless (null compatible) $ yield PackageMetadata { packageMetadataPkgId = pkg
|
||||
, packageMetadataPkgVersionRecords = compatible
|
||||
, packageMetadataPkgCategories = cats
|
||||
, packageMetadataPkgVersion = requestedVersion
|
||||
@@ -119,18 +117,13 @@ filterDependencyOsCompatible p PackageDependencyMetadata { packageDependencyMeta
|
||||
|
||||
filterLatestVersionFromSpec :: (Monad m, MonadLogger m)
|
||||
=> [(PkgId, VersionRange)]
|
||||
-> ConduitT
|
||||
(Entity PkgRecord, [Entity VersionRecord], [Entity Category])
|
||||
PackageMetadata
|
||||
m
|
||||
()
|
||||
filterLatestVersionFromSpec versionMap = awaitForever $ \(a, vs, cats) -> do
|
||||
let pkgId = entityKey a
|
||||
-> ConduitT (PkgId, [Entity VersionRecord], [Entity Category]) PackageMetadata m ()
|
||||
filterLatestVersionFromSpec versionMap = awaitForever $ \(pkgId, vs, cats) -> do
|
||||
-- if no packages are specified, the VersionRange is implicitly `*`
|
||||
let spec = fromMaybe Any $ lookup (unPkgRecordKey $ entityKey a) versionMap
|
||||
let spec = fromMaybe Any $ lookup pkgId versionMap
|
||||
case headMay . sortOn Down $ filter (`satisfies` spec) $ fmap (versionRecordNumber . entityVal) vs of
|
||||
Nothing -> $logInfo [i|No version for #{pkgId} satisfying #{spec}|]
|
||||
Just v -> yield $ PackageMetadata { packageMetadataPkgRecord = a
|
||||
Just v -> yield $ PackageMetadata { packageMetadataPkgId = pkgId
|
||||
, packageMetadataPkgVersionRecords = vs
|
||||
, packageMetadataPkgCategories = cats
|
||||
, packageMetadataPkgVersion = v
|
||||
|
||||
Reference in New Issue
Block a user