diff --git a/apps.yaml b/apps.yaml new file mode 100644 index 0000000..645eadd --- /dev/null +++ b/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/config/routes b/config/routes index f231800..00c3ec2 100644 --- a/config/routes +++ b/config/routes @@ -1,4 +1,8 @@ --authed -/version VersionR GET +/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 diff --git a/src/Constants.hs b/src/Constants.hs index 9fa3bff..51ffd0b 100644 --- a/src/Constants.hs +++ b/src/Constants.hs @@ -4,15 +4,18 @@ import Data.Aeson import Data.Aeson.Types import Data.Maybe import Data.Version (showVersion) -import Lib.Types.ServerApp +import Lib.Types.Semver import Paths_start9_registry (version) import Startlude -configBasePath :: FilePath -configBasePath = "./config" +configPath :: FilePath +configPath = "./config" + +resourcesPath :: FilePath +resourcesPath = "./resources" registryVersion :: AppVersion registryVersion = fromJust . parseMaybe parseJSON . String . toS . showVersion $ version getRegistryHostname :: IsString a => a -getRegistryHostname = "registry" +getRegistryHostname = "registry.start9labs.com" diff --git a/src/Foundation.hs b/src/Foundation.hs index 6d93b9d..a1f762f 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -11,6 +11,7 @@ import Startlude import Control.Monad.Logger (LogSource) import Data.IORef import Database.Persist.Sql +import Lib.Types.Semver import Yesod.Core import Yesod.Core.Types (Logger) import qualified Yesod.Core.Unsafe as Unsafe diff --git a/src/Handler/Status.hs b/src/Handler/Status.hs index 7fb5066..a87c34c 100644 --- a/src/Handler/Status.hs +++ b/src/Handler/Status.hs @@ -5,6 +5,7 @@ import Startlude import Constants import Foundation import Handler.Types.Status +import Lib.Types.Semver -getVersionR :: Handler AppVersionRes -getVersionR = pure . AppVersionRes $ registryVersion +getVersionR :: AppVersion -> Handler AppVersionRes +getVersionR = pure . AppVersionRes -- $ registryVersion diff --git a/src/Handler/Types/Apps.hs b/src/Handler/Types/Apps.hs index ac16fc2..5ecbfcc 100644 --- a/src/Handler/Types/Apps.hs +++ b/src/Handler/Types/Apps.hs @@ -7,6 +7,7 @@ import Data.Aeson import Data.Time.ISO8601 import Yesod.Core.Content +import Lib.Types.Semver import Lib.Types.ServerApp newtype AvailableAppsRes = AvailableAppsRes diff --git a/src/Handler/Types/Status.hs b/src/Handler/Types/Status.hs index dbc060f..73b42d9 100644 --- a/src/Handler/Types/Status.hs +++ b/src/Handler/Types/Status.hs @@ -8,6 +8,7 @@ import Data.Text import Yesod.Core.Content import Lib.Types.ServerApp +import Lib.Types.Semver data ServerRes = ServerRes { serverStatus :: AppStatus diff --git a/src/Lib/Semver.hs b/src/Lib/Semver.hs new file mode 100644 index 0000000..4efe18d --- /dev/null +++ b/src/Lib/Semver.hs @@ -0,0 +1,45 @@ +module Lib.Semver where + +import Startlude + +import Lib.Types.Semver + +(<||) :: HasAppVersion a => a -> AppVersionSpecification -> Bool +(<||) a (AppVersionSpecification SVEquals av1) = version a == av1 +(<||) a (AppVersionSpecification SVLessThan av1) = version a < av1 +(<||) a (AppVersionSpecification SVGreaterThan av1) = version a > av1 +(<||) a (AppVersionSpecification SVLessThanEq av1) = version a <= av1 +(<||) a (AppVersionSpecification SVGreaterThanEq av1) = version a >= av1 +(<||) a (AppVersionSpecification SVGreatestWithMajor av1) + = major av == major av1 && av >= av1 + where + av = version a +(<||) a (AppVersionSpecification SVGreatestWithMajorMinor av1) + = major av == major av1 && minor av == minor av1 && av >= av1 + where + av = version a + +major :: AppVersion -> Word16 +major (AppVersion (a, _, _)) = a +minor :: AppVersion -> Word16 +minor (AppVersion (_, a, _)) = a +patch :: AppVersion -> Word16 +patch (AppVersion (_, _, a)) = a + +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. + +class HasAppVersion a where + version :: a -> AppVersion + +instance HasAppVersion AppVersion where + version = id + +appVersionMax :: HasAppVersion a => [a] -> Maybe a +appVersionMax [] = Nothing +appVersionMax as = Just $ maximumBy (\a1 a2 -> version a1 `compare` version a2) as + + diff --git a/src/Lib/Ssl.hs b/src/Lib/Ssl.hs index cc5c516..2b42e0e 100644 --- a/src/Lib/Ssl.hs +++ b/src/Lib/Ssl.hs @@ -15,7 +15,7 @@ import Constants -- openssl x509 -req -in certificate.csr -signkey key.pem -out certificate.pem sslBaseLocation :: FilePath -sslBaseLocation = configBasePath "ssl" +sslBaseLocation = configPath "ssl" sslKeyLocation :: FilePath sslKeyLocation = sslBaseLocation "key.pem" diff --git a/src/Lib/Types/Semver.hs b/src/Lib/Types/Semver.hs new file mode 100644 index 0000000..cb35ecb --- /dev/null +++ b/src/Lib/Types/Semver.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +module Lib.Types.Semver where + +import Startlude hiding (break) + +import qualified GHC.Read (Read (..)) +import qualified GHC.Show (Show (..)) + +import Control.Monad.Fail +import Data.Aeson +import Data.Char (isDigit) +import Data.String.Interpolate +import Data.Text +import Yesod.Core + +newtype AppVersion = AppVersion + { unAppVersion :: (Word16, Word16, Word16) } deriving (Eq, Ord) + +instance Read AppVersion where + readsPrec _ s = case traverse (readMaybe . toS) $ split (=='.') (toS s) of + Just [major, minor, patch] -> [(AppVersion (major, minor, patch), "")] + _ -> [] +instance PathPiece AppVersion where + fromPathPiece = readMaybe . toS + toPathPiece = show + +instance Show AppVersion where + show (AppVersion (a, b, c)) = [i|#{a}.#{b}.#{c}|] +instance IsString AppVersion where + fromString s = case traverse (readMaybe . toS) $ split (=='.') (toS s) of + Just [major, minor, patch] -> AppVersion (major, minor, patch) + _ -> panic . toS $ "Invalid App Version: " <> s +instance ToJSON AppVersion where + toJSON av = String . toS $ let (a,b,c) = unAppVersion av in [i|#{a}.#{b}.#{c}|] +instance FromJSON AppVersion where + parseJSON = withText "app version" $ \t -> + case splitOn "." t of + [a, b, c] -> + case traverse (decode . toS) [a, b, c] of + Just [a', b', c'] -> pure $ AppVersion (a', b', c') + _ -> fail "non word16 versioning" + _ -> fail "unknown versioning" +instance ToTypedContent AppVersion where + toTypedContent = toTypedContent . toJSON +instance ToContent AppVersion where + toContent = toContent . toJSON + +(\\) :: AppVersion -> AppVersion -> (Word16, Word16, Word16) +(\\) (AppVersion (a, b, c)) (AppVersion (a1, b1, c1)) = (a `diffy` a1, b `diffy` b1, c `diffy` c1) + where + d `diffy` d1 = fromIntegral . abs $ (fromIntegral d :: Integer) - (fromIntegral d1 :: Integer) + +data AppVersionSpecification = AppVersionSpecification + { requestModifier :: SemverRequestModifier + , baseVersion :: AppVersion + } + +instance Show AppVersionSpecification where + show (AppVersionSpecification r b) = show r <> show b +instance ToJSON AppVersionSpecification where + toJSON = String . show +instance FromJSON AppVersionSpecification where + parseJSON = withText "app version spec" $ \t -> do + let (svMod, version) = break isDigit t + baseVersion <- parseJSON . String $ version + requestModifier <- parseJSON . String $ svMod + pure $ AppVersionSpecification {..} + +data SemverRequestModifier = SVEquals | SVLessThan | SVGreaterThan | SVGreatestWithMajor | SVGreatestWithMajorMinor | SVLessThanEq | SVGreaterThanEq deriving (Eq, Bounded, Enum) +instance Show SemverRequestModifier where + show SVEquals = "=" + show SVLessThan = "<" + show SVGreaterThan = ">" + show SVGreatestWithMajor = "~" + show SVGreatestWithMajorMinor = "^" + show SVLessThanEq = "<=" + 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" diff --git a/src/Lib/Types/ServerApp.hs b/src/Lib/Types/ServerApp.hs index 461b774..687064b 100644 --- a/src/Lib/Types/ServerApp.hs +++ b/src/Lib/Types/ServerApp.hs @@ -1,17 +1,14 @@ -{-# LANGUAGE QuasiQuotes #-} + {-# LANGUAGE RecordWildCards #-} module Lib.Types.ServerApp where -import Startlude hiding (break) - -import qualified GHC.Show (Show (..)) +import Startlude import Control.Monad.Fail import Data.Aeson -import Data.Char (isDigit) -import Data.String.Interpolate import Data.Text -import Yesod.Core + +import Lib.Types.Semver data StoreApp = StoreApp { storeAppId :: Text @@ -44,83 +41,6 @@ data ServerApp = ServerApp , serverAppIsConfigured :: Bool } deriving (Eq, Show) -data SemverRequestModifier = SVEquals | SVLessThan | SVGreaterThan | SVMinMinor | SVMinPatch | SVLessThanEq | SVGreaterThanEq deriving (Eq, Bounded, Enum) -instance Show SemverRequestModifier where - show SVEquals = "=" - show SVLessThan = "<" - show SVGreaterThan = ">" - show SVMinMinor = "~" - show SVMinPatch = "^" - show SVLessThanEq = "<=" - show SVGreaterThanEq = ">=" - -instance FromJSON SemverRequestModifier where - parseJSON = withText "semver request modifier" $ \case - "" -> pure SVMinPatch - "=" -> pure SVEquals - "<" -> pure SVLessThan - ">" -> pure SVGreaterThan - "~" -> pure SVMinMinor - "^" -> pure SVMinPatch - "<=" -> pure SVLessThanEq - ">=" -> pure SVGreaterThanEq - _ -> fail "invalid semver request modifier" - -data AppVersionSpecification = AppVersionSpecification - { requestModifier :: SemverRequestModifier - , baseVersion :: AppVersion - } - -instance Show AppVersionSpecification where - show (AppVersionSpecification r b) = show r <> show b -instance ToJSON AppVersionSpecification where - toJSON = String . show -instance FromJSON AppVersionSpecification where - parseJSON = withText "app version spec" $ \t -> do - let (svMod, version) = break isDigit t - baseVersion <- parseJSON . String $ version - requestModifier <- parseJSON . String $ svMod - pure $ AppVersionSpecification {..} - -(<||) :: AppVersion -> AppVersionSpecification -> Bool -(<||) av (AppVersionSpecification SVEquals av1) = av == av1 -(<||) av (AppVersionSpecification SVLessThan av1) = av < av1 -(<||) av (AppVersionSpecification SVGreaterThan av1) = av > av1 -(<||) av (AppVersionSpecification SVLessThanEq av1) = av <= av1 -(<||) av (AppVersionSpecification SVGreaterThanEq av1) = av >= av1 -(<||) (AppVersion (a,b,_)) (AppVersionSpecification SVMinMinor (AppVersion (a1, b1, _))) - = a == a1 && b >= b1 -(<||) (AppVersion (a,b,c)) (AppVersionSpecification SVMinPatch (AppVersion (a1, b1, c1))) - = a == a1 && b == b1 && c >= c1 - - -newtype AppVersion = AppVersion - { unAppVersion :: (Word16, Word16, Word16) } deriving (Eq, Ord) -instance Show AppVersion where - show (AppVersion (a, b, c)) = [i|#{a}.#{b}.#{c}|] -instance IsString AppVersion where - fromString s = case traverse (readMaybe . toS) $ split (=='.') (toS s) of - Just [major, minor, patch] -> AppVersion (major, minor, patch) - _ -> panic . toS $ "Invalid App Version: " <> s -instance ToJSON AppVersion where - toJSON av = String . toS $ let (a,b,c) = unAppVersion av in [i|#{a}.#{b}.#{c}|] -instance FromJSON AppVersion where - parseJSON = withText "app version" $ \t -> - case splitOn "." t of - [a, b, c] -> - case traverse (decode . toS) [a, b, c] of - Just [a', b', c'] -> pure $ AppVersion (a', b', c') - _ -> fail "non word16 versioning" - _ -> fail "unknown versioning" -instance ToTypedContent AppVersion where - toTypedContent = toTypedContent . toJSON -instance ToContent AppVersion where - toContent = toContent . toJSON - -(\\) :: AppVersion -> AppVersion -> (Word16, Word16, Word16) -(\\) (AppVersion (a, b, c)) (AppVersion (a1, b1, c1)) = (a `diffy` a1, b `diffy` b1, c `diffy` c1) - where - d `diffy` d1 = fromIntegral . abs $ (fromIntegral d :: Integer) - (fromIntegral d1 :: Integer) data AppStatus = Running | Stopped | Restarting | Removing | Dead deriving (Eq, Show) instance ToJSON AppStatus where diff --git a/src/Util/Function.hs b/src/Util/Function.hs index 0974318..da4ee4b 100644 --- a/src/Util/Function.hs +++ b/src/Util/Function.hs @@ -6,4 +6,18 @@ import Startlude (.*) = (.) . (.) (.**) :: (b -> c) -> (a0 -> a1 -> a2 -> b) -> a0 -> a1 -> a2 -> c -(.**) = (.) . (.*) \ No newline at end of file +(.**) = (.) . (.*) + +preimage :: Eq b => (a -> b) -> b -> [a] -> [a] +preimage f target = filter ((== target) . f) + +mapFind :: ([a] -> Maybe a) -> (b -> a) -> [b] -> Maybe b +mapFind _ _ [] = Nothing +mapFind finder mapping (b:bs) = let + mB = mapFind finder mapping bs + mA = finder [mapping b] + in case (mB, mA) of + (Just b',_) -> Just b' + (Nothing, Just _) -> Just b + _ -> Nothing +