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

rename all references from services to packages

Browse Source
This commit is contained in:
Lucy Cifferello
2021-11-22 13:06:05 -07:00
committed by Keagan McClelland
parent fd54d931f6
commit 7219912d93
4 changed files with 148 additions and 138 deletions
Download Patch File Download Diff File Expand all files Collapse all files

180
src/Handler/Marketplace.hs
View File

@@ -96,8 +96,8 @@ import Lib.Error ( S9Error(..)
) )
import Lib.PkgRepository ( getManifest ) import Lib.PkgRepository ( getManifest )
import Lib.Types.AppIndex ( PkgId(PkgId) import Lib.Types.AppIndex ( PkgId(PkgId)
, ServiceDependencyInfo(serviceDependencyInfoVersion) , PackageDependency(packageDependencyVersion)
, ServiceManifest(serviceManifestDependencies) , PackageManifest(packageManifestDependencies)
, VersionInfo(..) , VersionInfo(..)
) )
import Lib.Types.AppIndex ( ) import Lib.Types.AppIndex ( )
@@ -168,14 +168,14 @@ instance ToContent CategoryRes where
toContent = toContent . toJSON toContent = toContent . toJSON
instance ToTypedContent CategoryRes where instance ToTypedContent CategoryRes where
toTypedContent = toTypedContent . toJSON toTypedContent = toTypedContent . toJSON
data ServiceRes = ServiceRes data PackageRes = PackageRes
{ serviceResIcon :: URL { packageResIcon :: URL
, serviceResManifest :: Data.Aeson.Value -- ServiceManifest , packageResManifest :: Data.Aeson.Value -- PackageManifest
, serviceResCategories :: [CategoryTitle] , packageResCategories :: [CategoryTitle]
, serviceResInstructions :: URL , packageResInstructions :: URL
, serviceResLicense :: URL , packageResLicense :: URL
, serviceResVersions :: [Version] , packageResVersions :: [Version]
, serviceResDependencyInfo :: HM.HashMap PkgId DependencyInfo , packageResDependencies :: HM.HashMap PkgId DependencyRes
} }
deriving (Show, Generic) deriving (Show, Generic)
newtype ReleaseNotes = ReleaseNotes { unReleaseNotes :: HM.HashMap Version Text } newtype ReleaseNotes = ReleaseNotes { unReleaseNotes :: HM.HashMap Version Text }
@@ -186,44 +186,44 @@ instance ToContent ReleaseNotes where
toContent = toContent . toJSON toContent = toContent . toJSON
instance ToTypedContent ReleaseNotes where instance ToTypedContent ReleaseNotes where
toTypedContent = toTypedContent . toJSON toTypedContent = toTypedContent . toJSON
instance ToJSON ServiceRes where instance ToJSON PackageRes where
toJSON ServiceRes {..} = object toJSON PackageRes {..} = object
[ "icon" .= serviceResIcon [ "icon" .= packageResIcon
, "license" .= serviceResLicense , "license" .= packageResLicense
, "instructions" .= serviceResInstructions , "instructions" .= packageResInstructions
, "manifest" .= serviceResManifest , "manifest" .= packageResManifest
, "categories" .= serviceResCategories , "categories" .= packageResCategories
, "versions" .= serviceResVersions , "versions" .= packageResVersions
, "dependency-metadata" .= serviceResDependencyInfo , "dependency-metadata" .= packageResDependencies
] ]
instance FromJSON ServiceRes where instance FromJSON PackageRes where
parseJSON = withObject "ServiceRes" $ \o -> do parseJSON = withObject "PackageRes" $ \o -> do
serviceResIcon <- o .: "icon" packageResIcon <- o .: "icon"
serviceResLicense <- o .: "license" packageResLicense <- o .: "license"
serviceResInstructions <- o .: "instructions" packageResInstructions <- o .: "instructions"
serviceResManifest <- o .: "manifest" packageResManifest <- o .: "manifest"
serviceResCategories <- o .: "categories" packageResCategories <- o .: "categories"
serviceResVersions <- o .: "versions" packageResVersions <- o .: "versions"
serviceResDependencyInfo <- o .: "dependency-metadata" packageResDependencies <- o .: "dependency-metadata"
pure ServiceRes { .. } pure PackageRes { .. }
data DependencyInfo = DependencyInfo data DependencyRes = DependencyRes
{ dependencyInfoTitle :: PkgId { dependencyResTitle :: PkgId
, dependencyInfoIcon :: URL , dependencyResIcon :: URL
} }
deriving (Eq, Show) deriving (Eq, Show)
instance ToJSON DependencyInfo where instance ToJSON DependencyRes where
toJSON DependencyInfo {..} = object ["icon" .= dependencyInfoIcon, "title" .= dependencyInfoTitle] toJSON DependencyRes {..} = object ["icon" .= dependencyResIcon, "title" .= dependencyResTitle]
instance FromJSON DependencyInfo where instance FromJSON DependencyRes where
parseJSON = withObject "DependencyInfo" $ \o -> do parseJSON = withObject "DependencyRes" $ \o -> do
dependencyInfoIcon <- o .: "icon" dependencyResIcon <- o .: "icon"
dependencyInfoTitle <- o .: "title" dependencyResTitle <- o .: "title"
pure DependencyInfo { .. } pure DependencyRes { .. }
newtype ServiceAvailableRes = ServiceAvailableRes [ServiceRes] newtype PackageListRes = PackageListRes [PackageRes]
deriving (Generic) deriving (Generic)
instance ToJSON ServiceAvailableRes instance ToJSON PackageListRes
instance ToContent ServiceAvailableRes where instance ToContent PackageListRes where
toContent = toContent . toJSON toContent = toContent . toJSON
instance ToTypedContent ServiceAvailableRes where instance ToTypedContent PackageListRes where
toTypedContent = toTypedContent . toJSON toTypedContent = toTypedContent . toJSON
newtype VersionLatestRes = VersionLatestRes (HM.HashMap PkgId (Maybe Version)) newtype VersionLatestRes = VersionLatestRes (HM.HashMap PkgId (Maybe Version))
@@ -235,12 +235,12 @@ instance ToTypedContent VersionLatestRes where
toTypedContent = toTypedContent . toJSON toTypedContent = toTypedContent . toJSON
data OrderArrangement = ASC | DESC data OrderArrangement = ASC | DESC
deriving (Eq, Show, Read) deriving (Eq, Show, Read)
data ServiceListDefaults = ServiceListDefaults data PackageListDefaults = PackageListDefaults
{ serviceListOrder :: OrderArrangement { packageListOrder :: OrderArrangement
, serviceListPageLimit :: Int -- the number of items per page , packageListPageLimit :: Int -- the number of items per page
, serviceListPageNumber :: Int -- the page you are on , packageListPageNumber :: Int -- the page you are on
, serviceListCategory :: Maybe CategoryTitle , packageListCategory :: Maybe CategoryTitle
, serviceListQuery :: Text , packageListQuery :: Text
} }
deriving (Eq, Show, Read) deriving (Eq, Show, Read)
data EosRes = EosRes data EosRes = EosRes
@@ -257,16 +257,16 @@ instance ToContent EosRes where
instance ToTypedContent EosRes where instance ToTypedContent EosRes where
toTypedContent = toTypedContent . toJSON toTypedContent = toTypedContent . toJSON
data PackageVersion = PackageVersion data PackageReq = PackageReq
{ packageVersionId :: PkgId { packageReqId :: PkgId
, packageVersionVersion :: VersionRange , packageReqVersion :: VersionRange
} }
deriving Show deriving Show
instance FromJSON PackageVersion where instance FromJSON PackageReq where
parseJSON = withObject "package version" $ \o -> do parseJSON = withObject "package version" $ \o -> do
packageVersionId <- o .: "id" packageReqId <- o .: "id"
packageVersionVersion <- o .: "version" packageReqVersion <- o .: "version"
pure PackageVersion { .. } pure PackageReq { .. }
getCategoriesR :: Handler CategoryRes getCategoriesR :: Handler CategoryRes
getCategoriesR = do getCategoriesR = do
@@ -353,19 +353,26 @@ getVersionLatestR = do
) )
$ HM.fromList packageList $ HM.fromList packageList
getPackageListR :: Handler ServiceAvailableRes getPackageListR :: Handler PackageListRes
getPackageListR = do getPackageListR = do
osPredicate <- getOsVersionQuery <&> \case osPredicate <- getOsVersionQuery <&> \case
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
category <- getCategoryQuery category <- getCategoryQuery
page <- getPageQuery page <- getPageQuery
limit' <- getLimitQuery limit' <- getLimitQuery
query <- T.strip . fromMaybe (serviceListQuery defaults) <$> lookupGetParam "query" query <- T.strip . fromMaybe (packageListQuery defaults) <$> lookupGetParam "query"
runDB runDB
$ runConduit $ runConduit
$ searchServices category query $ searchServices category query
@@ -377,10 +384,10 @@ getPackageListR = do
.| sinkList .| sinkList
Just packages' -> do Just packages' -> 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 = (packageVersionId &&& packageVersionVersion) <$> packages' let vMap = (packageReqId &&& packageReqVersion) <$> packages'
runDB runDB
. runConduit . runConduit
$ getPkgData (packageVersionId <$> packages') $ getPkgData (packageReqId <$> packages')
.| zipVersions .| zipVersions
.| mapC .| mapC
(\(a, vs) -> (\(a, vs) ->
@@ -398,16 +405,16 @@ getPackageListR = do
-- log all errors but just throw first error until Validation implemented - TODO https://hackage.haskell.org/package/validation -- 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}|]) for_ xs (\e -> $logWarn [i|Get package list errors: #{e}|])
sendResponseStatus (toStatus x) x sendResponseStatus (toStatus x) x
[] -> pure $ ServiceAvailableRes res [] -> pure $ PackageListRes res
where where
defaults = ServiceListDefaults { serviceListOrder = DESC defaults = PackageListDefaults { packageListOrder = DESC
, serviceListPageLimit = 20 , packageListPageLimit = 20
, serviceListPageNumber = 1 , packageListPageNumber = 1
, serviceListCategory = Nothing , packageListCategory = Nothing
, serviceListQuery = "" , packageListQuery = ""
} }
getPkgIdsQuery :: Handler (Maybe [PackageVersion]) getPkgIdsQuery :: Handler (Maybe [PackageReq])
getPkgIdsQuery = lookupGetParam "ids" >>= \case getPkgIdsQuery = lookupGetParam "ids" >>= \case
Nothing -> pure Nothing Nothing -> pure Nothing
Just ids -> case eitherDecodeStrict (encodeUtf8 ids) of Just ids -> case eitherDecodeStrict (encodeUtf8 ids) of
@@ -427,7 +434,7 @@ getPackageListR = do
Just t -> pure $ Just t Just t -> pure $ Just t
getPageQuery :: Handler Int getPageQuery :: Handler Int
getPageQuery = lookupGetParam "page" >>= \case getPageQuery = lookupGetParam "page" >>= \case
Nothing -> pure $ serviceListPageNumber defaults Nothing -> pure $ packageListPageNumber defaults
Just p -> case readMaybe p of Just p -> case readMaybe p of
Nothing -> do Nothing -> do
let e = InvalidParamsE "get:page" p let e = InvalidParamsE "get:page" p
@@ -438,7 +445,7 @@ getPackageListR = do
_ -> t _ -> t
getLimitQuery :: Handler Int getLimitQuery :: Handler Int
getLimitQuery = lookupGetParam "per-page" >>= \case getLimitQuery = lookupGetParam "per-page" >>= \case
Nothing -> pure $ serviceListPageLimit defaults Nothing -> pure $ packageListPageLimit defaults
Just pp -> case readMaybe pp of Just pp -> case readMaybe pp of
Nothing -> do Nothing -> do
let e = InvalidParamsE "get:per-page" pp let e = InvalidParamsE "get:per-page" pp
@@ -475,12 +482,12 @@ createPackageMetadata pkgs = do
& HM.fromListWith mergeDupes & HM.fromListWith mergeDupes
pure $ (keys, HM.intersectionWith (,) vers (categoryName <<$>> cats)) pure $ (keys, HM.intersectionWith (,) vers (categoryName <<$>> cats))
getServiceDetails :: (MonadIO m, MonadResource m, MonadReader r m, MonadLogger m, Has AppSettings r, MonadUnliftIO m) getServiceDetails :: (MonadResource m, MonadReader r m, MonadLogger m, Has AppSettings r, MonadUnliftIO m)
=> (Version -> Bool) => (Version -> Bool)
-> ConnectionPool -> ConnectionPool
-> (HM.HashMap PkgId (([Version], VersionRange), [CategoryTitle])) -> (HM.HashMap PkgId (([Version], VersionRange), [CategoryTitle]))
-> PkgId -> PkgId
-> m (Either S9Error ServiceRes) -> m (Either S9Error PackageRes)
getServiceDetails osPredicate appConnPool metadata pkg = runExceptT $ do getServiceDetails osPredicate appConnPool metadata pkg = runExceptT $ do
settings <- ask settings <- ask
packageMetadata <- case HM.lookup pkg metadata of packageMetadata <- case HM.lookup pkg metadata of
@@ -502,23 +509,22 @@ getServiceDetails osPredicate appConnPool metadata pkg = runExceptT $ do
case eitherDecode manifest of case eitherDecode manifest of
Left _ -> liftEither . Left $ AssetParseE [i|#{pkg}:manifest|] (decodeUtf8 $ BS.toStrict manifest) Left _ -> liftEither . Left $ AssetParseE [i|#{pkg}:manifest|] (decodeUtf8 $ BS.toStrict manifest)
Right m -> do Right m -> do
let depVerList = let depVerList = (fst &&& (packageDependencyVersion . snd)) <$> (HM.toList $ packageManifestDependencies m)
(fst &&& (serviceDependencyInfoVersion . snd)) <$> (HM.toList $ serviceManifestDependencies m)
(_, depMetadata) <- lift $ runSqlPool (createPackageMetadata =<< getDependencies depVerList) appConnPool (_, depMetadata) <- lift $ runSqlPool (createPackageMetadata =<< getDependencies depVerList) appConnPool
let (errors, deps) = partitionEithers $ parMap let (errors, deps) = partitionEithers $ parMap
rpar rpar
(mapDependencyMetadata domain $ (HM.union depMetadata metadata)) (mapDependencyMetadata domain $ (HM.union depMetadata metadata))
(HM.toList $ serviceManifestDependencies m) (HM.toList $ packageManifestDependencies m)
case errors of case errors of
_ : xs -> liftEither . Left $ DepMetadataE xs _ : xs -> liftEither . Left $ DepMetadataE xs
[] -> pure $ ServiceRes { serviceResIcon = [i|https://#{domain}/package/icon/#{pkg}|] [] -> pure $ PackageRes { packageResIcon = [i|https://#{domain}/package/icon/#{pkg}|]
-- pass through raw JSON Value, we have checked its correct parsing above -- pass through raw JSON Value, we have checked its correct parsing above
, serviceResManifest = unsafeFromJust . decode $ manifest , packageResManifest = unsafeFromJust . decode $ manifest
, serviceResCategories = snd packageMetadata , packageResCategories = snd packageMetadata
, serviceResInstructions = [i|https://#{domain}/package/instructions/#{pkg}|] , packageResInstructions = [i|https://#{domain}/package/instructions/#{pkg}|]
, serviceResLicense = [i|https://#{domain}/package/license/#{pkg}|] , packageResLicense = [i|https://#{domain}/package/license/#{pkg}|]
, serviceResVersions = fst . fst $ packageMetadata , packageResVersions = fst . fst $ packageMetadata
, serviceResDependencyInfo = HM.fromList deps , packageResDependencies = HM.fromList deps
} }
where where
getDependencies :: (MonadResource m, MonadUnliftIO m) getDependencies :: (MonadResource m, MonadUnliftIO m)
@@ -538,23 +544,23 @@ getServiceDetails osPredicate appConnPool metadata pkg = runExceptT $ do
mapDependencyMetadata :: Text mapDependencyMetadata :: Text
-> HM.HashMap PkgId (([Version], VersionRange), [CategoryTitle]) -> HM.HashMap PkgId (([Version], VersionRange), [CategoryTitle])
-> (PkgId, ServiceDependencyInfo) -> (PkgId, PackageDependency)
-> Either Text (PkgId, DependencyInfo) -> Either Text (PkgId, DependencyRes)
mapDependencyMetadata domain metadata (appId, depInfo) = do mapDependencyMetadata domain metadata (appId, depInfo) = do
depMetadata <- case HM.lookup appId metadata of depMetadata <- case HM.lookup appId metadata of
Nothing -> Left [i|dependency metadata for #{appId} not found.|] Nothing -> Left [i|dependency metadata for #{appId} not found.|]
Just m -> pure m Just m -> pure m
-- get best version from VersionRange of dependency -- get best version from VersionRange of dependency
let satisfactory = filter (<|| serviceDependencyInfoVersion depInfo) (fst . fst $ depMetadata) let satisfactory = filter (<|| packageDependencyVersion depInfo) (fst . fst $ depMetadata)
let best = getMax <$> foldMap (Just . Max) satisfactory let best = getMax <$> foldMap (Just . Max) satisfactory
version <- case best of version <- case best of
Nothing -> Left [i|No satisfactory version for dependent package #{appId}|] Nothing -> Left [i|No satisfactory version for dependent package #{appId}|]
Just v -> pure v Just v -> pure v
pure pure
( appId ( appId
, DependencyInfo { dependencyInfoTitle = appId , DependencyRes { dependencyResTitle = appId
, dependencyInfoIcon = [i|https://#{domain}/package/icon/#{appId}?spec==#{version}|] , dependencyResIcon = [i|https://#{domain}/package/icon/#{appId}?spec==#{version}|]
} }
) )
fetchAllAppVersions :: PkgId -> Handler ([VersionInfo], ReleaseNotes) fetchAllAppVersions :: PkgId -> Handler ([VersionInfo], ReleaseNotes)

4
src/Lib/PkgRepository.hs
View File

@@ -37,7 +37,7 @@ import qualified Data.Text as T
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 ( PkgId(..)
, ServiceManifest(serviceManifestIcon) , PackageManifest(packageManifestIcon)
) )
import Lib.Types.Emver ( Version import Lib.Types.Emver ( Version
, VersionRange , VersionRange
@@ -163,7 +163,7 @@ extractPkg fp = handle @_ @SomeException cleanup $ do
liftIO . throwIO $ ManifestParseException (pkgRoot </> "manifest.json") liftIO . throwIO $ ManifestParseException (pkgRoot </> "manifest.json")
Right manifest -> do Right manifest -> do
wait iconTask wait iconTask
let iconDest = "icon" <.> case serviceManifestIcon manifest of let iconDest = "icon" <.> case packageManifestIcon manifest of
Nothing -> "png" Nothing -> "png"
Just x -> case takeExtension (T.unpack x) of Just x -> case takeExtension (T.unpack x) of
"" -> "png" "" -> "png"

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

@@ -8,6 +8,7 @@ module Lib.Types.AppIndex where
import Startlude import Startlude
-- NOTE: leave eitherDecode for inline test evaluation below
import Control.Monad ( fail ) import Control.Monad ( fail )
import Data.Aeson ( (.:) import Data.Aeson ( (.:)
, (.:?) , (.:?)
@@ -16,6 +17,7 @@ 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 )
@@ -76,43 +78,43 @@ data VersionInfo = VersionInfo
deriving (Eq, Show) deriving (Eq, Show)
-- TODO rename to PackageDependencyInfo -- TODO rename to PackageDependencyInfo
data ServiceDependencyInfo = ServiceDependencyInfo data PackageDependency = PackageDependency
{ serviceDependencyInfoOptional :: Maybe Text { packageDependencyOptional :: Maybe Text
, serviceDependencyInfoVersion :: VersionRange , packageDependencyVersion :: VersionRange
, serviceDependencyInfoDescription :: Maybe Text , packageDependencyDescription :: Maybe Text
, serviceDependencyInfoCritical :: Bool , packageDependencyCritical :: Bool
} }
deriving Show deriving Show
instance FromJSON ServiceDependencyInfo where instance FromJSON PackageDependency where
parseJSON = withObject "service dependency info" $ \o -> do parseJSON = withObject "service dependency info" $ \o -> do
serviceDependencyInfoOptional <- o .:? "optional" packageDependencyOptional <- o .:? "optional"
serviceDependencyInfoVersion <- o .: "version" packageDependencyVersion <- o .: "version"
serviceDependencyInfoDescription <- o .:? "description" packageDependencyDescription <- o .:? "description"
serviceDependencyInfoCritical <- o .: "critical" packageDependencyCritical <- o .: "critical"
pure ServiceDependencyInfo { .. } pure PackageDependency { .. }
data ServiceAlert = INSTALL | UNINSTALL | RESTORE | START | STOP data ServiceAlert = INSTALL | UNINSTALL | RESTORE | START | STOP
deriving (Show, Eq, Generic, Hashable, Read) deriving (Show, Eq, Generic, Hashable, Read)
data ServiceManifest = ServiceManifest data PackageManifest = PackageManifest
{ serviceManifestId :: !PkgId { packageManifestId :: !PkgId
, serviceManifestTitle :: !Text , packageManifestTitle :: !Text
, serviceManifestVersion :: !Version , packageManifestVersion :: !Version
, serviceManifestDescriptionLong :: !Text , packageManifestDescriptionLong :: !Text
, serviceManifestDescriptionShort :: !Text , packageManifestDescriptionShort :: !Text
, serviceManifestReleaseNotes :: !Text , packageManifestReleaseNotes :: !Text
, serviceManifestIcon :: !(Maybe Text) , packageManifestIcon :: !(Maybe Text)
, serviceManifestAlerts :: !(HM.HashMap ServiceAlert (Maybe Text)) , packageManifestAlerts :: !(HM.HashMap ServiceAlert (Maybe Text))
, serviceManifestDependencies :: !(HM.HashMap PkgId ServiceDependencyInfo) , packageManifestDependencies :: !(HM.HashMap PkgId PackageDependency)
} }
deriving Show deriving Show
instance FromJSON ServiceManifest where instance FromJSON PackageManifest where
parseJSON = withObject "service manifest" $ \o -> do parseJSON = withObject "service manifest" $ \o -> do
serviceManifestId <- o .: "id" packageManifestId <- o .: "id"
serviceManifestTitle <- o .: "title" packageManifestTitle <- o .: "title"
serviceManifestVersion <- o .: "version" packageManifestVersion <- o .: "version"
serviceManifestDescriptionLong <- o .: "description" >>= (.: "long") packageManifestDescriptionLong <- o .: "description" >>= (.: "long")
serviceManifestDescriptionShort <- o .: "description" >>= (.: "short") packageManifestDescriptionShort <- o .: "description" >>= (.: "short")
serviceManifestIcon <- o .: "assets" >>= (.: "icon") packageManifestIcon <- o .: "assets" >>= (.: "icon")
serviceManifestReleaseNotes <- o .: "release-notes" packageManifestReleaseNotes <- o .: "release-notes"
alerts <- o .: "alerts" alerts <- o .: "alerts"
a <- for (HM.toList alerts) $ \(key, value) -> do a <- for (HM.toList alerts) $ \(key, value) -> do
alertType <- case readMaybe $ T.toUpper key of alertType <- case readMaybe $ T.toUpper key of
@@ -120,12 +122,12 @@ instance FromJSON ServiceManifest where
Just t -> pure t Just t -> pure t
alertDesc <- parseJSON value alertDesc <- parseJSON value
pure (alertType, alertDesc) pure (alertType, alertDesc)
let serviceManifestAlerts = HM.fromList a let packageManifestAlerts = HM.fromList a
serviceManifestDependencies <- o .: "dependencies" packageManifestDependencies <- o .: "dependencies"
pure ServiceManifest { .. } pure PackageManifest { .. }
-- >>> eitherDecode testManifest :: Either String ServiceManifest -- >>> eitherDecode testManifest :: Either String PackageManifest
-- Right (ServiceManifest {serviceManifestId = embassy-pages, serviceManifestTitle = "Embassy Pages", serviceManifestVersion = 0.1.3, serviceManifestDescriptionLong = "Embassy Pages is a simple web server that uses directories inside File Browser to serve Tor websites.", serviceManifestDescriptionShort = "Create Tor websites, hosted on your Embassy.", serviceManifestReleaseNotes = "Upgrade to EmbassyOS v0.3.0", serviceManifestIcon = Just "icon.png", serviceManifestAlerts = fromList [(INSTALL,Nothing),(UNINSTALL,Nothing),(STOP,Nothing),(RESTORE,Nothing),(START,Nothing)], serviceManifestDependencies = fromList [(filebrowser,ServiceDependencyInfo {serviceDependencyInfoOptional = Nothing, serviceDependencyInfoVersion = >=2.14.1.1 <3.0.0, serviceDependencyInfoDescription = Just "Used to upload files to serve.", serviceDependencyInfoCritical = False})]}) -- Right (PackageManifest {packageManifestId = embassy-pages, packageManifestTitle = "Embassy Pages", packageManifestVersion = 0.1.3, packageManifestDescriptionLong = "Embassy Pages is a simple web server that uses directories inside File Browser to serve Tor websites.", packageManifestDescriptionShort = "Create Tor websites, hosted on your Embassy.", packageManifestReleaseNotes = "Upgrade to EmbassyOS v0.3.0", packageManifestIcon = Just "icon.png", packageManifestAlerts = fromList [(INSTALL,Nothing),(UNINSTALL,Nothing),(STOP,Nothing),(RESTORE,Nothing),(START,Nothing)], packageManifestDependencies = fromList [(filebrowser,PackageDependency {packageDependencyOptional = Nothing, packageDependencyVersion = >=2.14.1.1 <3.0.0, packageDependencyDescription = Just "Used to upload files to serve.", packageDependencyCritical = False})]})
testManifest :: BS.ByteString testManifest :: BS.ByteString
testManifest = [i|{ testManifest = [i|{
"id": "embassy-pages", "id": "embassy-pages",

32
test/Handler/AppSpec.hs
View File

@@ -17,6 +17,8 @@ import Seed
import Lib.Types.AppIndex import Lib.Types.AppIndex
import Data.Aeson import Data.Aeson
import Data.Either.Extra import Data.Either.Extra
import Handler.Marketplace ( PackageListRes )
spec :: Spec spec :: Spec
spec = do spec = do
describe "GET /package/index" $ withApp $ it "returns list of packages" $ do describe "GET /package/index" $ withApp $ it "returns list of packages" $ do
@@ -25,7 +27,7 @@ spec = do
setMethod "GET" setMethod "GET"
setUrl ("/package/index" :: Text) setUrl ("/package/index" :: Text)
statusIs 200 statusIs 200
(res :: [ServiceRes]) <- requireJSONResponse (res :: PackageListRes) <- requireJSONResponse
assertEq "response should have two packages" (length res) 3 assertEq "response should have two packages" (length res) 3
describe "GET /package/index?ids" $ withApp $ it "returns list of packages at specified version" $ do describe "GET /package/index?ids" $ withApp $ it "returns list of packages at specified version" $ do
_ <- seedBitcoinLndStack _ <- seedBitcoinLndStack
@@ -33,11 +35,11 @@ spec = do
setMethod "GET" setMethod "GET"
setUrl ("/package/index?ids=[{\"id\":\"bitcoind\",\"version\":\"=0.21.1.2\"}]" :: Text) setUrl ("/package/index?ids=[{\"id\":\"bitcoind\",\"version\":\"=0.21.1.2\"}]" :: Text)
statusIs 200 statusIs 200
(res :: [ServiceRes]) <- requireJSONResponse (res :: PackageListRes) <- 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 :: ServiceManifest) = fromRight' $ eitherDecode $ encode $ serviceResManifest pkg let (manifest :: PackageManifest) = fromRight' $ eitherDecode $ encode $ packageResManifest pkg
assertEq "manifest id should be bitcoind" (serviceManifestId manifest) "bitcoind" assertEq "manifest id should be bitcoind" (packageManifestId manifest) "bitcoind"
describe "GET /package/index?ids" describe "GET /package/index?ids"
$ withApp $ withApp
$ it "returns list of packages and dependencies at specified version" $ it "returns list of packages and dependencies at specified version"
@@ -47,43 +49,43 @@ spec = do
setMethod "GET" setMethod "GET"
setUrl ("/package/index?ids=[{\"id\":\"lnd\",\"version\":\"=0.13.3.1\"}]" :: Text) setUrl ("/package/index?ids=[{\"id\":\"lnd\",\"version\":\"=0.13.3.1\"}]" :: Text)
statusIs 200 statusIs 200
(res :: [ServiceRes]) <- requireJSONResponse (res :: PackageListRes) <- 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
assertEq "package dependency metadata should not be empty" (null $ serviceResDependencyInfo pkg) False assertEq "package dependency metadata should not be empty" (null $ packageResDependencyInfo pkg) False
describe "GET /package/index?ids" $ withApp $ it "returns list of packages at exactly specified version" $ do describe "GET /package/index?ids" $ withApp $ it "returns list of packages at exactly specified version" $ do
_ <- seedBitcoinLndStack _ <- seedBitcoinLndStack
request $ do request $ do
setMethod "GET" setMethod "GET"
setUrl ("/package/index?ids=[{\"id\":\"bitcoind\",\"version\":\"=0.21.1.1\"}]" :: Text) setUrl ("/package/index?ids=[{\"id\":\"bitcoind\",\"version\":\"=0.21.1.1\"}]" :: Text)
statusIs 200 statusIs 200
(res :: [ServiceRes]) <- requireJSONResponse (res :: PackageListRes) <- 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 :: ServiceManifest) = fromRight' $ eitherDecode $ encode $ serviceResManifest pkg let (manifest :: PackageManifest) = fromRight' $ eitherDecode $ encode $ packageResManifest pkg
assertEq "manifest version should be 0.21.1.1" (serviceManifestVersion 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
request $ do request $ do
setMethod "GET" setMethod "GET"
setUrl ("/package/index?ids=[{\"id\":\"bitcoind\",\"version\":\">=0.21.1.1\"}]" :: Text) setUrl ("/package/index?ids=[{\"id\":\"bitcoind\",\"version\":\">=0.21.1.1\"}]" :: Text)
statusIs 200 statusIs 200
(res :: [ServiceRes]) <- requireJSONResponse (res :: PackageListRes) <- 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 :: ServiceManifest) = fromRight' $ eitherDecode $ encode $ serviceResManifest pkg let (manifest :: PackageManifest) = fromRight' $ eitherDecode $ encode $ packageResManifest pkg
assertEq "manifest version should be 0.21.1.2" (serviceManifestVersion 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
request $ do request $ do
setMethod "GET" setMethod "GET"
setUrl ("/package/index?ids=[{\"id\":\"bitcoind\",\"version\":\">=0.21.1.2\"}]" :: Text) setUrl ("/package/index?ids=[{\"id\":\"bitcoind\",\"version\":\">=0.21.1.2\"}]" :: Text)
statusIs 200 statusIs 200
(res :: [ServiceRes]) <- requireJSONResponse (res :: PackageListRes) <- 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 :: ServiceManifest) = fromRight' $ eitherDecode $ encode $ serviceResManifest pkg let (manifest :: PackageManifest) = fromRight' $ eitherDecode $ encode $ packageResManifest pkg
assertEq "manifest version should be 0.21.1.2" (serviceManifestVersion 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
request $ do request $ do