resource gathering

src/Lib/Resource.hs

@@ -0,0 +1,45 @@
+{-# LANGUAGE TupleSections #-}
+
+module Lib.Resource where
+
+import           Startlude         hiding (empty)
+
+import           Data.Aeson
+import           Data.HashMap.Lazy hiding (mapMaybe)
+import           System.Directory
+import           System.FilePath
+
+import           Lib.Types.Semver
+
+
+resourcePath :: FilePath
+resourcePath = "./resources"
+
+manifestPath :: FilePath
+manifestPath = resourcePath </> "apps.yml"
+
+manifestFile :: FilePath
+manifestFile = "apps.yml"
+
+s9pkFile :: String -> FilePath
+s9pkFile appId = toS appId <.> "s9pk"
+
+type Registry = HashMap String (HashMap AppVersion FilePath)
+
+loadResources :: MonadIO m => m Registry
+loadResources = liftIO $ do
+    appDirectories <- getSubDirectories resourcePath
+    foldM
+        ( \hm appId -> do
+            subdirs <- getSubDirectories (resourcePath </> appId)
+            let validVersions = mapMaybe readMaybe subdirs
+            let newAppVersions = fromList $ fmap (, s9pkFile appId) validVersions
+            pure $ insert appId newAppVersions hm
+        ) empty appDirectories
+    where
+        getSubDirectories path = listDirectory path >>= filterM (fmap not . doesFileExist)
+
+getAppFile :: Registry -> String -> AppVersion -> Maybe FilePath
+getAppFile r appId av = do
+    s9pk <- lookup av <=< lookup appId $ r
+    pure $ resourcePath </> appId </> show av </> s9pk

src/Lib/Types/Api.hs

@@ -1,28 +0,0 @@
-{-# LANGUAGE DataKinds       #-}
-{-# LANGUAGE RecordWildCards #-}
-module Lib.Types.Api where
-
-import           Startlude
-
-import           Data.Aeson
-
-import           Orphans.Yesod ()
-
--- data PostWifiRes; TODO: do we need the PostWifiRes or equivalent??
-data AddWifiReq = AddWifiReq
-  { addWifiSsid :: Text
-  , addWifiPass :: Text
-  } deriving (Eq, Show)
-instance FromJSON AddWifiReq where
-    parseJSON = withObject "add wifi req" $ \o -> do
-        addWifiSsid <- o .: "ssid"
-        addWifiPass <- o .: "password"
-        pure AddWifiReq{..}
-
-newtype EnableWifiReq = EnableWifiReq
-  { enableWifiSsid :: Text
-  } deriving (Eq, Show)
-instance FromJSON EnableWifiReq where
-    parseJSON = withObject "enable wifi req" $ \o -> do
-        enableWifiSsid <- o .: "ssid"
-        pure $ EnableWifiReq {..}

src/Lib/Types/AppsManifest.hs

@@ -0,0 +1,56 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Lib.Types.AppsManifest where
+
+import           Data.HashMap.Strict
+import           Data.Yaml
+
+import           Lib.Types.Semver
+import           Startlude
+
+
+type AppsManifest = HashMap Text FullAppManifest
+data FullAppManifest = FullAppManifest { name :: Text, appGlobals :: AppGlobals, appVersionDetails :: NonEmpty AppVersionDetails }
+
+data AppGlobals = AppGlobals
+    { globalAppTitle            :: Text
+    , globalAppDescriptionShort :: Text
+    , globalAppDescriptionLong  :: Text
+    , globalAppIconUrl          :: Text
+    }
+
+instance FromJSON AppGlobals where
+    parseJSON = withObject "App Globals" $ \o -> do
+        desc <- o .: "description"
+        (globalAppDescriptionShort, globalAppDescriptionLong) <-
+            ( withObject "App Description" $ \d -> do
+                s <- d .: "short"
+                l <- d .: "long"
+                pure (s,l)
+            ) desc
+        globalAppTitle <- o .: "title"
+        globalAppIconUrl <- o .: "icon-url"
+        pure AppGlobals{..}
+instance ToJSON AppGlobals where
+    toJSON AppGlobals{..} = object
+        [ "title" .= globalAppTitle
+        , "descriptionShort" .= globalAppDescriptionShort
+        , "descriptionLong" .= globalAppDescriptionLong
+        , "iconUrl" .= globalAppIconUrl
+        ]
+
+
+data AppVersionDetails = AppVersionDetails
+    { versionDetailsVersion      :: AppVersion
+    , versionDetailsReleaseNotes :: Text
+    } deriving (Eq, Ord, Show)
+instance FromJSON AppVersionDetails where
+    parseJSON = withObject "Store App Version Info" $ \o -> do
+        versionDetailsVersion <- o .: "version"
+        versionDetailsReleaseNotes <- o .: "release-notes"
+        pure AppVersionDetails{..}
+instance ToJSON AppVersionDetails where
+    toJSON AppVersionDetails{..} = object
+        [ "version" .= versionDetailsVersion
+        , "releaseNotes" .= versionDetailsReleaseNotes
+        ]

src/Lib/Types/Semver.hs

@@ -17,6 +17,10 @@ import           Yesod.Core
 newtype AppVersion = AppVersion
     { unAppVersion :: (Word16, Word16, Word16) } deriving (Eq, Ord)
 
+instance Hashable AppVersion where
+    hash (AppVersion (a, b, c)) = (2 ^ c) * (3 ^ b) * (5 ^ a)
+    hashWithSalt _ = hash
+
 instance Read AppVersion where
     readsPrec _ s = case traverse (readMaybe . toS) $ split (=='.') (toS s) of
         Just [major, minor, patch] -> [(AppVersion (major, minor, patch), "")]

src/Lib/Types/ServerApp.hs

@@ -1,57 +0,0 @@
-
-{-# LANGUAGE RecordWildCards #-}
-module Lib.Types.ServerApp where
-
-import           Startlude
-
-import           Control.Monad.Fail
-import           Data.Aeson
-import           Data.Text
-
-import           Lib.Types.Semver
-
-data StoreApp = StoreApp
-    { storeAppId               :: Text
-    , storeAppTitle            :: Text
-    , storeAppDescriptionShort :: Text
-    , storeAppDescriptionLong  :: Text
-    , storeAppIconUrl          :: Text
-    , storeAppVersions         :: NonEmpty StoreAppVersionInfo
-    } deriving (Eq, Show)
-
-data StoreAppVersionInfo = StoreAppVersionInfo
-    { storeAppVersionInfoVersion      :: AppVersion
-    , storeAppVersionInfoReleaseNotes :: Text
-    } deriving (Eq, Ord, Show)
-instance FromJSON StoreAppVersionInfo where
-    parseJSON = withObject "Store App Version Info" $ \o -> do
-        storeAppVersionInfoVersion <- o .: "version"
-        storeAppVersionInfoReleaseNotes <- o .: "release-notes"
-        pure StoreAppVersionInfo{..}
-instance ToJSON StoreAppVersionInfo where
-    toJSON StoreAppVersionInfo{..} = object
-        [ "version" .= storeAppVersionInfoVersion
-        , "releaseNotes" .= storeAppVersionInfoReleaseNotes
-        ]
-
-data ServerApp = ServerApp
-    { serverAppId               :: Text
-    , serverAppVersionInstalled :: AppVersion
-    , serverAppTorService       :: Text
-    , serverAppIsConfigured     :: Bool
-    } deriving (Eq, Show)
-
-
-data AppStatus = Running | Stopped | Restarting | Removing | Dead deriving (Eq, Show)
-instance ToJSON AppStatus where
-    toJSON = String . toUpper . show
-instance FromJSON AppStatus where
-    parseJSON = withText "health status" $ \case
-        "RUNNING" -> pure Running
-        "STOPPED" -> pure Stopped
-        "RESTARTING" -> pure Restarting
-        "REMOVING" -> pure Removing
-        "DEAD" -> pure Dead
-        _         -> fail "unknown status"
-
-data AppAction = Start | Stop deriving (Eq, Show)

src/Lib/Types/StoreApp.hs

@@ -0,0 +1,33 @@
+
+{-# LANGUAGE RecordWildCards #-}
+module Lib.Types.StoreApp where
+
+import           Startlude
+
+import           Control.Monad.Fail
+import           Data.Aeson
+import           Data.Text
+
+import           Lib.Types.AppsManifest
+import           Lib.Types.Semver
+
+data StoreApp = StoreApp
+    { storeAppId               :: Text
+    , storeAppTitle            :: Text
+    , storeAppDescriptionShort :: Text
+    , storeAppDescriptionLong  :: Text
+    , storeAppIconUrl          :: Text
+    , storeAppVersions         :: NonEmpty AppVersionDetails
+    } deriving (Eq, Show)
+
+instance ToJSON StoreApp where
+    toJSON (StoreApp{..}) = object
+                [ "id" .= storeAppId
+                , "title" .= storeAppTitle
+                , "iconURL" .= storeAppIconUrl
+                , "description" .= object
+                    [ "short" .= storeAppDescriptionShort
+                    , "long" .= storeAppDescriptionLong
+                    ]
+                , "versionInfo" .= storeAppVersions
+                ]