mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-26 10:21:51 +00:00
70 lines
2.3 KiB
Haskell
70 lines
2.3 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
|
|
module Handler.Apps where
|
|
|
|
import Startlude
|
|
|
|
import Control.Monad.Logger
|
|
import Data.Aeson
|
|
import qualified Data.ByteString.Lazy as BS
|
|
import Data.Conduit
|
|
import qualified Data.Conduit.Binary as CB
|
|
import qualified GHC.Show (Show (..))
|
|
import System.Directory
|
|
import Yesod.Core
|
|
|
|
import Foundation
|
|
import Handler.Types.Status
|
|
import Lib.Registry
|
|
import Lib.Semver
|
|
import Lib.Types.Semver
|
|
import System.FilePath ((<.>))
|
|
|
|
pureLog :: Show a => a -> Handler a
|
|
pureLog = liftA2 (*>) ($logInfo . show) pure
|
|
|
|
logRet :: ToJSON a => Handler a -> Handler a
|
|
logRet = (>>= liftA2 (*>) ($logInfo . decodeUtf8 . BS.toStrict . encode) pure)
|
|
|
|
data FileExtension = FileExtension FilePath (Maybe String)
|
|
instance Show FileExtension where
|
|
show (FileExtension f Nothing) = f
|
|
show (FileExtension f (Just e)) = f <.> e
|
|
|
|
getAppsManifestR :: Handler TypedContent
|
|
getAppsManifestR = respondSource typePlain $ CB.sourceFile appManifestPath .| awaitForever sendChunkBS
|
|
|
|
getImageR :: Handler TypedContent
|
|
getImageR = getApp sysResourceDir ("image" :: Extension "")
|
|
|
|
getAgentR :: Handler TypedContent
|
|
getAgentR = getApp sysResourceDir ("agent" :: Extension "")
|
|
|
|
getAppMgrR :: Handler TypedContent
|
|
getAppMgrR = getApp sysResourceDir ("appmgr" :: Extension "")
|
|
|
|
getTorrcR :: Handler TypedContent
|
|
getTorrcR = getApp sysResourceDir ("torrc" :: Extension "")
|
|
|
|
getAppR :: Extension "s9pk" -> Handler TypedContent
|
|
getAppR = getApp appResourceDir
|
|
|
|
getApp :: KnownSymbol a => FilePath -> Extension a -> Handler TypedContent
|
|
getApp rootDir ext = do
|
|
spec <- querySpecD mostRecentVersion <$> lookupGetParam "spec"
|
|
appVersions <- liftIO $ getAvailableAppVersions rootDir ext
|
|
putStrLn $ "valid appversion for " <> (show ext :: String) <> ": " <> show appVersions
|
|
case getSpecifiedAppVersion spec appVersions of
|
|
Nothing -> notFound
|
|
Just (RegisteredAppVersion (_, filePath)) -> do
|
|
exists <- liftIO $ doesFileExist filePath
|
|
if exists
|
|
then respondSource typePlain $ CB.sourceFile filePath .| awaitForever sendChunkBS
|
|
else notFound
|
|
|
|
|