mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-26 02:11:53 +00:00
format all the things
This commit is contained in:
committed by
Keagan McClelland
parent
ac5acaa685
commit
e2d2fb6afc
@@ -1,7 +1,9 @@
|
||||
module DevelMain where
|
||||
|
||||
import Prelude
|
||||
import Application (getApplicationRepl, shutdownApp)
|
||||
import Application ( getApplicationRepl
|
||||
, shutdownApp
|
||||
)
|
||||
|
||||
import Control.Monad ( (>=>) )
|
||||
import Control.Concurrent
|
||||
@@ -79,8 +81,7 @@ update = do
|
||||
-> IO ThreadId
|
||||
start done = do
|
||||
(port, site, app) <- getApplicationRepl
|
||||
forkFinally
|
||||
(runSettings (setPort port defaultSettings) app)
|
||||
forkFinally (runSettings (setPort port defaultSettings) app)
|
||||
-- Note that this implies concurrency
|
||||
-- between shutdownApp and the next app that is starting.
|
||||
-- Normally this should be fine
|
||||
|
||||
@@ -4,7 +4,10 @@
|
||||
|
||||
module Database.Marketplace where
|
||||
|
||||
import Startlude hiding ((%), from, on)
|
||||
import Startlude hiding ( (%)
|
||||
, from
|
||||
, on
|
||||
)
|
||||
import Database.Esqueleto.Experimental
|
||||
import Lib.Types.Category
|
||||
import Model
|
||||
@@ -16,10 +19,12 @@ import Data.Aeson
|
||||
searchServices :: MonadIO m => Maybe CategoryTitle -> Int64 -> Int64 -> Text -> ReaderT SqlBackend m [P.Entity SApp]
|
||||
searchServices Nothing pageItems offset' query = select $ do
|
||||
service <- from $ table @SApp
|
||||
where_ ((service ^. SAppDescShort `ilike` (%) ++. val query ++. (%))
|
||||
where_
|
||||
( (service ^. SAppDescShort `ilike` (%) ++. val query ++. (%))
|
||||
||. (service ^. SAppDescLong `ilike` (%) ++. val query ++. (%))
|
||||
||. (service ^. SAppTitle `ilike` (%) ++. val query ++. (%))
|
||||
||. (service ^. SAppAppId `ilike` (%) ++. val query ++. (%)))
|
||||
||. (service ^. SAppAppId `ilike` (%) ++. val query ++. (%))
|
||||
)
|
||||
orderBy [desc (service ^. SAppUpdatedAt)]
|
||||
limit pageItems
|
||||
offset offset'
|
||||
@@ -28,13 +33,16 @@ searchServices (Just category) pageItems offset' query = select $ do
|
||||
services <- from
|
||||
(do
|
||||
(service :& sc) <-
|
||||
from $ table @SApp
|
||||
from
|
||||
$ table @SApp
|
||||
`innerJoin` table @ServiceCategory
|
||||
`on` (\(s :& sc) ->
|
||||
sc ^. ServiceCategoryServiceId ==. s ^. SAppId)
|
||||
`on` (\(s :& sc) -> sc ^. ServiceCategoryServiceId ==. s ^. SAppId)
|
||||
-- if there is a cateogry, only search in category
|
||||
-- weight title, short, long (bitcoin should equal Bitcoin Core)
|
||||
where_ $ sc ^. ServiceCategoryCategoryName ==. val category
|
||||
where_
|
||||
$ sc
|
||||
^. ServiceCategoryCategoryName
|
||||
==. val category
|
||||
&&. ( (service ^. SAppDescShort `ilike` (%) ++. val query ++. (%))
|
||||
||. (service ^. SAppDescLong `ilike` (%) ++. val query ++. (%))
|
||||
||. (service ^. SAppTitle `ilike` (%) ++. val query ++. (%))
|
||||
|
||||
@@ -10,7 +10,11 @@
|
||||
|
||||
|
||||
module Handler.Marketplace where
|
||||
import Startlude hiding (from, Handler, on, sortOn)
|
||||
import Startlude hiding ( from
|
||||
, Handler
|
||||
, on
|
||||
, sortOn
|
||||
)
|
||||
import Foundation
|
||||
import Yesod.Core
|
||||
import qualified Database.Persist as P
|
||||
@@ -82,20 +86,15 @@ data DependencyInfo = DependencyInfo
|
||||
, dependencyInfoIcon :: Text -- url
|
||||
} deriving (Eq, Show)
|
||||
instance ToJSON DependencyInfo where
|
||||
toJSON DependencyInfo {..} = object
|
||||
[ "icon" .= dependencyInfoIcon
|
||||
, "title" .= dependencyInfoTitle
|
||||
]
|
||||
toJSON DependencyInfo {..} = object ["icon" .= dependencyInfoIcon, "title" .= dependencyInfoTitle]
|
||||
|
||||
data ServiceListRes = ServiceListRes {
|
||||
serviceListResCategories :: [CategoryTitle]
|
||||
, serviceListResServices :: [ServiceAvailable]
|
||||
} deriving (Show)
|
||||
instance ToJSON ServiceListRes where
|
||||
toJSON ServiceListRes {..} = object
|
||||
[ "categories" .= serviceListResCategories
|
||||
, "services" .= serviceListResServices
|
||||
]
|
||||
toJSON ServiceListRes {..} =
|
||||
object ["categories" .= serviceListResCategories, "services" .= serviceListResServices]
|
||||
instance ToContent ServiceListRes where
|
||||
toContent = toContent . toJSON
|
||||
instance ToTypedContent ServiceListRes where
|
||||
@@ -152,11 +151,8 @@ data EosRes = EosRes
|
||||
, eosResReleaseNotes :: ReleaseNotes
|
||||
} deriving (Eq, Show, Generic)
|
||||
instance ToJSON EosRes where
|
||||
toJSON EosRes { .. } = object
|
||||
[ "version" .= eosResVersion
|
||||
, "headline" .= eosResHeadline
|
||||
, "release-notes" .= eosResReleaseNotes
|
||||
]
|
||||
toJSON EosRes {..} =
|
||||
object ["version" .= eosResVersion, "headline" .= eosResHeadline, "release-notes" .= eosResReleaseNotes]
|
||||
instance ToContent EosRes where
|
||||
toContent = toContent . toJSON
|
||||
instance ToTypedContent EosRes where
|
||||
@@ -188,9 +184,13 @@ getEosR = do
|
||||
pure vers
|
||||
let osV = entityVal <$> allEosVersions
|
||||
let latest = Data.List.head osV
|
||||
let mappedVersions = ReleaseNotes $ HM.fromList $ sortOn (Down . fst) $ (\v -> (osVersionNumber v, osVersionReleaseNotes v)) <$> osV
|
||||
pure $ EosRes
|
||||
{ eosResVersion = osVersionNumber latest
|
||||
let mappedVersions =
|
||||
ReleaseNotes
|
||||
$ HM.fromList
|
||||
$ sortOn (Down . fst)
|
||||
$ (\v -> (osVersionNumber v, osVersionReleaseNotes v))
|
||||
<$> osV
|
||||
pure $ EosRes { eosResVersion = osVersionNumber latest
|
||||
, eosResHeadline = osVersionHeadline latest
|
||||
, eosResReleaseNotes = mappedVersions
|
||||
}
|
||||
@@ -215,13 +215,23 @@ getVersionLatestR = do
|
||||
Right (p :: [AppIdentifier]) -> do
|
||||
let packageList :: [(AppIdentifier, Maybe Version)] = (, Nothing) <$> p
|
||||
found <- runDB $ traverse fetchLatestApp $ fst <$> packageList
|
||||
pure $ VersionLatestRes $ HM.union (HM.fromList $ (\v -> (sAppAppId $ entityVal $ fst v :: AppIdentifier, Just $ sVersionNumber $ entityVal $ snd v)) <$> catMaybes found) $ HM.fromList packageList
|
||||
pure
|
||||
$ VersionLatestRes
|
||||
$ HM.union
|
||||
( HM.fromList
|
||||
$ (\v ->
|
||||
( sAppAppId $ entityVal $ fst v :: AppIdentifier
|
||||
, Just $ sVersionNumber $ entityVal $ snd v
|
||||
)
|
||||
)
|
||||
<$> catMaybes found
|
||||
)
|
||||
$ HM.fromList packageList
|
||||
|
||||
getPackageListR :: Handler ServiceAvailableRes
|
||||
getPackageListR = do
|
||||
getParameters <- reqGetParams <$> getRequest
|
||||
let defaults = ServiceListDefaults
|
||||
{ serviceListOrder = DESC
|
||||
let defaults = ServiceListDefaults { serviceListOrder = DESC
|
||||
, serviceListPageLimit = 20
|
||||
, serviceListPageNumber = 1
|
||||
, serviceListCategory = Nothing
|
||||
@@ -274,9 +284,13 @@ getPackageListR = do
|
||||
let spec = packageVersionVersion pv
|
||||
let appExt = Extension (toS appId) :: Extension "s9pk"
|
||||
getBestVersion appsDir appExt spec >>= \case
|
||||
Nothing -> sendResponseStatus status404 ("best version could not be found for " <> appId <> " with spec " <> show spec :: Text)
|
||||
Nothing -> sendResponseStatus
|
||||
status404
|
||||
("best version could not be found for " <> appId <> " with spec " <> show spec :: Text)
|
||||
Just v -> do
|
||||
(service, version) <- runDB $ fetchLatestAppAtVersion appId v >>= errOnNothing status404 ("service at version " <> show v <> " not found")
|
||||
(service, version) <- runDB $ fetchLatestAppAtVersion appId v >>= errOnNothing
|
||||
status404
|
||||
("service at version " <> show v <> " not found")
|
||||
pure (Just version, service)
|
||||
|
||||
getServiceR :: Handler ServiceRes
|
||||
@@ -291,7 +305,9 @@ getServiceR = do
|
||||
Just v -> do
|
||||
case readMaybe v of
|
||||
Nothing -> sendResponseStatus status400 ("Invalid App Version Specification" :: Text)
|
||||
Just vv -> runDB $ fetchLatestAppAtVersion appId' vv >>= errOnNothing status404 ("service at version " <> show v <> " not found")
|
||||
Just vv -> runDB $ fetchLatestAppAtVersion appId' vv >>= errOnNothing
|
||||
status404
|
||||
("service at version " <> show v <> " not found")
|
||||
getServiceDetails (Just version) service
|
||||
|
||||
getServiceDetails :: Maybe (Entity SVersion) -> Entity SApp -> HandlerFor RegistryCtx ServiceRes
|
||||
@@ -316,8 +332,7 @@ getServiceDetails maybeVersion service = do
|
||||
sendResponseStatus status500 ("Internal Server Error" :: Text)
|
||||
Right a -> pure a
|
||||
d <- traverse (mapDependencyMetadata appsDir domain) (HM.toList $ serviceManifestDependencies manifest)
|
||||
pure $ ServiceRes
|
||||
{ serviceResIcon = [i|https://#{domain}/package/icon/#{appId}|]
|
||||
pure $ ServiceRes { serviceResIcon = [i|https://#{domain}/package/icon/#{appId}|]
|
||||
, serviceResManifest = decode $ BS.fromStrict manifest' -- pass through raw JSON Value
|
||||
, serviceResCategories = serviceCategoryCategoryName . entityVal <$> categories
|
||||
, serviceResInstructions = [i|https://#{domain}/package/instructions/#{appId}|]
|
||||
@@ -327,17 +342,23 @@ getServiceDetails maybeVersion service = do
|
||||
}
|
||||
|
||||
type URL = Text
|
||||
mapDependencyMetadata :: (MonadIO m, MonadHandler m) => FilePath -> Text -> (AppIdentifier, ServiceDependencyInfo) -> m (AppIdentifier, DependencyInfo)
|
||||
mapDependencyMetadata :: (MonadIO m, MonadHandler m)
|
||||
=> FilePath
|
||||
-> Text
|
||||
-> (AppIdentifier, ServiceDependencyInfo)
|
||||
-> m (AppIdentifier, DependencyInfo)
|
||||
mapDependencyMetadata appsDir domain (appId, depInfo) = do
|
||||
let ext = (Extension (toS appId) :: Extension "s9pk")
|
||||
-- get best version from VersionRange of dependency
|
||||
version <- getBestVersion appsDir ext (serviceDependencyInfoVersion depInfo) >>= \case
|
||||
Nothing -> sendResponseStatus status404 ("best version not found for dependent package " <> appId :: Text)
|
||||
Just v -> pure v
|
||||
pure (appId, DependencyInfo
|
||||
{ dependencyInfoTitle = appId
|
||||
pure
|
||||
( appId
|
||||
, DependencyInfo { dependencyInfoTitle = appId
|
||||
, dependencyInfoIcon = [i|https://#{domain}/package/icon/#{appId}?spec==#{version}|]
|
||||
})
|
||||
}
|
||||
)
|
||||
|
||||
decodeIcon :: (MonadHandler m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> m URL
|
||||
decodeIcon appmgrPath depPath e@(Extension icon) = do
|
||||
@@ -377,32 +398,34 @@ fetchMostRecentAppVersions appId = select $ do
|
||||
fetchLatestApp :: MonadIO m => Text -> ReaderT SqlBackend m (Maybe (P.Entity SApp, P.Entity SVersion))
|
||||
fetchLatestApp appId = selectOne $ do
|
||||
(service :& version) <-
|
||||
from $ table @SApp
|
||||
from
|
||||
$ table @SApp
|
||||
`innerJoin` table @SVersion
|
||||
`on` (\(service :& version) ->
|
||||
service ^. SAppId ==. version ^. SVersionAppId)
|
||||
`on` (\(service :& version) -> service ^. SAppId ==. version ^. SVersionAppId)
|
||||
where_ (service ^. SAppAppId ==. val appId)
|
||||
orderBy [desc (version ^. SVersionNumber)]
|
||||
pure (service, version)
|
||||
|
||||
fetchLatestAppAtVersion :: MonadIO m => Text -> Version -> ReaderT SqlBackend m (Maybe (P.Entity SApp, P.Entity SVersion))
|
||||
fetchLatestAppAtVersion :: MonadIO m
|
||||
=> Text
|
||||
-> Version
|
||||
-> ReaderT SqlBackend m (Maybe (P.Entity SApp, P.Entity SVersion))
|
||||
fetchLatestAppAtVersion appId version' = selectOne $ do
|
||||
(service :& version) <-
|
||||
from $ table @SApp
|
||||
from
|
||||
$ table @SApp
|
||||
`innerJoin` table @SVersion
|
||||
`on` (\(service :& version) ->
|
||||
service ^. SAppId ==. version ^. SVersionAppId)
|
||||
where_ $ (service ^. SAppAppId ==. val appId)
|
||||
&&. (version ^. SVersionNumber ==. val version')
|
||||
`on` (\(service :& version) -> service ^. SAppId ==. version ^. SVersionAppId)
|
||||
where_ $ (service ^. SAppAppId ==. val appId) &&. (version ^. SVersionNumber ==. val version')
|
||||
pure (service, version)
|
||||
|
||||
fetchAppCategories :: MonadIO m => Key SApp -> ReaderT SqlBackend m [P.Entity ServiceCategory]
|
||||
fetchAppCategories appId = select $ do
|
||||
(categories :& service) <-
|
||||
from $ table @ServiceCategory
|
||||
from
|
||||
$ table @ServiceCategory
|
||||
`innerJoin` table @SApp
|
||||
`on` (\(sc :& s) ->
|
||||
sc ^. ServiceCategoryServiceId ==. s ^. SAppId)
|
||||
`on` (\(sc :& s) -> sc ^. ServiceCategoryServiceId ==. s ^. SAppId)
|
||||
where_ (service ^. SAppId ==. val appId)
|
||||
pure categories
|
||||
|
||||
@@ -412,8 +435,7 @@ mapEntityToStoreApp serviceEntity = do
|
||||
entityVersion <- fetchMostRecentAppVersions $ entityKey serviceEntity
|
||||
let vers = entityVal <$> entityVersion
|
||||
let vv = mapSVersionToVersionInfo vers
|
||||
pure $ StoreApp {
|
||||
storeAppTitle = sAppTitle service
|
||||
pure $ StoreApp { storeAppTitle = sAppTitle service
|
||||
, storeAppDescShort = sAppDescShort service
|
||||
, storeAppDescLong = sAppDescLong service
|
||||
, storeAppVersionInfo = NE.fromList vv
|
||||
@@ -421,13 +443,15 @@ mapEntityToStoreApp serviceEntity = do
|
||||
, storeAppTimestamp = Just (sAppCreatedAt service) -- case on if updatedAt? or always use updated time? was file timestamp
|
||||
}
|
||||
|
||||
mapEntityToServiceAvailable :: (MonadIO m, MonadHandler m) => Text -> Entity SApp -> ReaderT SqlBackend m ServiceAvailable
|
||||
mapEntityToServiceAvailable :: (MonadIO m, MonadHandler m)
|
||||
=> Text
|
||||
-> Entity SApp
|
||||
-> ReaderT SqlBackend m ServiceAvailable
|
||||
mapEntityToServiceAvailable domain service = do
|
||||
let appId = sAppAppId $ entityVal service
|
||||
(_, v) <- fetchLatestApp appId >>= errOnNothing status404 "service not found"
|
||||
let appVersion = sVersionNumber (entityVal v)
|
||||
pure $ ServiceAvailable
|
||||
{ serviceAvailableId = appId
|
||||
pure $ ServiceAvailable { serviceAvailableId = appId
|
||||
, serviceAvailableTitle = sAppTitle $ entityVal service
|
||||
, serviceAvailableDescShort = sAppDescShort $ entityVal service
|
||||
, serviceAvailableVersion = appVersion
|
||||
|
||||
4
src/Lib/External/AppMgr.hs
vendored
4
src/Lib/External/AppMgr.hs
vendored
@@ -44,7 +44,9 @@ readProcessInheritStderr a b c = liftIO $ do
|
||||
|
||||
getConfig :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m Text
|
||||
getConfig appmgrPath appPath e@(Extension appId) = fmap decodeUtf8 $ do
|
||||
(ec, out) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "config", appPath <> show e, "--json"] ""
|
||||
(ec, out) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk")
|
||||
["inspect", "config", appPath <> show e, "--json"]
|
||||
""
|
||||
case ec of
|
||||
ExitSuccess -> pure out
|
||||
ExitFailure n -> throwE $ AppMgrE [i|info config #{appId} \--json|] n
|
||||
|
||||
@@ -37,14 +37,15 @@ data VersionInfo = VersionInfo
|
||||
|
||||
mapSVersionToVersionInfo :: [SVersion] -> [VersionInfo]
|
||||
mapSVersionToVersionInfo sv = do
|
||||
(\v -> VersionInfo {
|
||||
versionInfoVersion = sVersionNumber v
|
||||
(\v -> VersionInfo { versionInfoVersion = sVersionNumber v
|
||||
, versionInfoReleaseNotes = sVersionReleaseNotes v
|
||||
, versionInfoDependencies = HM.empty
|
||||
, versionInfoOsRequired = sVersionOsVersionRequired v
|
||||
, versionInfoOsRecommended = sVersionOsVersionRecommended v
|
||||
, versionInfoInstallAlert = Nothing
|
||||
}) <$> sv
|
||||
}
|
||||
)
|
||||
<$> sv
|
||||
|
||||
instance Ord VersionInfo where
|
||||
compare = compare `on` versionInfoVersion
|
||||
|
||||
@@ -13,8 +13,8 @@ preimage f target = filter ((== target) . f)
|
||||
|
||||
mapFind :: ([a] -> Maybe a) -> (b -> a) -> [b] -> Maybe b
|
||||
mapFind _ _ [] = Nothing
|
||||
mapFind finder mapping (b:bs) = let
|
||||
mB = mapFind finder mapping bs
|
||||
mapFind finder mapping (b : bs) =
|
||||
let mB = mapFind finder mapping bs
|
||||
mA = finder [mapping b]
|
||||
in case (mB, mA) of
|
||||
(Just b', _ ) -> Just b'
|
||||
|
||||
@@ -23,7 +23,11 @@ getVersionFromQuery rootDir ext = do
|
||||
Just t -> pure t
|
||||
getBestVersion rootDir ext spec
|
||||
|
||||
getBestVersion :: (MonadIO m, KnownSymbol a, MonadLogger m) => FilePath -> Extension a -> VersionRange -> m (Maybe Version)
|
||||
getBestVersion :: (MonadIO m, KnownSymbol a, MonadLogger m)
|
||||
=> FilePath
|
||||
-> Extension a
|
||||
-> VersionRange
|
||||
-> m (Maybe Version)
|
||||
getBestVersion rootDir ext spec = do
|
||||
-- @TODO change to db query?
|
||||
appVersions <- liftIO $ getAvailableAppVersions rootDir ext
|
||||
|
||||
@@ -1,6 +1,9 @@
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Handler.AppSpec (spec) where
|
||||
module Handler.AppSpec
|
||||
( spec
|
||||
)
|
||||
where
|
||||
|
||||
import Startlude
|
||||
import Database.Persist.Sql
|
||||
@@ -11,28 +14,27 @@ import Model
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "GET /apps" $
|
||||
withApp $ it "returns list of apps" $ do
|
||||
describe "GET /apps" $ withApp $ it "returns list of apps" $ do
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/apps" :: Text)
|
||||
bodyContains "bitcoind"
|
||||
bodyContains "version: 0.18.1"
|
||||
statusIs 200
|
||||
describe "GET /apps/:appId with unknown version spec for bitcoin" $
|
||||
withApp $ it "fails to get unknown app" $ do
|
||||
describe "GET /apps/:appId with unknown version spec for bitcoin" $ withApp $ it "fails to get unknown app" $ do
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/apps/bitcoind.s9pk?spec=0.18.3" :: Text)
|
||||
statusIs 404
|
||||
describe "GET /apps/:appId with unknown app" $
|
||||
withApp $ it "fails to get an unregistered app" $ do
|
||||
describe "GET /apps/:appId with unknown app" $ withApp $ it "fails to get an unregistered app" $ do
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/apps/tempapp.s9pk?spec=0.0.1" :: Text)
|
||||
statusIs 404
|
||||
describe "GET /apps/:appId with existing version spec for bitcoin" $
|
||||
withApp $ it "creates app and metric records" $ do
|
||||
describe "GET /apps/:appId with existing version spec for bitcoin"
|
||||
$ withApp
|
||||
$ it "creates app and metric records"
|
||||
$ do
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/apps/bitcoind.s9pk?spec==0.18.1" :: Text)
|
||||
@@ -42,8 +44,7 @@ spec = do
|
||||
let app = fromJust $ head apps
|
||||
metrics <- runDBtest $ selectList [MetricAppId ==. entityKey app] []
|
||||
assertEq "metric should exist" (length metrics) 1
|
||||
describe "GET /apps/:appId with existing version spec for cups" $
|
||||
withApp $ it "creates app and metric records" $ do
|
||||
describe "GET /apps/:appId with existing version spec for cups" $ withApp $ it "creates app and metric records" $ do
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/apps/cups.s9pk?spec=0.2.1" :: Text)
|
||||
@@ -55,8 +56,7 @@ spec = do
|
||||
assertEq "metric should exist" (length metrics) 1
|
||||
version <- runDBtest $ selectList [SVersionAppId ==. entityKey app] []
|
||||
assertEq "version should exist" (length version) 1
|
||||
describe "GET /sys/proxy.pac" $
|
||||
withApp $ it "does not record metric but request successful" $ do
|
||||
describe "GET /sys/proxy.pac" $ withApp $ it "does not record metric but request successful" $ do
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/sys/proxy.pac?spec=0.1.0" :: Text)
|
||||
@@ -64,8 +64,7 @@ spec = do
|
||||
-- select * from s_app
|
||||
apps <- runDBtest $ selectList ([] :: [Filter SApp]) []
|
||||
assertEq "no apps should exist" (length apps) 0
|
||||
describe "GET /sys/:sysId" $
|
||||
withApp $ it "does not record metric but request successful" $ do
|
||||
describe "GET /sys/:sysId" $ withApp $ it "does not record metric but request successful" $ do
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/sys/agent?spec=0.0.0" :: Text)
|
||||
@@ -73,10 +72,10 @@ spec = do
|
||||
apps <- runDBtest $ selectList ([] :: [Filter SApp]) []
|
||||
assertEq "no apps should exist" (length apps) 0
|
||||
-- @TODO uncomment when new portable appmgr live
|
||||
xdescribe "GET /apps/manifest/#S9PK" $
|
||||
withApp $ it "gets bitcoin manifest" $ do
|
||||
xdescribe "GET /apps/manifest/#S9PK" $ withApp $ it "gets bitcoin manifest" $ do
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/apps/manifest/bitcoind?spec==0.20.1" :: Text)
|
||||
statusIs 200
|
||||
bodyContains "{\"id\":\"bitcoind\",\"version\":\"0.20.1\",\"title\":\"Bitcoin Core\",\"description\":{\"short\":\"Bitcoin Full Node by Bitcoin Core\",\"long\":\"Bitcoin is an innovative payment network and a new kind of money. Bitcoin uses peer-to-peer technology to operate with no central authority or banks; managing transactions and the issuing of bitcoins is carried out collectively by the network. Bitcoin is open-source; its design is public, nobody owns or controls Bitcoin and everyone can take part. Through many of its unique properties, Bitcoin allows exciting uses that could not be covered by any previous payment system.\"},\"release-notes\":\"https://github.com/bitcoin/bitcoin/blob/master/doc/release-notes/release-notes-0.20.1.md\",\"has-instructions\":true,\"os-version-required\":\">=0.2.4\",\"os-version-recommended\":\">=0.2.4\",\"ports\":[{\"internal\":8332,\"tor\":8332},{\"internal\":8333,\"tor\":8333}],\"image\":{\"type\":\"tar\"},\"mount\":\"/root/.bitcoin\",\"assets\":[{\"src\":\"bitcoin.conf.template\",\"dst\":\".\",\"overwrite\":true}],\"hidden-service-version\":\"v2\",\"dependencies\":{}}"
|
||||
bodyContains
|
||||
"{\"id\":\"bitcoind\",\"version\":\"0.20.1\",\"title\":\"Bitcoin Core\",\"description\":{\"short\":\"Bitcoin Full Node by Bitcoin Core\",\"long\":\"Bitcoin is an innovative payment network and a new kind of money. Bitcoin uses peer-to-peer technology to operate with no central authority or banks; managing transactions and the issuing of bitcoins is carried out collectively by the network. Bitcoin is open-source; its design is public, nobody owns or controls Bitcoin and everyone can take part. Through many of its unique properties, Bitcoin allows exciting uses that could not be covered by any previous payment system.\"},\"release-notes\":\"https://github.com/bitcoin/bitcoin/blob/master/doc/release-notes/release-notes-0.20.1.md\",\"has-instructions\":true,\"os-version-required\":\">=0.2.4\",\"os-version-recommended\":\">=0.2.4\",\"ports\":[{\"internal\":8332,\"tor\":8332},{\"internal\":8333,\"tor\":8333}],\"image\":{\"type\":\"tar\"},\"mount\":\"/root/.bitcoin\",\"assets\":[{\"src\":\"bitcoin.conf.template\",\"dst\":\".\",\"overwrite\":true}],\"hidden-service-version\":\"v2\",\"dependencies\":{}}"
|
||||
|
||||
@@ -1,6 +1,9 @@
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Handler.MarketplaceSpec (spec) where
|
||||
module Handler.MarketplaceSpec
|
||||
( spec
|
||||
)
|
||||
where
|
||||
|
||||
import Startlude hiding ( Any )
|
||||
import Database.Persist.Sql
|
||||
@@ -14,11 +17,22 @@ import Lib.Types.Emver
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "searchServices with category" $
|
||||
withApp $ it "should filter services with featured category" $ do
|
||||
describe "searchServices with category" $ withApp $ it "should filter services with featured category" $ do
|
||||
time <- liftIO getCurrentTime
|
||||
btc <- runDBtest $ insert $ SApp time (Just time) "Bitcoin Core" "bitcoind" "short desc bitcoin" "long desc bitcoin" "png"
|
||||
lnd <- runDBtest $ insert $ SApp time (Just time) "Lightning Network Daemon" "lnd" "short desc lnd" "long desc lnd" "png"
|
||||
btc <- runDBtest $ insert $ SApp time
|
||||
(Just time)
|
||||
"Bitcoin Core"
|
||||
"bitcoind"
|
||||
"short desc bitcoin"
|
||||
"long desc bitcoin"
|
||||
"png"
|
||||
lnd <- runDBtest $ insert $ SApp time
|
||||
(Just time)
|
||||
"Lightning Network Daemon"
|
||||
"lnd"
|
||||
"short desc lnd"
|
||||
"long desc lnd"
|
||||
"png"
|
||||
featuredCat <- runDBtest $ insert $ Category time FEATURED Nothing "desc"
|
||||
btcCat <- runDBtest $ insert $ Category time BITCOIN Nothing "desc"
|
||||
lnCat <- runDBtest $ insert $ Category time LIGHTNING Nothing "desc"
|
||||
@@ -30,11 +44,22 @@ spec = do
|
||||
assertEq "should exist" (length apps) 1
|
||||
let app' = fromJust $ head apps
|
||||
assertEq "should be bitcoin" (sAppTitle $ entityVal app') "Bitcoin Core"
|
||||
describe "searchServices with category" $
|
||||
withApp $ it "should filter services with bitcoin category" $ do
|
||||
describe "searchServices with category" $ withApp $ it "should filter services with bitcoin category" $ do
|
||||
time <- liftIO getCurrentTime
|
||||
btc <- runDBtest $ insert $ SApp time (Just time) "Bitcoin Core" "bitcoind" "short desc bitcoin" "long desc bitcoin" "png"
|
||||
lnd <- runDBtest $ insert $ SApp time (Just time) "Lightning Network Daemon" "lnd" "short desc lnd" "long desc lnd" "png"
|
||||
btc <- runDBtest $ insert $ SApp time
|
||||
(Just time)
|
||||
"Bitcoin Core"
|
||||
"bitcoind"
|
||||
"short desc bitcoin"
|
||||
"long desc bitcoin"
|
||||
"png"
|
||||
lnd <- runDBtest $ insert $ SApp time
|
||||
(Just time)
|
||||
"Lightning Network Daemon"
|
||||
"lnd"
|
||||
"short desc lnd"
|
||||
"long desc lnd"
|
||||
"png"
|
||||
featuredCat <- runDBtest $ insert $ Category time FEATURED Nothing "desc"
|
||||
btcCat <- runDBtest $ insert $ Category time BITCOIN Nothing "desc"
|
||||
lnCat <- runDBtest $ insert $ Category time LIGHTNING Nothing "desc"
|
||||
@@ -44,11 +69,25 @@ spec = do
|
||||
_ <- runDBtest $ insert_ $ ServiceCategory time btc btcCat "bitcon" BITCOIN Nothing
|
||||
apps <- runDBtest $ searchServices BITCOIN 20 0 ""
|
||||
assertEq "should exist" (length apps) 2
|
||||
describe "searchServices with fuzzy query" $
|
||||
withApp $ it "runs search service with fuzzy text in long description" $ do
|
||||
describe "searchServices with fuzzy query"
|
||||
$ withApp
|
||||
$ it "runs search service with fuzzy text in long description"
|
||||
$ do
|
||||
time <- liftIO getCurrentTime
|
||||
app1 <- runDBtest $ insert $ SApp time (Just time) "Bitcoin Core" "bitcoind" "short desc" "long desc" "png"
|
||||
app2 <- runDBtest $ insert $ SApp time (Just time) "Lightning Network Daemon" "lnd" "short desc" "lightning long desc" "png"
|
||||
app1 <- runDBtest $ insert $ SApp time
|
||||
(Just time)
|
||||
"Bitcoin Core"
|
||||
"bitcoind"
|
||||
"short desc"
|
||||
"long desc"
|
||||
"png"
|
||||
app2 <- runDBtest $ insert $ SApp time
|
||||
(Just time)
|
||||
"Lightning Network Daemon"
|
||||
"lnd"
|
||||
"short desc"
|
||||
"lightning long desc"
|
||||
"png"
|
||||
cate <- runDBtest $ insert $ Category time FEATURED Nothing "desc"
|
||||
_ <- runDBtest $ insert_ $ ServiceCategory time app1 cate "bitcoind" FEATURED Nothing
|
||||
_ <- runDBtest $ insert_ $ ServiceCategory time app2 cate "lnd" FEATURED Nothing
|
||||
@@ -56,13 +95,24 @@ spec = do
|
||||
assertEq "should exist" (length apps) 1
|
||||
let app' = fromJust $ head apps
|
||||
print app'
|
||||
describe "searchServices with any category" $
|
||||
withApp $ it "runs search service for any category" $ do
|
||||
describe "searchServices with any category" $ withApp $ it "runs search service for any category" $ do
|
||||
time <- liftIO getCurrentTime
|
||||
btc <- runDBtest $ insert $ SApp time (Just time) "Bitcoin Core" "bitcoind" "short desc bitcoin" "long desc bitcoin" "png"
|
||||
btc <- runDBtest $ insert $ SApp time
|
||||
(Just time)
|
||||
"Bitcoin Core"
|
||||
"bitcoind"
|
||||
"short desc bitcoin"
|
||||
"long desc bitcoin"
|
||||
"png"
|
||||
_ <- runDBtest $ insert $ SVersion time (Just time) btc "0.19.0" "notes" Any Any
|
||||
_ <- runDBtest $ insert $ SVersion time (Just time) btc "0.20.0" "notes" Any Any
|
||||
lnd <- runDBtest $ insert $ SApp time (Just time) "Lightning Network Daemon" "lnd" "short desc lnd" "long desc lnd" "png"
|
||||
lnd <- runDBtest $ insert $ SApp time
|
||||
(Just time)
|
||||
"Lightning Network Daemon"
|
||||
"lnd"
|
||||
"short desc lnd"
|
||||
"long desc lnd"
|
||||
"png"
|
||||
_ <- runDBtest $ insert $ SVersion time (Just time) lnd "0.18.0" "notes" Any Any
|
||||
_ <- runDBtest $ insert $ SVersion time (Just time) lnd "0.17.0" "notes" Any Any
|
||||
featuredCat <- runDBtest $ insert $ Category time FEATURED Nothing "desc"
|
||||
|
||||
Reference in New Issue
Block a user