typeable/octopod
1
0
Fork 0
mirror of https://github.com/typeable/octopod.git synced 2024-11-22 16:56:29 +03:00
Code Issues Projects Releases Wiki Activity

Fixed failure state when creating deployments and added sorting direction (#125)

Browse Source 
* Fixed failure statuses when creating or updating deployments

* Added sorting
This commit is contained in:
iko 2021-10-04 18:30:01 +03:00 committed by GitHub
parent a873765e4e
commit 33d507286e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 14 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
octopod-backend/src/Octopod/Server.hs
View File

@ -30,6 +30,7 @@ import qualified Data.Csv as C
import Data.Fixed
import Data.Foldable
import Data.Functor
import Data.Functor.Contravariant
import Data.Generics.Labels ()
import Data.Generics.Product
import Data.IORef
@ -471,7 +472,9 @@ getFullInfo ::
m [DeploymentFullInfo]
getFullInfo = do
AppState {logger = l} <- ask
deploymentsSchema <- runStatement . select $ each deploymentSchema
deploymentsSchema <-
runStatement . select . orderBy (view #updatedAt >$< desc) $
each deploymentSchema
deployments <- forM deploymentsSchema extractDeploymentFullInfo
liftBase . logInfo l $ "get deployments: " <> (pack . show $ deployments)
return deployments
@ -510,7 +513,7 @@ createH dep = do
, createdAt = now
, updatedAt = now
, archivedAt = litExpr Nothing
, status = litExpr Running
, status = litExpr CreatePending
, statusUpdatedAt = now
, checkedAt = now
, metadata = litExpr (DeploymentMetadata [])
@ -593,12 +596,14 @@ selectDeploymentLogs ::
(MonadBaseControl IO m, MonadReader AppState m) =>
DeploymentName ->
m [DeploymentLog]
selectDeploymentLogs dName = (fmap . fmap) extractDeploymentLog . runStatement . select $ do
dls <- each deploymentLogSchema
ds <- each deploymentSchema
where_ $ ds ^. #name ==. litExpr dName
where_ $ dls ^. #deploymentId ==. ds ^. #id_
pure dls
selectDeploymentLogs dName = (fmap . fmap) extractDeploymentLog . runStatement . select
. orderBy (view #createdAt >$< desc)
$ do
dls <- each deploymentLogSchema
ds <- each deploymentSchema
where_ $ ds ^. #name ==. litExpr dName
where_ $ dls ^. #deploymentId ==. ds ^. #id_
pure dls
data StatusTransitionProcessOutput = StatusTransitionProcessOutput
{ exitCode :: ExitCode
@ -719,6 +724,7 @@ transitionToStatus dName s = do
dep
& #status .~ litExpr newS
& #updatedAt .~ now
& #statusUpdatedAt .~ now
& if newS == Archived then #archivedAt .~ nullify now else id
, updateWhere = \() dep -> dep ^. #name ==. litExpr dName
, returning = Projection id