eos endpoint, lowercase categories, sdk get instructions and license

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
+/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

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
@@ -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
+

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
@@ -51,8 +51,3 @@ getVersionWSpec :: KnownSymbol a => FilePath -> Extension a -> Handler (Maybe Ap
 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)

src/Lib/External/AppMgr.hs

@@ -69,3 +69,17 @@ getPackageHash appmgrPath appPath e@(Extension appId) = do
     case ec of
         ExitSuccess -> pure bs
         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

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
 

src/Lib/Types/Category.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE QuasiQuotes #-}
 
-
 module Lib.Types.Category where
 
 import Startlude
@@ -9,34 +8,35 @@ 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
-