Merge pull request #1 from Start9Labs/feat/manifest

Feat/manifest

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}

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:

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

resources/sys/appmgr/0.0.0/appmgr.s9pk

@@ -0,0 +1 @@
+some appmgr code

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

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

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
+
+

src/Handler/Status.hs

@@ -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

src/Handler/Types/Apps.hs

@@ -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{..}

src/Handler/Types/Register.hs

@@ -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{..}

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

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

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
 

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)

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

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/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, "")]
+        _    -> []

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/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

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