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

format all the things

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

9
app/DevelMain.hs
View File

@@ -1,9 +1,11 @@
module DevelMain where
import Prelude
import Application (getApplicationRepl, shutdownApp)
import Application ( getApplicationRepl
, shutdownApp
)
import Control.Monad ((>=>))
import Control.Monad ( (>=>) )
import Control.Concurrent
import Data.IORef
import Foreign.Store
@@ -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
app/devel.hs
View File

@@ -1,6 +1,6 @@
{-# LANGUAGE PackageImports #-}
import "start9-registry" Application (develMain)
import Prelude (IO)
import "start9-registry" Application ( develMain )
import Prelude ( IO )
main :: IO ()
main = develMain

2
app/main.hs
View File

@@ -1,4 +1,4 @@
import Application (appMain)
import Application ( appMain )
import Startlude
main :: IO ()

28
src/Database/Marketplace.hs
View File

@@ -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,11 +19,13 @@ 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 ++. (%)))
orderBy [ desc (service ^. SAppUpdatedAt) ]
||. (service ^. SAppAppId `ilike` (%) ++. val query ++. (%))
)
orderBy [desc (service ^. SAppUpdatedAt)]
limit pageItems
offset offset'
pure service
@@ -28,21 +33,24 @@ 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
&&. ((service ^. SAppDescShort `ilike` (%) ++. val query ++. (%))
where_
$ sc
^. ServiceCategoryCategoryName
==. val category
&&. ( (service ^. SAppDescShort `ilike` (%) ++. val query ++. (%))
||. (service ^. SAppDescLong `ilike` (%) ++. val query ++. (%))
||. (service ^. SAppTitle `ilike` (%) ++. val query ++. (%))
||. (service ^. SAppAppId `ilike` (%) ++. val query ++. (%))
)
pure service
)
orderBy [ desc (services ^. SAppUpdatedAt) ]
orderBy [desc (services ^. SAppUpdatedAt)]
limit pageItems
offset offset'
pure services

2
src/Handler/Apps.hs
View File

@@ -9,7 +9,7 @@
module Handler.Apps where
import Startlude hiding (Handler)
import Startlude hiding ( Handler )
import Control.Monad.Logger
import Data.Aeson

136
src/Handler/Marketplace.hs
View File

@@ -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
@@ -58,7 +62,7 @@ data ServiceRes = ServiceRes
newtype ReleaseNotes = ReleaseNotes { unReleaseNotes :: HM.HashMap Version Text }
deriving (Eq, Show)
instance ToJSON ReleaseNotes where
toJSON ReleaseNotes { .. } = object [ t .= v | (k,v) <- HM.toList unReleaseNotes, let (String t) = toJSON k ]
toJSON ReleaseNotes {..} = object [ t .= v | (k, v) <- HM.toList unReleaseNotes, let (String t) = toJSON k ]
instance ToContent ReleaseNotes where
toContent = toContent . toJSON
instance ToTypedContent ReleaseNotes where
@@ -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
@@ -109,7 +108,7 @@ data ServiceAvailable = ServiceAvailable
, serviceAvailableDescShort :: Text
} deriving (Show)
instance ToJSON ServiceAvailable where
toJSON ServiceAvailable { .. } = object
toJSON ServiceAvailable {..} = object
[ "id" .= serviceAvailableId
, "title" .= serviceAvailableTitle
, "version" .= serviceAvailableVersion
@@ -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
@@ -178,7 +174,7 @@ getCategoriesR = do
cats <- from $ table @Category
orderBy [desc (cats ^. CategoryPriority)]
pure cats
pure $ CategoryRes $ categoryName . entityVal <$>allCategories
pure $ CategoryRes $ categoryName . entityVal <$> allCategories
getEosR :: Handler EosRes
getEosR = do
@@ -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
}
@@ -201,8 +201,8 @@ getReleaseNotesR = do
case lookup "id" getParameters of
Nothing -> sendResponseStatus status400 ("expected query param \"id\" to exist" :: Text)
Just package -> do
(service, _) <- runDB $ fetchLatestApp package >>= errOnNothing status404 "package not found"
(_, mappedVersions) <- fetchAllAppVersions (entityKey service)
(service, _ ) <- runDB $ fetchLatestApp package >>= errOnNothing status404 "package not found"
(_ , mappedVersions) <- fetchAllAppVersions (entityKey service)
pure mappedVersions
getVersionLatestR :: Handler VersionLatestRes
@@ -212,16 +212,26 @@ getVersionLatestR = do
Nothing -> sendResponseStatus status400 ("expected query param \"ids\" to exist" :: Text)
Just packages -> case eitherDecode $ BS.fromStrict $ encodeUtf8 packages of
Left e -> sendResponseStatus status400 ("could not parse query param \"ids\"" <> show e :: Text)
Right (p :: [AppIdentifier])-> 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
@@ -261,7 +271,7 @@ getPackageListR = do
Just packageVersionList -> case eitherDecode $ BS.fromStrict $ encodeUtf8 packageVersionList of
Left e -> sendResponseStatus status400 ("could not parse query param \"ids\"" <> show e :: Text)
Right (packages :: [PackageVersion])-> do
Right (packages :: [PackageVersion]) -> do
-- for each item in list get best available from version range
availableServices <- traverse getPackageDetails packages
services <- traverse (uncurry getServiceDetails) availableServices
@@ -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
@@ -370,39 +391,41 @@ fetchMostRecentAppVersions :: MonadIO m => Key SApp -> ReaderT SqlBackend m [Ent
fetchMostRecentAppVersions appId = select $ do
version <- from $ table @SVersion
where_ (version ^. SVersionAppId ==. val appId)
orderBy [ desc (version ^. SVersionNumber) ]
orderBy [desc (version ^. SVersionNumber)]
limit 1
pure version
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)]
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
@@ -437,7 +461,7 @@ mapEntityToServiceAvailable domain service = do
-- >>> encode hm
-- "{\"0.2.0\":\"some notes\"}"
hm :: Data.Aeson.Value
hm = object [ t .= v | (k,v) <- [("0.2.0", "some notes") :: (Version, Text)], let (String t) = toJSON k ]
hm = object [ t .= v | (k, v) <- [("0.2.0", "some notes") :: (Version, Text)], let (String t) = toJSON k ]
-- >>> encode rn
-- "{\"0.2.0\":\"notes one\",\"0.3.0\":\"notes two\"}"

