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 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
import Data.IORef import Data.IORef
import Foreign.Store import Foreign.Store
@@ -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

4
app/devel.hs
View File

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

2
app/main.hs
View File

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

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

2
src/Handler/Apps.hs
View File

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

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

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

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

2
src/Handler/Version.hs
View File

@@ -6,7 +6,7 @@
module Handler.Version where module Handler.Version where
import Startlude hiding (Handler) import Startlude hiding ( Handler )
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import Yesod.Core 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 :: (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

2
src/Lib/SystemCtl.hs
View File

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

11
src/Lib/Types/AppIndex.hs
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
@@ -124,7 +125,7 @@ addFileTimestamp appDir ext service v = do
Nothing -> pure Nothing Nothing -> pure Nothing
Just file -> do Just file -> do
time <- getModificationTime file time <- getModificationTime file
pure $ Just service {storeAppTimestamp = Just time } pure $ Just service { storeAppTimestamp = Just time }
data ServiceDependencyInfo = ServiceDependencyInfo data ServiceDependencyInfo = ServiceDependencyInfo
{ serviceDependencyInfoOptional :: Maybe Text { serviceDependencyInfoOptional :: Maybe Text
@@ -197,7 +198,7 @@ instance ToJSON ServiceManifest where
, "version" .= serviceManifestVersion , "version" .= serviceManifestVersion
, "description" .= object ["short" .= serviceManifestDescriptionShort, "long" .= serviceManifestDescriptionLong] , "description" .= object ["short" .= serviceManifestDescriptionShort, "long" .= serviceManifestDescriptionLong]
, "release-notes" .= serviceManifestReleaseNotes , "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 , "dependencies" .= serviceManifestDependencies
] ]

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

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

8
src/Util/Shared.hs
View File

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

39
test/Handler/AppSpec.hs
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,28 +56,26 @@ 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)
statusIs 200 statusIs 200
-- 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)
statusIs 200 statusIs 200
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\":{}}"

94
test/Handler/MarketplaceSpec.hs
View File

@@ -1,8 +1,11 @@
{-# 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
import Data.Maybe import Data.Maybe
@@ -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,15 +95,26 @@ 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
_ <- runDBtest $ insert $ SVersion time (Just time)btc "0.19.0" "notes" Any Any (Just time)
_ <- runDBtest $ insert $ SVersion time (Just time)btc "0.20.0" "notes" Any Any "Bitcoin Core"
lnd <- runDBtest $ insert $ SApp time (Just time) "Lightning Network Daemon" "lnd" "short desc lnd" "long desc lnd" "png" "bitcoind"
_ <- runDBtest $ insert $ SVersion time (Just time)lnd "0.18.0" "notes" Any Any "short desc bitcoin"
_ <- runDBtest $ insert $ SVersion time (Just time)lnd "0.17.0" "notes" Any Any "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" 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"

2
test/TestImport.hs
View File

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