categories refactor

src/Application.hs

@@ -11,6 +11,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Application
     ( appMain
+    , develMain
     , makeFoundation
     , makeLogWare
     , shutdownApp
@@ -25,7 +26,7 @@ module Application
     , handler
     ) where
 
-import           Startlude
+import           Startlude hiding (Handler)
 
 import           Control.Monad.Logger                  (liftLoc, runLoggingT)
 import           Data.Default
@@ -53,6 +54,7 @@ import           Foundation
 import           Handler.Apps
 import           Handler.Icons
 import           Handler.Version
+import           Handler.Marketplace
 import           Lib.Ssl
 import           Settings
 import           System.Posix.Process
@@ -310,16 +312,32 @@ shutdownWeb RegistryCtx{..} = do
 -- Functions for DevelMain.hs (a way to run the RegistryCtx from GHCi)
 --------------------------------------------------------------
 
-getApplicationRepl :: AppPort -> IO (Int, RegistryCtx, Application)
-getApplicationRepl port = do
+getApplicationRepl ::  IO (Int, RegistryCtx, Application)
+getApplicationRepl = do
+    settings <- getAppSettings
     foundation <- getAppSettings >>= makeFoundation
-    wsettings <- getDevSettings $ warpSettings port foundation
+    wsettings <- getDevSettings $ warpSettings (appPort settings) foundation
     app1 <- makeApplication foundation
     return (getPort wsettings, foundation,  app1)
 
 shutdownApp :: RegistryCtx -> IO ()
 shutdownApp _ = return ()
 
+-- | For yesod devel, return the Warp settings and WAI Application.
+getApplicationDev :: AppPort -> IO (Settings, Application)
+getApplicationDev port = do
+    settings <- getAppSettings
+    foundation <- makeFoundation settings
+    app <- makeApplication foundation
+    wsettings <- getDevSettings $ warpSettings port foundation
+    return (wsettings, app)
+
+-- | main function for use by yesod devel
+develMain :: IO ()
+develMain = do
+    settings <- getAppSettings
+    develMainHelper $ getApplicationDev $ appPort settings
+
 ---------------------------------------------
 -- Functions for use in development with GHCi
 ---------------------------------------------

src/Database/Marketplace.hs

@@ -0,0 +1,56 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module Database.Marketplace where
+
+import Startlude hiding ((%), from, on)
+import Database.Esqueleto.Experimental
+import Lib.Types.Category
+import Model
+import qualified Database.Persist as P
+import Data.HashMap.Strict
+import Data.Version
+import Data.Aeson
+
+searchServices :: MonadIO m => CategoryTitle -> Int64 ->  Int64 -> Text -> ReaderT SqlBackend m [P.Entity SApp]
+searchServices ANY pageItems offset' query = select $ do
+        service <- from $ table @SApp
+        where_ ((service ^. SAppDescShort `ilike` (%) ++. val query ++. (%)) 
+            ||. (service ^. SAppDescLong `ilike` (%) ++. val query ++. (%))
+            ||. (service ^. SAppTitle `ilike` (%) ++. val query ++. (%))
+            ||. (service ^. SAppAppId `ilike` (%) ++. val query ++. (%)))
+        orderBy [ desc (service ^. SAppUpdatedAt) ]
+        limit pageItems
+        offset offset'
+        pure service
+searchServices category pageItems offset' query = select $ do
+    services <- from
+        (do
+            (service :& sc) <-
+                from $ table @SApp
+                `innerJoin` table @ServiceCategory
+                `on` (\(s :& sc) ->
+                        sc ^. ServiceCategoryServiceId ==. s ^. SAppId)
+            where_ $ sc ^. ServiceCategoryCategoryName ==. val category
+                &&. ((service ^. SAppDescShort `ilike` (%) ++. val query ++. (%)) 
+                    ||. (service ^. SAppDescLong `ilike` (%) ++. val query ++. (%))
+                    ||. (service ^. SAppTitle `ilike` (%) ++. val query ++. (%))
+                    ||. (service ^. SAppAppId `ilike` (%) ++. val query ++. (%))
+                    )
+            pure service
+        )
+    orderBy [ desc (services ^. SAppUpdatedAt) ]
+    limit pageItems
+    offset offset'
+    pure services
+
+newtype VersionsWithReleaseNotes = VersionsWithReleaseNotes (HashMap Version Text) deriving (Eq, Show, Generic)
+instance FromJSON VersionsWithReleaseNotes
+instance PersistField VersionsWithReleaseNotes where
+    fromPersistValue = fromPersistValueJSON
+    toPersistValue = PersistText . show
+
+-- in progress attempt to do postgres aggregation with raw sql in esqueleto
+-- getServiceVersionsWithReleaseNotes :: MonadIO m => Text -> ReaderT SqlBackend m (Entity SApp)
+-- getServiceVersionsWithReleaseNotes appId = rawSql "SELECT ??, json_agg(json_build_object(v.number, v.release_notes)) as versions FROM s_app s LEFT JOIN version v ON v.app_id = s.id WHERE s.app_id = ? GROUP BY s.id;" [PersistText appId]

