From a42c5c5caa253798e1d7eb5c2a618168f4c25aac Mon Sep 17 00:00:00 2001 From: Lucy Cifferello <12953208+elvece@users.noreply.github.com> Date: Wed, 14 Jul 2021 17:43:13 -0400 Subject: [PATCH] eos endpoint, lowercase categories, sdk get instructions and license --- config/routes | 23 ++++---- src/Handler/Marketplace.hs | 112 +++++++++++++++++++++++++++++++------ src/Handler/Version.hs | 9 +-- src/Lib/External/AppMgr.hs | 16 +++++- src/Lib/Types/AppIndex.hs | 2 - src/Lib/Types/Category.hs | 28 +++++----- 6 files changed, 137 insertions(+), 53 deletions(-) diff --git a/config/routes b/config/routes index a039fda..d646e3a 100644 --- a/config/routes +++ b/config/routes @@ -1,15 +1,16 @@ -/package/manifest/#AppIdentifier AppManifestR GET -- get app manifest from appmgr -- ?spec={semver-spec} -/package/config/#AppIdentifier AppConfigR GET -- get app config from appmgr -- ?spec={semver-spec} -/version VersionR GET - -/package/version/#Text VersionAppR GET -- get most recent appId version -/sys/version/#Text VersionSysR GET -- get most recent sys app version - -/icons/#PNG IconsR GET -- get icons !/package/#S9PK AppR GET -- get most recent appId at appversion spec, defaults to >=0.0.0 -- ?spec={semver-spec} - -!/sys/#SYS_EXTENSIONLESS SysR GET -- get most recent sys app -- ?spec={semver-spec} /marketplace/data CategoriesR GET -- get all marketplace categories /marketplace/available/list ServiceListR GET -- filter marketplace services by various query params -/marketplace/available ServiceR GET -- get service information \ No newline at end of file +/marketplace/available ServiceR GET -- get service information +/marketplace/Extension EosR GET -- get eos information + + +-- TODO deprecate +!/sys/#SYS_EXTENSIONLESS SysR GET -- get most recent sys app -- ?spec={semver-spec} +/version VersionR GET +/icons/#PNG IconsR GET -- get icons +/sys/version/#Text VersionSysR GET -- get most recent sys app version +/package/manifest/#AppIdentifier AppManifestR GET -- get app manifest from appmgr -- ?spec={semver-spec} +/package/config/#AppIdentifier AppConfigR GET -- get app config from appmgr -- ?spec={semver-spec} +/package/version/#Text VersionAppR GET -- get most recent appId version \ No newline at end of file diff --git a/src/Handler/Marketplace.hs b/src/Handler/Marketplace.hs index 8b555ea..3b19f38 100644 --- a/src/Handler/Marketplace.hs +++ b/src/Handler/Marketplace.hs @@ -48,30 +48,28 @@ data ServiceRes = ServiceRes { serviceResIcon :: Text , serviceResManifest :: ServiceManifest , serviceResCategories :: [CategoryTitle] + , serviceResInstructions :: Text -- markdown + , serviceResLicense :: Text , serviceResVersions :: [Version] , serviceResDependencyInfo :: HM.HashMap AppIdentifier DependencyInfo - , serviceResReleaseNotes :: HM.HashMap Version Text + , serviceResReleaseNotes :: ReleaseNotes } deriving (Show, Generic) --- newtype ReleaseNotes = ReleaseNotes (HM.HashMap Version Text) --- deriving(Eq, Show) --- instance ToJSON ReleaseNotes where --- toJSON kvs = object [ t .= v | (k,v) <- kvs, let (String t) = toJSON k ] +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 ] instance ToJSON ServiceRes where toJSON ServiceRes {..} = object [ "icon" .= serviceResIcon , "manifest" .= serviceResManifest , "categories" .= serviceResCategories + , "instructions" .= serviceResInstructions + , "license" .= serviceResLicense , "versions" .= serviceResVersions , "dependency-metadata" .= serviceResDependencyInfo - , "release-notes" .= object [ t .= v | (k,v) <- HM.toList serviceResReleaseNotes, let (String t) = toJSON k ] + , "release-notes" .= serviceResReleaseNotes ] --- >>> encode hm --- "{\"0.2.0\":\"some notes\"}" -hm :: Data.Aeson.Value -hm = do - object [ t .= v | (k,v) <- [("0.2.0", "some notes") :: (Version, Text)], let (String t) = toJSON k ] - instance ToContent ServiceRes where toContent = toContent . toJSON instance ToTypedContent ServiceRes where @@ -120,6 +118,14 @@ instance ToContent ServiceAvailable where instance ToTypedContent ServiceAvailable where toTypedContent = toTypedContent . toJSON +newtype ServiceAvailableRes = ServiceAvailableRes [ServiceAvailable] + deriving (Show, Generic) +instance ToJSON ServiceAvailableRes +instance ToContent ServiceAvailableRes where + toContent = toContent . toJSON +instance ToTypedContent ServiceAvailableRes where + toTypedContent = toTypedContent . toJSON + data OrderArrangement = ASC | DESC deriving (Eq, Show, Read) data ServiceListDefaults = ServiceListDefaults @@ -131,12 +137,38 @@ data ServiceListDefaults = ServiceListDefaults } deriving (Eq, Show, Read) +data EosRes = EosRes + { eosResVersion :: Version + , eosResHeadline :: Text + , eosResReleaseNotes :: ReleaseNotes +} deriving (Eq, Show, Generic) +instance ToJSON EosRes +instance ToContent EosRes where + toContent = toContent . toJSON +instance ToTypedContent EosRes where + toTypedContent = toTypedContent . toJSON + getCategoriesR :: Handler CategoryRes getCategoriesR = do allCategories <- runDB $ select $ do from $ table @Category pure $ CategoryRes $ categoryName . entityVal <$>allCategories -getServiceListR :: Handler [ServiceAvailable] +getEosR :: Handler EosRes +getEosR = do + allEosVersions <- runDB $ select $ do + vers <- from $ table @OsVersion + orderBy [desc (vers ^. OsVersionUpdatedAt)] + pure vers + let osV = entityVal <$> allEosVersions + let latest = Data.List.head osV + let mappedVersions = ReleaseNotes $ HM.fromList $ (\v -> (osVersionNumber v, osVersionReleaseNotes v)) <$> osV + pure $ EosRes + { eosResVersion = osVersionNumber latest + , eosResHeadline = osVersionHeadline latest + , eosResReleaseNotes = mappedVersions + } + +getServiceListR :: Handler ServiceAvailableRes getServiceListR = do getParameters <- reqGetParams <$> getRequest let defaults = ServiceListDefaults { @@ -172,7 +204,8 @@ getServiceListR = do filteredServices <- runDB $ searchServices category limit' ((page - 1) * limit') query domain <- getsYesod $ registryHostname . appSettings (appsDir, appMgrDir) <- getsYesod $ (( "apps") . resourcesDir &&& staticBinDir) . appSettings - runDB $ traverse (mapEntityToServiceAvailable appMgrDir appsDir domain) filteredServices + res <- runDB $ traverse (mapEntityToServiceAvailable appMgrDir appsDir domain) filteredServices + pure $ ServiceAvailableRes res getServiceR :: Handler ServiceRes getServiceR = do @@ -184,7 +217,7 @@ getServiceR = do -- 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 + 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") (versions, mappedVersions) <- fetchAllAppVersions (entityKey service) @@ -206,11 +239,15 @@ getServiceR = do -- @TODO uncomment when sdk icon working -- icon <- decodeIcon appMgrDir depPath appExt let icon = [i|https://#{domain}/icons/#{appId}.png|] + instructions <- decodeInstructions appMgrDir depPath appExt + license <- decodeLicense appMgrDir depPath appExt addPackageHeader appMgrDir appDir appExt pure $ ServiceRes { serviceResIcon = icon , serviceResManifest = manifest -- TypedContent "application/json" (toContent manifest) , serviceResCategories = serviceCategoryCategoryName . entityVal <$> categories + , serviceResInstructions = instructions + , serviceResLicense = license , serviceResVersions = versionInfoVersion <$> versions , serviceResDependencyInfo = HM.fromList d , serviceResReleaseNotes = mappedVersions @@ -243,19 +280,37 @@ decodeIcon appmgrPath depPath e@(Extension icon) = do sendResponseStatus status400 e' Right (i' :: URL) -> pure $ i' <> T.pack icon -fetchAllAppVersions :: Key SApp -> HandlerFor RegistryCtx ([VersionInfo], HM.HashMap Version Text) +decodeInstructions :: (MonadHandler m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> m Text +decodeInstructions appmgrPath depPath package = do + instructions <- handleS9ErrT $ getInstructions appmgrPath depPath package + case eitherDecode $ BS.fromStrict instructions of + Left e -> do + $logInfo $ T.pack e + sendResponseStatus status400 e + Right a -> pure a + +decodeLicense :: (MonadHandler m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> m Text +decodeLicense appmgrPath depPath package = do + license <- handleS9ErrT $ getLicense appmgrPath depPath package + case eitherDecode $ BS.fromStrict license of + Left e -> do + $logInfo $ T.pack e + sendResponseStatus status400 e + Right a -> pure a + +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 mappedVersions = HM.fromList $ (\v -> (versionInfoVersion v, versionInfoReleaseNotes v)) <$> vv + 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 [ asc (version ^. SVersionNumber) ] + orderBy [ desc (version ^. SVersionNumber) ] limit 1 pure version @@ -321,3 +376,24 @@ mapEntityToServiceAvailable appMgrDir appsDir domain service = do , serviceAvailableVersion = appVersion , serviceAvailableIcon = icon } + +-- >>> 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 ] + +-- >>> encode rn +-- "{\"0.2.0\":\"notes one\",\"0.3.0\":\"notes two\"}" +rn :: ReleaseNotes +rn = ReleaseNotes $ HM.fromList [("0.2.0", "notes one"), ("0.3.0", "notes two")] + +-- >>> readMaybe $ cc :: Maybe CategoryTitle +-- Just FEATURED +cc :: Text +cc = T.toUpper "featured" + +-- >>> encode ccc +-- "\"featured\"" +ccc :: CategoryTitle +ccc = FEATURED + diff --git a/src/Handler/Version.hs b/src/Handler/Version.hs index 1077aae..d506857 100644 --- a/src/Handler/Version.hs +++ b/src/Handler/Version.hs @@ -37,7 +37,7 @@ getVersionAppR appId = do pure res where appExt = Extension (toS appId) :: Extension "s9pk" --- @TODO update to using db record +-- @TODO - deprecate getVersionSysR :: Text -> Handler (Maybe AppVersionRes) getVersionSysR sysAppId = runMaybeT $ do sysDir <- ( "sys") . resourcesDir . appSettings <$> getYesod @@ -50,9 +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) - -getSystemStatusR :: Handler OSVersionRes -getSystemStatusR = do - -- hardcoded to the next major version release so the UI can by dynamic. this might change depending on the version number we decide to release. - pure $ OSVersionRes INSTRUCTIONS $ Version (0,3,0,0) \ No newline at end of file + pure $ liftA3 AppVersionRes av (pure Nothing) (pure Nothing) \ No newline at end of file diff --git a/src/Lib/External/AppMgr.hs b/src/Lib/External/AppMgr.hs index 6416274..cf762c6 100644 --- a/src/Lib/External/AppMgr.hs +++ b/src/Lib/External/AppMgr.hs @@ -68,4 +68,18 @@ getPackageHash appmgrPath appPath e@(Extension appId) = do (ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "hash", appPath <> show e] "" case ec of ExitSuccess -> pure bs - ExitFailure n -> throwE $ AppMgrE [i|embassy-sdk inspect hash #{appId}|] n \ No newline at end of file + ExitFailure n -> throwE $ AppMgrE [i|embassy-sdk inspect hash #{appId}|] n + +getInstructions :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m ByteString +getInstructions appmgrPath appPath e@(Extension appId) = do + (ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "instructions", appPath <> show e] "" + case ec of + ExitSuccess -> pure bs + ExitFailure n -> throwE $ AppMgrE [i|embassy-sdk inspect instructions #{appId}|] n + +getLicense :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m ByteString +getLicense appmgrPath appPath e@(Extension appId) = do + (ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "license", appPath <> show e] "" + case ec of + ExitSuccess -> pure bs + ExitFailure n -> throwE $ AppMgrE [i|embassy-sdk inspect license #{appId}|] n \ No newline at end of file diff --git a/src/Lib/Types/AppIndex.hs b/src/Lib/Types/AppIndex.hs index d2171be..2e7e126 100644 --- a/src/Lib/Types/AppIndex.hs +++ b/src/Lib/Types/AppIndex.hs @@ -22,8 +22,6 @@ import Model import qualified Data.Text as T import Data.String.Interpolate.IsString import qualified Data.ByteString.Lazy as BS -import Data.Tuple.Extra -import qualified Data.Attoparsec.Text as Atto type AppIdentifier = Text diff --git a/src/Lib/Types/Category.hs b/src/Lib/Types/Category.hs index a0c97ca..711df5e 100644 --- a/src/Lib/Types/Category.hs +++ b/src/Lib/Types/Category.hs @@ -1,42 +1,42 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} - module Lib.Types.Category where -import Startlude +import Startlude import Database.Persist.Postgresql import Data.Aeson import Control.Monad import Yesod.Core - +import qualified Data.Text as T data CategoryTitle = FEATURED | BITCOIN | LIGHTNING | DATA | MESSAGING + | SOCIAL | NONE | ANY - deriving (Eq, Show, Enum, Read) + deriving (Eq, Enum, Show, Read) instance PersistField CategoryTitle where fromPersistValue = fromPersistValueJSON toPersistValue = toPersistValueJSON instance PersistFieldSql CategoryTitle where sqlType _ = SqlString instance ToJSON CategoryTitle where - toJSON = String . show + toJSON = String . T.toLower . show instance FromJSON CategoryTitle where parseJSON = withText "CategoryTitle" $ \case - "FEATURED" -> pure FEATURED - "BITCOIN" -> pure BITCOIN - "LIGHTNING" -> pure LIGHTNING - "DATA" -> pure DATA - "MESSAGING" -> pure MESSAGING - "NONE" -> pure NONE - "ANY" -> pure ANY + "featured" -> pure FEATURED + "bitcoin" -> pure BITCOIN + "lightning" -> pure LIGHTNING + "data" -> pure DATA + "messaging" -> pure MESSAGING + "social" -> pure SOCIAL + "none" -> pure NONE + "any" -> pure ANY _ -> fail "unknown category title" instance ToContent CategoryTitle where toContent = toContent . toJSON instance ToTypedContent CategoryTitle where - toTypedContent = toTypedContent . toJSON - + toTypedContent = toTypedContent . toJSON \ No newline at end of file