Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-26 02:11:53 +00:00
Code Issues Packages Projects Releases Wiki Activity

streaming output works

Browse Source
This commit is contained in:
Aaron Greenspan
2019-12-24 00:13:57 -07:00
parent b3fef3e4b3
commit 5483980805
21 changed files with 171 additions and 221 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
config/routes
View File

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

1
package.yaml
View File

@@ -71,6 +71,7 @@ dependencies:
- protolude
- safe
- secp256k1-haskell
- split
- template-haskell
- text >=0.11 && <2.0
- time

0
resources/apps.yaml → resources/apps/apps.yaml
View File

2
resources/bitcoind/0.18.1/version.yaml
View File

@@ -1,2 +0,0 @@
version: 0.18.1
release-notes: "Some stuff"

5
resources/bitcoind/app.yaml
View File

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

1
resources/sys/appmgr/0.0.0/appmgr.s9pk Normal file
View File

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

2
src/Application.hs
View File

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

2
src/Foundation.hs
View File

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

35
src/Handler/Apps.hs
View File

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

11
src/Handler/Status.hs
View File

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

19
src/Handler/Types/Apps.hs
View File

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

23
src/Handler/Types/Register.hs
View File

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

23
src/Handler/Types/Status.hs
View File

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

31
src/Handler/Version.hs Normal file
View File

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

4
src/Lib/Error.hs
View File

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

77
src/Lib/Registry.hs Normal file
View File

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

50
src/Lib/Resource.hs
View File

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

2
src/Lib/Semver.hs
View File

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

56
src/Lib/Types/AppsManifest.hs
View File

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

3
src/Lib/Types/Semver.hs
View File

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

33
src/Lib/Types/StoreApp.hs
View File

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