format all the things

This commit is contained in:
Lucy Cifferello
2021-09-23 19:18:25 -06:00
committed by Keagan McClelland
parent ac5acaa685
commit e2d2fb6afc
24 changed files with 604 additions and 515 deletions

View File

@@ -1,7 +1,9 @@
module DevelMain where module DevelMain where
import Prelude import Prelude
import Application (getApplicationRepl, shutdownApp) import Application ( getApplicationRepl
, shutdownApp
)
import Control.Monad ( (>=>) ) import Control.Monad ( (>=>) )
import Control.Concurrent import Control.Concurrent
@@ -79,8 +81,7 @@ update = do
-> IO ThreadId -> IO ThreadId
start done = do start done = do
(port, site, app) <- getApplicationRepl (port, site, app) <- getApplicationRepl
forkFinally forkFinally (runSettings (setPort port defaultSettings) app)
(runSettings (setPort port defaultSettings) app)
-- Note that this implies concurrency -- Note that this implies concurrency
-- between shutdownApp and the next app that is starting. -- between shutdownApp and the next app that is starting.
-- Normally this should be fine -- Normally this should be fine

View File

@@ -4,7 +4,10 @@
module Database.Marketplace where module Database.Marketplace where
import Startlude hiding ((%), from, on) import Startlude hiding ( (%)
, from
, on
)
import Database.Esqueleto.Experimental import Database.Esqueleto.Experimental
import Lib.Types.Category import Lib.Types.Category
import Model import Model
@@ -16,10 +19,12 @@ import Data.Aeson
searchServices :: MonadIO m => Maybe CategoryTitle -> Int64 -> Int64 -> Text -> ReaderT SqlBackend m [P.Entity SApp] searchServices :: MonadIO m => Maybe CategoryTitle -> Int64 -> Int64 -> Text -> ReaderT SqlBackend m [P.Entity SApp]
searchServices Nothing pageItems offset' query = select $ do searchServices Nothing pageItems offset' query = select $ do
service <- from $ table @SApp service <- from $ table @SApp
where_ ((service ^. SAppDescShort `ilike` (%) ++. val query ++. (%)) where_
( (service ^. SAppDescShort `ilike` (%) ++. val query ++. (%))
||. (service ^. SAppDescLong `ilike` (%) ++. val query ++. (%)) ||. (service ^. SAppDescLong `ilike` (%) ++. val query ++. (%))
||. (service ^. SAppTitle `ilike` (%) ++. val query ++. (%)) ||. (service ^. SAppTitle `ilike` (%) ++. val query ++. (%))
||. (service ^. SAppAppId `ilike` (%) ++. val query ++. (%))) ||. (service ^. SAppAppId `ilike` (%) ++. val query ++. (%))
)
orderBy [desc (service ^. SAppUpdatedAt)] orderBy [desc (service ^. SAppUpdatedAt)]
limit pageItems limit pageItems
offset offset' offset offset'
@@ -28,13 +33,16 @@ searchServices (Just category) pageItems offset' query = select $ do
services <- from services <- from
(do (do
(service :& sc) <- (service :& sc) <-
from $ table @SApp from
$ table @SApp
`innerJoin` table @ServiceCategory `innerJoin` table @ServiceCategory
`on` (\(s :& sc) -> `on` (\(s :& sc) -> sc ^. ServiceCategoryServiceId ==. s ^. SAppId)
sc ^. ServiceCategoryServiceId ==. s ^. SAppId)
-- if there is a cateogry, only search in category -- if there is a cateogry, only search in category
-- weight title, short, long (bitcoin should equal Bitcoin Core) -- 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 ^. SAppDescShort `ilike` (%) ++. val query ++. (%))
||. (service ^. SAppDescLong `ilike` (%) ++. val query ++. (%)) ||. (service ^. SAppDescLong `ilike` (%) ++. val query ++. (%))
||. (service ^. SAppTitle `ilike` (%) ++. val query ++. (%)) ||. (service ^. SAppTitle `ilike` (%) ++. val query ++. (%))

View File

@@ -10,7 +10,11 @@
module Handler.Marketplace where module Handler.Marketplace where
import Startlude hiding (from, Handler, on, sortOn) import Startlude hiding ( from
, Handler
, on
, sortOn
)
import Foundation import Foundation
import Yesod.Core import Yesod.Core
import qualified Database.Persist as P import qualified Database.Persist as P
@@ -82,20 +86,15 @@ data DependencyInfo = DependencyInfo
, dependencyInfoIcon :: Text -- url , dependencyInfoIcon :: Text -- url
} deriving (Eq, Show) } deriving (Eq, Show)
instance ToJSON DependencyInfo where instance ToJSON DependencyInfo where
toJSON DependencyInfo {..} = object toJSON DependencyInfo {..} = object ["icon" .= dependencyInfoIcon, "title" .= dependencyInfoTitle]
[ "icon" .= dependencyInfoIcon
, "title" .= dependencyInfoTitle
]
data ServiceListRes = ServiceListRes { data ServiceListRes = ServiceListRes {
serviceListResCategories :: [CategoryTitle] serviceListResCategories :: [CategoryTitle]
, serviceListResServices :: [ServiceAvailable] , serviceListResServices :: [ServiceAvailable]
} deriving (Show) } deriving (Show)
instance ToJSON ServiceListRes where instance ToJSON ServiceListRes where
toJSON ServiceListRes {..} = object toJSON ServiceListRes {..} =
[ "categories" .= serviceListResCategories object ["categories" .= serviceListResCategories, "services" .= serviceListResServices]
, "services" .= serviceListResServices
]
instance ToContent ServiceListRes where instance ToContent ServiceListRes where
toContent = toContent . toJSON toContent = toContent . toJSON
instance ToTypedContent ServiceListRes where instance ToTypedContent ServiceListRes where
@@ -152,11 +151,8 @@ data EosRes = EosRes
, eosResReleaseNotes :: ReleaseNotes , eosResReleaseNotes :: ReleaseNotes
} deriving (Eq, Show, Generic) } deriving (Eq, Show, Generic)
instance ToJSON EosRes where instance ToJSON EosRes where
toJSON EosRes { .. } = object toJSON EosRes {..} =
[ "version" .= eosResVersion object ["version" .= eosResVersion, "headline" .= eosResHeadline, "release-notes" .= eosResReleaseNotes]
, "headline" .= eosResHeadline
, "release-notes" .= eosResReleaseNotes
]
instance ToContent EosRes where instance ToContent EosRes where
toContent = toContent . toJSON toContent = toContent . toJSON
instance ToTypedContent EosRes where instance ToTypedContent EosRes where
@@ -188,9 +184,13 @@ getEosR = do
pure vers pure vers
let osV = entityVal <$> allEosVersions let osV = entityVal <$> allEosVersions
let latest = Data.List.head osV let latest = Data.List.head osV
let mappedVersions = ReleaseNotes $ HM.fromList $ sortOn (Down . fst) $ (\v -> (osVersionNumber v, osVersionReleaseNotes v)) <$> osV let mappedVersions =
pure $ EosRes ReleaseNotes
{ eosResVersion = osVersionNumber latest $ HM.fromList
$ sortOn (Down . fst)
$ (\v -> (osVersionNumber v, osVersionReleaseNotes v))
<$> osV
pure $ EosRes { eosResVersion = osVersionNumber latest
, eosResHeadline = osVersionHeadline latest , eosResHeadline = osVersionHeadline latest
, eosResReleaseNotes = mappedVersions , eosResReleaseNotes = mappedVersions
} }
@@ -215,13 +215,23 @@ getVersionLatestR = do
Right (p :: [AppIdentifier]) -> do Right (p :: [AppIdentifier]) -> do
let packageList :: [(AppIdentifier, Maybe Version)] = (, Nothing) <$> p let packageList :: [(AppIdentifier, Maybe Version)] = (, Nothing) <$> p
found <- runDB $ traverse fetchLatestApp $ fst <$> packageList 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 :: Handler ServiceAvailableRes
getPackageListR = do getPackageListR = do
getParameters <- reqGetParams <$> getRequest getParameters <- reqGetParams <$> getRequest
let defaults = ServiceListDefaults let defaults = ServiceListDefaults { serviceListOrder = DESC
{ serviceListOrder = DESC
, serviceListPageLimit = 20 , serviceListPageLimit = 20
, serviceListPageNumber = 1 , serviceListPageNumber = 1
, serviceListCategory = Nothing , serviceListCategory = Nothing
@@ -274,9 +284,13 @@ getPackageListR = do
let spec = packageVersionVersion pv let spec = packageVersionVersion pv
let appExt = Extension (toS appId) :: Extension "s9pk" let appExt = Extension (toS appId) :: Extension "s9pk"
getBestVersion appsDir appExt spec >>= \case 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 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) pure (Just version, service)
getServiceR :: Handler ServiceRes getServiceR :: Handler ServiceRes
@@ -291,7 +305,9 @@ getServiceR = do
Just v -> do Just v -> do
case readMaybe v of case readMaybe v of
Nothing -> sendResponseStatus status400 ("Invalid App Version Specification" :: Text) 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 (Just version) service
getServiceDetails :: Maybe (Entity SVersion) -> Entity SApp -> HandlerFor RegistryCtx ServiceRes getServiceDetails :: Maybe (Entity SVersion) -> Entity SApp -> HandlerFor RegistryCtx ServiceRes
@@ -316,8 +332,7 @@ getServiceDetails maybeVersion service = do
sendResponseStatus status500 ("Internal Server Error" :: Text) sendResponseStatus status500 ("Internal Server Error" :: Text)
Right a -> pure a Right a -> pure a
d <- traverse (mapDependencyMetadata appsDir domain) (HM.toList $ serviceManifestDependencies manifest) d <- traverse (mapDependencyMetadata appsDir domain) (HM.toList $ serviceManifestDependencies manifest)
pure $ ServiceRes pure $ ServiceRes { serviceResIcon = [i|https://#{domain}/package/icon/#{appId}|]
{ serviceResIcon = [i|https://#{domain}/package/icon/#{appId}|]
, serviceResManifest = decode $ BS.fromStrict manifest' -- pass through raw JSON Value , serviceResManifest = decode $ BS.fromStrict manifest' -- pass through raw JSON Value
, serviceResCategories = serviceCategoryCategoryName . entityVal <$> categories , serviceResCategories = serviceCategoryCategoryName . entityVal <$> categories
, serviceResInstructions = [i|https://#{domain}/package/instructions/#{appId}|] , serviceResInstructions = [i|https://#{domain}/package/instructions/#{appId}|]
@@ -327,17 +342,23 @@ getServiceDetails maybeVersion service = do
} }
type URL = Text 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 mapDependencyMetadata appsDir domain (appId, depInfo) = do
let ext = (Extension (toS appId) :: Extension "s9pk") let ext = (Extension (toS appId) :: Extension "s9pk")
-- get best version from VersionRange of dependency -- get best version from VersionRange of dependency
version <- getBestVersion appsDir ext (serviceDependencyInfoVersion depInfo) >>= \case version <- getBestVersion appsDir ext (serviceDependencyInfoVersion depInfo) >>= \case
Nothing -> sendResponseStatus status404 ("best version not found for dependent package " <> appId :: Text) Nothing -> sendResponseStatus status404 ("best version not found for dependent package " <> appId :: Text)
Just v -> pure v Just v -> pure v
pure (appId, DependencyInfo pure
{ dependencyInfoTitle = appId ( appId
, DependencyInfo { dependencyInfoTitle = appId
, dependencyInfoIcon = [i|https://#{domain}/package/icon/#{appId}?spec==#{version}|] , dependencyInfoIcon = [i|https://#{domain}/package/icon/#{appId}?spec==#{version}|]
}) }
)
decodeIcon :: (MonadHandler m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> m URL decodeIcon :: (MonadHandler m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> m URL
decodeIcon appmgrPath depPath e@(Extension icon) = do 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 :: MonadIO m => Text -> ReaderT SqlBackend m (Maybe (P.Entity SApp, P.Entity SVersion))
fetchLatestApp appId = selectOne $ do fetchLatestApp appId = selectOne $ do
(service :& version) <- (service :& version) <-
from $ table @SApp from
$ table @SApp
`innerJoin` table @SVersion `innerJoin` table @SVersion
`on` (\(service :& version) -> `on` (\(service :& version) -> service ^. SAppId ==. version ^. SVersionAppId)
service ^. SAppId ==. version ^. SVersionAppId)
where_ (service ^. SAppAppId ==. val appId) where_ (service ^. SAppAppId ==. val appId)
orderBy [desc (version ^. SVersionNumber)] orderBy [desc (version ^. SVersionNumber)]
pure (service, version) 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 fetchLatestAppAtVersion appId version' = selectOne $ do
(service :& version) <- (service :& version) <-
from $ table @SApp from
$ table @SApp
`innerJoin` table @SVersion `innerJoin` table @SVersion
`on` (\(service :& version) -> `on` (\(service :& version) -> service ^. SAppId ==. version ^. SVersionAppId)
service ^. SAppId ==. version ^. SVersionAppId) where_ $ (service ^. SAppAppId ==. val appId) &&. (version ^. SVersionNumber ==. val version')
where_ $ (service ^. SAppAppId ==. val appId)
&&. (version ^. SVersionNumber ==. val version')
pure (service, version) pure (service, version)
fetchAppCategories :: MonadIO m => Key SApp -> ReaderT SqlBackend m [P.Entity ServiceCategory] fetchAppCategories :: MonadIO m => Key SApp -> ReaderT SqlBackend m [P.Entity ServiceCategory]
fetchAppCategories appId = select $ do fetchAppCategories appId = select $ do
(categories :& service) <- (categories :& service) <-
from $ table @ServiceCategory from
$ table @ServiceCategory
`innerJoin` table @SApp `innerJoin` table @SApp
`on` (\(sc :& s) -> `on` (\(sc :& s) -> sc ^. ServiceCategoryServiceId ==. s ^. SAppId)
sc ^. ServiceCategoryServiceId ==. s ^. SAppId)
where_ (service ^. SAppId ==. val appId) where_ (service ^. SAppId ==. val appId)
pure categories pure categories
@@ -412,8 +435,7 @@ mapEntityToStoreApp serviceEntity = do
entityVersion <- fetchMostRecentAppVersions $ entityKey serviceEntity entityVersion <- fetchMostRecentAppVersions $ entityKey serviceEntity
let vers = entityVal <$> entityVersion let vers = entityVal <$> entityVersion
let vv = mapSVersionToVersionInfo vers let vv = mapSVersionToVersionInfo vers
pure $ StoreApp { pure $ StoreApp { storeAppTitle = sAppTitle service
storeAppTitle = sAppTitle service
, storeAppDescShort = sAppDescShort service , storeAppDescShort = sAppDescShort service
, storeAppDescLong = sAppDescLong service , storeAppDescLong = sAppDescLong service
, storeAppVersionInfo = NE.fromList vv , 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 , 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 mapEntityToServiceAvailable domain service = do
let appId = sAppAppId $ entityVal service let appId = sAppAppId $ entityVal service
(_, v) <- fetchLatestApp appId >>= errOnNothing status404 "service not found" (_, v) <- fetchLatestApp appId >>= errOnNothing status404 "service not found"
let appVersion = sVersionNumber (entityVal v) let appVersion = sVersionNumber (entityVal v)
pure $ ServiceAvailable pure $ ServiceAvailable { serviceAvailableId = appId
{ serviceAvailableId = appId
, serviceAvailableTitle = sAppTitle $ entityVal service , serviceAvailableTitle = sAppTitle $ entityVal service
, serviceAvailableDescShort = sAppDescShort $ entityVal service , serviceAvailableDescShort = sAppDescShort $ entityVal service
, serviceAvailableVersion = appVersion , serviceAvailableVersion = appVersion

View File

@@ -44,7 +44,9 @@ readProcessInheritStderr a b c = liftIO $ do
getConfig :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m Text getConfig :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m Text
getConfig appmgrPath appPath e@(Extension appId) = fmap decodeUtf8 $ do 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 case ec of
ExitSuccess -> pure out ExitSuccess -> pure out
ExitFailure n -> throwE $ AppMgrE [i|info config #{appId} \--json|] n ExitFailure n -> throwE $ AppMgrE [i|info config #{appId} \--json|] n

View File

@@ -37,14 +37,15 @@ data VersionInfo = VersionInfo
mapSVersionToVersionInfo :: [SVersion] -> [VersionInfo] mapSVersionToVersionInfo :: [SVersion] -> [VersionInfo]
mapSVersionToVersionInfo sv = do mapSVersionToVersionInfo sv = do
(\v -> VersionInfo { (\v -> VersionInfo { versionInfoVersion = sVersionNumber v
versionInfoVersion = sVersionNumber v
, versionInfoReleaseNotes = sVersionReleaseNotes v , versionInfoReleaseNotes = sVersionReleaseNotes v
, versionInfoDependencies = HM.empty , versionInfoDependencies = HM.empty
, versionInfoOsRequired = sVersionOsVersionRequired v , versionInfoOsRequired = sVersionOsVersionRequired v
, versionInfoOsRecommended = sVersionOsVersionRecommended v , versionInfoOsRecommended = sVersionOsVersionRecommended v
, versionInfoInstallAlert = Nothing , versionInfoInstallAlert = Nothing
}) <$> sv }
)
<$> sv
instance Ord VersionInfo where instance Ord VersionInfo where
compare = compare `on` versionInfoVersion compare = compare `on` versionInfoVersion

View File

@@ -13,8 +13,8 @@ preimage f target = filter ((== target) . f)
mapFind :: ([a] -> Maybe a) -> (b -> a) -> [b] -> Maybe b mapFind :: ([a] -> Maybe a) -> (b -> a) -> [b] -> Maybe b
mapFind _ _ [] = Nothing mapFind _ _ [] = Nothing
mapFind finder mapping (b:bs) = let mapFind finder mapping (b : bs) =
mB = mapFind finder mapping bs let mB = mapFind finder mapping bs
mA = finder [mapping b] mA = finder [mapping b]
in case (mB, mA) of in case (mB, mA) of
(Just b', _ ) -> Just b' (Just b', _ ) -> Just b'

View File

@@ -23,7 +23,11 @@ getVersionFromQuery rootDir ext = do
Just t -> pure t Just t -> pure t
getBestVersion rootDir ext spec 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 getBestVersion rootDir ext spec = do
-- @TODO change to db query? -- @TODO change to db query?
appVersions <- liftIO $ getAvailableAppVersions rootDir ext appVersions <- liftIO $ getAvailableAppVersions rootDir ext

View File

@@ -1,6 +1,9 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
module Handler.AppSpec (spec) where module Handler.AppSpec
( spec
)
where
import Startlude import Startlude
import Database.Persist.Sql import Database.Persist.Sql
@@ -11,28 +14,27 @@ import Model
spec :: Spec spec :: Spec
spec = do spec = do
describe "GET /apps" $ describe "GET /apps" $ withApp $ it "returns list of apps" $ do
withApp $ it "returns list of apps" $ do
request $ do request $ do
setMethod "GET" setMethod "GET"
setUrl ("/apps" :: Text) setUrl ("/apps" :: Text)
bodyContains "bitcoind" bodyContains "bitcoind"
bodyContains "version: 0.18.1" bodyContains "version: 0.18.1"
statusIs 200 statusIs 200
describe "GET /apps/:appId with unknown version spec for bitcoin" $ describe "GET /apps/:appId with unknown version spec for bitcoin" $ withApp $ it "fails to get unknown app" $ do
withApp $ it "fails to get unknown app" $ do
request $ do request $ do
setMethod "GET" setMethod "GET"
setUrl ("/apps/bitcoind.s9pk?spec=0.18.3" :: Text) setUrl ("/apps/bitcoind.s9pk?spec=0.18.3" :: Text)
statusIs 404 statusIs 404
describe "GET /apps/:appId with unknown app" $ describe "GET /apps/:appId with unknown app" $ withApp $ it "fails to get an unregistered app" $ do
withApp $ it "fails to get an unregistered app" $ do
request $ do request $ do
setMethod "GET" setMethod "GET"
setUrl ("/apps/tempapp.s9pk?spec=0.0.1" :: Text) setUrl ("/apps/tempapp.s9pk?spec=0.0.1" :: Text)
statusIs 404 statusIs 404
describe "GET /apps/:appId with existing version spec for bitcoin" $ describe "GET /apps/:appId with existing version spec for bitcoin"
withApp $ it "creates app and metric records" $ do $ withApp
$ it "creates app and metric records"
$ do
request $ do request $ do
setMethod "GET" setMethod "GET"
setUrl ("/apps/bitcoind.s9pk?spec==0.18.1" :: Text) setUrl ("/apps/bitcoind.s9pk?spec==0.18.1" :: Text)
@@ -42,8 +44,7 @@ spec = do
let app = fromJust $ head apps let app = fromJust $ head apps
metrics <- runDBtest $ selectList [MetricAppId ==. entityKey app] [] metrics <- runDBtest $ selectList [MetricAppId ==. entityKey app] []
assertEq "metric should exist" (length metrics) 1 assertEq "metric should exist" (length metrics) 1
describe "GET /apps/:appId with existing version spec for cups" $ describe "GET /apps/:appId with existing version spec for cups" $ withApp $ it "creates app and metric records" $ do
withApp $ it "creates app and metric records" $ do
request $ do request $ do
setMethod "GET" setMethod "GET"
setUrl ("/apps/cups.s9pk?spec=0.2.1" :: Text) setUrl ("/apps/cups.s9pk?spec=0.2.1" :: Text)
@@ -55,8 +56,7 @@ spec = do
assertEq "metric should exist" (length metrics) 1 assertEq "metric should exist" (length metrics) 1
version <- runDBtest $ selectList [SVersionAppId ==. entityKey app] [] version <- runDBtest $ selectList [SVersionAppId ==. entityKey app] []
assertEq "version should exist" (length version) 1 assertEq "version should exist" (length version) 1
describe "GET /sys/proxy.pac" $ describe "GET /sys/proxy.pac" $ withApp $ it "does not record metric but request successful" $ do
withApp $ it "does not record metric but request successful" $ do
request $ do request $ do
setMethod "GET" setMethod "GET"
setUrl ("/sys/proxy.pac?spec=0.1.0" :: Text) setUrl ("/sys/proxy.pac?spec=0.1.0" :: Text)
@@ -64,8 +64,7 @@ spec = do
-- select * from s_app -- select * from s_app
apps <- runDBtest $ selectList ([] :: [Filter SApp]) [] apps <- runDBtest $ selectList ([] :: [Filter SApp]) []
assertEq "no apps should exist" (length apps) 0 assertEq "no apps should exist" (length apps) 0
describe "GET /sys/:sysId" $ describe "GET /sys/:sysId" $ withApp $ it "does not record metric but request successful" $ do
withApp $ it "does not record metric but request successful" $ do
request $ do request $ do
setMethod "GET" setMethod "GET"
setUrl ("/sys/agent?spec=0.0.0" :: Text) setUrl ("/sys/agent?spec=0.0.0" :: Text)
@@ -73,10 +72,10 @@ spec = do
apps <- runDBtest $ selectList ([] :: [Filter SApp]) [] apps <- runDBtest $ selectList ([] :: [Filter SApp]) []
assertEq "no apps should exist" (length apps) 0 assertEq "no apps should exist" (length apps) 0
-- @TODO uncomment when new portable appmgr live -- @TODO uncomment when new portable appmgr live
xdescribe "GET /apps/manifest/#S9PK" $ xdescribe "GET /apps/manifest/#S9PK" $ withApp $ it "gets bitcoin manifest" $ do
withApp $ it "gets bitcoin manifest" $ do
request $ do request $ do
setMethod "GET" setMethod "GET"
setUrl ("/apps/manifest/bitcoind?spec==0.20.1" :: Text) setUrl ("/apps/manifest/bitcoind?spec==0.20.1" :: Text)
statusIs 200 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\":{}}"

View File

@@ -1,6 +1,9 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
module Handler.MarketplaceSpec (spec) where module Handler.MarketplaceSpec
( spec
)
where
import Startlude hiding ( Any ) import Startlude hiding ( Any )
import Database.Persist.Sql import Database.Persist.Sql
@@ -14,11 +17,22 @@ import Lib.Types.Emver
spec :: Spec spec :: Spec
spec = do spec = do
describe "searchServices with category" $ describe "searchServices with category" $ withApp $ it "should filter services with featured category" $ do
withApp $ it "should filter services with featured category" $ do
time <- liftIO getCurrentTime 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
lnd <- runDBtest $ insert $ SApp time (Just time) "Lightning Network Daemon" "lnd" "short desc lnd" "long desc lnd" "png" (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" featuredCat <- runDBtest $ insert $ Category time FEATURED Nothing "desc"
btcCat <- runDBtest $ insert $ Category time BITCOIN Nothing "desc" btcCat <- runDBtest $ insert $ Category time BITCOIN Nothing "desc"
lnCat <- runDBtest $ insert $ Category time LIGHTNING Nothing "desc" lnCat <- runDBtest $ insert $ Category time LIGHTNING Nothing "desc"
@@ -30,11 +44,22 @@ spec = do
assertEq "should exist" (length apps) 1 assertEq "should exist" (length apps) 1
let app' = fromJust $ head apps let app' = fromJust $ head apps
assertEq "should be bitcoin" (sAppTitle $ entityVal app') "Bitcoin Core" assertEq "should be bitcoin" (sAppTitle $ entityVal app') "Bitcoin Core"
describe "searchServices with category" $ describe "searchServices with category" $ withApp $ it "should filter services with bitcoin category" $ do
withApp $ it "should filter services with bitcoin category" $ do
time <- liftIO getCurrentTime 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
lnd <- runDBtest $ insert $ SApp time (Just time) "Lightning Network Daemon" "lnd" "short desc lnd" "long desc lnd" "png" (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" featuredCat <- runDBtest $ insert $ Category time FEATURED Nothing "desc"
btcCat <- runDBtest $ insert $ Category time BITCOIN Nothing "desc" btcCat <- runDBtest $ insert $ Category time BITCOIN Nothing "desc"
lnCat <- runDBtest $ insert $ Category time LIGHTNING 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 _ <- runDBtest $ insert_ $ ServiceCategory time btc btcCat "bitcon" BITCOIN Nothing
apps <- runDBtest $ searchServices BITCOIN 20 0 "" apps <- runDBtest $ searchServices BITCOIN 20 0 ""
assertEq "should exist" (length apps) 2 assertEq "should exist" (length apps) 2
describe "searchServices with fuzzy query" $ describe "searchServices with fuzzy query"
withApp $ it "runs search service with fuzzy text in long description" $ do $ withApp
$ it "runs search service with fuzzy text in long description"
$ do
time <- liftIO getCurrentTime time <- liftIO getCurrentTime
app1 <- runDBtest $ insert $ SApp time (Just time) "Bitcoin Core" "bitcoind" "short desc" "long desc" "png" app1 <- runDBtest $ insert $ SApp time
app2 <- runDBtest $ insert $ SApp time (Just time) "Lightning Network Daemon" "lnd" "short desc" "lightning long desc" "png" (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" cate <- runDBtest $ insert $ Category time FEATURED Nothing "desc"
_ <- runDBtest $ insert_ $ ServiceCategory time app1 cate "bitcoind" FEATURED Nothing _ <- runDBtest $ insert_ $ ServiceCategory time app1 cate "bitcoind" FEATURED Nothing
_ <- runDBtest $ insert_ $ ServiceCategory time app2 cate "lnd" FEATURED Nothing _ <- runDBtest $ insert_ $ ServiceCategory time app2 cate "lnd" FEATURED Nothing
@@ -56,13 +95,24 @@ spec = do
assertEq "should exist" (length apps) 1 assertEq "should exist" (length apps) 1
let app' = fromJust $ head apps let app' = fromJust $ head apps
print app' print app'
describe "searchServices with any category" $ describe "searchServices with any category" $ withApp $ it "runs search service for any category" $ do
withApp $ it "runs search service for any category" $ do
time <- liftIO getCurrentTime 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.19.0" "notes" Any Any
_ <- runDBtest $ insert $ SVersion time (Just time) btc "0.20.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.18.0" "notes" Any Any
_ <- runDBtest $ insert $ SVersion time (Just time) lnd "0.17.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" featuredCat <- runDBtest $ insert $ Category time FEATURED Nothing "desc"