add routes for getting app config and manifest

src/Lib/Error.hs

@@ -1,14 +1,19 @@
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE QuasiQuotes     #-}
+
 module Lib.Error where
 
 import           Startlude
 
 import           Network.HTTP.Types
 import           Yesod.Core
+import           Data.String.Interpolate.IsString
 
 type S9ErrT m = ExceptT S9Error m
 
-data S9Error = PersistentE Text
+data S9Error = 
+      PersistentE Text
+    | AppMgrE Text Int
     deriving (Show, Eq)
 
 instance Exception S9Error
@@ -17,8 +22,12 @@ instance Exception S9Error
 toError :: S9Error -> Error
 toError = \case
     PersistentE t -> Error DATABASE_ERROR t
+    AppMgrE cmd code -> Error APPMGR_ERROR [i|"appmgr #{cmd}" exited with #{code}|]
+
+data ErrorCode = 
+      DATABASE_ERROR
+    | APPMGR_ERROR
 
-data ErrorCode = DATABASE_ERROR
     deriving (Eq, Show)
 instance ToJSON ErrorCode where
     toJSON = String . show
@@ -42,7 +51,9 @@ instance ToContent S9Error where
 
 toStatus :: S9Error -> Status
 toStatus = \case
-    PersistentE _ -> status500
+    PersistentE _          -> status500
+    AppMgrE     _ _        -> status500
+
 
 handleS9ErrT :: MonadHandler m => S9ErrT m a -> m a
 handleS9ErrT action = runExceptT action >>= \case

src/Lib/External/AppMgr.hs

@@ -0,0 +1,57 @@
+{-# LANGUAGE DataKinds        #-}
+{-# LANGUAGE GADTs            #-}
+{-# LANGUAGE QuasiQuotes      #-}
+{-# LANGUAGE RecordWildCards  #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies     #-}
+
+module Lib.External.AppMgr where
+
+import           Startlude
+
+import qualified Data.ByteString.Lazy          as LBS
+import           Data.String.Interpolate.IsString
+import           System.Process.Typed    hiding ( createPipe )
+
+import           Lib.Error
+import           Lib.Registry
+
+readProcessWithExitCode' :: MonadIO m => String -> [String] -> ByteString -> m (ExitCode, ByteString, ByteString)
+readProcessWithExitCode' a b c = liftIO $ do
+    let pc =
+            setStdin (byteStringInput $ LBS.fromStrict c)
+                $ setStderr byteStringOutput
+                $ setEnvInherit
+                $ setStdout byteStringOutput
+                $ (System.Process.Typed.proc a b)
+    withProcessWait pc $ \process -> atomically $ liftA3 (,,)
+                                                         (waitExitCodeSTM process)
+                                                         (fmap LBS.toStrict $ getStdout process)
+                                                         (fmap LBS.toStrict $ getStderr process)
+
+readProcessInheritStderr :: MonadIO m => String -> [String] -> ByteString -> m (ExitCode, ByteString)
+readProcessInheritStderr a b c = liftIO $ do
+    let pc =
+            setStdin (byteStringInput $ LBS.fromStrict c)
+                $ setStderr inherit
+                $ setEnvInherit
+                $ setStdout byteStringOutput
+                $ (System.Process.Typed.proc a b)
+    withProcessWait pc
+        $ \process -> atomically $ liftA2 (,) (waitExitCodeSTM process) (fmap LBS.toStrict $ getStdout process)
+
+getConfig :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m Text
+getConfig appmgrPath appPath e@(Extension appId) = fmap decodeUtf8 $ do
+    (ec, out) <- readProcessInheritStderr (appmgrPath <> "appmgr") ["inspect", "info", appPath <> show e, "-C", "--json"] ""
+    case ec of
+        ExitSuccess   -> pure out
+        ExitFailure n -> throwE $ AppMgrE [i|info #{appId} -C \--json|] n
+
+getManifest :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m ByteString
+getManifest appmgrPath appPath e@(Extension appId) = do
+    (ec, bs) <- readProcessInheritStderr (appmgrPath <> "appmgr") ["inspect", "info", appPath <> show e, "-M", "--json"] ""
+    case ec of
+        ExitSuccess -> pure bs
+        ExitFailure n -> throwE $ AppMgrE [i|info -M #{appId} \--json|] n