From a00f4f10e3b52537863aa8ec3000e767a91b984c Mon Sep 17 00:00:00 2001 From: Aaron Greenspan Date: Mon, 23 Dec 2019 18:14:37 -0700 Subject: [PATCH 1/3] resource gathering --- config/routes | 4 +- package.yaml | 1 + resources/apps.yaml | 9 ++++ resources/bitcoind/0.18.1/version.yaml | 2 + resources/bitcoind/app.yaml | 5 ++ src/Application.hs | 1 + src/Handler/Apps.hs | 11 +++- src/Handler/Status.hs | 4 +- src/Handler/Types/Apps.hs | 69 ++------------------------ src/Handler/Types/Status.hs | 31 +++--------- src/Lib/Resource.hs | 45 +++++++++++++++++ src/Lib/Types/Api.hs | 28 ----------- src/Lib/Types/AppsManifest.hs | 56 +++++++++++++++++++++ src/Lib/Types/Semver.hs | 4 ++ src/Lib/Types/ServerApp.hs | 57 --------------------- src/Lib/Types/StoreApp.hs | 33 ++++++++++++ src/Startlude.hs | 3 +- test/Live/UpdateAgent.hs | 2 +- 18 files changed, 182 insertions(+), 183 deletions(-) create mode 100644 resources/apps.yaml create mode 100644 resources/bitcoind/0.18.1/version.yaml create mode 100644 resources/bitcoind/app.yaml create mode 100644 src/Lib/Resource.hs delete mode 100644 src/Lib/Types/Api.hs create mode 100644 src/Lib/Types/AppsManifest.hs delete mode 100644 src/Lib/Types/ServerApp.hs create mode 100644 src/Lib/Types/StoreApp.hs diff --git a/config/routes b/config/routes index 00c3ec2..ff86c7e 100644 --- a/config/routes +++ b/config/routes @@ -1,6 +1,6 @@ --authed -/version/#AppVersion VersionR GET --- /apps AppsManifestR GET --get current apps listing +/version VersionR GET +/apps AppsManifestR GET --get current apps listing -- /apps/#Text/#AppVersion AppR GET --install new app -- /sys/agent/#AppVersion AgentR GET --install new agent version -- /sys/appmgr/#AppVersion AppMgrR GET --install new appmgr version diff --git a/package.yaml b/package.yaml index 8a025c2..08797b7 100644 --- a/package.yaml +++ b/package.yaml @@ -88,6 +88,7 @@ dependencies: - yaml >=0.11 && <0.12 - yesod >=1.6 && <1.7 - yesod-core >=1.6 && <1.7 +- yesod-static - yesod-persistent >= 1.6 && < 1.7 default-extensions: diff --git a/resources/apps.yaml b/resources/apps.yaml new file mode 100644 index 0000000..645eadd --- /dev/null +++ b/resources/apps.yaml @@ -0,0 +1,9 @@ +bitcoind: + title: "Bitcoin Core" + description: + short: "A Bitcoin Full Node" + long: "The bitcoin full node implementation by Bitcoin Core." + version-info: + - version: 0.18.1 + release-notes: "Some stuff" + icon-type: png \ No newline at end of file diff --git a/resources/bitcoind/0.18.1/version.yaml b/resources/bitcoind/0.18.1/version.yaml new file mode 100644 index 0000000..610cb0a --- /dev/null +++ b/resources/bitcoind/0.18.1/version.yaml @@ -0,0 +1,2 @@ +version: 0.18.1 +release-notes: "Some stuff" \ No newline at end of file diff --git a/resources/bitcoind/app.yaml b/resources/bitcoind/app.yaml new file mode 100644 index 0000000..27b96af --- /dev/null +++ b/resources/bitcoind/app.yaml @@ -0,0 +1,5 @@ +title: "Bitcoin Core" +description: + short: "A Bitcoin Full Node" + long: "The bitcoin full node implementation by Bitcoin Core." +icon-type: png \ No newline at end of file diff --git a/src/Application.hs b/src/Application.hs index 0b58091..56dc089 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -50,6 +50,7 @@ import Yesod.Persist.Core -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! import Foundation +import Handler.Apps import Handler.Status import Lib.Ssl import Model diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index 460a7fe..3b7c18c 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -2,6 +2,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} + module Handler.Apps where import Startlude @@ -9,12 +10,20 @@ import Startlude import Control.Monad.Logger import Data.Aeson import qualified Data.ByteString.Lazy as BS +import Data.Conduit +import qualified Data.Conduit.Binary as CB +import System.FilePath +import Yesod.Core import Foundation - +import Lib.Resource pureLog :: Show a => a -> Handler a pureLog = liftA2 (*>) ($logInfo . show) pure logRet :: ToJSON a => Handler a -> Handler a logRet = (>>= liftA2 (*>) ($logInfo . decodeUtf8 . BS.toStrict . encode) pure) + +type AppManifestYml = TypedContent +getAppsManifestR :: Handler AppManifestYml +getAppsManifestR = respondSource typePlain $ CB.sourceFile manifestPath .| awaitForever sendChunkBS diff --git a/src/Handler/Status.hs b/src/Handler/Status.hs index a87c34c..3b828c9 100644 --- a/src/Handler/Status.hs +++ b/src/Handler/Status.hs @@ -7,5 +7,5 @@ import Foundation import Handler.Types.Status import Lib.Types.Semver -getVersionR :: AppVersion -> Handler AppVersionRes -getVersionR = pure . AppVersionRes -- $ registryVersion +getVersionR :: Handler AppVersionRes +getVersionR = pure . AppVersionRes $ registryVersion diff --git a/src/Handler/Types/Apps.hs b/src/Handler/Types/Apps.hs index 5ecbfcc..c5f3dcb 100644 --- a/src/Handler/Types/Apps.hs +++ b/src/Handler/Types/Apps.hs @@ -4,79 +4,16 @@ module Handler.Types.Apps where import Startlude import Data.Aeson -import Data.Time.ISO8601 import Yesod.Core.Content -import Lib.Types.Semver -import Lib.Types.ServerApp +import Lib.Types.StoreApp newtype AvailableAppsRes = AvailableAppsRes - { availableApps :: [(StoreApp, Maybe AppVersion)] + { availableApps :: [StoreApp] } deriving (Eq, Show) instance ToJSON AvailableAppsRes where - toJSON = toJSON . fmap toJSON' . availableApps - where - toJSON' (StoreApp{..}, version) = object - [ "id" .= storeAppId - , "title" .= storeAppTitle - , "versionInstalled" .= version - , "versionLatest" .= (storeAppVersionInfoVersion . extract) storeAppVersions - , "iconURL" .= storeAppIconUrl - , "descriptionShort" .= storeAppDescriptionShort - ] + toJSON = toJSON . availableApps instance ToTypedContent AvailableAppsRes where toTypedContent = toTypedContent . toJSON instance ToContent AvailableAppsRes where toContent = toContent . toJSON - -newtype AvailableAppFullRes = AvailableAppFullRes - { availableAppFull :: (StoreApp, Maybe AppVersion) - } deriving (Eq, Show) -instance ToJSON AvailableAppFullRes where - toJSON = toJSON' . availableAppFull - where - toJSON' (StoreApp{..}, version) = object - [ "id" .= storeAppId - , "title" .= storeAppTitle - , "versionInstalled" .= version - , "versionLatest" .= (storeAppVersionInfoVersion . extract) storeAppVersions - , "iconURL" .= storeAppIconUrl - , "descriptionShort" .= storeAppDescriptionShort - , "descriptionLong" .= storeAppDescriptionLong - , "versions" .= storeAppVersions - ] -instance ToContent AvailableAppFullRes where - toContent = toContent . toJSON -instance ToTypedContent AvailableAppFullRes where - toTypedContent = toTypedContent . toJSON - -newtype InstalledAppRes = InstalledAppRes - { installedApp :: (StoreApp, ServerApp, AppStatus, UTCTime) - } deriving (Eq, Show) -instance ToJSON InstalledAppRes where - toJSON = toJSON' . installedApp - where - toJSON' (store, server, status, time) = object - [ "id" .= storeAppId store - , "title" .= storeAppTitle store - , "versionLatest" .= (storeAppVersionInfoVersion . extract) (storeAppVersions store) - , "versionInstalled" .= serverAppVersionInstalled server - , "iconURL" .= storeAppIconUrl store - , "torAddress" .= serverAppTorService server - , "status" .= status - , "statusAt" .= formatISO8601Javascript time - ] -instance ToTypedContent InstalledAppRes where - toTypedContent = toTypedContent . toJSON -instance ToContent InstalledAppRes where - toContent = toContent . toJSON - -data InstallNewAppReq = InstallNewAppReq - { installNewAppId :: Text - , installNewAppVersion :: Text - } deriving (Eq, Show) -instance FromJSON InstallNewAppReq where - parseJSON = withObject "Install New App Request" $ \o -> do - installNewAppId <- o .: "id" - installNewAppVersion <- o .: "version" - pure InstallNewAppReq{..} diff --git a/src/Handler/Types/Status.hs b/src/Handler/Types/Status.hs index 73b42d9..2f3c2bf 100644 --- a/src/Handler/Types/Status.hs +++ b/src/Handler/Types/Status.hs @@ -1,31 +1,14 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE NamedFieldPuns #-} module Handler.Types.Status where -import Startlude +import Startlude -import Data.Aeson -import Data.Text -import Yesod.Core.Content +import Data.Aeson +import Data.Text +import Yesod.Core.Content -import Lib.Types.ServerApp -import Lib.Types.Semver - -data ServerRes = ServerRes - { serverStatus :: AppStatus - , serverVersion :: AppVersion - , serverSpecs :: Value - } deriving (Eq, Show) -instance ToJSON ServerRes where - toJSON ServerRes{..} = object - [ "status" .= toUpper (show serverStatus) - , "versionInstalled" .= serverVersion - , "specs" .= serverSpecs - , "versionLatest" .= serverVersion -- TODO: change this. - ] -instance ToTypedContent ServerRes where - toTypedContent = toTypedContent . toJSON -instance ToContent ServerRes where - toContent = toContent . toJSON +import Lib.Types.Semver +import Lib.Types.StoreApp newtype AppVersionRes = AppVersionRes { unAppVersionRes :: AppVersion } deriving (Eq, Show) diff --git a/src/Lib/Resource.hs b/src/Lib/Resource.hs new file mode 100644 index 0000000..ae15619 --- /dev/null +++ b/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 diff --git a/src/Lib/Types/Api.hs b/src/Lib/Types/Api.hs deleted file mode 100644 index 18cad2e..0000000 --- a/src/Lib/Types/Api.hs +++ /dev/null @@ -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 {..} diff --git a/src/Lib/Types/AppsManifest.hs b/src/Lib/Types/AppsManifest.hs new file mode 100644 index 0000000..67b85b7 --- /dev/null +++ b/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 + ] diff --git a/src/Lib/Types/Semver.hs b/src/Lib/Types/Semver.hs index cb35ecb..1c3faa1 100644 --- a/src/Lib/Types/Semver.hs +++ b/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), "")] diff --git a/src/Lib/Types/ServerApp.hs b/src/Lib/Types/ServerApp.hs deleted file mode 100644 index 687064b..0000000 --- a/src/Lib/Types/ServerApp.hs +++ /dev/null @@ -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) diff --git a/src/Lib/Types/StoreApp.hs b/src/Lib/Types/StoreApp.hs new file mode 100644 index 0000000..fff9d0d --- /dev/null +++ b/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 + ] diff --git a/src/Startlude.hs b/src/Startlude.hs index 9ef788c..fff9cd5 100644 --- a/src/Startlude.hs +++ b/src/Startlude.hs @@ -10,8 +10,7 @@ import Control.Error.Util as X import Data.Coerce as X import Data.String as X (String, fromString) import Data.Time.Clock as X -import Protolude as X hiding (bool, hush, isLeft, isRight, - note, tryIO) +import Protolude as X hiding (bool, hush, isLeft, isRight, note, tryIO, (<.>)) id :: a -> a id = identity diff --git a/test/Live/UpdateAgent.hs b/test/Live/UpdateAgent.hs index 89457fc..ce3e1eb 100644 --- a/test/Live/UpdateAgent.hs +++ b/test/Live/UpdateAgent.hs @@ -1,7 +1,7 @@ module Live.UpdateAgent where import Application -import Lib.Types.ServerApp +import Lib.Types.StoreApp import Lib.UpdateAgent import Startlude From b3fef3e4b3c7e8d9d5755d10c047344c4c765fa0 Mon Sep 17 00:00:00 2001 From: Aaron Greenspan Date: Mon, 23 Dec 2019 19:00:03 -0700 Subject: [PATCH 2/3] cleans semver --- config/routes | 17 ++++++++------ src/Lib/Resource.hs | 17 +++++++++----- src/Lib/Types/Semver.hs | 50 ++++++++++++++++++++++++++++++++--------- 3 files changed, 61 insertions(+), 23 deletions(-) diff --git a/config/routes b/config/routes index ff86c7e..02a73db 100644 --- a/config/routes +++ b/config/routes @@ -1,8 +1,11 @@ ---authed -/version VersionR GET -/apps AppsManifestR GET --get current apps listing --- /apps/#Text/#AppVersion AppR GET --install new app --- /sys/agent/#AppVersion AgentR GET --install new agent version --- /sys/appmgr/#AppVersion AppMgrR GET --install new appmgr version --- /v0/authorizedKeys AuthorizeKeyR POST + +/ AppsManifestR GET --get current apps listing +/version VersionR GET +-- /version/:appId VersionAppR GET --get most recent appId version +-- /sys/version/agent VersionAgentR GET --get most recent agent version +-- /sys/version/appmgr VersionAppMgrR GET --get most recent appmgr version + +-- /{:appId}.s9pk AppR GET --get most recent appId at appversion spec, defaults to >=0.0.0 -- ?version={semver-spec} +-- /sys/agent.s9pk AgentR GET --get most recent agent at appversion -- ?version={semver-spec} +-- /sys/appmgr.s9pk AppMgrR GET --get most recent appmgr at appversion -- ?version={semver-spec} \ No newline at end of file diff --git a/src/Lib/Resource.hs b/src/Lib/Resource.hs index ae15619..453705c 100644 --- a/src/Lib/Resource.hs +++ b/src/Lib/Resource.hs @@ -2,13 +2,13 @@ module Lib.Resource where -import Startlude hiding (empty) +import Startlude hiding (empty, toList) -import Data.Aeson import Data.HashMap.Lazy hiding (mapMaybe) import System.Directory import System.FilePath +import Lib.Semver import Lib.Types.Semver @@ -26,6 +26,10 @@ s9pkFile appId = toS appId <.> "s9pk" type Registry = HashMap String (HashMap AppVersion FilePath) +newtype RegisteredAppVersion = RegisteredAppVersion (AppVersion, FilePath) +instance HasAppVersion RegisteredAppVersion where + version (RegisteredAppVersion (av, _)) = av + loadResources :: MonadIO m => m Registry loadResources = liftIO $ do appDirectories <- getSubDirectories resourcePath @@ -33,13 +37,14 @@ loadResources = liftIO $ do ( \hm appId -> do subdirs <- getSubDirectories (resourcePath appId) let validVersions = mapMaybe readMaybe subdirs - let newAppVersions = fromList $ fmap (, s9pkFile appId) validVersions + let newAppVersions = fromList $ fmap (\v -> (v, resourcePath show v 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 +getAppFile r appId av = lookup av <=< lookup appId $ r + +registeredAppVersions :: Registry -> String -> [RegisteredAppVersion] +registeredAppVersions r appId = fromMaybe [] $ fmap RegisteredAppVersion . toList <$> lookup appId r diff --git a/src/Lib/Types/Semver.hs b/src/Lib/Types/Semver.hs index 1c3faa1..560ff46 100644 --- a/src/Lib/Types/Semver.hs +++ b/src/Lib/Types/Semver.hs @@ -14,6 +14,10 @@ import Data.String.Interpolate import Data.Text import Yesod.Core +------------------------------------------------------------------------------------------------------------------------ +-- Semver AppVersion +------------------------------------------------------------------------------------------------------------------------ + newtype AppVersion = AppVersion { unAppVersion :: (Word16, Word16, Word16) } deriving (Eq, Ord) @@ -55,11 +59,27 @@ instance ToContent AppVersion where where d `diffy` d1 = fromIntegral . abs $ (fromIntegral d :: Integer) - (fromIntegral d1 :: Integer) +------------------------------------------------------------------------------------------------------------------------ +-- Semver AppVersionSpecification +------------------------------------------------------------------------------------------------------------------------ + data AppVersionSpecification = AppVersionSpecification { requestModifier :: SemverRequestModifier , baseVersion :: AppVersion } +instance Read AppVersionSpecification where + readsPrec _ s = + case (readMaybe . toS $ svMod, readMaybe . toS $ version) of + (Just m, Just av) -> [(AppVersionSpecification m av, "")] + _ -> [] + where + (svMod, version) = break isDigit . toS $ s + +instance PathPiece AppVersionSpecification where + fromPathPiece = readMaybe . toS + toPathPiece = show + instance Show AppVersionSpecification where show (AppVersionSpecification r b) = show r <> show b instance ToJSON AppVersionSpecification where @@ -71,6 +91,10 @@ instance FromJSON AppVersionSpecification where requestModifier <- parseJSON . String $ svMod pure $ AppVersionSpecification {..} +------------------------------------------------------------------------------------------------------------------------ +-- Semver RequestModifier +------------------------------------------------------------------------------------------------------------------------ + data SemverRequestModifier = SVEquals | SVLessThan | SVGreaterThan | SVGreatestWithMajor | SVGreatestWithMajorMinor | SVLessThanEq | SVGreaterThanEq deriving (Eq, Bounded, Enum) instance Show SemverRequestModifier where show SVEquals = "=" @@ -82,13 +106,19 @@ instance Show SemverRequestModifier where show SVGreaterThanEq = ">=" instance FromJSON SemverRequestModifier where - parseJSON = withText "semver request modifier" $ \case - "" -> pure SVGreatestWithMajorMinor - "=" -> pure SVEquals - "<" -> pure SVLessThan - ">" -> pure SVGreaterThan - "~" -> pure SVGreatestWithMajor - "^" -> pure SVGreatestWithMajorMinor - "<=" -> pure SVLessThanEq - ">=" -> pure SVGreaterThanEq - _ -> fail "invalid semver request modifier" + parseJSON = withText "semver request modifier" $ \t -> + case readMaybe . toS $ t of + Just m -> pure m + Nothing -> fail "invalid semver request modifier" + +instance Read SemverRequestModifier where + readsPrec _ = \case + "" -> [(SVGreatestWithMajorMinor, "")] + "=" -> [(SVEquals, "")] + "<" -> [(SVLessThan, "")] + ">" -> [(SVGreaterThan, "")] + "~" -> [(SVGreatestWithMajor, "")] + "^" -> [(SVGreatestWithMajorMinor, "")] + "<=" -> [(SVLessThanEq, "")] + ">=" -> [(SVGreaterThanEq, "")] + _ -> [] From 5483980805e56b8a95b5aab0effebcae43f9abac Mon Sep 17 00:00:00 2001 From: Aaron Greenspan Date: Tue, 24 Dec 2019 00:13:57 -0700 Subject: [PATCH 3/3] streaming output works --- config/routes | 12 ++-- package.yaml | 1 + resources/{ => apps}/apps.yaml | 0 resources/bitcoind/0.18.1/version.yaml | 2 - resources/bitcoind/app.yaml | 5 -- resources/sys/appmgr/0.0.0/appmgr.s9pk | 1 + src/Application.hs | 2 +- src/Foundation.hs | 2 +- src/Handler/Apps.hs | 35 ++++++++++-- src/Handler/Status.hs | 11 ---- src/Handler/Types/Apps.hs | 19 ------- src/Handler/Types/Register.hs | 23 -------- src/Handler/Types/Status.hs | 23 ++++++-- src/Handler/Version.hs | 31 +++++++++++ src/Lib/Error.hs | 4 +- src/Lib/Registry.hs | 77 ++++++++++++++++++++++++++ src/Lib/Resource.hs | 50 ----------------- src/Lib/Semver.hs | 2 +- src/Lib/Types/AppsManifest.hs | 56 ------------------- src/Lib/Types/Semver.hs | 3 + src/Lib/Types/StoreApp.hs | 33 ----------- 21 files changed, 171 insertions(+), 221 deletions(-) rename resources/{ => apps}/apps.yaml (100%) delete mode 100644 resources/bitcoind/0.18.1/version.yaml delete mode 100644 resources/bitcoind/app.yaml create mode 100644 resources/sys/appmgr/0.0.0/appmgr.s9pk delete mode 100644 src/Handler/Status.hs delete mode 100644 src/Handler/Types/Apps.hs delete mode 100644 src/Handler/Types/Register.hs create mode 100644 src/Handler/Version.hs create mode 100644 src/Lib/Registry.hs delete mode 100644 src/Lib/Resource.hs delete mode 100644 src/Lib/Types/AppsManifest.hs delete mode 100644 src/Lib/Types/StoreApp.hs diff --git a/config/routes b/config/routes index 02a73db..fed18af 100644 --- a/config/routes +++ b/config/routes @@ -2,10 +2,10 @@ / AppsManifestR GET --get current apps listing /version VersionR GET --- /version/:appId VersionAppR GET --get most recent appId version --- /sys/version/agent VersionAgentR GET --get most recent agent version --- /sys/version/appmgr VersionAppMgrR GET --get most recent appmgr version +/version/#Text VersionAppR GET --get most recent appId version +/sys/version/agent VersionAgentR GET --get most recent agent version +/sys/version/appmgr VersionAppMgrR GET --get most recent appmgr version --- /{:appId}.s9pk AppR GET --get most recent appId at appversion spec, defaults to >=0.0.0 -- ?version={semver-spec} --- /sys/agent.s9pk AgentR GET --get most recent agent at appversion -- ?version={semver-spec} --- /sys/appmgr.s9pk AppMgrR GET --get most recent appmgr at appversion -- ?version={semver-spec} \ No newline at end of file +/sys/agent.s9pk AgentR GET --get most recent agent at appversion -- ?spec={semver-spec} +/sys/appmgr.s9pk AppMgrR GET --get most recent appmgr at appversion -- ?spec={semver-spec} +!/#S9PK AppR GET --get most recent appId at appversion spec, defaults to >=0.0.0 -- ?spec={semver-spec} \ No newline at end of file diff --git a/package.yaml b/package.yaml index 08797b7..74b5256 100644 --- a/package.yaml +++ b/package.yaml @@ -71,6 +71,7 @@ dependencies: - protolude - safe - secp256k1-haskell +- split - template-haskell - text >=0.11 && <2.0 - time diff --git a/resources/apps.yaml b/resources/apps/apps.yaml similarity index 100% rename from resources/apps.yaml rename to resources/apps/apps.yaml diff --git a/resources/bitcoind/0.18.1/version.yaml b/resources/bitcoind/0.18.1/version.yaml deleted file mode 100644 index 610cb0a..0000000 --- a/resources/bitcoind/0.18.1/version.yaml +++ /dev/null @@ -1,2 +0,0 @@ -version: 0.18.1 -release-notes: "Some stuff" \ No newline at end of file diff --git a/resources/bitcoind/app.yaml b/resources/bitcoind/app.yaml deleted file mode 100644 index 27b96af..0000000 --- a/resources/bitcoind/app.yaml +++ /dev/null @@ -1,5 +0,0 @@ -title: "Bitcoin Core" -description: - short: "A Bitcoin Full Node" - long: "The bitcoin full node implementation by Bitcoin Core." -icon-type: png \ No newline at end of file diff --git a/resources/sys/appmgr/0.0.0/appmgr.s9pk b/resources/sys/appmgr/0.0.0/appmgr.s9pk new file mode 100644 index 0000000..158db5b --- /dev/null +++ b/resources/sys/appmgr/0.0.0/appmgr.s9pk @@ -0,0 +1 @@ +some appmgr code \ No newline at end of file diff --git a/src/Application.hs b/src/Application.hs index 56dc089..0f92fa4 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -51,7 +51,7 @@ import Yesod.Persist.Core -- Don't forget to add new modules to your cabal file! import Foundation import Handler.Apps -import Handler.Status +import Handler.Version import Lib.Ssl import Model import Settings diff --git a/src/Foundation.hs b/src/Foundation.hs index a1f762f..c350c95 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -11,7 +11,7 @@ import Startlude import Control.Monad.Logger (LogSource) import Data.IORef import Database.Persist.Sql -import Lib.Types.Semver +import Lib.Registry import Yesod.Core import Yesod.Core.Types (Logger) import qualified Yesod.Core.Unsafe as Unsafe diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index 3b7c18c..373dfd2 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -12,11 +12,14 @@ import Data.Aeson import qualified Data.ByteString.Lazy as BS import Data.Conduit import qualified Data.Conduit.Binary as CB -import System.FilePath +import System.Directory import Yesod.Core import Foundation -import Lib.Resource +import Handler.Types.Status +import Lib.Registry +import Lib.Semver +import Lib.Types.Semver pureLog :: Show a => a -> Handler a pureLog = liftA2 (*>) ($logInfo . show) pure @@ -24,6 +27,28 @@ pureLog = liftA2 (*>) ($logInfo . show) pure logRet :: ToJSON a => Handler a -> Handler a logRet = (>>= liftA2 (*>) ($logInfo . decodeUtf8 . BS.toStrict . encode) pure) -type AppManifestYml = TypedContent -getAppsManifestR :: Handler AppManifestYml -getAppsManifestR = respondSource typePlain $ CB.sourceFile manifestPath .| awaitForever sendChunkBS +getAppsManifestR :: Handler TypedContent +getAppsManifestR = respondSource typePlain $ CB.sourceFile appManifestPath .| awaitForever sendChunkBS + +getAgentR :: Handler TypedContent +getAgentR = getApp sysResourceDir $ S9PK "agent" + +getAppMgrR :: Handler TypedContent +getAppMgrR = getApp sysResourceDir $ S9PK "appmgr" + +getAppR :: S9PK -> Handler TypedContent +getAppR = getApp appResourceDir + +getApp :: FilePath -> S9PK -> Handler TypedContent +getApp rootDir (S9PK appId) = do + spec <- querySpecD mostRecentVersion <$> lookupGetParam "spec" + appVersions <- registeredAppVersions appId <$> loadRegistry rootDir + case getSpecifiedAppVersion spec appVersions of + Nothing -> respondSource typePlain sendFlush + Just (RegisteredAppVersion (_, filePath)) -> do + exists <- liftIO $ doesFileExist filePath + if exists + then respondSource typePlain $ CB.sourceFile filePath .| awaitForever sendChunkBS + else respondSource typePlain sendFlush + + diff --git a/src/Handler/Status.hs b/src/Handler/Status.hs deleted file mode 100644 index 3b828c9..0000000 --- a/src/Handler/Status.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Handler.Status where - -import Startlude - -import Constants -import Foundation -import Handler.Types.Status -import Lib.Types.Semver - -getVersionR :: Handler AppVersionRes -getVersionR = pure . AppVersionRes $ registryVersion diff --git a/src/Handler/Types/Apps.hs b/src/Handler/Types/Apps.hs deleted file mode 100644 index c5f3dcb..0000000 --- a/src/Handler/Types/Apps.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} -module Handler.Types.Apps where - -import Startlude - -import Data.Aeson -import Yesod.Core.Content - -import Lib.Types.StoreApp - -newtype AvailableAppsRes = AvailableAppsRes - { availableApps :: [StoreApp] - } deriving (Eq, Show) -instance ToJSON AvailableAppsRes where - toJSON = toJSON . availableApps -instance ToTypedContent AvailableAppsRes where - toTypedContent = toTypedContent . toJSON -instance ToContent AvailableAppsRes where - toContent = toContent . toJSON diff --git a/src/Handler/Types/Register.hs b/src/Handler/Types/Register.hs deleted file mode 100644 index 093a814..0000000 --- a/src/Handler/Types/Register.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE RecordWildCards #-} -module Handler.Types.Register where - -import Startlude - -import Control.Monad.Fail -import Data.Aeson -import Data.ByteArray.Encoding -import Data.ByteArray.Sized - -data RegisterReq = RegisterReq - { registerProductKey :: Text - , registerPubKey :: SizedByteArray 33 ByteString - } deriving (Eq, Show) -instance FromJSON RegisterReq where - parseJSON = withObject "Register Request" $ \o -> do - registerProductKey <- o .: "productKey" - registerPubKey <- o .: "pubKey" >>= \t -> - case sizedByteArray <=< hush . convertFromBase Base16 $ encodeUtf8 t of - Nothing -> fail "Invalid Hex Encoded Public Key" - Just x -> pure x - pure RegisterReq{..} diff --git a/src/Handler/Types/Status.hs b/src/Handler/Types/Status.hs index 2f3c2bf..85ec323 100644 --- a/src/Handler/Types/Status.hs +++ b/src/Handler/Types/Status.hs @@ -1,20 +1,31 @@ -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NamedFieldPuns #-} module Handler.Types.Status where import Startlude import Data.Aeson -import Data.Text import Yesod.Core.Content import Lib.Types.Semver -import Lib.Types.StoreApp -newtype AppVersionRes = AppVersionRes - { unAppVersionRes :: AppVersion } deriving (Eq, Show) +newtype AppVersionRes = AppVersionRes { unAppVersionRes ::AppVersion } deriving (Eq, Show) instance ToJSON AppVersionRes where - toJSON AppVersionRes{unAppVersionRes} = object ["version" .= unAppVersionRes] + toJSON AppVersionRes{ unAppVersionRes } = object ["version" .= unAppVersionRes] + instance ToContent AppVersionRes where toContent = toContent . toJSON instance ToTypedContent AppVersionRes where toTypedContent = toTypedContent . toJSON + +-- Ugh +instance ToContent (Maybe AppVersionRes) where + toContent = toContent . toJSON +instance ToTypedContent (Maybe AppVersionRes) where + toTypedContent = toTypedContent . toJSON + +querySpec :: Maybe Text -> Maybe AppVersionSpecification +querySpec = (readMaybe . toS =<<) + +querySpecD :: AppVersionSpecification -> Maybe Text -> AppVersionSpecification +querySpecD defaultSpec = fromMaybe defaultSpec . querySpec diff --git a/src/Handler/Version.hs b/src/Handler/Version.hs new file mode 100644 index 0000000..d49c8b8 --- /dev/null +++ b/src/Handler/Version.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Handler.Version where + +import Startlude + +import Yesod.Core + +import Constants +import Foundation +import Handler.Types.Status +import Lib.Registry +import Lib.Semver +import Lib.Types.Semver + +getVersionR :: Handler AppVersionRes +getVersionR = pure . AppVersionRes $ registryVersion + +getVersionAppR :: Text -> Handler (Maybe AppVersionRes) +getVersionAppR = getVersionWSpec appResourceDir + +getVersionAgentR :: Handler (Maybe AppVersionRes) +getVersionAgentR = getVersionWSpec sysResourceDir "agent" + +getVersionAppMgrR :: Handler (Maybe AppVersionRes) +getVersionAppMgrR = getVersionWSpec sysResourceDir "appmgr" + +getVersionWSpec :: FilePath -> Text -> Handler (Maybe AppVersionRes) +getVersionWSpec rootDir appId = do + spec <- querySpecD mostRecentVersion <$> lookupGetParam "spec" + appVersions <- registeredAppVersions (toS appId) <$> loadRegistry rootDir + pure . fmap (AppVersionRes . version) $ getSpecifiedAppVersion spec appVersions diff --git a/src/Lib/Error.hs b/src/Lib/Error.hs index 152d14c..d3e9e54 100644 --- a/src/Lib/Error.hs +++ b/src/Lib/Error.hs @@ -46,8 +46,8 @@ toStatus :: S9Error -> Status toStatus = \case PersistentE _ -> status500 -respondStatusException :: MonadHandler m => S9ErrT m a -> m a -respondStatusException action = runExceptT action >>= \case +handleS9ErrT :: MonadHandler m => S9ErrT m a -> m a +handleS9ErrT action = runExceptT action >>= \case Left e -> toStatus >>= sendResponseStatus $ e Right a -> pure a diff --git a/src/Lib/Registry.hs b/src/Lib/Registry.hs new file mode 100644 index 0000000..6d77595 --- /dev/null +++ b/src/Lib/Registry.hs @@ -0,0 +1,77 @@ +module Lib.Registry where + +import Startlude hiding (empty, toList) + +import Data.HashMap.Lazy hiding (mapMaybe) +import qualified GHC.Read (Read (..)) +import qualified GHC.Show (Show (..)) +import System.Directory +import System.FilePath +import Yesod.Core + +import Data.Text (isSuffixOf) + +import Lib.Semver +import Lib.Types.Semver + +newtype S9PK = S9PK String deriving (Eq) +instance Show S9PK where + show (S9PK t) = t <.> "s9pk" + +instance Read S9PK where + readsPrec _ s = [(S9PK . take (m - n) $ s, "") | toS s9pk `isSuffixOf` toS s] + where + m = length s + s9pk = ".s9pk" :: String + n = length s9pk + +instance PathPiece S9PK where + fromPathPiece = readMaybe . toS + toPathPiece = show + +appResourceDir :: FilePath +appResourceDir = "./resources/apps" + +sysResourceDir :: FilePath +sysResourceDir = "./resources/sys" + +appManifestPath :: FilePath +appManifestPath = appResourceDir "apps.yaml" + +appManifestFile :: FilePath +appManifestFile = "apps.yml" + +s9pkExt :: String -> FilePath +s9pkExt = show . S9PK + +type Registry = HashMap String (HashMap AppVersion FilePath) + +newtype RegisteredAppVersion = RegisteredAppVersion (AppVersion, FilePath) +instance HasAppVersion RegisteredAppVersion where + version (RegisteredAppVersion (av, _)) = av + +loadAppRegistry :: MonadIO m => m Registry +loadAppRegistry = loadRegistry appResourceDir + +loadSysRegistry :: MonadIO m => m Registry +loadSysRegistry = loadRegistry sysResourceDir + +loadRegistry :: MonadIO m => FilePath -> m Registry +loadRegistry rootDirectory = liftIO $ do + appDirectories <- getSubDirectories rootDirectory + foldM + ( \registry appId -> do + subdirs <- getSubDirectories (rootDirectory appId) + let validVersions = mapMaybe readMaybe subdirs + let versionedApps = fromList . fmap (id &&& fullS9pk rootDirectory appId) $ validVersions + pure $ insert appId versionedApps registry + ) empty appDirectories + where + getSubDirectories path = listDirectory path >>= filterM (fmap not . doesFileExist) + fullS9pk root appId' appVersion = root appId' show appVersion s9pkExt appId' + +getAppFile :: String -> Registry -> AppVersion -> Maybe FilePath +getAppFile appId r av = lookup av <=< lookup appId $ r + +registeredAppVersions :: String -> Registry -> [RegisteredAppVersion] +registeredAppVersions appId r = maybe [] (fmap RegisteredAppVersion . toList) (lookup appId r) diff --git a/src/Lib/Resource.hs b/src/Lib/Resource.hs deleted file mode 100644 index 453705c..0000000 --- a/src/Lib/Resource.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE TupleSections #-} - -module Lib.Resource where - -import Startlude hiding (empty, toList) - -import Data.HashMap.Lazy hiding (mapMaybe) -import System.Directory -import System.FilePath - -import Lib.Semver -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) - -newtype RegisteredAppVersion = RegisteredAppVersion (AppVersion, FilePath) -instance HasAppVersion RegisteredAppVersion where - version (RegisteredAppVersion (av, _)) = av - -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 (\v -> (v, resourcePath show v 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 = lookup av <=< lookup appId $ r - -registeredAppVersions :: Registry -> String -> [RegisteredAppVersion] -registeredAppVersions r appId = fromMaybe [] $ fmap RegisteredAppVersion . toList <$> lookup appId r diff --git a/src/Lib/Semver.hs b/src/Lib/Semver.hs index 4efe18d..3befb02 100644 --- a/src/Lib/Semver.hs +++ b/src/Lib/Semver.hs @@ -30,7 +30,7 @@ hasGiven :: (AppVersion -> Word16) -> AppVersion -> AppVersion -> Bool hasGiven projection av = (== projection av) . projection getSpecifiedAppVersion :: HasAppVersion a => AppVersionSpecification -> [a] -> Maybe a -getSpecifiedAppVersion avSpec = appVersionMax . filter (<|| avSpec) -- get the largest thing satisfying the spec. +getSpecifiedAppVersion avSpec = appVersionMax . filter (<|| avSpec) class HasAppVersion a where version :: a -> AppVersion diff --git a/src/Lib/Types/AppsManifest.hs b/src/Lib/Types/AppsManifest.hs deleted file mode 100644 index 67b85b7..0000000 --- a/src/Lib/Types/AppsManifest.hs +++ /dev/null @@ -1,56 +0,0 @@ -{-# 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 - ] diff --git a/src/Lib/Types/Semver.hs b/src/Lib/Types/Semver.hs index 560ff46..82f4e02 100644 --- a/src/Lib/Types/Semver.hs +++ b/src/Lib/Types/Semver.hs @@ -91,6 +91,9 @@ instance FromJSON AppVersionSpecification where requestModifier <- parseJSON . String $ svMod pure $ AppVersionSpecification {..} +mostRecentVersion :: AppVersionSpecification +mostRecentVersion = AppVersionSpecification SVGreaterThanEq $ AppVersion (0,0,0) + ------------------------------------------------------------------------------------------------------------------------ -- Semver RequestModifier ------------------------------------------------------------------------------------------------------------------------ diff --git a/src/Lib/Types/StoreApp.hs b/src/Lib/Types/StoreApp.hs deleted file mode 100644 index fff9d0d..0000000 --- a/src/Lib/Types/StoreApp.hs +++ /dev/null @@ -1,33 +0,0 @@ - -{-# 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 - ]