mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-26 02:11:53 +00:00
fsnotify extraction attempt
This commit is contained in:
Keagan McClelland
@@ -31,6 +31,7 @@ dependencies:
|
||||
- fast-logger
|
||||
- filepath
|
||||
- foreign-store
|
||||
- fsnotify
|
||||
- http-types
|
||||
- interpolate
|
||||
- lens
|
||||
|
||||
@@ -24,51 +24,79 @@ module Application
|
||||
, getAppSettings
|
||||
-- * for GHCI
|
||||
, handler
|
||||
,db) where
|
||||
, db
|
||||
) where
|
||||
|
||||
import Startlude hiding (Handler)
|
||||
import Startlude hiding ( Handler )
|
||||
|
||||
import Control.Monad.Logger (liftLoc, runLoggingT)
|
||||
import Control.Monad.Logger ( liftLoc
|
||||
, runLoggingT
|
||||
)
|
||||
import Data.Default
|
||||
import Database.Persist.Postgresql (createPostgresqlPool, pgConnStr, pgPoolSize, runSqlPool, runMigration)
|
||||
import Language.Haskell.TH.Syntax (qLocation)
|
||||
import Database.Persist.Postgresql ( createPostgresqlPool
|
||||
, pgConnStr
|
||||
, pgPoolSize
|
||||
, runMigration
|
||||
, runSqlPool
|
||||
)
|
||||
import Language.Haskell.TH.Syntax ( qLocation )
|
||||
import Network.Wai
|
||||
import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException,
|
||||
getPort, setHost, setOnException, setPort, runSettings, setHTTP2Disabled)
|
||||
import Network.Wai.Handler.Warp ( Settings
|
||||
, defaultSettings
|
||||
, defaultShouldDisplayException
|
||||
, getPort
|
||||
, runSettings
|
||||
, setHTTP2Disabled
|
||||
, setHost
|
||||
, setOnException
|
||||
, setPort
|
||||
)
|
||||
import Network.Wai.Handler.WarpTLS
|
||||
import Network.Wai.Middleware.AcceptOverride
|
||||
import Network.Wai.Middleware.Autohead
|
||||
import Network.Wai.Middleware.Cors (CorsResourcePolicy (..), cors, simpleCorsResourcePolicy)
|
||||
import Network.Wai.Middleware.Cors ( CorsResourcePolicy(..)
|
||||
, cors
|
||||
, simpleCorsResourcePolicy
|
||||
)
|
||||
import Network.Wai.Middleware.MethodOverride
|
||||
import Network.Wai.Middleware.RequestLogger (Destination (Logger), OutputFormat (..),
|
||||
destination, mkRequestLogger, outputFormat)
|
||||
import System.IO (hSetBuffering, BufferMode (..))
|
||||
import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr)
|
||||
import Network.Wai.Middleware.RequestLogger
|
||||
( Destination(Logger)
|
||||
, OutputFormat(..)
|
||||
, destination
|
||||
, mkRequestLogger
|
||||
, outputFormat
|
||||
)
|
||||
import System.IO ( BufferMode(..)
|
||||
, hSetBuffering
|
||||
)
|
||||
import System.Log.FastLogger ( defaultBufSize
|
||||
, newStdoutLoggerSet
|
||||
, toLogStr
|
||||
)
|
||||
import Yesod.Core
|
||||
import Yesod.Core.Types hiding (Logger)
|
||||
import Yesod.Core.Types hiding ( Logger )
|
||||
import Yesod.Default.Config2
|
||||
|
||||
-- Import all relevant handler modules here.
|
||||
-- Don't forget to add new modules to your cabal file!
|
||||
import Control.Arrow ( (***) )
|
||||
import Control.Lens
|
||||
import Data.List ( lookup )
|
||||
import Database.Persist.Sql ( SqlBackend )
|
||||
import Foundation
|
||||
import Handler.Apps
|
||||
import Handler.ErrorLogs
|
||||
import Handler.Icons
|
||||
import Handler.Version
|
||||
import Handler.Marketplace
|
||||
import Handler.Version
|
||||
import Lib.PkgRepository ( watchPkgRepoRoot )
|
||||
import Lib.Ssl
|
||||
import Model
|
||||
import Network.HTTP.Types.Header ( hOrigin )
|
||||
import Network.Wai.Middleware.RequestLogger.JSON
|
||||
import Settings
|
||||
import System.Directory ( createDirectoryIfMissing )
|
||||
import System.Posix.Process
|
||||
import System.Time.Extra
|
||||
import Model
|
||||
import Control.Lens
|
||||
import Control.Arrow ((***))
|
||||
import Network.HTTP.Types.Header ( hOrigin )
|
||||
import Data.List (lookup)
|
||||
import Network.Wai.Middleware.RequestLogger.JSON
|
||||
import System.Directory (createDirectoryIfMissing)
|
||||
import Database.Persist.Sql (SqlBackend)
|
||||
import Yesod
|
||||
import Yesod
|
||||
|
||||
-- This line actually creates our YesodDispatch instance. It is the second half
|
||||
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
|
||||
@@ -83,35 +111,36 @@ makeFoundation :: AppSettings -> IO RegistryCtx
|
||||
makeFoundation appSettings = do
|
||||
-- Some basic initializations: HTTP connection manager, logger, and static
|
||||
-- subsite.
|
||||
appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
|
||||
appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
|
||||
|
||||
appWebServerThreadId <- newEmptyMVar
|
||||
appShouldRestartWeb <- newMVar False
|
||||
appShouldRestartWeb <- newMVar False
|
||||
|
||||
-- We need a log function to create a connection pool. We need a connection
|
||||
-- pool to create our foundation. And we need our foundation to get a
|
||||
-- logging function. To get out of this loop, we initially create a
|
||||
-- temporary foundation without a real connection pool, get a log function
|
||||
-- from there, and then create the real foundation.
|
||||
let mkFoundation appConnPool = RegistryCtx {..}
|
||||
-- The RegistryCtx {..} syntax is an example of record wild cards. For more
|
||||
-- information, see:
|
||||
-- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html
|
||||
tempFoundation = mkFoundation $ panic "connPool forced in tempFoundation"
|
||||
let mkFoundation appConnPool appStopFsNotify = RegistryCtx { .. }
|
||||
-- The RegistryCtx {..} syntax is an example of record wild cards. For more
|
||||
-- information, see:
|
||||
-- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html
|
||||
tempFoundation =
|
||||
mkFoundation (panic "connPool forced in tempFoundation") (panic "stopFsNotify forced in tempFoundation")
|
||||
logFunc = messageLoggerSource tempFoundation appLogger
|
||||
|
||||
stop <- runLoggingT (runReaderT watchPkgRepoRoot appSettings) logFunc
|
||||
createDirectoryIfMissing True (errorLogRoot appSettings)
|
||||
|
||||
-- Create the database connection pool
|
||||
pool <- flip runLoggingT logFunc $ createPostgresqlPool
|
||||
(pgConnStr $ appDatabaseConf appSettings)
|
||||
(pgPoolSize . appDatabaseConf $ appSettings)
|
||||
pool <- flip runLoggingT logFunc
|
||||
$ createPostgresqlPool (pgConnStr $ appDatabaseConf appSettings) (pgPoolSize . appDatabaseConf $ appSettings)
|
||||
|
||||
-- Preform database migration using application logging settings
|
||||
runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc
|
||||
|
||||
-- Return the foundation
|
||||
return $ mkFoundation pool
|
||||
return $ mkFoundation pool stop
|
||||
|
||||
-- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
|
||||
-- applying some additional middlewares.
|
||||
@@ -189,14 +218,12 @@ dynamicCorsResourcePolicy req = Just . policy . lookup hOrigin $ requestHeaders
|
||||
}
|
||||
|
||||
makeLogWare :: RegistryCtx -> IO Middleware
|
||||
makeLogWare foundation =
|
||||
mkRequestLogger def
|
||||
{ outputFormat =
|
||||
if appDetailedRequestLogging $ appSettings foundation
|
||||
then Detailed True
|
||||
else CustomOutputFormatWithDetailsAndHeaders formatAsJSONWithHeaders
|
||||
, destination = Logger $ loggerSet $ appLogger foundation
|
||||
}
|
||||
makeLogWare foundation = mkRequestLogger def
|
||||
{ outputFormat = if appDetailedRequestLogging $ appSettings foundation
|
||||
then Detailed True
|
||||
else CustomOutputFormatWithDetailsAndHeaders formatAsJSONWithHeaders
|
||||
, destination = Logger $ loggerSet $ appLogger foundation
|
||||
}
|
||||
|
||||
makeAuthWare :: RegistryCtx -> Middleware
|
||||
makeAuthWare _ app req res = next
|
||||
@@ -229,10 +256,10 @@ appMain = do
|
||||
-- Get the settings from all relevant sources
|
||||
settings <- loadYamlSettingsArgs
|
||||
-- fall back to compile-time values, set to [] to require values at runtime
|
||||
[configSettingsYmlValue]
|
||||
[configSettingsYmlValue]
|
||||
|
||||
-- allow environment variables to override
|
||||
useEnv
|
||||
useEnv
|
||||
|
||||
-- Generate the foundation from the settings
|
||||
makeFoundation settings >>= startApp
|
||||
@@ -262,15 +289,14 @@ startWeb foundation = do
|
||||
app <- makeApplication foundation
|
||||
startWeb' app
|
||||
where
|
||||
startWeb' app = do
|
||||
let AppSettings{..} = appSettings foundation
|
||||
startWeb' app = (`onException` (appStopFsNotify foundation)) $ do
|
||||
let AppSettings {..} = appSettings foundation
|
||||
putStrLn @Text $ "Launching Tor Web Server on port " <> show torPort
|
||||
torAction <- async $ runSettings (warpSettings torPort foundation) app
|
||||
putStrLn @Text $ "Launching Web Server on port " <> show appPort
|
||||
action <- if sslAuto
|
||||
then async $ runTLS (tlsSettings sslCertLocation sslKeyLocation)
|
||||
(warpSettings appPort foundation) app
|
||||
else async $ runSettings (warpSettings appPort foundation) app
|
||||
then async $ runTLS (tlsSettings sslCertLocation sslKeyLocation) (warpSettings appPort foundation) app
|
||||
else async $ runSettings (warpSettings appPort foundation) app
|
||||
let actions = (action, torAction)
|
||||
|
||||
setWebProcessThreadId (join (***) asyncThreadId actions) foundation
|
||||
@@ -303,21 +329,21 @@ shutdownAll threadIds = do
|
||||
|
||||
-- Careful, you should always spawn this within forkIO so as to avoid accidentally killing the running process
|
||||
shutdownWeb :: RegistryCtx -> IO ()
|
||||
shutdownWeb RegistryCtx{..} = do
|
||||
threadIds <- takeMVar appWebServerThreadId
|
||||
shutdownWeb RegistryCtx {..} = do
|
||||
threadIds <- takeMVar appWebServerThreadId
|
||||
void $ both killThread threadIds
|
||||
|
||||
--------------------------------------------------------------
|
||||
-- Functions for DevelMain.hs (a way to run the RegistryCtx from GHCi)
|
||||
--------------------------------------------------------------
|
||||
|
||||
getApplicationRepl :: IO (Int, RegistryCtx, Application)
|
||||
getApplicationRepl :: IO (Int, RegistryCtx, Application)
|
||||
getApplicationRepl = do
|
||||
settings <- getAppSettings
|
||||
settings <- getAppSettings
|
||||
foundation <- getAppSettings >>= makeFoundation
|
||||
wsettings <- getDevSettings $ warpSettings (appPort settings) foundation
|
||||
app1 <- makeApplication foundation
|
||||
return (getPort wsettings, foundation, app1)
|
||||
wsettings <- getDevSettings $ warpSettings (appPort settings) foundation
|
||||
app1 <- makeApplication foundation
|
||||
return (getPort wsettings, foundation, app1)
|
||||
|
||||
shutdownApp :: RegistryCtx -> IO ()
|
||||
shutdownApp _ = return ()
|
||||
@@ -325,10 +351,10 @@ shutdownApp _ = return ()
|
||||
-- | For yesod devel, return the Warp settings and WAI Application.
|
||||
getApplicationDev :: AppPort -> IO (Settings, Application)
|
||||
getApplicationDev port = do
|
||||
settings <- getAppSettings
|
||||
settings <- getAppSettings
|
||||
foundation <- makeFoundation settings
|
||||
app <- makeApplication foundation
|
||||
wsettings <- getDevSettings $ warpSettings port foundation
|
||||
app <- makeApplication foundation
|
||||
wsettings <- getDevSettings $ warpSettings port foundation
|
||||
return (wsettings, app)
|
||||
|
||||
-- | main function for use by yesod devel
|
||||
@@ -347,4 +373,4 @@ handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h
|
||||
|
||||
-- | Run DB queries
|
||||
db :: ReaderT SqlBackend (HandlerFor RegistryCtx) a -> IO a
|
||||
db = handler . runDB
|
||||
db = handler . runDB
|
||||
|
||||
@@ -15,8 +15,11 @@ import Yesod.Core
|
||||
import Yesod.Core.Types ( Logger )
|
||||
import qualified Yesod.Core.Unsafe as Unsafe
|
||||
|
||||
import Control.Monad.Reader.Has ( Has(extract, update) )
|
||||
import Lib.PkgRepository
|
||||
import Lib.Types.AppIndex
|
||||
import Settings
|
||||
import System.FilePath ( (</>) )
|
||||
import Yesod.Persist.Core
|
||||
|
||||
-- | The foundation datatype for your application. This can be a good place to
|
||||
@@ -31,7 +34,17 @@ data RegistryCtx = RegistryCtx
|
||||
, appWebServerThreadId :: MVar (ThreadId, ThreadId)
|
||||
, appShouldRestartWeb :: MVar Bool
|
||||
, appConnPool :: ConnectionPool
|
||||
, appStopFsNotify :: IO Bool
|
||||
}
|
||||
instance Has PkgRepo RegistryCtx where
|
||||
extract = do
|
||||
liftA2 PkgRepo ((</> "apps") . resourcesDir . appSettings) (staticBinDir . appSettings)
|
||||
update f ctx =
|
||||
let repo = f $ extract ctx
|
||||
settings = (appSettings ctx) { resourcesDir = pkgRepoFileRoot repo, staticBinDir = pkgRepoAppMgrBin repo }
|
||||
in ctx { appSettings = settings }
|
||||
|
||||
|
||||
|
||||
setWebProcessThreadId :: (ThreadId, ThreadId) -> RegistryCtx -> IO ()
|
||||
setWebProcessThreadId tid a = putMVar (appWebServerThreadId a) $ tid
|
||||
|
||||
1
src/Lib/External/AppMgr.hs
vendored
1
src/Lib/External/AppMgr.hs
vendored
@@ -18,7 +18,6 @@ import System.Process.Typed hiding ( createPipe )
|
||||
|
||||
import Conduit ( (.|)
|
||||
, ConduitT
|
||||
, MonadThrow
|
||||
, runConduit
|
||||
)
|
||||
import qualified Data.Conduit.List as CL
|
||||
|
||||
160
src/Lib/PkgRepository.hs
Normal file
160
src/Lib/PkgRepository.hs
Normal file
@@ -0,0 +1,160 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
module Lib.PkgRepository where
|
||||
|
||||
import Conduit ( (.|)
|
||||
, runConduit
|
||||
, runResourceT
|
||||
, sinkFileCautious
|
||||
)
|
||||
import Control.Monad.Logger ( MonadLogger
|
||||
, MonadLoggerIO
|
||||
, logError
|
||||
, logInfo
|
||||
, logWarn
|
||||
)
|
||||
import Control.Monad.Reader.Has ( Has
|
||||
, ask
|
||||
, asks
|
||||
)
|
||||
import Data.Aeson ( eitherDecodeFileStrict' )
|
||||
import qualified Data.Attoparsec.Text as Atto
|
||||
import Data.String.Interpolate.IsString
|
||||
( i )
|
||||
import qualified Data.Text as T
|
||||
import qualified Lib.External.AppMgr as AppMgr
|
||||
import Lib.Registry ( Extension(Extension) )
|
||||
import Lib.Types.AppIndex ( PkgId(PkgId)
|
||||
, ServiceManifest(serviceManifestIcon)
|
||||
)
|
||||
import Lib.Types.Emver ( Version
|
||||
, parseVersion
|
||||
)
|
||||
import Startlude ( ($)
|
||||
, (&&)
|
||||
, (.)
|
||||
, (<$>)
|
||||
, Bool(..)
|
||||
, Either(Left, Right)
|
||||
, Eq((==))
|
||||
, Exception
|
||||
, FilePath
|
||||
, IO
|
||||
, MonadIO(liftIO)
|
||||
, MonadReader
|
||||
, Show
|
||||
, String
|
||||
, filter
|
||||
, for_
|
||||
, fromMaybe
|
||||
, not
|
||||
, partitionEithers
|
||||
, pure
|
||||
, show
|
||||
, throwIO
|
||||
)
|
||||
import System.FSNotify ( Event(Added)
|
||||
, eventPath
|
||||
, watchTree
|
||||
, withManager
|
||||
)
|
||||
import System.FilePath ( (<.>)
|
||||
, (</>)
|
||||
, takeBaseName
|
||||
, takeDirectory
|
||||
, takeExtension
|
||||
, takeFileName
|
||||
)
|
||||
import UnliftIO ( MonadUnliftIO
|
||||
, askRunInIO
|
||||
, async
|
||||
, mapConcurrently
|
||||
, newEmptyMVar
|
||||
, onException
|
||||
, takeMVar
|
||||
, wait
|
||||
)
|
||||
import UnliftIO ( tryPutMVar )
|
||||
import UnliftIO.Concurrent ( forkIO )
|
||||
import UnliftIO.Directory ( listDirectory
|
||||
, removeFile
|
||||
, renameFile
|
||||
)
|
||||
|
||||
data ManifestParseException = ManifestParseException PkgId Version String
|
||||
deriving Show
|
||||
instance Exception ManifestParseException
|
||||
|
||||
data PkgRepo = PkgRepo
|
||||
{ pkgRepoFileRoot :: FilePath
|
||||
, pkgRepoAppMgrBin :: FilePath
|
||||
}
|
||||
|
||||
getVersionsFor :: (MonadIO m, MonadReader r m, Has PkgRepo r, MonadLogger m) => PkgId -> m [Version]
|
||||
getVersionsFor pkg = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
subdirs <- listDirectory $ root </> show pkg
|
||||
let (failures, successes) = partitionEithers $ (Atto.parseOnly parseVersion . T.pack) <$> subdirs
|
||||
for_ failures $ \f -> $logWarn [i|Emver Parse Failure for #{pkg}: #{f}|]
|
||||
pure successes
|
||||
|
||||
-- extract all package assets into their own respective files
|
||||
extractPkg :: (MonadUnliftIO m, MonadReader r m, Has PkgRepo r, MonadLoggerIO m) => PkgId -> Version -> m ()
|
||||
extractPkg pkg v = (`onException` cleanup) $ do
|
||||
$logInfo [i|Extracting package: #{pkg}@#{v}|]
|
||||
PkgRepo { pkgRepoFileRoot = root, pkgRepoAppMgrBin = appmgr } <- ask
|
||||
let s9pk = Extension @"s9pk" $ show pkg
|
||||
let pkgRoot = root </> show pkg </> show v
|
||||
manifestTask <- async $ liftIO . runResourceT $ AppMgr.sourceManifest appmgr root s9pk $ sinkIt
|
||||
(pkgRoot </> "manifest.json")
|
||||
instructionsTask <- async $ liftIO . runResourceT $ AppMgr.sourceInstructions appmgr root s9pk $ sinkIt
|
||||
(pkgRoot </> "instructions.md")
|
||||
licenseTask <- async $ liftIO . runResourceT $ AppMgr.sourceLicense appmgr root s9pk $ sinkIt
|
||||
(pkgRoot </> "license.md")
|
||||
iconTask <- async $ liftIO . runResourceT $ AppMgr.sourceIcon appmgr root s9pk $ sinkIt (pkgRoot </> "icon.tmp")
|
||||
wait manifestTask
|
||||
eManifest <- liftIO (eitherDecodeFileStrict' (pkgRoot </> "manifest.json"))
|
||||
case eManifest of
|
||||
Left e -> do
|
||||
$logError [i|Invalid Package Manifest: #{pkg}@#{v}|]
|
||||
liftIO . throwIO $ ManifestParseException pkg v e
|
||||
Right manifest -> do
|
||||
wait iconTask
|
||||
let iconDest = "icon" <.> T.unpack (fromMaybe "png" (serviceManifestIcon manifest))
|
||||
liftIO $ renameFile (pkgRoot </> "icon.tmp") (pkgRoot </> iconDest)
|
||||
wait instructionsTask
|
||||
wait licenseTask
|
||||
where
|
||||
sinkIt fp source = runConduit $ source .| sinkFileCautious fp
|
||||
cleanup = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
let pkgRoot = root </> show pkg </> show v
|
||||
fs <- listDirectory pkgRoot
|
||||
let toRemove = filter (not . (== ".s9pk") . takeExtension) fs
|
||||
mapConcurrently (removeFile . (pkgRoot </>)) toRemove
|
||||
|
||||
watchPkgRepoRoot :: (MonadUnliftIO m, MonadReader r m, Has PkgRepo r, MonadLoggerIO m) => m (IO Bool)
|
||||
watchPkgRepoRoot = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
runInIO <- askRunInIO
|
||||
box <- newEmptyMVar @_ @()
|
||||
_ <- forkIO $ liftIO $ withManager $ \watchManager -> do
|
||||
stop <- watchTree watchManager root onlyAdded $ \evt ->
|
||||
let pkg = PkgId . T.pack $ takeBaseName (eventPath evt)
|
||||
version = Atto.parseOnly parseVersion . T.pack . takeFileName . takeDirectory $ (eventPath evt)
|
||||
in case version of
|
||||
Left _ -> runInIO $ do
|
||||
$logError [i|Invalid Version in package path: #{eventPath evt}|]
|
||||
Right v -> runInIO (extractPkg pkg v)
|
||||
takeMVar box
|
||||
stop
|
||||
pure $ tryPutMVar box ()
|
||||
where
|
||||
onlyAdded = \case
|
||||
Added path _ isDir -> not isDir && takeExtension path == ".s9pk"
|
||||
_ -> False
|
||||
@@ -1,5 +1,6 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
-- | Settings are centralized, as much as possible, into this file. This
|
||||
-- includes database connection settings, static file locations, etc.
|
||||
-- In addition, you can configure a number of different aspects of Yesod
|
||||
@@ -23,6 +24,8 @@ import Network.Wai.Handler.Warp ( HostPreference )
|
||||
import System.FilePath ( (</>) )
|
||||
import Yesod.Default.Config2 ( configSettingsYml )
|
||||
|
||||
import Control.Monad.Reader.Has ( Has(extract, update) )
|
||||
import Lib.PkgRepository ( PkgRepo(PkgRepo, pkgRepoAppMgrBin, pkgRepoFileRoot) )
|
||||
import Lib.Types.Emver
|
||||
import Orphans.Emver ( )
|
||||
-- | Runtime settings to configure this application. These settings can be
|
||||
@@ -54,6 +57,11 @@ data AppSettings = AppSettings
|
||||
, staticBinDir :: FilePath
|
||||
, errorLogRoot :: FilePath
|
||||
}
|
||||
instance Has PkgRepo AppSettings where
|
||||
extract = liftA2 PkgRepo ((</> "apps") . resourcesDir) staticBinDir
|
||||
update f r =
|
||||
let repo = f $ extract r in r { resourcesDir = pkgRepoFileRoot repo, staticBinDir = pkgRepoAppMgrBin repo }
|
||||
|
||||
|
||||
instance FromJSON AppSettings where
|
||||
parseJSON = withObject "AppSettings" $ \o -> do
|
||||
|
||||
Reference in New Issue
Block a user