diff --git a/config/routes b/config/routes index 00c3ec2..fed18af 100644 --- a/config/routes +++ b/config/routes @@ -1,8 +1,11 @@ ---authed -/version/#AppVersion 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/#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 + +/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 8a025c2..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 @@ -88,6 +89,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/apps.yaml b/resources/apps/apps.yaml new file mode 100644 index 0000000..645eadd --- /dev/null +++ b/resources/apps/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/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 0b58091..0f92fa4 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -50,7 +50,8 @@ 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.Status +import Handler.Apps +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 460a7fe..373dfd2 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,45 @@ 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.Directory +import Yesod.Core import Foundation - +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 logRet :: ToJSON a => Handler a -> Handler a logRet = (>>= liftA2 (*>) ($logInfo . decodeUtf8 . BS.toStrict . encode) pure) + +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 a87c34c..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 :: AppVersion -> 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 5ecbfcc..0000000 --- a/src/Handler/Types/Apps.hs +++ /dev/null @@ -1,82 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} -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 - -newtype AvailableAppsRes = AvailableAppsRes - { availableApps :: [(StoreApp, Maybe AppVersion)] - } 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 - ] -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/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 73b42d9..85ec323 100644 --- a/src/Handler/Types/Status.hs +++ b/src/Handler/Types/Status.hs @@ -1,37 +1,31 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE FlexibleInstances #-} +{-# 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 Yesod.Core.Content -import Lib.Types.ServerApp -import Lib.Types.Semver +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 - -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/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/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/Semver.hs b/src/Lib/Types/Semver.hs index cb35ecb..82f4e02 100644 --- a/src/Lib/Types/Semver.hs +++ b/src/Lib/Types/Semver.hs @@ -14,9 +14,17 @@ import Data.String.Interpolate import Data.Text import Yesod.Core +------------------------------------------------------------------------------------------------------------------------ +-- Semver AppVersion +------------------------------------------------------------------------------------------------------------------------ + 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), "")] @@ -51,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 @@ -67,6 +91,13 @@ instance FromJSON AppVersionSpecification where requestModifier <- parseJSON . String $ svMod pure $ AppVersionSpecification {..} +mostRecentVersion :: AppVersionSpecification +mostRecentVersion = AppVersionSpecification SVGreaterThanEq $ AppVersion (0,0,0) + +------------------------------------------------------------------------------------------------------------------------ +-- Semver RequestModifier +------------------------------------------------------------------------------------------------------------------------ + data SemverRequestModifier = SVEquals | SVLessThan | SVGreaterThan | SVGreatestWithMajor | SVGreatestWithMajorMinor | SVLessThanEq | SVGreaterThanEq deriving (Eq, Bounded, Enum) instance Show SemverRequestModifier where show SVEquals = "=" @@ -78,13 +109,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, "")] + _ -> [] 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/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