Add persistent command transfer

shared-common/src/Shared/Common/Util/Error.hs

@@ -0,0 +1,6 @@
+module Shared.Common.Util.Error where
+
+import Control.Monad.Error.Class (MonadError, catchError)
+
+tryError :: MonadError e m => m a -> m (Either e a)
+tryError action = (Right <$> action) `catchError` (pure . Left)

wizard-server/src/Wizard/Service/PersistentCommand/PersistentCommandService.hs

@@ -19,6 +19,7 @@ import Shared.Common.Model.Common.Pageable
 import Shared.Common.Model.Common.Sort
 import Shared.Common.Model.Config.BuildInfoConfig
 import Shared.Common.Model.Config.ServerConfig
+import Shared.Common.Util.Error (tryError)
 import Shared.PersistentCommand.Api.Resource.PersistentCommand.PersistentCommandChangeDTO
 import Shared.PersistentCommand.Database.DAO.PersistentCommand.PersistentCommandDAO
 import Shared.PersistentCommand.Model.PersistentCommand.PersistentCommand
@@ -101,26 +102,31 @@ runPersistentCommandById uuid = do
  getPersistentCommandById uuid
 
 runPersistentCommand :: Bool -> PersistentCommandSimple U.UUID -> AppContextM ()
-runPersistentCommand force command = do
- user <-
- case command.createdBy of
- Just userUuid -> findUserByUuidSystem' userUuid
- Nothing -> return Nothing
- context <- ask
- let updatedContext =
- context
- { currentAppUuid = command.appUuid
- , currentUser = fmap UM.toDTO user
- }
- executePersistentCommandByUuid force command.uuid updatedContext
+runPersistentCommand force commandSimple = do
+ case commandSimple.destination of
+ Just destination -> do
+ runInTransaction $ do
+ tranferPersistentCommandByUuid commandSimple.uuid
+ Nothing -> do
+ user <-
+ case commandSimple.createdBy of
+ Just userUuid -> findUserByUuidSystem' userUuid
+ Nothing -> return Nothing
+ context <- ask
+ let updatedContext =
+ context
+ { currentAppUuid = commandSimple.appUuid
+ , currentUser = fmap UM.toDTO user
+ }
+ executePersistentCommandByUuid force commandSimple.uuid updatedContext
 
 executePersistentCommandByUuid :: Bool -> U.UUID -> AppContext -> AppContextM ()
 executePersistentCommandByUuid force uuid context =
  runInTransaction $ do
  logInfoU _CMP_SERVICE (f' "Running command '%s'" [U.toString uuid])
  command <- findPersistentCommandByUuid uuid
  when
- (command.attempts < command.maxAttempts || force)
+ (command.state == NewPersistentCommandState || (command.state == ErrorPersistentCommandState && command.attempts < command.maxAttempts) || force)
  ( do
  eResult <- liftIO . E.try $ runAppContextWithAppContext (execute command) context
  let (resultState, mErrorMessage) =
@@ -142,6 +148,33 @@ executePersistentCommandByUuid force uuid context =
  logInfoU _CMP_SERVICE (f' "Command finished with following state: '%s'" [show resultState])
  )
 
+tranferPersistentCommandByUuid :: U.UUID -> AppContextM ()
+tranferPersistentCommandByUuid uuid =
+ runInTransaction $ do
+ logInfoU _CMP_SERVICE (f' "Transfering command '%s'" [U.toString uuid])
+ command <- findPersistentCommandByUuid uuid
+ when
+ (command.attempts < command.maxAttempts)
+ ( do
+ eResult <- tryError (createPersistentCommand command)
+ let (resultState, mErrorMessage) =
+ case eResult of
+ Right _ -> (DonePersistentCommandState, Nothing)
+ Left exception -> (ErrorPersistentCommandState, Just . show $ exception)
+ now <- liftIO getCurrentTime
+ let updatedCommand =
+ command
+ { state = resultState
+ , lastErrorMessage = mErrorMessage
+ , attempts = command.attempts + 1
+ , updatedAt = now
+ }
+ :: PersistentCommand U.UUID
+ when (resultState == ErrorPersistentCommandState) (sendToSentry updatedCommand)
+ updatePersistentCommandByUuid updatedCommand
+ logInfoU _CMP_SERVICE (f' "Command transfered with following state: '%s'" [show resultState])
+ )
+
 runPersistentCommandChannelListener :: AppContextM ()
 runPersistentCommandChannelListener = do
  forever $ do