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

add index and deindex endpoints

Browse Source
This commit is contained in:
Keagan McClelland
2022-05-23 16:16:14 -06:00
parent 729e9bf507
commit 411d186517
8 changed files with 176 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
src/Application.hs
View File

@@ -303,7 +303,7 @@ startApp foundation = do
-- certbot renew loop
void . forkIO $ forever $ flip runReaderT foundation $ do
shouldRenew <- doesSslNeedRenew
runLog $ $logInfo $ [i|Checking if SSL Certs should be renewed: #{shouldRenew}|]
runLog $ $logInfo [i|Checking if SSL Certs should be renewed: #{shouldRenew}|]
when shouldRenew $ do
runLog $ $logInfo "Renewing SSL Certs."
renewSslCerts
@@ -322,9 +322,9 @@ startWeb foundation = do
where
startWeb' app = (`onException` (appStopFsNotifyPkg foundation *> appStopFsNotifyEos foundation)) $ do
let AppSettings {..} = appSettings foundation
runLog $ $logInfo $ [i|Launching Tor Web Server on port #{torPort}|]
runLog $ $logInfo [i|Launching Tor Web Server on port #{torPort}|]
torAction <- async $ runSettings (warpSettings torPort foundation) app
runLog $ $logInfo $ [i|Launching Web Server on port #{appPort}|]
runLog $ $logInfo [i|Launching Web Server on port #{appPort}|]
action <- async $ if sslAuto
then runTLS (tlsSettings sslCertLocation sslKeyLocation) (warpSettings appPort foundation) app
else runSettings (warpSettings appPort foundation) app

36
src/Database/Marketplace.hs
View File

@@ -1,6 +1,7 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Fuse on/on" #-}
module Database.Marketplace where
@@ -54,24 +55,24 @@ type CategoryTitle = Text
searchServices :: (MonadResource m, MonadIO m)
=> Maybe CategoryTitle
-> Text
-> ConduitT () (Entity PkgRecord) (ReaderT SqlBackend m) ()
-> ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) ()
searchServices Nothing query = selectSource $ do
service <- from $ table @PkgRecord
service <- from $ table @VersionRecord
where_
( (service ^. PkgRecordDescShort `ilike` (%) ++. val query ++. (%))
||. (service ^. PkgRecordDescLong `ilike` (%) ++. val query ++. (%))
||. (service ^. PkgRecordTitle `ilike` (%) ++. val query ++. (%))
( (service ^. VersionRecordDescShort `ilike` (%) ++. val query ++. (%))
||. (service ^. VersionRecordDescLong `ilike` (%) ++. val query ++. (%))
||. (service ^. VersionRecordTitle `ilike` (%) ++. val query ++. (%))
)
orderBy [desc (service ^. PkgRecordUpdatedAt)]
orderBy [desc (service ^. VersionRecordUpdatedAt)]
pure service
searchServices (Just category) query = selectSource $ do
services <- from
(do
(service :& _ :& cat) <-
from
$ table @PkgRecord
$ table @VersionRecord
`innerJoin` table @PkgCategory
`on` (\(s :& sc) -> sc ^. PkgCategoryPkgId ==. s ^. PkgRecordId)
`on` (\(s :& sc) -> sc ^. PkgCategoryPkgId ==. s ^. VersionRecordPkgId)
`innerJoin` table @Category
`on` (\(_ :& sc :& cat) -> sc ^. PkgCategoryCategoryId ==. cat ^. CategoryId)
-- if there is a cateogry, only search in category
@@ -80,13 +81,13 @@ searchServices (Just category) query = selectSource $ do
$ cat
^. CategoryName
==. val category
&&. ( (service ^. PkgRecordDescShort `ilike` (%) ++. val query ++. (%))
||. (service ^. PkgRecordDescLong `ilike` (%) ++. val query ++. (%))
||. (service ^. PkgRecordTitle `ilike` (%) ++. val query ++. (%))
&&. ( (service ^. VersionRecordDescShort `ilike` (%) ++. val query ++. (%))
||. (service ^. VersionRecordDescLong `ilike` (%) ++. val query ++. (%))
||. (service ^. VersionRecordTitle `ilike` (%) ++. val query ++. (%))
)
pure service
)
orderBy [desc (services ^. PkgRecordUpdatedAt)]
orderBy [desc (services ^. VersionRecordUpdatedAt)]
pure services
getPkgData :: (MonadResource m, MonadIO m) => [PkgId] -> ConduitT () (Entity PkgRecord) (ReaderT SqlBackend m) ()
@@ -98,20 +99,19 @@ getPkgData pkgs = selectSource $ do
getPkgDependencyData :: MonadIO m
=> Key PkgRecord
-> Version
-> ReaderT SqlBackend m ([(Entity PkgDependency, Entity PkgRecord)])
-> ReaderT SqlBackend m [(Entity PkgDependency, Entity PkgRecord)]
getPkgDependencyData pkgId pkgVersion = select $ do
pd <- from
from
(do
(pkgDepRecord :& depPkgRecord) <-
from
$ table @PkgDependency
`innerJoin` table @PkgRecord
`on` (\(pdr :& dpr) -> dpr ^. PkgRecordId ==. pdr ^. PkgDependencyDepId)
where_ (pkgDepRecord ^. PkgDependencyPkgId ==. (val pkgId))
where_ (pkgDepRecord ^. PkgDependencyPkgId ==. val pkgId)
where_ (pkgDepRecord ^. PkgDependencyPkgVersion ==. val pkgVersion)
pure (pkgDepRecord, depPkgRecord)
)
pure pd
zipCategories :: MonadUnliftIO m
=> ConduitT
@@ -147,7 +147,7 @@ zipDependencyVersions :: (Monad m, MonadIO m)
=> (Entity PkgDependency, Entity PkgRecord)
-> ReaderT SqlBackend m PackageDependencyMetadata
zipDependencyVersions (pkgDepRecord, depRecord) = do
let pkgDbId = entityKey $ depRecord
let pkgDbId = entityKey depRecord
depVers <- select $ do
v <- from $ table @VersionRecord
where_ $ v ^. VersionRecordPkgId ==. val pkgDbId

52
src/Database/Queries.hs
View File

@@ -1,15 +1,38 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
module Database.Queries where
import Database.Persist.Sql
import Lib.Types.AppIndex
import Lib.Types.Emver
import Model
import Database.Persist.Sql ( PersistStoreRead(get)
, PersistStoreWrite(insertKey, insert_, repsert)
, SqlBackend
)
import Lib.Types.AppIndex ( PackageManifest(..)
, PkgId
)
import Lib.Types.Emver ( Version )
import Model ( Key(PkgRecordKey, VersionRecordKey)
, Metric(Metric)
, PkgRecord(PkgRecord)
, VersionRecord(VersionRecord)
)
import Orphans.Emver ( )
import Startlude hiding ( get )
import Startlude ( ($)
, (.)
, ConvertText(toS)
, Maybe(..)
, MonadIO(..)
, ReaderT
, SomeException
, getCurrentTime
, maybe
)
import System.FilePath ( takeExtension )
import UnliftIO ( MonadUnliftIO
, try
)
fetchApp :: MonadIO m => PkgId -> ReaderT SqlBackend m (Maybe PkgRecord)
fetchApp = get . PkgRecordKey
@@ -21,3 +44,22 @@ createMetric :: MonadIO m => PkgId -> Version -> ReaderT SqlBackend m ()
createMetric appId version = do
time <- liftIO getCurrentTime
insert_ $ Metric time (PkgRecordKey appId) version
upsertPackageVersion :: (MonadUnliftIO m) => PackageManifest -> ReaderT SqlBackend m ()
upsertPackageVersion PackageManifest {..} = do
now <- liftIO getCurrentTime
let iconType = maybe "png" (toS . takeExtension . toS) packageManifestIcon
let pkgId = PkgRecordKey packageManifestId
let ins = VersionRecord now
(Just now)
pkgId
packageManifestVersion
packageManifestTitle
packageManifestDescriptionShort
packageManifestDescriptionLong
iconType
packageManifestReleaseNotes
packageManifestEosVersion
Nothing
_res <- try @_ @SomeException $ insertKey pkgId (PkgRecord now (Just now))
repsert (VersionRecordKey pkgId packageManifestVersion) ins

52
src/Handler/Admin.hs
View File

@@ -9,16 +9,33 @@ import Conduit ( (.|)
)
import Control.Monad.Reader.Has ( ask )
import Control.Monad.Trans.Maybe ( MaybeT(..) )
import Data.Aeson ( decodeFileStrict )
import Data.Aeson ( (.:)
, FromJSON(parseJSON)
, decodeFileStrict
, withObject
)
import Data.String.Interpolate.IsString
( i )
import Database.Queries ( upsertPackageVersion )
import Foundation
import Lib.PkgRepository ( PkgRepo(PkgRepo, pkgRepoFileRoot)
, extractPkg
, getManifestLocation
)
import Lib.Types.AppIndex ( PackageManifest(..)
, PkgId
)
import Lib.Types.Emver ( Version(..) )
import Model ( Key(PkgRecordKey, VersionRecordKey) )
import Network.HTTP.Types ( status404
, status500
)
import Lib.Types.AppIndex ( PackageManifest(..) )
import Network.HTTP.Types ( status500 )
import Startlude ( ($)
, (.)
, (<$>)
, Applicative(pure)
, Eq
, Show
, SomeException(..)
, asum
, hush
@@ -38,9 +55,12 @@ import UnliftIO.Directory ( renameDirectory )
import Util.Shared ( orThrow
, sendResponseText
)
import Yesod ( getsYesod
import Yesod ( delete
, getsYesod
, logError
, rawRequestBody
, requireCheckJsonBody
, runDB
)
postPkgUploadR :: Handler ()
@@ -58,8 +78,28 @@ postPkgUploadR = do
renameDirectory path (pkgRepoFileRoot </> show packageManifestId </> show packageManifestVersion)
where retry m = runMaybeT . asum $ replicate 3 (MaybeT $ hush <$> try @_ @SomeException m)
data IndexPkgReq = IndexPkgReq
{ indexPkgReqId :: !PkgId
, indexPkgReqVersion :: !Version
}
deriving (Eq, Show)
instance FromJSON IndexPkgReq where
parseJSON = withObject "Index Package Request" $ \o -> do
indexPkgReqId <- o .: "id"
indexPkgReqVersion <- o .: "version"
pure IndexPkgReq { .. }
postPkgIndexR :: Handler ()
postPkgIndexR = _
postPkgIndexR = do
IndexPkgReq {..} <- requireCheckJsonBody
manifest <- getManifestLocation indexPkgReqId indexPkgReqVersion
man <- liftIO (decodeFileStrict manifest) `orThrow` sendResponseText
status404
[i|Could not locate manifest for #{indexPkgReqId}@#{indexPkgReqVersion}|]
runDB $ upsertPackageVersion man
postPkgDeindexR :: Handler ()
postPkgDeindexR = _
postPkgDeindexR = do
IndexPkgReq {..} <- requireCheckJsonBody
runDB $ delete (VersionRecordKey (PkgRecordKey indexPkgReqId) indexPkgReqVersion)

8
src/Lib/PkgRepository.hs
View File

@@ -286,13 +286,17 @@ watchEosRepoRoot pool = do
Right version ->
void $ flip runSqlPool pool $ upsert (EosHash version hashText) [EosHashHash =. hashText]
getManifestLocation :: (MonadReader r m, Has PkgRepo r) => PkgId -> Version -> m FilePath
getManifestLocation pkg version = do
root <- asks pkgRepoFileRoot
pure $ root </> show pkg </> show version </> "manifest.json"
getManifest :: (MonadResource m, MonadReader r m, Has PkgRepo r)
=> PkgId
-> Version
-> m (Integer, ConduitT () ByteString m ())
getManifest pkg version = do
root <- asks pkgRepoFileRoot
let manifestPath = root </> show pkg </> show version </> "manifest.json"
manifestPath <- getManifestLocation pkg version
n <- getFileSize manifestPath
pure (n, sourceFile manifestPath)

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

@@ -100,6 +100,7 @@ data PackageManifest = PackageManifest
, packageManifestIcon :: !(Maybe Text)
, packageManifestAlerts :: !(HM.HashMap ServiceAlert (Maybe Text))
, packageManifestDependencies :: !(HM.HashMap PkgId PackageDependency)
, packageManifestEosVersion :: !Version
}
deriving Show
instance FromJSON PackageManifest where
@@ -120,6 +121,7 @@ instance FromJSON PackageManifest where
pure (alertType, alertDesc)
let packageManifestAlerts = HM.fromList a
packageManifestDependencies <- o .: "dependencies"
packageManifestEosVersion <- o .: "eos-version"
pure PackageManifest { .. }
-- >>> eitherDecode testManifest :: Either String PackageManifest

12
src/Model.hs
View File

@@ -24,10 +24,10 @@ PkgRecord
Id PkgId sql=pkg_id
createdAt UTCTime
updatedAt UTCTime Maybe
title Text
descShort Text
descLong Text
iconType Text
-- title Text
-- descShort Text
-- descLong Text
-- iconType Text
deriving Eq
deriving Show
@@ -36,6 +36,10 @@ VersionRecord sql=version
updatedAt UTCTime Maybe
pkgId PkgRecordId
number Version
title Text
descShort Text
descLong Text
iconType Text
releaseNotes Text
osVersion Version
arch Text Maybe

58
src/Util/Shared.hs
View File

@@ -1,14 +1,13 @@
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
module Util.Shared where
import Startlude hiding ( Any
, Handler
, yield
)
import qualified Data.Text as T
import Network.HTTP.Types
@@ -18,10 +17,10 @@ import Conduit ( ConduitT
, awaitForever
, yield
)
import Control.Monad.Reader.Has ( Has )
import Data.Semigroup ( Max(Max)
, getMax
import Control.Monad.Reader.Has ( Has
, MonadReader
)
import Data.Semigroup ( (<>) )
import Data.String.Interpolate.IsString
( i )
import Database.Esqueleto.Experimental
@@ -43,10 +42,33 @@ import Lib.Types.Emver
import Model ( Category
, Key(unPkgRecordKey)
, PkgDependency(pkgDependencyDepId, pkgDependencyDepVersionRange)
, PkgRecord(pkgRecordTitle)
, VersionRecord(versionRecordNumber, versionRecordOsVersion)
, PkgRecord
, VersionRecord(..)
, pkgDependencyPkgId
)
import Startlude ( ($)
, (.)
, (<$>)
, Alternative((<|>))
, Applicative(pure)
, Bool(..)
, Down(Down)
, Foldable(foldr, null)
, Functor(fmap)
, Maybe(..)
, Monad((>>=))
, Ord((>))
, Text
, decodeUtf8
, filter
, fromMaybe
, headMay
, isSpace
, not
, readMaybe
, sortOn
, unless
)
getVersionSpecFromQuery :: Handler VersionRange
getVersionSpecFromQuery = do
@@ -116,17 +138,17 @@ filterLatestVersionFromSpec versionMap = awaitForever $ \(a, vs, cats) -> do
-- 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 => PackageDependencyMetadata -> m (Maybe (Key PkgRecord, Text, Version))
filterDependencyBestVersion PackageDependencyMetadata { packageDependencyMetadataPkgDependencyRecord = pkgDepRecord, packageDependencyMetadataDepPkgRecord = depRecord, packageDependencyMetadataDepVersions = depVersions }
filterDependencyBestVersion PackageDependencyMetadata { packageDependencyMetadataPkgDependencyRecord = pkgDepRecord, packageDependencyMetadataDepVersions = depVersions }
= do
-- get best version from VersionRange of dependency
let pkgId = pkgDependencyPkgId $ entityVal pkgDepRecord
let depId = pkgDependencyDepId $ entityVal pkgDepRecord
let depTitle = pkgRecordTitle $ entityVal depRecord
let satisfactory = filter (<|| (pkgDependencyDepVersionRange $ entityVal pkgDepRecord))
(versionRecordNumber . entityVal <$> depVersions)
case getMax <$> foldMap (Just . Max) satisfactory of
let satisfactory = filter
((<|| (pkgDependencyDepVersionRange $ entityVal pkgDepRecord)) . versionRecordNumber)
(entityVal <$> depVersions)
case maximumOn versionRecordNumber 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)
Just bestVersion -> pure $ Just (depId, versionRecordTitle bestVersion, versionRecordNumber bestVersion)
Nothing -> do
-- TODO it would be better if we could return the requirements for display
$logInfo [i|No satisfactory version of #{depId} for dependent package #{pkgId}|]
@@ -134,3 +156,9 @@ filterDependencyBestVersion PackageDependencyMetadata { packageDependencyMetadat
sendResponseText :: MonadHandler m => Status -> Text -> m a
sendResponseText = sendResponseStatus @_ @Text
maximumOn :: forall a b t . (Ord b, Foldable t) => (a -> b) -> t a -> Maybe a
maximumOn f = foldr (\x y -> maxOn f x <$> y <|> Just x) Nothing
maxOn :: Ord b => (a -> b) -> a -> a -> a
maxOn f x y = if f x > f y then x else y