@@ -26,6 +26,7 @@ import Data.Text (lines, pack, unpack, unwords)
2626import Data.Text.IO (hGetContents)
2727import Data.Traversable
2828import Database.PostgreSQL.Simple
29+import Database.PostgreSQL.Simple.Instances ()
2930import Network.Wai.Handler.Warp
3031import Network.Wai.Handler.WarpTLS
3132import Options.Generic
@@ -309,7 +310,7 @@ getFullInfo listType = do
309310 dMeta <- selectDeploymentMetadata conn n
310311 pure $ do
311312 let dep = (Deployment n t appOvs depOvs)
312− DeploymentFullInfo dep (read st) a dMeta ct ut
313+ DeploymentFullInfo dep st a dMeta ct ut
313314 liftIO . logInfo l $ "get deployments: " <> (pack . show $ deployments)
314315 return deployments
315316 where
@@ -344,7 +345,7 @@ createH dep = do
344345 createDep :: PgPool -> Deployment -> IO [Only Int]
345346 createDep p Deployment { name = n, tag = t } =
346347 withResource p $ \conn ->
347− query conn q (n, t, show CreatePending)
348+ query conn q (n, t, CreatePending)
348349 failIfImageNotFound (name dep) (tag dep)
349350 failIfGracefulShutdownActivated
350351 res :: Either SqlError [Only Int] <- liftIO . try $ createDep pgPool dep
@@ -554,7 +555,7 @@ archiveDeployment p dName = withResource p $ \conn -> do
554555 \SET archived = 't', archived_at = now(), \
555556 \status = ?, status_updated_at = now() \
556557 \WHERE name = ?"
557− execute conn q (show ArchivePending, dName)
558+ execute conn q (ArchivePending, dName)
558559
559560-- | Handles the 'update' request.
560561updateH :: DeploymentName -> DeploymentUpdate -> AppM CommandResponse
@@ -743,7 +744,7 @@ updateDeployment conn dName dTag = do
743744 \SET tag = ?, updated_at = now(), \
744745 \status = ?, status_updated_at = now() \
745746 \WHERE name = ?"
746− execute conn q (dTag, show UpdatePending, dName)
747+ execute conn q (dTag, UpdatePending, dName)
747748
748749-- | Handles the 'info' request of the Web UI API.
749750infoH :: DeploymentName -> AppM [DeploymentInfo]
@@ -1069,7 +1070,6 @@ upsertDeploymentMetadata
10691070 -> [DeploymentMetadata]
10701071 -> IO ()
10711072upsertDeploymentMetadata pgPool dName dMetadatas = do
1072− let
10731073 withResource pgPool $ \conn -> withTransactionSerializable conn $ do
10741074 void $ execute
10751075 conn
@@ -1148,11 +1148,11 @@ runStatusUpdater state = do
11481148 "UPDATE deployments SET checked_at = now() WHERE name = ? and status = ?"
11491149
11501150 forever $ do
1151− rows :: [(DeploymentName, Text, Int)] <- liftIO $
1151+ rows :: [(DeploymentName, DeploymentStatus, Int)] <- liftIO $
11521152 withResource pgPool $ \conn -> query conn selectDeps (Only interval)
11531153 let
11541154 checkList :: [(DeploymentName, DeploymentStatus, Timestamp)] =
1155− (\(n, s, t) -> (n, read . unpack $ s, coerce t)) <$> rows
1155+ (\(n, s, t) -> (n, s, coerce t)) <$> rows
11561156 checkResult <- for checkList $ \(dName, dStatus, ts) -> do
11571157 let
11581158 args =
@@ -1169,8 +1169,8 @@ runStatusUpdater state = do
11691169 for (zip checkList checkResult) $ \((dName, oldSt, _), (_, newSt, _)) ->
11701170 withResource pgPool $ \conn ->
11711171 if oldSt == newSt
1172− then execute conn updateCheckedAt (dName, show oldSt)
1173− else execute conn updateStatus (show newSt, dName, show oldSt)
1172+ then execute conn updateCheckedAt (dName, oldSt)
1173+ else execute conn updateStatus (newSt, dName, oldSt)
11741174 if checkList == checkResult
11751175 then pure ()
11761176 else sendReloadEvent state
@@ -1185,14 +1185,19 @@ newStatus
11851185 -> DeploymentStatus
11861186newStatus ExitSuccess ArchivePending _ _ = Archived
11871187newStatus ExitSuccess _ _ _ = Running
1188−newStatus (ExitFailure _) Running _ _ = Failure
1189−newStatus (ExitFailure _) CreatePending ts timeout | ts > coerce timeout =
1190− Failure
1191−newStatus (ExitFailure _) UpdatePending ts timeout | ts > coerce timeout =
1192− Failure
1188+newStatus (ExitFailure n) Running _ _ = Failure $ failureStatusType n
1189+newStatus (ExitFailure n) CreatePending ts timeout | ts > coerce timeout =
1190+ Failure $ failureStatusType n
1191+newStatus (ExitFailure n) UpdatePending ts timeout | ts > coerce timeout =
1192+ Failure $ failureStatusType n
11931193newStatus (ExitFailure _) ArchivePending _ _ = ArchivePending
11941194newStatus (ExitFailure _) oldStatus _ _ = oldStatus
11951195
1196+failureStatusType :: Int -> FailureType
1197+failureStatusType 2 = PartialAvailability
1198+failureStatusType 3 = TagMismatch
1199+failureStatusType _ = GenericFailure
1200+
11961201-- | Checks if graceful shutdown has been activated activated.
11971202-- Returns 405 'Graceful shutdown activated' response
11981203-- if graceful shutdown has been activated.