clean up instrumentation

This commit is contained in:
Keagan McClelland
2021-09-24 14:15:07 -06:00
parent 7217265fe3
commit 483a3631df
2 changed files with 11 additions and 27 deletions

View File

@@ -236,15 +236,6 @@ getVersionLatestR = do
)
$ HM.fromList packageList
time :: MonadIO m => Text -> m a -> m a
time label m = do
start <- liftIO getCurrentTime
res <- m
end <- liftIO getCurrentTime
putStrLn $ label <> ": " <> show (diffUTCTime end start)
pure res
getPackageListR :: Handler ServiceAvailableRes
getPackageListR = do
getParameters <- reqGetParams <$> getRequest
@@ -278,19 +269,14 @@ getPackageListR = do
Just c -> case readMaybe $ toS c of
Nothing -> sendResponseStatus status400 ("could not read per-page" :: Text)
Just l -> pure l
query <- time "filter" $ T.filter (not . isSpace) . fromMaybe (serviceListQuery defaults) <$> lookupGetParam
"query"
filteredServices <- time "search services" $ runDB $ searchServices category
limit'
((page - 1) * limit')
query
query <- T.filter (not . isSpace) . fromMaybe (serviceListQuery defaults) <$> lookupGetParam "query"
filteredServices <- runDB $ searchServices category limit' ((page - 1) * limit') query
let filteredServices' = sAppAppId . entityVal <$> filteredServices
settings <- getsYesod appSettings
packageMetadata <- time "metadata" $ runDB $ fetchPackageMetadata
packageMetadata <- runDB $ fetchPackageMetadata
$logInfo $ show packageMetadata
serviceDetailResult <- time "service details" $ liftIO $ mapConcurrently
(getServiceDetails settings packageMetadata Nothing)
filteredServices'
serviceDetailResult <- liftIO
$ mapConcurrently (getServiceDetails settings packageMetadata Nothing) filteredServices'
let (_, services) = partitionEithers serviceDetailResult
pure $ ServiceAvailableRes services
-- if null errors
@@ -303,12 +289,11 @@ getPackageListR = do
-- for each item in list get best available from version range
settings <- getsYesod appSettings
-- @TODO fix _ error
packageMetadata <- time "metadata2" $ runDB $ fetchPackageMetadata
packageMetadata <- runDB $ fetchPackageMetadata
availableServicesResult <- traverse (getPackageDetails packageMetadata) packages
let (_, availableServices) = partitionEithers availableServicesResult
serviceDetailResult <- time "service details 2" $ liftIO $ mapConcurrently
(uncurry $ getServiceDetails settings packageMetadata)
availableServices
serviceDetailResult <- liftIO
$ mapConcurrently (uncurry $ getServiceDetails settings packageMetadata) availableServices
-- @TODO fix _ error
let (_, services) = partitionEithers serviceDetailResult
pure $ ServiceAvailableRes services
@@ -424,12 +409,12 @@ 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' <- time "appmgr sucks" $ handleS9ErrNuclear $ getManifest appMgrDir appDir appExt
manifest' <- handleS9ErrNuclear $ getManifest appMgrDir appDir appExt
case eitherDecode $ manifest' of
Left e -> pure $ Left $ "Could not parse service manifest for " <> show appId <> ": " <> show e
Right m -> do
d <- liftIO
$ mapConcurrently (mapDependencyMetadata domain metadata) (HM.toList $ serviceManifestDependencies m)
d <- liftIO $ mapConcurrently (mapDependencyMetadata domain metadata)
(HM.toList $ serviceManifestDependencies m)
pure $ Right $ ServiceRes { serviceResIcon = [i|https://#{domain}/package/icon/#{appId}|]
, serviceResManifest = decode $ manifest' -- pass through raw JSON Value
, serviceResCategories = snd packageMetadata

View File

@@ -54,7 +54,6 @@ getConfig appmgrPath appPath e@(Extension appId) = fmap decodeUtf8 $ do
getManifest :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m LBS.ByteString
getManifest appmgrPath appPath e@(Extension appId) = do
(!ec, !bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "manifest", appPath <> show e] ""
print appId
case ec of
ExitSuccess -> pure bs
ExitFailure n -> throwE $ AppMgrE [i|embassy-sdk inspect manifest #{appId}|] n