categories refactor

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