streaming output works

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

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