4
src/Handler/Types/Status.hs
View File

@@ -3,7 +3,7 @@
{-# LANGUAGE NamedFieldPuns #-}
module Handler.Types.Status where
import Startlude hiding (toLower)
import Startlude hiding ( toLower )
import Data.Aeson
import Yesod.Core.Content
@@ -51,7 +51,7 @@ data OSVersionRes = OSVersionRes
, osVersionVersion :: Version
} deriving (Eq, Show)
instance ToJSON OSVersionRes where
toJSON OSVersionRes { .. } = object ["status" .= osVersionStatus, "version" .= osVersionVersion]
toJSON OSVersionRes {..} = object ["status" .= osVersionStatus, "version" .= osVersionVersion]
instance ToContent OSVersionRes where
toContent = toContent . toJSON
instance ToTypedContent OSVersionRes where

2
src/Handler/Version.hs
View File

@@ -6,7 +6,7 @@
module Handler.Version where
import Startlude hiding (Handler)
import Startlude hiding ( Handler )
import Control.Monad.Trans.Maybe
import Yesod.Core

4
src/Lib/External/AppMgr.hs vendored
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 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

2
src/Lib/SystemCtl.hs
View File

@@ -1,6 +1,6 @@
module Lib.SystemCtl where
import Startlude hiding (words)
import Startlude hiding ( words )
import Protolude.Unsafe
import Data.String

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

@@ -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
@@ -124,7 +125,7 @@ addFileTimestamp appDir ext service v = do
Nothing -> pure Nothing
Just file -> do
time <- getModificationTime file
pure $ Just service {storeAppTimestamp = Just time }
pure $ Just service { storeAppTimestamp = Just time }
data ServiceDependencyInfo = ServiceDependencyInfo
{ serviceDependencyInfoOptional :: Maybe Text
@@ -197,7 +198,7 @@ instance ToJSON ServiceManifest where
, "version" .= serviceManifestVersion
, "description" .= object ["short" .= serviceManifestDescriptionShort, "long" .= serviceManifestDescriptionLong]
, "release-notes" .= serviceManifestReleaseNotes
, "alerts" .= object [ t .= v | (k,v) <- HM.toList serviceManifestAlerts, let (String t) = toJSON k ]
, "alerts" .= object [ t .= v | (k, v) <- HM.toList serviceManifestAlerts, let (String t) = toJSON k ]
, "dependencies" .= serviceManifestDependencies
]

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

@@ -49,7 +49,7 @@ import Control.Applicative ( liftA2
import Data.String ( IsString(..) )
import qualified Data.Text as T
import Data.Aeson
import Startlude (Hashable)
import Startlude ( Hashable )
-- | AppVersion is the core representation of the SemverQuad type.
newtype Version = Version { unVersion :: (Word, Word, Word, Word) } deriving (Eq, Ord, ToJSONKey, Hashable)

6
src/Util/Function.hs
View File

@@ -13,11 +13,11 @@ 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'
(Just b', _ ) -> Just b'
(Nothing, Just _) -> Just b
_ -> Nothing

8
src/Util/Shared.hs
View File

@@ -2,7 +2,7 @@
module Util.Shared where
import Startlude hiding (Handler)
import Startlude hiding ( Handler )
import qualified Data.Text as T
import Network.HTTP.Types
@@ -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

39
test/Handler/AppSpec.hs
View File

@@ -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,28 +56,26 @@ 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)
statusIs 200
-- select * from s_app
apps <- runDBtest $ selectList ([] :: [Filter SApp])[]
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)
statusIs 200
apps <- runDBtest $ selectList ([] :: [Filter SApp])[]
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\":{}}"

94
test/Handler/MarketplaceSpec.hs
View File

@@ -1,8 +1,11 @@
{-# 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 Data.Maybe
@@ -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,15 +95,26 @@ 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"
_ <- 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"
_ <- 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
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"
_ <- 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"
btcCat <- runDBtest $ insert $ Category time BITCOIN Nothing "desc"
lnCat <- runDBtest $ insert $ Category time LIGHTNING Nothing "desc"

2
test/TestImport.hs
View File

@@ -8,7 +8,7 @@ module TestImport
)
where
import Startlude hiding (Handler)
import Startlude hiding ( Handler )
import Application ( makeFoundation
, makeLogWare
)