{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Hercules.CLI.Lock (commandParser) where
import Control.Monad.IO.Unlift (UnliftIO (UnliftIO), askUnliftIO)
import Control.Retry (retrying)
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Has (Has)
import Data.IORef (IORef)
import qualified Data.UUID
import qualified Data.UUID.V4 as UUID4
import Hercules.API (Id, NoContent)
import qualified Hercules.API.Accounts.SimpleAccount as SimpleAccount
import qualified Hercules.API.Forge.SimpleForge as SimpleForge
import Hercules.API.Id (Id (Id), idText)
import Hercules.API.Name (nameText)
import qualified Hercules.API.Projects.SimpleJob as SimpleJob
import qualified Hercules.API.Projects.SimpleProject as SimpleProject
import Hercules.API.State (ProjectStateResourceGroup (acquireLock), StateAPI (deleteLockLease, updateLockLease))
import qualified Hercules.API.State.StateLockAcquireRequest as StateLockAcquireRequest
import Hercules.API.State.StateLockAcquireResponse (StateLockAcquireResponse (Acquired, Blocked))
import qualified Hercules.API.State.StateLockAcquireResponse as StateLockAcquireResponse
import qualified Hercules.API.State.StateLockLease as StateLockLease
import qualified Hercules.API.State.StateLockUpdateRequest as StateLockUpdateRequest
import Hercules.CLI.Client (HerculesClientEnv, HerculesClientToken, determineDefaultApiBaseUrl, retryOnFail, stateClient, waitRetryPolicy)
import Hercules.CLI.Common (runAuthenticated)
import Hercules.CLI.Options (mkCommand)
import Hercules.CLI.Project (projectOption)
import Hercules.CLI.State (getProjectAndClient)
import Hercules.Frontend (mkLinks)
import qualified Hercules.Frontend
import qualified Network.URI
import Options.Applicative (help, long, metavar, strArgument, strOption, subparser)
import qualified Options.Applicative as Optparse
import Protolude
import RIO (RIO)
import Servant.Auth.Client (Token)
import Servant.Client.Internal.HttpClient.Streaming (ClientM)
import qualified System.Environment
import qualified System.Process
import qualified UnliftIO
import UnliftIO.IORef (newIORef, readIORef, writeIORef)
commandParser, acquireCommandParser, releaseCommandParser, updateCommandParser, runCommandParser :: Optparse.Parser (IO ())
commandParser :: Parser (IO ())
commandParser =
Mod CommandFields (IO ()) -> Parser (IO ())
forall a. Mod CommandFields a -> Parser a
subparser
( [Char]
-> InfoMod (IO ()) -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. [Char] -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
[Char]
"acquire"
([Char] -> InfoMod (IO ())
forall a. [Char] -> InfoMod a
Optparse.progDesc [Char]
"Acquire a lock")
Parser (IO ())
acquireCommandParser
Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> [Char]
-> InfoMod (IO ()) -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. [Char] -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
[Char]
"update"
([Char] -> InfoMod (IO ())
forall a. [Char] -> InfoMod a
Optparse.progDesc [Char]
"Refresh a lock timeout and/or description")
Parser (IO ())
updateCommandParser
Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> [Char]
-> InfoMod (IO ()) -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. [Char] -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
[Char]
"release"
([Char] -> InfoMod (IO ())
forall a. [Char] -> InfoMod a
Optparse.progDesc [Char]
"Release a lock")
Parser (IO ())
releaseCommandParser
Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> [Char]
-> InfoMod (IO ()) -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. [Char] -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
[Char]
"run"
([Char] -> InfoMod (IO ())
forall a. [Char] -> InfoMod a
Optparse.progDesc [Char]
"Run a command holding a lock")
Parser (IO ())
runCommandParser
)
acquireCommandParser :: Parser (IO ())
acquireCommandParser = do
Maybe ProjectPath
projectMaybe <- Parser ProjectPath -> Parser (Maybe ProjectPath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ProjectPath
projectOption
Text
name <- Parser Text
nameOption
Bool
json <- Parser Bool
jsonOption
Text
description <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"hci lock acquire" (Maybe Text -> Text) -> Parser (Maybe Text) -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text
descriptionOption
Bool
exclusive <- Parser Bool
exclusiveOption
Bool
wait_ <- Parser Bool
waitOption
pure do
Maybe (Id "StateLockLease")
parent <- IO (Maybe (Id "StateLockLease"))
getLeaseIdFromEnv
Id "IdempotencyKey"
idempotencyKey <- UUID -> Id "IdempotencyKey"
forall k (a :: k). UUID -> Id a
Id (UUID -> Id "IdempotencyKey")
-> IO UUID -> IO (Id "IdempotencyKey")
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID
UUID4.nextRandom
let request :: StateLockAcquireRequest
request =
StateLockAcquireRequest.StateLockAcquireRequest
{ description :: Text
description = Text
description,
exclusive :: Bool
exclusive = Bool
exclusive,
parent :: Maybe (Id "StateLockLease")
parent = Maybe (Id "StateLockLease")
parent,
idempotencyKey :: Maybe (Id "IdempotencyKey")
idempotencyKey = Id "IdempotencyKey" -> Maybe (Id "IdempotencyKey")
forall a. a -> Maybe a
Just Id "IdempotencyKey"
idempotencyKey
}
RIO (HerculesClientToken, HerculesClientEnv) () -> IO ()
forall b. RIO (HerculesClientToken, HerculesClientEnv) b -> IO b
runAuthenticated do
ProjectStateResourceGroup ClientAuth (AsClientT ClientM)
projectStateClient <- Maybe ProjectPath
-> RIO
(HerculesClientToken, HerculesClientEnv)
(ProjectStateResourceGroup ClientAuth (AsClientT ClientM))
forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
Maybe ProjectPath
-> RIO r (ProjectStateResourceGroup ClientAuth (AsClientT ClientM))
getProjectAndClient Maybe ProjectPath
projectMaybe
let acquireReq :: Token -> ClientM StateLockAcquireResponse
acquireReq = ProjectStateResourceGroup ClientAuth (AsClientT ClientM)
-> AsClientT ClientM
:- (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (ClientAuth :> Post '[JSON] StateLockAcquireResponse)))))
forall auth f.
ProjectStateResourceGroup auth f
-> f
:- (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (auth :> Post '[JSON] StateLockAcquireResponse)))))
acquireLock ProjectStateResourceGroup ClientAuth (AsClientT ClientM)
projectStateClient Text
name StateLockAcquireRequest
request
onAcquire :: StateLockAcquiredResponse -> m ()
onAcquire StateLockAcquiredResponse
s = do
Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText Text
"hci: lock acquired"
if Bool
json
then ByteString -> m ()
forall (m :: * -> *). MonadIO m => ByteString -> m ()
putLByteString (StateLockAcquiredResponse -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty StateLockAcquiredResponse
s)
else Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText (Id "StateLockLease" -> Text
forall {k} (a :: k). Id a -> Text
idText (Id "StateLockLease" -> Text) -> Id "StateLockLease" -> Text
forall a b. (a -> b) -> a -> b
$ StateLockAcquiredResponse -> Id "StateLockLease"
StateLockAcquireResponse.leaseId StateLockAcquiredResponse
s)
if Bool
wait_
then (Token -> ClientM StateLockAcquireResponse)
-> RIO
(HerculesClientToken, HerculesClientEnv) StateLockAcquiredResponse
forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
(Token -> ClientM StateLockAcquireResponse)
-> RIO r StateLockAcquiredResponse
pollAcquire Token -> ClientM StateLockAcquireResponse
acquireReq RIO
(HerculesClientToken, HerculesClientEnv) StateLockAcquiredResponse
-> (StateLockAcquiredResponse
-> RIO (HerculesClientToken, HerculesClientEnv) ())
-> RIO (HerculesClientToken, HerculesClientEnv) ()
forall a b.
RIO (HerculesClientToken, HerculesClientEnv) a
-> (a -> RIO (HerculesClientToken, HerculesClientEnv) b)
-> RIO (HerculesClientToken, HerculesClientEnv) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StateLockAcquiredResponse
-> RIO (HerculesClientToken, HerculesClientEnv) ()
forall {m :: * -> *}.
MonadIO m =>
StateLockAcquiredResponse -> m ()
onAcquire
else do
IORef (Maybe StateLockBlockedResponse)
ref <- Maybe StateLockBlockedResponse
-> RIO
(HerculesClientToken, HerculesClientEnv)
(IORef (Maybe StateLockBlockedResponse))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Maybe StateLockBlockedResponse
forall a. Maybe a
Nothing
IORef (Maybe StateLockBlockedResponse)
-> (Token -> ClientM StateLockAcquireResponse)
-> RIO
(HerculesClientToken, HerculesClientEnv) StateLockAcquireResponse
forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
IORef (Maybe StateLockBlockedResponse)
-> (Token -> ClientM StateLockAcquireResponse)
-> RIO r StateLockAcquireResponse
tryAcquire IORef (Maybe StateLockBlockedResponse)
ref Token -> ClientM StateLockAcquireResponse
acquireReq RIO
(HerculesClientToken, HerculesClientEnv) StateLockAcquireResponse
-> (StateLockAcquireResponse
-> RIO (HerculesClientToken, HerculesClientEnv) ())
-> RIO (HerculesClientToken, HerculesClientEnv) ()
forall a b.
RIO (HerculesClientToken, HerculesClientEnv) a
-> (a -> RIO (HerculesClientToken, HerculesClientEnv) b)
-> RIO (HerculesClientToken, HerculesClientEnv) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Acquired StateLockAcquiredResponse
s -> StateLockAcquiredResponse
-> RIO (HerculesClientToken, HerculesClientEnv) ()
forall {m :: * -> *}.
MonadIO m =>
StateLockAcquiredResponse -> m ()
onAcquire StateLockAcquiredResponse
s
Blocked StateLockBlockedResponse
s -> do
Bool
-> RIO (HerculesClientToken, HerculesClientEnv) ()
-> RIO (HerculesClientToken, HerculesClientEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
json do
ByteString -> RIO (HerculesClientToken, HerculesClientEnv) ()
forall (m :: * -> *). MonadIO m => ByteString -> m ()
putLByteString (StateLockBlockedResponse -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty StateLockBlockedResponse
s)
IO () -> RIO (HerculesClientToken, HerculesClientEnv) ()
forall a. IO a -> RIO (HerculesClientToken, HerculesClientEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
forall a. IO a
exitFailure
releaseCommandParser :: Parser (IO ())
releaseCommandParser = do
Id "StateLockLease"
leaseId <- Parser (Id "StateLockLease")
leaseIdOption
pure do
RIO (HerculesClientToken, HerculesClientEnv) () -> IO ()
forall b. RIO (HerculesClientToken, HerculesClientEnv) b -> IO b
runAuthenticated do
(NoContent
_ :: NoContent) <- Text
-> (Token -> ClientM NoContent)
-> RIO (HerculesClientToken, HerculesClientEnv) NoContent
forall b r.
(NFData b, Has HerculesClientToken r, Has HerculesClientEnv r) =>
Text -> (Token -> ClientM b) -> RIO r b
retryOnFail Text
"lock release" (StateAPI ClientAuth (AsClientT ClientM)
-> AsClientT ClientM
:- ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ClientAuth :> Delete '[JSON] NoContent)))
forall auth f.
StateAPI auth f
-> f
:- ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (auth :> Delete '[JSON] NoContent)))
deleteLockLease StateAPI ClientAuth (AsClientT ClientM)
stateClient Id "StateLockLease"
leaseId)
Text -> RIO (HerculesClientToken, HerculesClientEnv) ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText Text
"hci: lock released"
updateCommandParser :: Parser (IO ())
updateCommandParser = do
Id "StateLockLease"
leaseId <- Parser (Id "StateLockLease")
leaseIdOption
Maybe Text
descriptionUpdate <- Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text
descriptionOption
Bool
json <- Parser Bool
jsonOption
pure do
RIO (HerculesClientToken, HerculesClientEnv) () -> IO ()
forall b. RIO (HerculesClientToken, HerculesClientEnv) b -> IO b
runAuthenticated do
let request :: StateLockUpdateRequest
request = StateLockUpdateRequest.StateLockUpdateRequest {description :: Maybe Text
description = Maybe Text
descriptionUpdate}
StateLockAcquiredResponse
response <- Text
-> (Token -> ClientM StateLockAcquiredResponse)
-> RIO
(HerculesClientToken, HerculesClientEnv) StateLockAcquiredResponse
forall b r.
(NFData b, Has HerculesClientToken r, Has HerculesClientEnv r) =>
Text -> (Token -> ClientM b) -> RIO r b
retryOnFail Text
"lock update" (StateAPI ClientAuth (AsClientT ClientM)
-> AsClientT ClientM
:- ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (ClientAuth :> Post '[JSON] StateLockAcquiredResponse))))
forall auth f.
StateAPI auth f
-> f
:- ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (auth :> Post '[JSON] StateLockAcquiredResponse))))
updateLockLease StateAPI ClientAuth (AsClientT ClientM)
stateClient Id "StateLockLease"
leaseId StateLockUpdateRequest
request)
Bool
-> RIO (HerculesClientToken, HerculesClientEnv) ()
-> RIO (HerculesClientToken, HerculesClientEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
json do
ByteString -> RIO (HerculesClientToken, HerculesClientEnv) ()
forall (m :: * -> *). MonadIO m => ByteString -> m ()
putLByteString (StateLockAcquiredResponse -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty StateLockAcquiredResponse
response)
runCommandParser :: Parser (IO ())
runCommandParser = do
Maybe ProjectPath
projectMaybe <- Parser ProjectPath -> Parser (Maybe ProjectPath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ProjectPath
projectOption
Text
name <- Parser Text
nameOption
Maybe Text
descriptionMaybe <- Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text
descriptionOption
Bool
exclusive <- Parser Bool
exclusiveOption
[Char]
exe <- Mod ArgumentFields [Char] -> Parser [Char]
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument ([Char] -> Mod ArgumentFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"COMMAND")
[[Char]]
args <- Parser [Char] -> Parser [[Char]]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields [Char] -> Parser [Char]
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument ([Char] -> Mod ArgumentFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"ARGS"))
pure do
Maybe (Id "StateLockLease")
parent <- IO (Maybe (Id "StateLockLease"))
getLeaseIdFromEnv
Id "IdempotencyKey"
idempotencyKey <- UUID -> Id "IdempotencyKey"
forall k (a :: k). UUID -> Id a
Id (UUID -> Id "IdempotencyKey")
-> IO UUID -> IO (Id "IdempotencyKey")
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID
UUID4.nextRandom
let request :: StateLockAcquireRequest
request =
StateLockAcquireRequest.StateLockAcquireRequest
{ description :: Text
description = Text
description,
exclusive :: Bool
exclusive = Bool
exclusive,
parent :: Maybe (Id "StateLockLease")
parent = Maybe (Id "StateLockLease")
parent,
idempotencyKey :: Maybe (Id "IdempotencyKey")
idempotencyKey = Id "IdempotencyKey" -> Maybe (Id "IdempotencyKey")
forall a. a -> Maybe a
Just Id "IdempotencyKey"
idempotencyKey
}
description :: Text
description = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text
"hci lock run " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
forall a b. ConvertText a b => a -> b
toS [Char]
exe) Maybe Text
descriptionMaybe
RIO (HerculesClientToken, HerculesClientEnv) () -> IO ()
forall b. RIO (HerculesClientToken, HerculesClientEnv) b -> IO b
runAuthenticated do
ProjectStateResourceGroup ClientAuth (AsClientT ClientM)
projectStateClient <- Maybe ProjectPath
-> RIO
(HerculesClientToken, HerculesClientEnv)
(ProjectStateResourceGroup ClientAuth (AsClientT ClientM))
forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
Maybe ProjectPath
-> RIO r (ProjectStateResourceGroup ClientAuth (AsClientT ClientM))
getProjectAndClient Maybe ProjectPath
projectMaybe
StateLockAcquiredResponse
lease0 <- (Token -> ClientM StateLockAcquireResponse)
-> RIO
(HerculesClientToken, HerculesClientEnv) StateLockAcquiredResponse
forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
(Token -> ClientM StateLockAcquireResponse)
-> RIO r StateLockAcquiredResponse
pollAcquire (ProjectStateResourceGroup ClientAuth (AsClientT ClientM)
-> AsClientT ClientM
:- (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (ClientAuth :> Post '[JSON] StateLockAcquireResponse)))))
forall auth f.
ProjectStateResourceGroup auth f
-> f
:- (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (auth :> Post '[JSON] StateLockAcquireResponse)))))
acquireLock ProjectStateResourceGroup ClientAuth (AsClientT ClientM)
projectStateClient Text
name StateLockAcquireRequest
request)
Text -> RIO (HerculesClientToken, HerculesClientEnv) ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText Text
"hci: lock acquired"
let leaseId :: Id "StateLockLease"
leaseId = StateLockAcquiredResponse -> Id "StateLockLease"
StateLockAcquireResponse.leaseId StateLockAcquiredResponse
lease0
ExitCode
exitCode <-
( do
[([Char], [Char])]
env <- IO [([Char], [Char])]
-> RIO (HerculesClientToken, HerculesClientEnv) [([Char], [Char])]
forall a. IO a -> RIO (HerculesClientToken, HerculesClientEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [([Char], [Char])]
System.Environment.getEnvironment
let procSpec :: CreateProcess
procSpec = ([Char] -> [[Char]] -> CreateProcess
System.Process.proc [Char]
exe [[Char]]
args) {env :: Maybe [([Char], [Char])]
System.Process.env = [([Char], [Char])] -> Maybe [([Char], [Char])]
forall a. a -> Maybe a
Just [([Char], [Char])]
env'}
env' :: [([Char], [Char])]
env' = ([Char]
leaseIdEnvVar, Text -> [Char]
forall a b. ConvertText a b => a -> b
toS (Id "StateLockLease" -> Text
forall {k} (a :: k). Id a -> Text
idText Id "StateLockLease"
leaseId)) ([Char], [Char]) -> [([Char], [Char])] -> [([Char], [Char])]
forall a. a -> [a] -> [a]
: (([Char], [Char]) -> Bool)
-> [([Char], [Char])] -> [([Char], [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Char]
k, [Char]
_) -> [Char]
k [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
leaseIdEnvVar) [([Char], [Char])]
env
updateRequest :: StateLockUpdateRequest
updateRequest =
StateLockUpdateRequest.StateLockUpdateRequest
{
description :: Maybe Text
description = Maybe Text
forall a. Maybe a
Nothing
}
updateInterval :: Int
updateInterval = Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000
pinger :: RIO (HerculesClientToken, HerculesClientEnv) b
pinger = do
IO () -> RIO (HerculesClientToken, HerculesClientEnv) ()
forall a. IO a -> RIO (HerculesClientToken, HerculesClientEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO (HerculesClientToken, HerculesClientEnv) ())
-> IO () -> RIO (HerculesClientToken, HerculesClientEnv) ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
updateInterval
RIO (HerculesClientToken, HerculesClientEnv) ()
-> RIO (HerculesClientToken, HerculesClientEnv) b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever do
( do
(StateLockAcquiredResponse
_ :: StateLockAcquireResponse.StateLockAcquiredResponse) <-
Text
-> (Token -> ClientM StateLockAcquiredResponse)
-> RIO
(HerculesClientToken, HerculesClientEnv) StateLockAcquiredResponse
forall b r.
(NFData b, Has HerculesClientToken r, Has HerculesClientEnv r) =>
Text -> (Token -> ClientM b) -> RIO r b
retryOnFail Text
"lock pinger" do
StateAPI ClientAuth (AsClientT ClientM)
-> AsClientT ClientM
:- ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (ClientAuth :> Post '[JSON] StateLockAcquiredResponse))))
forall auth f.
StateAPI auth f
-> f
:- ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (auth :> Post '[JSON] StateLockAcquiredResponse))))
updateLockLease StateAPI ClientAuth (AsClientT ClientM)
stateClient Id "StateLockLease"
leaseId StateLockUpdateRequest
updateRequest
IO () -> RIO (HerculesClientToken, HerculesClientEnv) ()
forall a. IO a -> RIO (HerculesClientToken, HerculesClientEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO (HerculesClientToken, HerculesClientEnv) ())
-> IO () -> RIO (HerculesClientToken, HerculesClientEnv) ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
updateInterval
)
UnliftIO forall b. RIO (HerculesClientToken, HerculesClientEnv) b -> IO b
unlift <- RIO
(HerculesClientToken, HerculesClientEnv)
(UnliftIO (RIO (HerculesClientToken, HerculesClientEnv)))
forall (m :: * -> *). MonadUnliftIO m => m (UnliftIO m)
askUnliftIO
IO ExitCode
-> RIO (HerculesClientToken, HerculesClientEnv) ExitCode
forall a. IO a -> RIO (HerculesClientToken, HerculesClientEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
IO Any -> (Async Any -> IO ExitCode) -> IO ExitCode
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync
(RIO (HerculesClientToken, HerculesClientEnv) Any -> IO Any
forall b. RIO (HerculesClientToken, HerculesClientEnv) b -> IO b
unlift RIO (HerculesClientToken, HerculesClientEnv) Any
pinger)
( \Async Any
_ -> do
(Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
processHandle) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
System.Process.createProcess CreateProcess
procSpec
ProcessHandle -> IO ExitCode
System.Process.waitForProcess ProcessHandle
processHandle
)
)
RIO (HerculesClientToken, HerculesClientEnv) ExitCode
-> RIO (HerculesClientToken, HerculesClientEnv) ()
-> RIO (HerculesClientToken, HerculesClientEnv) ExitCode
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
`UnliftIO.finally` do
(NoContent
_ :: NoContent) <- Text
-> (Token -> ClientM NoContent)
-> RIO (HerculesClientToken, HerculesClientEnv) NoContent
forall b r.
(NFData b, Has HerculesClientToken r, Has HerculesClientEnv r) =>
Text -> (Token -> ClientM b) -> RIO r b
retryOnFail Text
"lock release" (StateAPI ClientAuth (AsClientT ClientM)
-> AsClientT ClientM
:- ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ClientAuth :> Delete '[JSON] NoContent)))
forall auth f.
StateAPI auth f
-> f
:- ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (auth :> Delete '[JSON] NoContent)))
deleteLockLease StateAPI ClientAuth (AsClientT ClientM)
stateClient Id "StateLockLease"
leaseId)
Text -> RIO (HerculesClientToken, HerculesClientEnv) ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText Text
"hci: lock released"
IO () -> RIO (HerculesClientToken, HerculesClientEnv) ()
forall a. IO a -> RIO (HerculesClientToken, HerculesClientEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO (HerculesClientToken, HerculesClientEnv) ())
-> IO () -> RIO (HerculesClientToken, HerculesClientEnv) ()
forall a b. (a -> b) -> a -> b
$ ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
exitCode
tryAcquire ::
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
IORef (Maybe StateLockAcquireResponse.StateLockBlockedResponse) ->
(Token -> ClientM StateLockAcquireResponse) ->
RIO r StateLockAcquireResponse
tryAcquire :: forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
IORef (Maybe StateLockBlockedResponse)
-> (Token -> ClientM StateLockAcquireResponse)
-> RIO r StateLockAcquireResponse
tryAcquire IORef (Maybe StateLockBlockedResponse)
ref Token -> ClientM StateLockAcquireResponse
acquireLockRequest = do
StateLockAcquireResponse
r <- Text
-> (Token -> ClientM StateLockAcquireResponse)
-> RIO r StateLockAcquireResponse
forall b r.
(NFData b, Has HerculesClientToken r, Has HerculesClientEnv r) =>
Text -> (Token -> ClientM b) -> RIO r b
retryOnFail Text
"lock acquire" Token -> ClientM StateLockAcquireResponse
acquireLockRequest
case StateLockAcquireResponse
r of
Blocked StateLockBlockedResponse
s -> IORef (Maybe StateLockBlockedResponse)
-> StateLockBlockedResponse -> RIO r ()
forall (m :: * -> *).
MonadIO m =>
IORef (Maybe StateLockBlockedResponse)
-> StateLockBlockedResponse -> m ()
logBlockedMaybe IORef (Maybe StateLockBlockedResponse)
ref StateLockBlockedResponse
s
Acquired {} -> RIO r ()
forall (f :: * -> *). Applicative f => f ()
pass
pure StateLockAcquireResponse
r
pollAcquire ::
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
(Token -> ClientM StateLockAcquireResponse) ->
RIO r StateLockAcquireResponse.StateLockAcquiredResponse
pollAcquire :: forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
(Token -> ClientM StateLockAcquireResponse)
-> RIO r StateLockAcquiredResponse
pollAcquire Token -> ClientM StateLockAcquireResponse
acquireLockRequest = do
IORef (Maybe StateLockBlockedResponse)
ref <- Maybe StateLockBlockedResponse
-> RIO r (IORef (Maybe StateLockBlockedResponse))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Maybe StateLockBlockedResponse
forall a. Maybe a
Nothing
StateLockAcquireResponse
finalResp <-
RetryPolicyM (RIO r)
-> (RetryStatus -> StateLockAcquireResponse -> RIO r Bool)
-> (RetryStatus -> RIO r StateLockAcquireResponse)
-> RIO r StateLockAcquireResponse
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
retrying
RetryPolicyM (RIO r)
forall (m :: * -> *). MonadIO m => RetryPolicyM m
waitRetryPolicy
( \RetryStatus
_rs StateLockAcquireResponse
s -> case StateLockAcquireResponse
s of
Blocked {} -> do
Text -> RIO r ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText Text
"hci: waiting for lock..."
pure Bool
True
Acquired {} -> Bool -> RIO r Bool
forall a. a -> RIO r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
)
(RIO r StateLockAcquireResponse
-> RetryStatus -> RIO r StateLockAcquireResponse
forall a b. a -> b -> a
const (RIO r StateLockAcquireResponse
-> RetryStatus -> RIO r StateLockAcquireResponse)
-> RIO r StateLockAcquireResponse
-> RetryStatus
-> RIO r StateLockAcquireResponse
forall a b. (a -> b) -> a -> b
$ IORef (Maybe StateLockBlockedResponse)
-> (Token -> ClientM StateLockAcquireResponse)
-> RIO r StateLockAcquireResponse
forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
IORef (Maybe StateLockBlockedResponse)
-> (Token -> ClientM StateLockAcquireResponse)
-> RIO r StateLockAcquireResponse
tryAcquire IORef (Maybe StateLockBlockedResponse)
ref Token -> ClientM StateLockAcquireResponse
acquireLockRequest)
case StateLockAcquireResponse
finalResp of
Blocked {} -> Text -> RIO r StateLockAcquiredResponse
forall a. HasCallStack => Text -> a
panic Text
"Retrying timed out"
Acquired StateLockAcquiredResponse
s -> StateLockAcquiredResponse -> RIO r StateLockAcquiredResponse
forall a. a -> RIO r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateLockAcquiredResponse
s
logBlockedMaybe ::
(MonadIO m) =>
IORef (Maybe StateLockAcquireResponse.StateLockBlockedResponse) ->
StateLockAcquireResponse.StateLockBlockedResponse ->
m ()
logBlockedMaybe :: forall (m :: * -> *).
MonadIO m =>
IORef (Maybe StateLockBlockedResponse)
-> StateLockBlockedResponse -> m ()
logBlockedMaybe IORef (Maybe StateLockBlockedResponse)
ref StateLockBlockedResponse
resp = do
Maybe StateLockBlockedResponse
old <- IORef (Maybe StateLockBlockedResponse)
-> m (Maybe StateLockBlockedResponse)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (Maybe StateLockBlockedResponse)
ref
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe StateLockBlockedResponse
old Maybe StateLockBlockedResponse
-> Maybe StateLockBlockedResponse -> Bool
forall a. Eq a => a -> a -> Bool
/= StateLockBlockedResponse -> Maybe StateLockBlockedResponse
forall a. a -> Maybe a
Just StateLockBlockedResponse
resp) do
IORef (Maybe StateLockBlockedResponse)
-> Maybe StateLockBlockedResponse -> m ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef (Maybe StateLockBlockedResponse)
ref (StateLockBlockedResponse -> Maybe StateLockBlockedResponse
forall a. a -> Maybe a
Just StateLockBlockedResponse
resp)
StateLockBlockedResponse -> m ()
forall (m :: * -> *). MonadIO m => StateLockBlockedResponse -> m ()
logBlocked StateLockBlockedResponse
resp
logBlocked :: (MonadIO m) => StateLockAcquireResponse.StateLockBlockedResponse -> m ()
logBlocked :: forall (m :: * -> *). MonadIO m => StateLockBlockedResponse -> m ()
logBlocked StateLockBlockedResponse
s = do
Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText Text
"hci: lock blocked"
[StateLockLease] -> (StateLockLease -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (StateLockBlockedResponse -> [StateLockLease]
StateLockAcquireResponse.blockedByLeases StateLockBlockedResponse
s) \StateLockLease
lease -> do
Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText Text
"blocked by lease:"
Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
" description: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StateLockLease -> Text
StateLockLease.description StateLockLease
lease
Maybe SimpleAccount -> (SimpleAccount -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (StateLockLease -> Maybe SimpleAccount
StateLockLease.user StateLockLease
lease) \SimpleAccount
user ->
Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
" user: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SimpleAccount -> Text
SimpleAccount.displayName SimpleAccount
user Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name Account -> Text
forall k (a :: k). Name a -> Text
nameText (SimpleAccount -> Name Account
SimpleAccount.name SimpleAccount
user) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
Maybe SimpleJob -> (SimpleJob -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (StateLockLease -> Maybe SimpleJob
StateLockLease.job StateLockLease
lease) \SimpleJob
job -> do
URI
baseUri <- IO URI -> m URI
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO URI
getLinksBase
let links :: FrontendRoutes Raw (AsLink Text)
links = URI -> FrontendRoutes Raw (AsLink Text)
mkLinks URI
baseUri
project :: SimpleProject
project = SimpleJob -> SimpleProject
SimpleJob.project SimpleJob
job
jobUrl :: Text
jobUrl =
FrontendRoutes Raw (AsLink Text)
-> AsLink Text
:- (Capture' '[Required, Strict] "site" (Name Forge)
:> (Capture' '[Required, Strict] "account" (Name Account)
:> (Capture' '[Required, Strict] "project" (Name Project)
:> ("jobs"
:> (Capture' '[Required, Strict] "jobIndex" Int :> Raw)))))
forall view f.
FrontendRoutes view f
-> f
:- (Capture' '[Required, Strict] "site" (Name Forge)
:> (Capture' '[Required, Strict] "account" (Name Account)
:> (Capture' '[Required, Strict] "project" (Name Project)
:> ("jobs"
:> (Capture' '[Required, Strict] "jobIndex" Int :> view)))))
Hercules.Frontend.job
FrontendRoutes Raw (AsLink Text)
links
(SimpleForge -> Name Forge
SimpleForge.name (SimpleForge -> Name Forge) -> SimpleForge -> Name Forge
forall a b. (a -> b) -> a -> b
$ SimpleAccount -> SimpleForge
SimpleAccount.site (SimpleAccount -> SimpleForge) -> SimpleAccount -> SimpleForge
forall a b. (a -> b) -> a -> b
$ SimpleProject -> SimpleAccount
SimpleProject.owner SimpleProject
project)
(SimpleAccount -> Name Account
SimpleAccount.name (SimpleAccount -> Name Account) -> SimpleAccount -> Name Account
forall a b. (a -> b) -> a -> b
$ SimpleProject -> SimpleAccount
SimpleProject.owner SimpleProject
project)
(SimpleProject -> Name Project
SimpleProject.name SimpleProject
project)
(Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SimpleJob -> Int64
SimpleJob.index SimpleJob
job))
Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
" job: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
jobUrl
getLinksBase :: IO Network.URI.URI
getLinksBase :: IO URI
getLinksBase = do
Text
url <- IO Text
determineDefaultApiBaseUrl
case [Char] -> Maybe URI
Network.URI.parseAbsoluteURI (Text -> [Char]
forall a b. ConvertText a b => a -> b
toS Text
url) of
Just URI
x -> URI -> IO URI
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure URI
x
Maybe URI
Nothing -> Text -> IO URI
forall a. HasCallStack => Text -> a
panic Text
"Could not parse API base url"
leaseIdEnvVar :: [Char]
leaseIdEnvVar :: [Char]
leaseIdEnvVar = [Char]
"HERCULES_CI_LOCK_LEASE_ID"
getLeaseIdFromEnv :: IO (Maybe (Id "StateLockLease"))
getLeaseIdFromEnv :: IO (Maybe (Id "StateLockLease"))
getLeaseIdFromEnv = do
Maybe [Char]
strMaybe <- [Char] -> IO (Maybe [Char])
System.Environment.lookupEnv [Char]
leaseIdEnvVar
Maybe [Char]
-> ([Char] -> IO (Id "StateLockLease"))
-> IO (Maybe (Id "StateLockLease"))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe [Char]
strMaybe \[Char]
str -> case [Char] -> Maybe UUID
Data.UUID.fromString [Char]
str of
Just UUID
x -> Id "StateLockLease" -> IO (Id "StateLockLease")
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UUID -> Id "StateLockLease"
forall k (a :: k). UUID -> Id a
Id UUID
x)
Maybe UUID
Nothing -> do
[Char] -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
forall (m :: * -> *). MonadIO m => [Char] -> m ()
putErrLn ([Char]
leaseIdEnvVar [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" is not a valid UUID")
IO (Id "StateLockLease")
forall a. IO a
exitFailure
nameOption :: Optparse.Parser Text
nameOption :: Parser Text
nameOption = Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields Text -> Parser Text)
-> Mod OptionFields Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"name" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NAME" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Text
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Name of the lock"
jsonOption :: Optparse.Parser Bool
jsonOption :: Parser Bool
jsonOption = Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
Optparse.flag Bool
False Bool
True ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"json" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Write JSON results on stdout")
descriptionOption :: Optparse.Parser Text
descriptionOption :: Parser Text
descriptionOption = Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields Text -> Parser Text)
-> Mod OptionFields Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"description" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"TEXT" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Text
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Describe the lock activity, for better messages"
exclusiveOption :: Optparse.Parser Bool
exclusiveOption :: Parser Bool
exclusiveOption = Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
Optparse.flag Bool
True Bool
False ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"non-exclusive" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Acquire a non-exclusive lock aka read lock")
waitOption :: Optparse.Parser Bool
waitOption :: Parser Bool
waitOption = Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
Optparse.flag Bool
True Bool
False ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"no-wait" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Fail immediately when the lock is already taken")
leaseIdOption :: Optparse.Parser (Id "StateLockLease")
leaseIdOption :: Parser (Id "StateLockLease")
leaseIdOption = (UUID -> Id "StateLockLease")
-> Parser UUID -> Parser (Id "StateLockLease")
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UUID -> Id "StateLockLease"
forall k (a :: k). UUID -> Id a
Id (Parser UUID -> Parser (Id "StateLockLease"))
-> Parser UUID -> Parser (Id "StateLockLease")
forall a b. (a -> b) -> a -> b
$ ReadM UUID -> Mod OptionFields UUID -> Parser UUID
forall a. ReadM a -> Mod OptionFields a -> Parser a
Optparse.option ReadM UUID
forall a. Read a => ReadM a
Optparse.auto (Mod OptionFields UUID -> Parser UUID)
-> Mod OptionFields UUID -> Parser UUID
forall a b. (a -> b) -> a -> b
$ [Char] -> Mod OptionFields UUID
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"lease-id" Mod OptionFields UUID
-> Mod OptionFields UUID -> Mod OptionFields UUID
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields UUID
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"UUID" Mod OptionFields UUID
-> Mod OptionFields UUID -> Mod OptionFields UUID
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields UUID
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Lease UUID"