changes appmgr calls to be conduit sources.

src/Handler/Apps.hs

@@ -31,16 +31,16 @@ import           System.Posix.Files             ( fileSize
 import           Yesod.Core
 import           Yesod.Persist.Core
 
+import           Database.Queries
 import           Foundation
+import           Lib.Error
+import           Lib.External.AppMgr
 import           Lib.Registry
 import           Lib.Types.AppIndex
 import           Lib.Types.Emver
 import           Lib.Types.FileSystem
-import           Lib.Error
-import           Lib.External.AppMgr
-import           Settings
-import           Database.Queries
 import           Network.Wai                    ( Request(requestHeaderUserAgent) )
+import           Settings
 import           Util.Shared
 
 pureLog :: Show a => a -> Handler a
@@ -78,9 +78,11 @@ getAppManifestR appId = do
         Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
         Just v  -> pure v
     let appDir = (<> "/") . (</> show av) . (</> show appId) $ appsDir
-    manifest <- handleS9ErrT $ getManifest appMgrDir appDir appExt
     addPackageHeader appMgrDir appDir appExt
-    pure $ TypedContent "application/json" (toContent manifest)
+    getManifest appMgrDir
+                appDir
+                appExt
+                (\bsSource -> respondSource "application/json" (bsSource .| awaitForever sendChunkBS))
     where appExt = Extension (show appId) :: Extension "s9pk"
 
 getAppConfigR :: AppIdentifier -> Handler TypedContent
@@ -92,8 +94,8 @@ getAppConfigR appId = do
         Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
         Just v  -> pure v
     let appDir = (<> "/") . (</> show av) . (</> show appId) $ appsDir
-    config <- handleS9ErrT $ getConfig appMgrDir appDir appExt
     addPackageHeader appMgrDir appDir appExt
+    config <- getConfig appMgrDir appDir appExt (\bsSource -> _)
     pure $ TypedContent "application/json" (toContent config)
     where appExt = Extension (show appId) :: Extension "s9pk"
 

src/Handler/Icons.hs

@@ -13,6 +13,11 @@ import           Yesod.Core
 
 import           Data.Aeson
 import qualified Data.ByteString.Lazy          as BS
+import           Data.Conduit                   ( (.|)
+                                                , awaitForever
+                                                , runConduit
+                                                )
+import qualified Data.Conduit.List             as CL
 import           Foundation
 import           Lib.Error
 import           Lib.External.AppMgr
@@ -40,7 +45,7 @@ getIconsR appId = do
         Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
         Just v  -> pure v
     let appDir = (<> "/") . (</> show spec) . (</> show appId) $ appsDir
-    manifest' <- handleS9ErrT $ getManifest appMgrDir appDir ext
+    manifest' <- getManifest appMgrDir appDir ext (\bsSource -> runConduit $ bsSource .| CL.foldMap BS.fromStrict)
     manifest  <- case eitherDecode manifest' of
         Left e -> do
             $logError "could not parse service manifest!"
@@ -61,10 +66,10 @@ getIconsR appId = do
                     SVG  -> pure typeSvg
                     JPG  -> pure typeJpeg
                     JPEG -> pure typeJpeg
-    respondSource mimeType (sendChunkBS =<< BS.toStrict <$> handleS9ErrT (getIcon appMgrDir (appDir </> show ext) ext))
-    -- (_, Just hout, _, _) <- liftIO (createProcess $ iconBs { std_out = CreatePipe })
-    -- respondSource typePlain (runConduit $ yieldMany () [iconBs])
-    -- respondSource typePlain $ sourceHandle hout .| awaitForever sendChunkBS
+    getIcon appMgrDir
+            (appDir </> show ext)
+            ext
+            (\bsSource -> respondSource mimeType (bsSource .| awaitForever sendChunkBS))
     where ext = Extension (show appId) :: Extension "s9pk"
 
 getLicenseR :: AppIdentifier -> Handler TypedContent
@@ -76,8 +81,8 @@ getLicenseR appId = do
     servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec
     case servicePath of
         Nothing -> notFound
-        Just p  -> do
-            respondSource typePlain (sendChunkBS =<< BS.toStrict <$> handleS9ErrT (getLicense appMgrDir p ext))
+        Just p ->
+            getLicense appMgrDir p ext (\bsSource -> respondSource typePlain (bsSource .| awaitForever sendChunkBS))
     where ext = Extension (show appId) :: Extension "s9pk"
 
 getInstructionsR :: AppIdentifier -> Handler TypedContent
@@ -89,6 +94,8 @@ getInstructionsR appId = do
     servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec
     case servicePath of
         Nothing -> notFound
-        Just p  -> do
-            respondSource typePlain (sendChunkBS =<< BS.toStrict <$> handleS9ErrT (getInstructions appMgrDir p ext))
+        Just p  -> getInstructions appMgrDir
+                                   p
+                                   ext
+                                   (\bsSource -> respondSource typePlain (bsSource .| awaitForever sendChunkBS))
     where ext = Extension (show appId) :: Extension "s9pk"

src/Handler/Marketplace.hs

@@ -11,8 +11,13 @@
 {-# LANGUAGE DeriveAnyClass #-}
 
 module Handler.Marketplace where
+import           Conduit                        ( (.|)
+                                                , MonadThrow
+                                                , mapC
+                                                )
 import           Data.Aeson
 import qualified Data.ByteString.Lazy          as BS
+import qualified Data.Conduit.Text             as CT
 import qualified Data.HashMap.Strict           as HM
 import           Data.List
 import qualified Data.List.NonEmpty            as NE
@@ -388,7 +393,7 @@ getPackageListR = do
                         Just v -> do
                             pure $ Right (Just v, appId)
 
-getServiceDetails :: (MonadIO m, Monad m, MonadError IOException m)
+getServiceDetails :: (MonadUnliftIO m, Monad m, MonadError IOException m)
                   => AppSettings
                   -> (HM.HashMap AppIdentifier ([Version], [CategoryTitle]))
                   -> Maybe Version
@@ -409,7 +414,7 @@ getServiceDetails settings metadata maybeVersion appId = do
         Just v -> pure v
     let appDir = (<> "/") . (</> show version) . (</> show appId) $ appsDir
     let appExt = Extension (show appId) :: Extension "s9pk"
-    manifest' <- handleS9ErrNuclear $ getManifest appMgrDir appDir appExt
+    manifest' <- getManifest appMgrDir appDir appExt (\bs -> sinkMem (bs .| mapC BS.fromStrict))
     case eitherDecode $ manifest' of
         Left  e -> pure $ Left $ "Could not parse service manifest for " <> show appId <> ": " <> show e
         Right m -> do
@@ -447,24 +452,30 @@ mapDependencyMetadata domain metadata (appId, depInfo) = do
                          }
         )
 
