streaming output works

config/routes

@@ -2,10 +2,10 @@
 
 /                                       AppsManifestR      GET --get current apps listing
 /version                                VersionR           GET
--- /version/:appId                         VersionAppR        GET --get most recent appId version
+/version/#Text                          VersionAppR        GET --get most recent appId version
--- /sys/version/agent                      VersionAgentR      GET --get most recent agent version
+/sys/version/agent                      VersionAgentR      GET --get most recent agent version
--- /sys/version/appmgr                     VersionAppMgrR     GET --get most recent appmgr 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 -- ?spec={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 -- ?spec={semver-spec}
--- /sys/appmgr.s9pk  AppMgrR            GET --get most recent appmgr at appversion -- ?version={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

resources/bitcoind/0.18.1/version.yaml

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

resources/bitcoind/app.yaml

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

resources/sys/appmgr/0.0.0/appmgr.s9pk

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

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

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

@@ -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 TypedContent
-getAppsManifestR :: Handler AppManifestYml
+getAppsManifestR = respondSource typePlain $ CB.sourceFile appManifestPath .| awaitForever sendChunkBS
-getAppsManifestR = respondSource typePlain $ CB.sourceFile manifestPath .| 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 :: Handler AppVersionRes
-getVersionR = pure . AppVersionRes $ registryVersion

src/Handler/Types/Apps.hs

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

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,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
+newtype AppVersionRes = AppVersionRes { unAppVersionRes ::AppVersion } deriving (Eq, Show)
-    { 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
+handleS9ErrT :: MonadHandler m => S9ErrT m a -> m a
-respondStatusException action = runExceptT action >>= \case
+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/Resource.hs

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

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/AppsManifest.hs

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

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

src/Lib/Types/StoreApp.hs

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