src/Database/Queries.hs

@@ -35,5 +35,5 @@ createAppVersion sId VersionInfo {..} = do
 
 createMetric :: MonadIO m => Key SApp -> Key SVersion -> ReaderT SqlBackend m ()
 createMetric appId versionId = do
-    time <- liftIO $ getCurrentTime
+    time <- liftIO getCurrentTime
     insert_ $ Metric time appId versionId

src/Foundation.hs

@@ -6,7 +6,7 @@
 {-# LANGUAGE ViewPatterns          #-}
 module Foundation where
 
-import           Startlude
+import           Startlude hiding (Handler)
 
 import           Control.Monad.Logger           ( LogSource )
 import           Database.Persist.Sql

src/Handler/Apps.hs

@@ -9,13 +9,12 @@
 
 module Handler.Apps where
 
-import           Startlude
+import           Startlude hiding (Handler)
 
 import           Control.Monad.Logger
 import           Data.Aeson
 import qualified Data.Attoparsec.Text          as Atto
 import qualified Data.ByteString.Lazy          as BS
-import           Data.Char
 import           Data.Conduit
 import qualified Data.Conduit.Binary           as CB
 import qualified Data.HashMap.Strict           as HM
@@ -101,6 +100,7 @@ getAppsManifestR = do
 getSysR :: Extension "" -> Handler TypedContent
 getSysR e = do
     sysResourceDir <- (</> "sys") . resourcesDir . appSettings <$> getYesod
+    -- @TODO update with new response type here
     getApp sysResourceDir e
 
 getAppManifestR :: AppIdentifier -> Handler TypedContent
@@ -145,10 +145,10 @@ getApp rootDir ext@(Extension appId) = do
     case best of
         Nothing -> notFound
         Just (RegisteredAppVersion (appVersion, filePath)) -> do
-            exists <- liftIO $ doesFileExist filePath >>= \case
+            exists' <- liftIO $ doesFileExist filePath >>= \case
                 True  -> pure Existent
                 False -> pure NonExistent
-            determineEvent exists (extension ext) filePath appVersion
+            determineEvent exists' (extension ext) filePath appVersion
     where
         determineEvent :: FileExistence -> String -> FilePath -> Version -> HandlerFor RegistryCtx TypedContent
         -- for app files

src/Handler/Icons.hs

@@ -4,7 +4,7 @@
 
 module Handler.Icons where
 
-import           Startlude
+import           Startlude hiding (Handler)
 
 import           Data.Conduit
 import qualified Data.Conduit.Binary as CB
@@ -18,6 +18,7 @@ import           System.FilePath ((</>))
 
 getIconsR :: Extension "png" -> Handler TypedContent
 getIconsR ext = do
+    -- @TODO switch to getting from service directory
     AppSettings{..} <- appSettings <$> getYesod
     mPng <- liftIO $ getUnversionedFileFromDir (resourcesDir </> "icons") ext
     case mPng of

src/Handler/Marketplace.hs

@@ -0,0 +1,319 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TemplateHaskell  #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+
+module Handler.Marketplace where
+
+import Startlude hiding (from, Handler, on)
+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 Text.Read hiding (readMaybe)
+import Lib.Types.AppIndex
+import qualified Data.HashMap.Strict as HM
+import Data.HashMap.Strict (HashMap)
+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
+
+
+newtype CategoryRes = CategoryRes {
+    categories :: [CategoryTitle]
+} deriving (Show, Generic)
+instance ToJSON CategoryRes
+instance FromJSON CategoryRes
+instance ToContent CategoryRes where
+    toContent = toContent . toJSON
+instance ToTypedContent CategoryRes where
+    toTypedContent = toTypedContent . toJSON
+data ServiceRes =  ServiceRes
+    { serviceResIcon :: Text
+    , serviceResManifest :: ServiceManifest
+    , serviceResCategories :: [CategoryTitle]
+    , serviceResVersions :: [Version]
+    , serviceResDependencyInfo :: HashMap AppIdentifier DependencyInfo
+    , serviceResReleaseNotes :: HashMap Version Text
+    } deriving (Show)
+instance ToJSON ServiceRes where
+    toJSON ServiceRes {..} = object
+        [ "icon" .= serviceResIcon
+        , "manifest" .= serviceResManifest
+        , "categories" .= serviceResCategories
+        , "versions" .= serviceResVersions
+        , "dependency-metadata" .= serviceResDependencyInfo
+        , "release-notes" .= serviceResReleaseNotes
+        ]
+instance ToContent ServiceRes where
+    toContent = toContent . toJSON
+instance ToTypedContent ServiceRes where
+    toTypedContent = toTypedContent . toJSON
+data DependencyInfo = DependencyInfo
+    { dependencyInfoTitle :: Text -- title
+    , dependencyInfoIcon :: Text -- url
+    } deriving (Eq, Show)
+instance ToJSON DependencyInfo where
+    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
+        ]
+instance ToContent ServiceListRes where
+    toContent = toContent . toJSON
+instance ToTypedContent ServiceListRes where
+    toTypedContent = toTypedContent . toJSON
+
+data ServiceAvailable = ServiceAvailable
+    { serviceAvailableId :: Text
+    , serviceAvailableTitle :: Text
+    , serviceAvailableVersion :: Version
+    , serviceAvailableIcon :: URL
+    , serviceAvailableDescShort :: Text
+    } deriving (Show)
+instance ToJSON ServiceAvailable where
+    toJSON ServiceAvailable { .. } = object
+        [ "id" .= serviceAvailableId
+        , "title" .= serviceAvailableTitle
+        , "version" .= serviceAvailableVersion
+        , "icon" .= serviceAvailableIcon
+        , "descriptionShort" .= serviceAvailableDescShort
+        ]
+instance ToContent ServiceAvailable where
+    toContent = toContent . toJSON
+instance ToTypedContent ServiceAvailable where
+    toTypedContent = toTypedContent . toJSON
+
+data OrderArrangement = ASC | DESC
+    deriving (Eq, Show, Read)
+data ServiceListDefaults = ServiceListDefaults
+    { serviceListOrder :: OrderArrangement
+    , serviceListPageLimit :: Int64 -- the number of items per page
+    , serviceListPageNumber :: Int64 -- the page you are on
+    , serviceListCategory :: CategoryTitle
+    , serviceListQuery :: Text
+    }
+    deriving (Eq, Show, Read)
+
+getCategoriesR :: Handler CategoryRes
+getCategoriesR = do
+    allCategories <- runDB $ select $ do from $ table @Category
+    pure $ CategoryRes $ categoryName . entityVal <$>allCategories
+
+getServiceListR :: Handler ServiceListRes
+getServiceListR = do
+    getParameters <- reqGetParams <$> getRequest
+    let defaults = ServiceListDefaults {
+              serviceListOrder = DESC
+            , serviceListPageLimit = 20
+            , serviceListPageNumber = 1
+            , serviceListCategory = ANY
+            , serviceListQuery = ""
+        }
+    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 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
+    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
+    query <- T.filter (not . isSpace) . fromMaybe (serviceListQuery defaults) <$> lookupGetParam "query"
+    $logInfo $ show category
+    filteredServices <- runDB $ searchServices category limit' ((page - 1) * limit') query
+    domain <- getsYesod $ registryHostname . appSettings
+    (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
+    services <- runDB $ traverse (mapEntityToServiceAvailable appMgrDir appsDir domain) filteredServices
+    pure $ ServiceListRes {
+          serviceListResCategories = [FEATURED .. MESSAGING]
+        , serviceListResServices = services
+    }
+
+getServiceR :: Handler ServiceRes
+getServiceR = do
+    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
+                            Nothing -> do
+                                        -- default to latest - need to determine best available based on OS version?
+                                        runDB $ fetchLatestApp appId' >>= errOnNothing status404 "service not found"
+                            Just c -> do
+                                let version' = Version $ read $ toS c
+                                runDB $ fetchLatestAppAtVersion appId' version' >>= errOnNothing status404 ("service at version " <> show version' <> " not found")
+    (versions, mappedVersions) <- fetchAllAppVersions (entityKey service)
+    categories <- runDB $ fetchAppCategories (entityKey service)
+    (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
+    let appId = sAppAppId $ entityVal service
+    let appVersion = sVersionNumber (entityVal version)
+    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 :: ServiceManifest) -> pure a
+    -- @TODO uncomment when new apps.yaml
+    -- let storeApp = fromMaybe
+    --       _
+    --       (HM.lookup (sAppAppId $ entityVal service)
+    --          $ unAppManifest manifest)
+    -- let versionInfo = filter (\v -> versionInfoVersion v == appVersion) $ NE.toList $ storeAppVersionInfo storeApp
+    -- let deps = HM.toList (versionInfoDependencies $ Data.List.head versionInfo)
+    d <- traverse (mapDependencyMetadata appsDir appMgrDir) (HM.toList $ serviceManifestDependencies manifest)
+    icon <- decodeIcon appMgrDir appsDir appExt
+    pure $ ServiceRes
+        { serviceResIcon = icon
+        , serviceResManifest = manifest -- TypedContent "application/json" (toContent manifest)
+        , serviceResCategories = serviceCategoryCategoryName . entityVal <$> categories
+        , serviceResVersions = versionInfoVersion <$> versions
+        , serviceResDependencyInfo = HM.fromList d
+        , serviceResReleaseNotes = mappedVersions
+        }
+
+type URL = Text
+mapDependencyMetadata :: (MonadIO m, MonadHandler m) => FilePath -> FilePath -> (AppIdentifier, ServiceDependencyInfo) -> m (AppIdentifier, DependencyInfo)
+mapDependencyMetadata appsDir appmgrPath (appId, depInfo) = do
+    let ext = (Extension (toS appId) :: Extension "s9pk")
+    -- use if we have VersionRange instead of Version
+    -- version <- getBestVersion appsDir ext (snd dep) >>= \case
+    --     Nothing -> sendResponseStatus status400 ("Specified App Version Not Found" :: Text)
+    --     Just v -> pure v
+    let depPath = appsDir </> toS appId </> show (serviceDependencyInfoVersion depInfo)
+    icon <- decodeIcon appmgrPath depPath ext
+    pure (appId, DependencyInfo
+            { dependencyInfoTitle = appId
+            , dependencyInfoIcon = icon
+            })
+
+decodeIcon :: (MonadHandler m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> m URL
+decodeIcon appmgrPath depPath e@(Extension icon) = do
+    icon' <- handleS9ErrT $ getIcon appmgrPath depPath e
+    case eitherDecode $ BS.fromStrict icon' of
+        Left e' -> do
+            $logInfo $ T.pack e'
+            sendResponseStatus status400 e'
+        Right (i' :: URL) -> pure $ i' <> T.pack icon
+
+fetchAllAppVersions :: Key SApp -> HandlerFor RegistryCtx ([VersionInfo], HashMap Version Text)
+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
+    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) ]
+                                        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)
+
+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)
+
+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
+
+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
+        }
+
+mapEntityToServiceAvailable :: (MonadIO m, MonadHandler m) => FilePath -> FilePath -> Text -> Entity SApp ->  ReaderT SqlBackend m ServiceAvailable
+mapEntityToServiceAvailable appMgrDir appsDir domain service = do
+        -- @TODO uncomment and replace icon when portable embassy-sdk live
+        -- icon <- decodeIcon appMgrDir appsDir (Extension "png")
+        let appId = sAppAppId $ entityVal service
+        let icon = [i|https://#{domain}/icons/#{appId}.png|]
+        (_, 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 = icon
+            }

src/Handler/Types/Status.hs

@@ -3,7 +3,7 @@
 {-# LANGUAGE NamedFieldPuns    #-}
 module Handler.Types.Status where
 
-import           Startlude
+import           Startlude hiding (toLower)
 
 import           Data.Aeson
 import           Yesod.Core.Content

src/Handler/Version.hs

@@ -6,7 +6,7 @@
 
 module Handler.Version where
 
-import           Startlude
+import           Startlude hiding (Handler)
 
 import           Control.Monad.Trans.Maybe
 import           Yesod.Core
@@ -48,4 +48,4 @@ getVersionWSpec rootDir ext = do
 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 NOTHING $ Version (1,0,0,0)
+    pure $ OSVersionRes NOTHING $ Version (0,3,0,0)

src/Lib/External/AppMgr.hs

@@ -25,11 +25,11 @@ readProcessWithExitCode' a b c = liftIO $ do
                 $ setStderr byteStringOutput
                 $ setEnvInherit
                 $ setStdout byteStringOutput
-                $ (System.Process.Typed.proc a b)
+                $ System.Process.Typed.proc a b
     withProcessWait pc $ \process -> atomically $ liftA3 (,,)
                                                          (waitExitCodeSTM process)
-                                                         (fmap LBS.toStrict $ getStdout process)
-                                                         (fmap LBS.toStrict $ getStderr process)
+                                                         (LBS.toStrict <$> getStdout process)
+                                                         (LBS.toStrict <$> getStderr process)
 
 readProcessInheritStderr :: MonadIO m => String -> [String] -> ByteString -> m (ExitCode, ByteString)
 readProcessInheritStderr a b c = liftIO $ do
@@ -38,20 +38,27 @@ readProcessInheritStderr a b c = liftIO $ do
                 $ setStderr inherit
                 $ setEnvInherit
                 $ setStdout byteStringOutput
-                $ (System.Process.Typed.proc a b)
+                $ System.Process.Typed.proc a b
     withProcessWait pc
-        $ \process -> atomically $ liftA2 (,) (waitExitCodeSTM process) (fmap LBS.toStrict $ getStdout process)
+        $ \process -> atomically $ liftA2 (,) (waitExitCodeSTM process) (LBS.toStrict <$> getStdout process)
 
 getConfig :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m Text
 getConfig appmgrPath appPath e@(Extension appId) = fmap decodeUtf8 $ do
-    (ec, out) <- readProcessInheritStderr (appmgrPath <> "appmgr") ["inspect", "info", appPath <> (show e), "-C", "--json"] ""
+    (ec, out) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "config", appPath <> show e, "--json"] ""
     case ec of
         ExitSuccess   -> pure out
-        ExitFailure n -> throwE $ AppMgrE [i|info #{appId} -C \--json|] n
+        ExitFailure n -> throwE $ AppMgrE [i|info config #{appId} \--json|] n
 
 getManifest ::  (MonadIO m, KnownSymbol a)  => FilePath -> FilePath ->  Extension a -> S9ErrT m ByteString
 getManifest appmgrPath appPath e@(Extension appId) = do
-    (ec, bs) <- readProcessInheritStderr (appmgrPath <> "appmgr") ["inspect", "info", appPath <> (show e), "-M", "--json"] ""
+    (ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "manifest", appPath <> show e, "--json"] ""
     case ec of
         ExitSuccess -> pure bs
-        ExitFailure n -> throwE $ AppMgrE [i|info -M #{appId} \--json|] n
+        ExitFailure n -> throwE $ AppMgrE [i|info manifest #{appId} \--json|] n
+
+getIcon ::  (MonadIO m, KnownSymbol a)  => FilePath -> FilePath ->  Extension a -> S9ErrT m ByteString
+getIcon appmgrPath appPath e@(Extension icon) = do
+    (ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "icon", appPath <> show e] ""
+    case ec of
+        ExitSuccess -> pure bs
+        ExitFailure n -> throwE $ AppMgrE [i|icon #{icon} \--json|] n

src/Lib/Registry.hs

@@ -27,6 +27,7 @@ instance Semigroup (MaxVersion a) where
     (MaxVersion (a, f)) <> (MaxVersion (b, g)) = if f a > g b then MaxVersion (a, f) else MaxVersion (b, g)
 
 -- retrieve all valid semver folder names with queried for file: rootDirectory/appId/[0.0.0 ...]/appId.extension
+-- TODO move to db query after all appversions are seeded qith post 0.3.0 migration script
 getAvailableAppVersions :: KnownSymbol a => FilePath -> Extension a -> IO [RegisteredAppVersion]
 getAvailableAppVersions rootDirectory ext@(Extension appId) = do
     versions <- mapMaybe (hush . Atto.parseOnly parseVersion . toS) <$> getSubDirectories (rootDirectory </> appId)
@@ -58,6 +59,7 @@ newtype Extension (a :: Symbol) = Extension String deriving (Eq)
 type S9PK = Extension "s9pk"
 type SYS_EXTENSIONLESS = Extension ""
 type PNG = Extension "png"
+type SVG = Extension "svg"
 
 instance IsString (Extension a) where
     fromString = Extension
@@ -72,7 +74,7 @@ instance KnownSymbol a => Show (Extension a) where
     show e@(Extension file) = file <.> extension e
 
 instance KnownSymbol a => Read (Extension a) where
-    readsPrec _ s = case (symbolVal $ Proxy @a) of
+    readsPrec _ s = case symbolVal $ Proxy @a of
         ""    -> [(Extension s, "")]
         other -> [ (Extension file, "") | ext' == "" <.> other ]
         where (file, ext') = splitExtension s

src/Lib/SystemCtl.hs

@@ -1,9 +1,8 @@
 module Lib.SystemCtl where
 
 import           Startlude      hiding (words)
-import           Unsafe
+import Protolude.Unsafe
 
-import           Data.Char
 import           Data.String
 import           System.Process
 import           Text.Casing

src/Lib/Types/AppIndex.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 module Lib.Types.AppIndex where
 
 import           Startlude               hiding ( Any )
@@ -14,19 +16,32 @@ import           Lib.Types.Emver
 import           Orphans.Emver                  ( )
 import           System.Directory
 import           Lib.Registry
+import Model
+import qualified Data.Text as T
 
 type AppIdentifier = Text
 
 data VersionInfo = VersionInfo
     { versionInfoVersion       :: Version
     , versionInfoReleaseNotes  :: Text
-    , versionInfoDependencies  :: HM.HashMap Text VersionRange
+    , versionInfoDependencies  :: HM.HashMap AppIdentifier VersionRange
     , versionInfoOsRequired    :: VersionRange
     , versionInfoOsRecommended :: VersionRange
     , versionInfoInstallAlert  :: Maybe Text
     }
     deriving (Eq, Show)
 
+mapSVersionToVersionInfo :: [SVersion] -> [VersionInfo]
+mapSVersionToVersionInfo sv = do
+    (\v -> VersionInfo {
+      versionInfoVersion = sVersionNumber v
+    , versionInfoReleaseNotes = sVersionReleaseNotes v
+    , versionInfoDependencies = HM.empty
+    , versionInfoOsRequired = sVersionOsVersionRequired v
+    , versionInfoOsRecommended = sVersionOsVersionRecommended v
+    , versionInfoInstallAlert = Nothing
+    }) <$> sv
+
 instance Ord VersionInfo where
     compare = compare `on` versionInfoVersion
 
@@ -68,7 +83,6 @@ instance ToJSON StoreApp where
         , "version-info" .= storeAppVersionInfo
         , "timestamp" .= storeAppTimestamp
         ]
-
 newtype AppManifest = AppManifest { unAppManifest :: HM.HashMap AppIdentifier StoreApp}
     deriving (Show)
 
@@ -90,7 +104,6 @@ instance FromJSON AppManifest where
 instance ToJSON AppManifest where
     toJSON = toJSON . unAppManifest
 
-
 filterOsRequired :: Version -> StoreApp -> Maybe StoreApp
 filterOsRequired av sa = case NE.filter ((av <||) . versionInfoOsRequired) (storeAppVersionInfo sa) of
     []       -> Nothing
@@ -107,4 +120,71 @@ addFileTimestamp appDir ext service v = do
                 Nothing -> pure Nothing
                 Just file -> do
                     time <- getModificationTime file
-                    pure $ Just service {storeAppTimestamp = Just time }
+                    pure $ Just service {storeAppTimestamp = Just time }
+
+data ServiceDependencyInfo = ServiceDependencyInfo
+    { serviceDependencyInfoOptional :: Maybe Text
+    , serviceDependencyInfoRecommended :: Bool 
+    , serviceDependencyInfoVersion :: Version
+    , serviceDependencyInfoDescription :: Maybe Text
+    } deriving (Show)
+instance FromJSON ServiceDependencyInfo where
+    parseJSON = withObject "service dependency info" $ \o -> do
+        serviceDependencyInfoOptional <- o .:? "optional"
+        serviceDependencyInfoRecommended <- o .: "recommended"
+        serviceDependencyInfoVersion <- o .: "version"
+        serviceDependencyInfoDescription <- o .:? "description"
+        pure ServiceDependencyInfo { .. }
+
+instance ToJSON ServiceDependencyInfo where
+    toJSON ServiceDependencyInfo {..} = object
+        [ "description" .= serviceDependencyInfoDescription
+        , "version" .= serviceDependencyInfoVersion
+        , "recommended" .= serviceDependencyInfoRecommended
+        , "optional" .= serviceDependencyInfoOptional
+        ]
+data ServiceAlert = INSTALL | UNINSTALL | RESTORE | START | STOP
+    deriving (Show, Eq, Generic, Hashable)
+instance FromJSONKey ServiceAlert
+instance ToJSONKey ServiceAlert
+instance ToJSON ServiceAlert where
+    toJSON = String . T.toLower . show
+instance FromJSON ServiceAlert where
+    parseJSON = withText "ServiceAlert" $ \case
+        "install"   -> pure INSTALL
+        "uninstall" -> pure UNINSTALL
+        "restore"   -> pure RESTORE
+        "start"     -> pure START
+        "stop"      -> pure STOP
+        _           -> fail "unknown service alert type"
+data ServiceManifest = ServiceManifest 
+    { serviceManifestId :: AppIdentifier
+    , serviceManifestTitle :: Text
+    , serviceManifestVersion :: Version
+    , serviceManifestDescriptionLong :: Text
+    , serviceManifestDescriptionShort :: Text
+    , serviceManifestReleaseNotes :: Text
+    , serviceManifestAlerts :: HM.HashMap ServiceAlert (Maybe Text)
+    , serviceManifestDependencies :: HM.HashMap AppIdentifier ServiceDependencyInfo
+    } deriving (Show)
+instance FromJSON ServiceManifest where
+    parseJSON = withObject "service manifest" $ \o -> do
+        serviceManifestId <- o .: "id"
+        serviceManifestTitle <- o .: "title"
+        serviceManifestVersion <- o .: "version"
+        serviceManifestDescriptionLong <- o .: "description" >>= (.: "long")
+        serviceManifestDescriptionShort <- o .: "description" >>= (.: "short")
+        serviceManifestReleaseNotes <- o .: "release-notes"
+        serviceManifestAlerts <- o .: "alerts"
+        serviceManifestDependencies <- o .: "dependencies"
+        pure ServiceManifest { .. }
+instance ToJSON ServiceManifest where
+    toJSON ServiceManifest {..} = object
+        [ "id" .= serviceManifestId
+        , "title" .= serviceManifestTitle
+        , "version" .= serviceManifestVersion
+        , "description" .= object ["short" .= serviceManifestDescriptionShort, "long" .= serviceManifestDescriptionLong]
+        , "release-notes" .= serviceManifestReleaseNotes
+        , "alerts" .= serviceManifestAlerts
+        , "dependencies" .= serviceManifestDependencies
+        ]

src/Lib/Types/Category.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+
+module Lib.Types.Category where
+
+import Startlude 
+import Database.Persist.Postgresql
+import Data.Aeson
+import qualified Data.Text as T
+import Control.Monad
+import Yesod.Core
+import Data.String.Interpolate.IsString
+import qualified Data.ByteString.Lazy     as BS
+
+data CategoryTitle = FEATURED 
+        | BITCOIN
+        | LIGHTNING
+        | DATA
+        | MESSAGING
+        | NONE
+        | ANY
+    deriving (Eq, Show, Enum, Read)
+instance PersistField CategoryTitle where
+    fromPersistValue = fromPersistValueJSON
+    toPersistValue = toPersistValueJSON
+instance PersistFieldSql CategoryTitle where
+  sqlType _ = SqlString
+instance ToJSON CategoryTitle where
+    toJSON = String . 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
+        _            -> fail "unknown category title"
+instance ToContent CategoryTitle where
+    toContent = toContent . toJSON
+instance ToTypedContent CategoryTitle where
+    toTypedContent = toTypedContent . toJSON
+
+cat :: BS.ByteString
+cat = [i|"featured"|]
+

src/Lib/Types/Emver.hs

@@ -48,9 +48,11 @@ import           Control.Applicative            ( liftA2
                                                 )
 import           Data.String                    ( IsString(..) )
 import qualified Data.Text                     as T
+import Data.Aeson
+import Startlude (Hashable)
 
 -- | AppVersion is the core representation of the SemverQuad type.
-newtype Version = Version { unVersion :: (Word, Word, Word, Word) } deriving (Eq, Ord)
+newtype Version = Version { unVersion :: (Word, Word, Word, Word) } deriving (Eq, Ord, ToJSONKey, Hashable)
 instance Show Version where
     show (Version (x, y, z, q)) =
         let postfix = if q == 0 then "" else '.' : show q in show x <> "." <> show y <> "." <> show z <> postfix

src/Model.hs

@@ -13,9 +13,9 @@ module Model where
 import           Startlude
 import           Database.Persist.TH
 import           Lib.Types.Emver
+import           Lib.Types.Category
 import           Orphans.Emver                  ( )
 
-
 share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
 SApp
     createdAt UTCTime
@@ -41,6 +41,14 @@ SVersion sql=version
     deriving Eq
     deriving Show
 
+OsVersion 
+    createdAt UTCTime
+    updatedAt UTCTime
+    number Version
+    headline Text
+    releaseNotes Text 
+    deriving Eq
+    deriving Show
 
 Metric
     createdAt UTCTime
@@ -48,4 +56,22 @@ Metric
     version SVersionId
     deriving Eq
     deriving Show
+
+Category
+    createdAt UTCTime
+    name CategoryTitle
+    parent CategoryId Maybe
+    description Text
+    deriving Eq
+    deriving Show
+
+ServiceCategory
+    createdAt UTCTime
+    serviceId SAppId
+    categoryId CategoryId
+    serviceName Text -- SAppAppId
+    categoryName CategoryTitle -- CategoryTitle
+    priority Int Maybe
+    deriving Eq
+    deriving Show
 |]

src/Util/Shared.hs

@@ -1,8 +1,7 @@
 module Util.Shared where
 
-import           Startlude
+import           Startlude hiding (Handler)
 
-import           Data.Char
 import qualified Data.Text                     as T
 import           Network.HTTP.Types
 import           Yesod.Core
@@ -18,7 +17,11 @@ getVersionFromQuery rootDir ext = do
     spec       <- case readMaybe specString of
         Nothing -> sendResponseStatus status400 ("Invalid App Version Specification" :: Text)
         Just t  -> pure t
+    getBestVersion rootDir ext spec
+
+getBestVersion :: (MonadIO m, KnownSymbol a, MonadLogger m) => FilePath -> Extension a -> VersionRange -> m (Maybe Version)
+getBestVersion rootDir ext spec = do
     appVersions <- liftIO $ getAvailableAppVersions rootDir ext
     let satisfactory = filter ((<|| spec) . fst . unRegisteredAppVersion) appVersions
     let best         = getMax <$> foldMap (Just . Max . fst . unRegisteredAppVersion) satisfactory
-    pure best
+    pure best