-decodeIcon :: (MonadHandler m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> m URL
-decodeIcon appmgrPath depPath e@(Extension icon) = do
-    icon' <- handleS9ErrT $ getIcon appmgrPath depPath e
-    case eitherDecode icon' of
-        Left e' -> do
-            $logInfo $ T.pack e'
-            sendResponseStatus status400 e'
-        Right (i' :: URL) -> pure $ i' <> T.pack icon
+-- decodeIcon :: (MonadHandler m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> m URL
+-- decodeIcon appmgrPath depPath e@(Extension icon) = do
+--     icon' <- handleS9ErrT $ getIcon appmgrPath depPath e
+--     case eitherDecode icon' of
+--         Left e' -> do
+--             $logInfo $ T.pack e'
+--             sendResponseStatus status400 e'
+--         Right (i' :: URL) -> pure $ i' <> T.pack icon
 
-decodeInstructions :: (MonadHandler m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> m Text
+decodeInstructions :: (MonadUnliftIO m, MonadHandler m, KnownSymbol a, MonadThrow m)
+                   => FilePath
+                   -> FilePath
+                   -> Extension a
+                   -> m Text
 decodeInstructions appmgrPath depPath package = do
-    instructions <- handleS9ErrT $ getInstructions appmgrPath depPath package
-    pure $ decodeUtf8 $ BS.toStrict instructions
+    getInstructions appmgrPath depPath package (\bs -> sinkMem (bs .| CT.decode CT.utf8))
 
-decodeLicense :: (MonadHandler m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> m Text
-decodeLicense appmgrPath depPath package = do
-    license <- handleS9ErrT $ getLicense appmgrPath depPath package
-    pure $ decodeUtf8 $ BS.toStrict license
+decodeLicense :: (MonadUnliftIO m, MonadThrow m, MonadHandler m, KnownSymbol a)
+              => FilePath
+              -> FilePath
+              -> Extension a
+              -> m Text
+decodeLicense appmgrPath depPath package =
+    getLicense appmgrPath depPath package (\bs -> sinkMem (bs .| CT.decode CT.utf8))
 
 fetchAllAppVersions :: Key SApp -> HandlerFor RegistryCtx ([VersionInfo], ReleaseNotes)
 fetchAllAppVersions appId = do