mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-26 10:21:51 +00:00
format all the things
This commit is contained in:
Lucy Cifferello
committed by
Keagan McClelland
Keagan McClelland
parent
ac5acaa685
commit
e2d2fb6afc
@@ -9,7 +9,7 @@
|
||||
|
||||
module Handler.Apps where
|
||||
|
||||
import Startlude hiding (Handler)
|
||||
import Startlude hiding ( Handler )
|
||||
|
||||
import Control.Monad.Logger
|
||||
import Data.Aeson
|
||||
@@ -74,7 +74,7 @@ getSysR e = do
|
||||
getAppManifestR :: AppIdentifier -> Handler TypedContent
|
||||
getAppManifestR appId = do
|
||||
(appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
|
||||
av <- getVersionFromQuery appsDir appExt >>= \case
|
||||
av <- getVersionFromQuery appsDir appExt >>= \case
|
||||
Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
|
||||
Just v -> pure v
|
||||
let appDir = (<> "/") . (</> show av) . (</> toS appId) $ appsDir
|
||||
@@ -146,7 +146,7 @@ recordMetrics appId appVersion = do
|
||||
case sa of
|
||||
Nothing -> do
|
||||
$logError $ appId' <> " not found in database"
|
||||
notFound
|
||||
notFound
|
||||
Just a -> do
|
||||
let appKey' = entityKey a
|
||||
existingVersion <- runDB $ fetchAppVersion appVersion appKey'
|
||||
@@ -155,4 +155,4 @@ recordMetrics appId appVersion = do
|
||||
$logError $ "Version: " <> show appVersion <> " not found in database"
|
||||
notFound
|
||||
Just v -> runDB $ createMetric (entityKey a) (entityKey v)
|
||||
|
||||
|
||||
|
||||
@@ -36,7 +36,7 @@ ixt = toS $ toUpper <$> drop 1 ".png"
|
||||
getIconsR :: AppIdentifier -> Handler TypedContent
|
||||
getIconsR appId = do
|
||||
(appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
|
||||
spec <- getVersionFromQuery appsDir ext >>= \case
|
||||
spec <- getVersionFromQuery appsDir ext >>= \case
|
||||
Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
|
||||
Just v -> pure v
|
||||
let appDir = (<> "/") . (</> show spec) . (</> toS appId) $ appsDir
|
||||
@@ -57,10 +57,10 @@ getIconsR appId = do
|
||||
$logInfo $ "unknown icon extension type: " <> show x <> ". Sending back typePlain."
|
||||
pure typePlain
|
||||
Just iconType -> case iconType of
|
||||
PNG -> pure typePng
|
||||
SVG -> pure typeSvg
|
||||
JPG -> pure typeJpeg
|
||||
JPEG -> pure typeJpeg
|
||||
PNG -> pure typePng
|
||||
SVG -> pure typeSvg
|
||||
JPG -> pure typeJpeg
|
||||
JPEG -> pure typeJpeg
|
||||
respondSource mimeType (sendChunkBS =<< handleS9ErrT (getIcon appMgrDir (appDir </> show ext) ext))
|
||||
-- (_, Just hout, _, _) <- liftIO (createProcess $ iconBs { std_out = CreatePipe })
|
||||
-- respondSource typePlain (runConduit $ yieldMany () [iconBs])
|
||||
@@ -70,7 +70,7 @@ getIconsR appId = do
|
||||
getLicenseR :: AppIdentifier -> Handler TypedContent
|
||||
getLicenseR appId = do
|
||||
(appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
|
||||
spec <- getVersionFromQuery appsDir ext >>= \case
|
||||
spec <- getVersionFromQuery appsDir ext >>= \case
|
||||
Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
|
||||
Just v -> pure v
|
||||
servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec
|
||||
@@ -83,7 +83,7 @@ getLicenseR appId = do
|
||||
getInstructionsR :: AppIdentifier -> Handler TypedContent
|
||||
getInstructionsR appId = do
|
||||
(appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
|
||||
spec <- getVersionFromQuery appsDir ext >>= \case
|
||||
spec <- getVersionFromQuery appsDir ext >>= \case
|
||||
Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
|
||||
Just v -> pure v
|
||||
servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec
|
||||
|
||||
@@ -10,31 +10,35 @@
|
||||
|
||||
|
||||
module Handler.Marketplace where
|
||||
import Startlude hiding (from, Handler, on, sortOn)
|
||||
import Foundation
|
||||
import Yesod.Core
|
||||
import qualified Database.Persist as P
|
||||
import Model
|
||||
import Yesod.Persist.Core
|
||||
import Database.Marketplace
|
||||
import Data.List
|
||||
import Lib.Types.Category
|
||||
import Lib.Types.AppIndex
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Lib.Types.Emver
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import Database.Esqueleto.Experimental
|
||||
import Lib.Error
|
||||
import Network.HTTP.Types
|
||||
import Lib.Registry
|
||||
import Settings
|
||||
import System.FilePath.Posix
|
||||
import Lib.External.AppMgr
|
||||
import Data.Aeson
|
||||
import qualified Data.ByteString.Lazy as BS
|
||||
import qualified Data.Text as T
|
||||
import Data.String.Interpolate.IsString
|
||||
import Util.Shared
|
||||
import Startlude hiding ( from
|
||||
, Handler
|
||||
, on
|
||||
, sortOn
|
||||
)
|
||||
import Foundation
|
||||
import Yesod.Core
|
||||
import qualified Database.Persist as P
|
||||
import Model
|
||||
import Yesod.Persist.Core
|
||||
import Database.Marketplace
|
||||
import Data.List
|
||||
import Lib.Types.Category
|
||||
import Lib.Types.AppIndex
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Lib.Types.Emver
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import Database.Esqueleto.Experimental
|
||||
import Lib.Error
|
||||
import Network.HTTP.Types
|
||||
import Lib.Registry
|
||||
import Settings
|
||||
import System.FilePath.Posix
|
||||
import Lib.External.AppMgr
|
||||
import Data.Aeson
|
||||
import qualified Data.ByteString.Lazy as BS
|
||||
import qualified Data.Text as T
|
||||
import Data.String.Interpolate.IsString
|
||||
import Util.Shared
|
||||
|
||||
newtype CategoryRes = CategoryRes {
|
||||
categories :: [CategoryTitle]
|
||||
@@ -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
|
||||
@@ -168,7 +164,7 @@ data PackageVersion = PackageVersion
|
||||
} deriving (Show)
|
||||
instance FromJSON PackageVersion where
|
||||
parseJSON = withObject "package version" $ \o -> do
|
||||
packageVersionId <- o .: "id"
|
||||
packageVersionId <- o .: "id"
|
||||
packageVersionVersion <- o .: "version"
|
||||
pure PackageVersion { .. }
|
||||
|
||||
@@ -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
|
||||
@@ -186,71 +182,85 @@ getEosR = do
|
||||
vers <- from $ table @OsVersion
|
||||
orderBy [desc (vers ^. OsVersionCreatedAt)]
|
||||
pure vers
|
||||
let osV = entityVal <$> allEosVersions
|
||||
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
|
||||
, eosResHeadline = osVersionHeadline latest
|
||||
, eosResReleaseNotes = mappedVersions
|
||||
}
|
||||
let mappedVersions =
|
||||
ReleaseNotes
|
||||
$ HM.fromList
|
||||
$ sortOn (Down . fst)
|
||||
$ (\v -> (osVersionNumber v, osVersionReleaseNotes v))
|
||||
<$> osV
|
||||
pure $ EosRes { eosResVersion = osVersionNumber latest
|
||||
, eosResHeadline = osVersionHeadline latest
|
||||
, eosResReleaseNotes = mappedVersions
|
||||
}
|
||||
|
||||
getReleaseNotesR :: Handler ReleaseNotes
|
||||
getReleaseNotesR = do
|
||||
getParameters <- reqGetParams <$> getRequest
|
||||
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
|
||||
(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
|
||||
getVersionLatestR = do
|
||||
getParameters <- reqGetParams <$> getRequest
|
||||
case lookup "ids" getParameters of
|
||||
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
|
||||
Left e -> sendResponseStatus status400 ("could not parse query param \"ids\"" <> show e :: Text)
|
||||
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
|
||||
Left e -> sendResponseStatus status400 ("could not parse query param \"ids\"" <> show e :: Text)
|
||||
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
|
||||
|
||||
getPackageListR :: Handler ServiceAvailableRes
|
||||
getPackageListR = do
|
||||
getParameters <- reqGetParams <$> getRequest
|
||||
let defaults = ServiceListDefaults
|
||||
{ serviceListOrder = DESC
|
||||
, serviceListPageLimit = 20
|
||||
, serviceListPageNumber = 1
|
||||
, serviceListCategory = Nothing
|
||||
, serviceListQuery = ""
|
||||
}
|
||||
let defaults = ServiceListDefaults { serviceListOrder = DESC
|
||||
, serviceListPageLimit = 20
|
||||
, serviceListPageNumber = 1
|
||||
, serviceListCategory = Nothing
|
||||
, serviceListQuery = ""
|
||||
}
|
||||
case lookup "ids" getParameters of
|
||||
Nothing -> do
|
||||
-- query for all
|
||||
category <- case lookup "category" getParameters of
|
||||
Nothing -> pure $ serviceListCategory defaults
|
||||
Just c -> case readMaybe $ T.toUpper c of
|
||||
Nothing -> do
|
||||
$logInfo c
|
||||
sendResponseStatus status400 ("could not read category" :: Text)
|
||||
Just t -> pure $ Just t
|
||||
Nothing -> pure $ serviceListCategory defaults
|
||||
Just c -> case readMaybe $ T.toUpper c of
|
||||
Nothing -> do
|
||||
$logInfo c
|
||||
sendResponseStatus status400 ("could not read category" :: Text)
|
||||
Just t -> pure $ Just t
|
||||
page <- case lookup "page" getParameters of
|
||||
Nothing -> pure $ serviceListPageNumber defaults
|
||||
Just p -> case readMaybe p of
|
||||
Nothing -> do
|
||||
$logInfo p
|
||||
sendResponseStatus status400 ("could not read page" :: Text)
|
||||
Just t -> pure $ case t of
|
||||
0 -> 1 -- disallow page 0 so offset is not negative
|
||||
_ -> t
|
||||
Nothing -> pure $ serviceListPageNumber defaults
|
||||
Just p -> case readMaybe p of
|
||||
Nothing -> do
|
||||
$logInfo p
|
||||
sendResponseStatus status400 ("could not read page" :: Text)
|
||||
Just t -> pure $ case t of
|
||||
0 -> 1 -- disallow page 0 so offset is not negative
|
||||
_ -> t
|
||||
limit' <- case lookup "per-page" getParameters of
|
||||
Nothing -> pure $ serviceListPageLimit defaults
|
||||
Just c -> case readMaybe $ toS c of
|
||||
Nothing -> sendResponseStatus status400 ("could not read per-page" :: Text)
|
||||
Just l -> pure l
|
||||
Nothing -> pure $ serviceListPageLimit defaults
|
||||
Just c -> case readMaybe $ toS c of
|
||||
Nothing -> sendResponseStatus status400 ("could not read per-page" :: Text)
|
||||
Just l -> pure l
|
||||
query <- T.filter (not . isSpace) . fromMaybe (serviceListQuery defaults) <$> lookupGetParam "query"
|
||||
filteredServices <- runDB $ searchServices category limit' ((page - 1) * limit') query
|
||||
-- domain <- getsYesod $ registryHostname . appSettings
|
||||
@@ -260,84 +270,95 @@ getPackageListR = do
|
||||
pure $ ServiceAvailableRes res
|
||||
|
||||
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
|
||||
-- for each item in list get best available from version range
|
||||
availableServices <- traverse getPackageDetails packages
|
||||
services <- traverse (uncurry getServiceDetails) availableServices
|
||||
pure $ ServiceAvailableRes services
|
||||
Left e -> sendResponseStatus status400 ("could not parse query param \"ids\"" <> show e :: Text)
|
||||
Right (packages :: [PackageVersion]) -> do
|
||||
-- for each item in list get best available from version range
|
||||
availableServices <- traverse getPackageDetails packages
|
||||
services <- traverse (uncurry getServiceDetails) availableServices
|
||||
pure $ ServiceAvailableRes services
|
||||
where
|
||||
getPackageDetails :: PackageVersion -> HandlerFor RegistryCtx (Maybe (Entity SVersion), Entity SApp)
|
||||
getPackageDetails pv = do
|
||||
appsDir <- getsYesod $ ((</> "apps") . resourcesDir) . appSettings
|
||||
let appId = packageVersionId pv
|
||||
let spec = packageVersionVersion pv
|
||||
let appId = packageVersionId pv
|
||||
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
|
||||
getServiceR = do
|
||||
getParameters <- reqGetParams <$> getRequest
|
||||
getParameters <- reqGetParams <$> getRequest
|
||||
(service, version) <- case lookup "id" getParameters of
|
||||
Nothing -> sendResponseStatus status404 ("id param should exist" :: Text)
|
||||
Just appId' -> do
|
||||
case lookup "version" getParameters of
|
||||
-- default to latest - @TODO need to determine best available based on OS version?
|
||||
Nothing -> runDB $ fetchLatestApp appId' >>= errOnNothing status404 "service not found"
|
||||
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")
|
||||
Nothing -> sendResponseStatus status404 ("id param should exist" :: Text)
|
||||
Just appId' -> do
|
||||
case lookup "version" getParameters of
|
||||
-- default to latest - @TODO need to determine best available based on OS version?
|
||||
Nothing -> runDB $ fetchLatestApp appId' >>= errOnNothing status404 "service not found"
|
||||
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")
|
||||
getServiceDetails (Just version) service
|
||||
|
||||
getServiceDetails :: Maybe (Entity SVersion) -> Entity SApp -> HandlerFor RegistryCtx ServiceRes
|
||||
getServiceDetails maybeVersion service = do
|
||||
(versions, _) <- fetchAllAppVersions (entityKey service)
|
||||
categories <- runDB $ fetchAppCategories (entityKey service)
|
||||
(versions, _) <- fetchAllAppVersions (entityKey service)
|
||||
categories <- runDB $ fetchAppCategories (entityKey service)
|
||||
(appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
|
||||
domain <- getsYesod $ registryHostname . appSettings
|
||||
domain <- getsYesod $ registryHostname . appSettings
|
||||
let appId = sAppAppId $ entityVal service
|
||||
version <- case maybeVersion of
|
||||
Nothing -> do
|
||||
(_, version) <- runDB $ fetchLatestApp appId >>= errOnNothing status404 "service not found"
|
||||
pure $ sVersionNumber $ entityVal version
|
||||
Just v -> pure $ sVersionNumber $ entityVal v
|
||||
Nothing -> do
|
||||
(_, version) <- runDB $ fetchLatestApp appId >>= errOnNothing status404 "service not found"
|
||||
pure $ sVersionNumber $ entityVal version
|
||||
Just v -> pure $ sVersionNumber $ entityVal v
|
||||
let appDir = (<> "/") . (</> show version) . (</> toS appId) $ appsDir
|
||||
let appExt = Extension (toS appId) :: Extension "s9pk"
|
||||
manifest' <- handleS9ErrT $ getManifest appMgrDir appDir appExt
|
||||
manifest <- case eitherDecode $ BS.fromStrict manifest' of
|
||||
Left e -> do
|
||||
$logError "could not parse service manifest!"
|
||||
$logError (show e)
|
||||
sendResponseStatus status500 ("Internal Server Error" :: Text)
|
||||
Right a -> pure a
|
||||
manifest <- case eitherDecode $ BS.fromStrict manifest' of
|
||||
Left e -> do
|
||||
$logError "could not parse service manifest!"
|
||||
$logError (show e)
|
||||
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}|]
|
||||
, serviceResManifest = decode $ BS.fromStrict manifest' -- pass through raw JSON Value
|
||||
, serviceResCategories = serviceCategoryCategoryName . entityVal <$> categories
|
||||
, serviceResInstructions = [i|https://#{domain}/package/instructions/#{appId}|]
|
||||
, serviceResLicense = [i|https://#{domain}/package/license/#{appId}|]
|
||||
, serviceResVersions = versionInfoVersion <$> versions
|
||||
, serviceResDependencyInfo = HM.fromList d
|
||||
}
|
||||
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}|]
|
||||
, serviceResLicense = [i|https://#{domain}/package/license/#{appId}|]
|
||||
, serviceResVersions = versionInfoVersion <$> versions
|
||||
, serviceResDependencyInfo = HM.fromList d
|
||||
}
|
||||
|
||||
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
|
||||
, dependencyInfoIcon = [i|https://#{domain}/package/icon/#{appId}?spec==#{version}|]
|
||||
})
|
||||
Just v -> pure v
|
||||
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
|
||||
@@ -361,83 +382,86 @@ decodeLicense appmgrPath depPath package = do
|
||||
fetchAllAppVersions :: Key SApp -> HandlerFor RegistryCtx ([VersionInfo], ReleaseNotes)
|
||||
fetchAllAppVersions appId = do
|
||||
entityAppVersions <- runDB $ P.selectList [SVersionAppId P.==. appId] [] -- orderby version
|
||||
let vers = entityVal <$> entityAppVersions
|
||||
let vv = mapSVersionToVersionInfo vers
|
||||
let vers = entityVal <$> entityAppVersions
|
||||
let vv = mapSVersionToVersionInfo vers
|
||||
let mappedVersions = ReleaseNotes $ HM.fromList $ (\v -> (versionInfoVersion v, versionInfoReleaseNotes v)) <$> vv
|
||||
pure (vv, mappedVersions)
|
||||
|
||||
fetchMostRecentAppVersions :: MonadIO m => Key SApp -> ReaderT SqlBackend m [Entity SVersion]
|
||||
fetchMostRecentAppVersions appId = select $ do
|
||||
version <- from $ table @SVersion
|
||||
where_ (version ^. SVersionAppId ==. val appId)
|
||||
orderBy [ desc (version ^. SVersionNumber) ]
|
||||
limit 1
|
||||
pure version
|
||||
version <- from $ table @SVersion
|
||||
where_ (version ^. SVersionAppId ==. val appId)
|
||||
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
|
||||
`innerJoin` table @SVersion
|
||||
`on` (\(service :& version) ->
|
||||
service ^. SAppId ==. version ^. SVersionAppId)
|
||||
where_ (service ^. SAppAppId ==. val appId)
|
||||
orderBy [ desc (version ^. SVersionNumber)]
|
||||
pure (service, version)
|
||||
(service :& version) <-
|
||||
from
|
||||
$ table @SApp
|
||||
`innerJoin` table @SVersion
|
||||
`on` (\(service :& version) -> service ^. SAppId ==. version ^. SVersionAppId)
|
||||
where_ (service ^. SAppAppId ==. val appId)
|
||||
orderBy [desc (version ^. SVersionNumber)]
|
||||
pure (service, version)
|
||||
|
||||
fetchLatestAppAtVersion :: MonadIO m => Text -> Version -> ReaderT SqlBackend m (Maybe (P.Entity SApp, P.Entity SVersion))
|
||||
fetchLatestAppAtVersion :: MonadIO m
|
||||
=> Text
|
||||
-> Version
|
||||
-> ReaderT SqlBackend m (Maybe (P.Entity SApp, P.Entity SVersion))
|
||||
fetchLatestAppAtVersion appId version' = selectOne $ do
|
||||
(service :& version) <-
|
||||
from $ table @SApp
|
||||
`innerJoin` table @SVersion
|
||||
`on` (\(service :& version) ->
|
||||
service ^. SAppId ==. version ^. SVersionAppId)
|
||||
where_ $ (service ^. SAppAppId ==. val appId)
|
||||
&&. (version ^. SVersionNumber ==. val version')
|
||||
pure (service, version)
|
||||
(service :& version) <-
|
||||
from
|
||||
$ table @SApp
|
||||
`innerJoin` table @SVersion
|
||||
`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
|
||||
`innerJoin` table @SApp
|
||||
`on` (\(sc :& s) ->
|
||||
sc ^. ServiceCategoryServiceId ==. s ^. SAppId)
|
||||
where_ (service ^. SAppId ==. val appId)
|
||||
pure categories
|
||||
(categories :& service) <-
|
||||
from
|
||||
$ table @ServiceCategory
|
||||
`innerJoin` table @SApp
|
||||
`on` (\(sc :& s) -> sc ^. ServiceCategoryServiceId ==. s ^. SAppId)
|
||||
where_ (service ^. SAppId ==. val appId)
|
||||
pure categories
|
||||
|
||||
mapEntityToStoreApp :: MonadIO m => Entity SApp -> ReaderT SqlBackend m StoreApp
|
||||
mapEntityToStoreApp serviceEntity = do
|
||||
let service = entityVal serviceEntity
|
||||
entityVersion <- fetchMostRecentAppVersions $ entityKey serviceEntity
|
||||
let vers = entityVal <$> entityVersion
|
||||
let vv = mapSVersionToVersionInfo vers
|
||||
pure $ StoreApp {
|
||||
storeAppTitle = sAppTitle service
|
||||
, storeAppDescShort = sAppDescShort service
|
||||
, storeAppDescLong = sAppDescLong service
|
||||
, storeAppVersionInfo = NE.fromList vv
|
||||
, storeAppIconType = sAppIconType service
|
||||
, storeAppTimestamp = Just (sAppCreatedAt service) -- case on if updatedAt? or always use updated time? was file timestamp
|
||||
}
|
||||
let service = entityVal serviceEntity
|
||||
entityVersion <- fetchMostRecentAppVersions $ entityKey serviceEntity
|
||||
let vers = entityVal <$> entityVersion
|
||||
let vv = mapSVersionToVersionInfo vers
|
||||
pure $ StoreApp { storeAppTitle = sAppTitle service
|
||||
, storeAppDescShort = sAppDescShort service
|
||||
, storeAppDescLong = sAppDescLong service
|
||||
, storeAppVersionInfo = NE.fromList vv
|
||||
, storeAppIconType = sAppIconType service
|
||||
, 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
|
||||
, serviceAvailableTitle = sAppTitle $ entityVal service
|
||||
, serviceAvailableDescShort = sAppDescShort $ entityVal service
|
||||
, serviceAvailableVersion = appVersion
|
||||
, serviceAvailableIcon = [i|https://#{domain}/package/icon/#{appId}?spec==#{appVersion}|]
|
||||
}
|
||||
let appId = sAppAppId $ entityVal service
|
||||
(_, v) <- fetchLatestApp appId >>= errOnNothing status404 "service not found"
|
||||
let appVersion = sVersionNumber (entityVal v)
|
||||
pure $ ServiceAvailable { serviceAvailableId = appId
|
||||
, serviceAvailableTitle = sAppTitle $ entityVal service
|
||||
, serviceAvailableDescShort = sAppDescShort $ entityVal service
|
||||
, serviceAvailableVersion = appVersion
|
||||
, serviceAvailableIcon = [i|https://#{domain}/package/icon/#{appId}?spec==#{appVersion}|]
|
||||
}
|
||||
|
||||
-- >>> 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\"}"
|
||||
|
||||
@@ -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,8 +51,8 @@ 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
|
||||
toTypedContent = toTypedContent . toJSON
|
||||
toTypedContent = toTypedContent . toJSON
|
||||
|
||||
@@ -6,7 +6,7 @@
|
||||
|
||||
module Handler.Version where
|
||||
|
||||
import Startlude hiding (Handler)
|
||||
import Startlude hiding ( Handler )
|
||||
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Yesod.Core
|
||||
@@ -28,10 +28,10 @@ getVersionR = do
|
||||
getVersionAppR :: Text -> Handler (Maybe AppVersionRes)
|
||||
getVersionAppR appId = do
|
||||
(appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
|
||||
res <- getVersionWSpec appsDir appExt
|
||||
res <- getVersionWSpec appsDir appExt
|
||||
case res of
|
||||
Nothing -> pure res
|
||||
Just r -> do
|
||||
Just r -> do
|
||||
let appDir = (<> "/") . (</> (show $ appVersionVersion r)) . (</> toS appId) $ appsDir
|
||||
addPackageHeader appMgrDir appDir appExt
|
||||
pure res
|
||||
@@ -50,4 +50,4 @@ getVersionSysR sysAppId = runMaybeT $ do
|
||||
getVersionWSpec :: KnownSymbol a => FilePath -> Extension a -> Handler (Maybe AppVersionRes)
|
||||
getVersionWSpec rootDir ext = do
|
||||
av <- getVersionFromQuery rootDir ext
|
||||
pure $ liftA3 AppVersionRes av (pure Nothing) (pure Nothing)
|
||||
pure $ liftA3 AppVersionRes av (pure Nothing) (pure Nothing)
|
||||
|
||||
Reference in New Issue
Block a user