diff --git a/hs-mesos.cabal b/hs-mesos.cabal --- a/hs-mesos.cabal +++ b/hs-mesos.cabal @@ -1,5 +1,5 @@ name: hs-mesos -version: 0.20.1.0 +version: 0.20.2.0 description: Bindings to the Apache Mesos platform. . @@ -118,7 +118,7 @@ executable test-executor main-is: TestExecutor.hs hs-source-dirs: test - build-depends: base, hs-mesos, bytestring + build-depends: base, hs-mesos, bytestring, lens default-language: Haskell2010 extra-libraries: mesos stdc++ diff --git a/src/System/Mesos/Internal.hs b/src/System/Mesos/Internal.hs --- a/src/System/Mesos/Internal.hs +++ b/src/System/Mesos/Internal.hs @@ -176,7 +176,7 @@ makePrefixFields p = makeLensesWith tweakedRules where - tweakedRules = defaultFieldRules & lensField .~ (\ns n -> baseF (map downcasePrefix ns) (downcasePrefix n)) + tweakedRules = defaultFieldRules & lensField .~ (\tn ns n -> baseF tn (map downcasePrefix ns) (downcasePrefix n)) baseF = defaultFieldRules ^. lensField downcasePrefix n@(Name (OccName s) f) = case L.stripPrefix p s of Nothing -> n diff --git a/src/System/Mesos/Lens.hs b/src/System/Mesos/Lens.hs --- a/src/System/Mesos/Lens.hs +++ b/src/System/Mesos/Lens.hs @@ -7,7 +7,6 @@ module System.Mesos.Lens where import Control.Lens.TH -import System.Mesos.Internal (makePrefixFields) import System.Mesos.Types makePrisms ''TaskState @@ -21,27 +20,27 @@ makeFields ''FrameworkInfo makeFields ''HealthCheckStrategy makePrisms ''HealthCheckStrategy -makePrefixFields "healthCheck" ''HealthCheck -makePrefixFields "command" ''CommandInfo -makePrefixFields "commandURI" ''CommandURI +makeFields ''HealthCheck +makeFields ''CommandInfo +makeFields ''CommandURI makePrisms ''CommandValue -makePrefixFields "executorInfo" ''ExecutorInfo -makePrefixFields "masterInfo" ''MasterInfo -makePrefixFields "slaveInfo" ''SlaveInfo -makeLenses ''Filters +makeFields ''ExecutorInfo +makeFields ''MasterInfo +makeFields ''SlaveInfo +makeFields ''Filters makePrisms ''Value makeFields ''Resource -makePrefixFields "resource" ''ResourceStatistics +makeFields ''ResourceStatistics makeFields ''ResourceUsage -makePrefixFields "performanceStatistics" ''PerformanceStatistics +makeFields ''PerformanceStatistics makeFields ''Request makeFields ''Offer makePrisms ''TaskExecutionInfo makeFields ''TaskInfo -makePrefixFields "taskStatus" ''TaskStatus +makeFields ''TaskStatus makeFields ''Credential makePrisms ''Mode makeFields ''Volume makeFields ''ContainerType makePrisms ''ContainerType -makePrefixFields "containerInfo" ''ContainerInfo +makeFields ''ContainerInfo diff --git a/src/System/Mesos/Raw/CommandInfo.hs b/src/System/Mesos/Raw/CommandInfo.hs --- a/src/System/Mesos/Raw/CommandInfo.hs +++ b/src/System/Mesos/Raw/CommandInfo.hs @@ -40,11 +40,11 @@ instance CPPValue CommandInfo where marshal i = do - envP <- maybe (return nullPtr) (cppValue . toEnvironment) $ commandEnvironment i - uriPs <- mapM cppValue $ commandInfoURIs i + envP <- maybe (return nullPtr) (cppValue . toEnvironment) $ commandInfoEnvironment i + uriPs <- mapM cppValue $ commandInfoUris i (upp, upl) <- arrayLen uriPs - (up, ul) <- maybeCString $ commandUser i - case commandValue i of + (up, ul) <- maybeCString $ commandInfoUser i + case commandInfoValue i of (ShellCommand cmd) -> do (vp, vl) <- cstring cmd liftIO $ c_toCommandInfo upp (fromIntegral upl) envP (toCBool True) vp (fromIntegral vl) nullPtr 0 up (fromIntegral ul) diff --git a/src/System/Mesos/Raw/ContainerId.hs b/src/System/Mesos/Raw/ContainerId.hs --- a/src/System/Mesos/Raw/ContainerId.hs +++ b/src/System/Mesos/Raw/ContainerId.hs @@ -12,7 +12,7 @@ instance CPPValue ContainerID where marshal x = do - (strp, l) <- cstring $ fromContainerID x + (strp, l) <- cstring $ containerIDId' x liftIO $ c_toContainerID strp $ fromIntegral l unmarshal p = fmap ContainerID $ do diff --git a/src/System/Mesos/Raw/ExecutorId.hs b/src/System/Mesos/Raw/ExecutorId.hs --- a/src/System/Mesos/Raw/ExecutorId.hs +++ b/src/System/Mesos/Raw/ExecutorId.hs @@ -11,7 +11,7 @@ instance CPPValue ExecutorID where marshal x = do - (strp, l) <- cstring $ fromExecutorID x + (strp, l) <- cstring $ executorIDId' x liftIO $ c_toExecutorID strp $ fromIntegral l unmarshal p = fmap ExecutorID $ do diff --git a/src/System/Mesos/Raw/ExecutorInfo.hs b/src/System/Mesos/Raw/ExecutorInfo.hs --- a/src/System/Mesos/Raw/ExecutorInfo.hs +++ b/src/System/Mesos/Raw/ExecutorInfo.hs @@ -46,16 +46,16 @@ instance CPPValue ExecutorInfo where marshal i = do - eidP <- cppValue $ executorInfoExecutorID i - fidP <- cppValue $ executorInfoFrameworkID i + eidP <- cppValue $ executorInfoExecutorId i + fidP <- cppValue $ executorInfoFrameworkId i ciP <- cppValue $ executorInfoCommandInfo i ctrP <- case executorInfoContainerInfo i of Nothing -> return nullPtr Just ctr -> cppValue ctr rps <- mapM cppValue $ executorInfoResources i - (np, nl) <- maybeCString $ executorName i - (sp, sl) <- maybeCString $ executorSource i - (dp, dl) <- maybeCString $ executorData i + (np, nl) <- maybeCString $ executorInfoName i + (sp, sl) <- maybeCString $ executorInfoSource i + (dp, dl) <- maybeCString $ executorInfoData i (rs, rLen) <- arrayLen rps liftIO $ c_toExecutorInfo eidP fidP ciP ctrP rs (fromIntegral rLen) np (fromIntegral nl) sp (fromIntegral sl) dp (fromIntegral dl) diff --git a/src/System/Mesos/Raw/Filters.hs b/src/System/Mesos/Raw/Filters.hs --- a/src/System/Mesos/Raw/Filters.hs +++ b/src/System/Mesos/Raw/Filters.hs @@ -18,7 +18,7 @@ -> IO () instance CPPValue Filters where - marshal f = case refuseSeconds f of + marshal f = case filtersRefuseSeconds f of Nothing -> liftIO $ c_toFilters nullPtr Just s -> do sp <- alloc diff --git a/src/System/Mesos/Raw/FrameworkId.hs b/src/System/Mesos/Raw/FrameworkId.hs --- a/src/System/Mesos/Raw/FrameworkId.hs +++ b/src/System/Mesos/Raw/FrameworkId.hs @@ -1,4 +1,6 @@ module System.Mesos.Raw.FrameworkId where +import Control.Lens +import System.Mesos.Lens import System.Mesos.Internal type FrameworkIDPtr = Ptr FrameworkID @@ -11,7 +13,7 @@ instance CPPValue FrameworkID where marshal x = do - (strp, l) <- cstring $ fromFrameworkID x + (strp, l) <- cstring (x^.id') liftIO $ c_toFrameworkID strp (fromIntegral l) unmarshal p = fmap FrameworkID $ do diff --git a/src/System/Mesos/Raw/FrameworkInfo.hs b/src/System/Mesos/Raw/FrameworkInfo.hs --- a/src/System/Mesos/Raw/FrameworkInfo.hs +++ b/src/System/Mesos/Raw/FrameworkInfo.hs @@ -46,14 +46,14 @@ instance CPPValue FrameworkInfo where marshal fi = do - (up, ul) <- cstring $ frameworkUser fi - (np, nl) <- cstring $ frameworkName fi - (rp, rl) <- maybeCString $ frameworkRole fi - (hp, hl) <- maybeCString $ frameworkHostname fi - (pp, pl) <- maybeCString $ frameworkPrincipal fi - fp' <- allocMaybe $ fmap CDouble $ frameworkFailoverTimeout fi - cp' <- allocMaybe $ fmap toCBool $ frameworkCheckpoint fi - let fidFun f = case frameworkID fi of + (up, ul) <- cstring $ frameworkInfoUser fi + (np, nl) <- cstring $ frameworkInfoName fi + (rp, rl) <- maybeCString $ frameworkInfoRole fi + (hp, hl) <- maybeCString $ frameworkInfoHostname fi + (pp, pl) <- maybeCString $ frameworkInfoPrincipal fi + fp' <- allocMaybe $ fmap CDouble $ frameworkInfoFailoverTimeout fi + cp' <- allocMaybe $ fmap toCBool $ frameworkInfoCheckpoint fi + let fidFun f = case frameworkInfoId' fi of Nothing -> f nullPtr Just r -> do p <- alloc diff --git a/src/System/Mesos/Raw/MasterInfo.hs b/src/System/Mesos/Raw/MasterInfo.hs --- a/src/System/Mesos/Raw/MasterInfo.hs +++ b/src/System/Mesos/Raw/MasterInfo.hs @@ -32,11 +32,11 @@ instance CPPValue MasterInfo where marshal i = do - (idp, idl) <- cstring $ masterInfoID i - (pidp, pidl) <- maybeCString $ masterInfoPID i + (idp, idl) <- cstring $ masterInfoId' i + (pidp, pidl) <- maybeCString $ masterInfoPid i (hnp, hnl) <- maybeCString $ masterInfoHostname i prt <- allocMaybe $ fmap CUInt $ masterInfoPort i - liftIO $ c_toMasterInfo idp (fromIntegral idl) (CUInt $ masterInfoIP i) prt pidp (fromIntegral pidl) hnp (fromIntegral hnl) + liftIO $ c_toMasterInfo idp (fromIntegral idl) (CUInt $ masterInfoIp i) prt pidp (fromIntegral pidl) hnp (fromIntegral hnl) unmarshal i = do (idpP, idlP) <- arrayPair diff --git a/src/System/Mesos/Raw/OfferId.hs b/src/System/Mesos/Raw/OfferId.hs --- a/src/System/Mesos/Raw/OfferId.hs +++ b/src/System/Mesos/Raw/OfferId.hs @@ -12,7 +12,7 @@ instance CPPValue OfferID where marshal x = do - (strp, l) <- cstring $ fromOfferID x + (strp, l) <- cstring $ offerIDId' x liftIO $ c_toOfferID strp $ fromIntegral l unmarshal p = fmap OfferID $ do diff --git a/src/System/Mesos/Raw/Request.hs b/src/System/Mesos/Raw/Request.hs --- a/src/System/Mesos/Raw/Request.hs +++ b/src/System/Mesos/Raw/Request.hs @@ -24,8 +24,8 @@ instance CPPValue Request where marshal r = do - sp <- maybe (return nullPtr) cppValue $ requestSlaveID r - rps <- mapM cppValue $ reqResources r + sp <- maybe (return nullPtr) cppValue $ requestSlaveId r + rps <- mapM cppValue $ requestResources r (rpp, rl) <- arrayLen rps liftIO $ c_toRequest sp rpp (fromIntegral rl) diff --git a/src/System/Mesos/Raw/ResourceStatistics.hs b/src/System/Mesos/Raw/ResourceStatistics.hs --- a/src/System/Mesos/Raw/ResourceStatistics.hs +++ b/src/System/Mesos/Raw/ResourceStatistics.hs @@ -88,33 +88,33 @@ memFB <- alloc memAB <- alloc memMB <- alloc - cpuUTS' <- maybe (return nullPtr) (\x -> poke cpuUTS (CDouble x) >> return cpuUTS) $ resourceStatisticsCPUsUserTimeSecs s - cpuSTS' <- maybe (return nullPtr) (\x -> poke cpuSTS (CDouble x) >> return cpuSTS) $ resourceStatisticsCPUsSystemTimeSecs s - cpuPs' <- maybe (return nullPtr) (\x -> poke cpuPs (CUInt x) >> return cpuPs) $ resourceCPUsPeriods s - cpuT' <- maybe (return nullPtr) (\x -> poke cpuT (CUInt x) >> return cpuT) $ resourceCPUsThrottled s - cpuTTS' <- maybe (return nullPtr) (\x -> poke cpuTTS (CDouble x) >> return cpuTTS) $ resourceCPUsThrottledTimeSecs s - memRSS' <- maybe (return nullPtr) (\x -> poke memRSS (CULong x) >> return memRSS) $ resourceMemoryResidentSetSize s - memLB' <- maybe (return nullPtr) (\x -> poke memLB (CULong x) >> return memLB) $ resourceMemoryLimitBytes s - memFB' <- maybe (return nullPtr) (\x -> poke memFB (CULong x) >> return memFB) $ resourceMemoryFileBytes s - memAB' <- maybe (return nullPtr) (\x -> poke memAB (CULong x) >> return memAB) $ resourceMemoryAnonymousBytes s - memMB' <- maybe (return nullPtr) (\x -> poke memMB (CULong x) >> return memMB) $ resourceMemoryMappedFileBytes s - perf <- case resourcePerformanceStatistics s of + cpuUTS' <- maybe (return nullPtr) (\x -> poke cpuUTS (CDouble x) >> return cpuUTS) $ resourceStatisticsCpusUserTimeSecs s + cpuSTS' <- maybe (return nullPtr) (\x -> poke cpuSTS (CDouble x) >> return cpuSTS) $ resourceStatisticsCpusSystemTimeSecs s + cpuPs' <- maybe (return nullPtr) (\x -> poke cpuPs (CUInt x) >> return cpuPs) $ resourceStatisticsCpusPeriods s + cpuT' <- maybe (return nullPtr) (\x -> poke cpuT (CUInt x) >> return cpuT) $ resourceStatisticsCpusThrottled s + cpuTTS' <- maybe (return nullPtr) (\x -> poke cpuTTS (CDouble x) >> return cpuTTS) $ resourceStatisticsCpusThrottledTimeSecs s + memRSS' <- maybe (return nullPtr) (\x -> poke memRSS (CULong x) >> return memRSS) $ resourceStatisticsMemoryResidentSetSize s + memLB' <- maybe (return nullPtr) (\x -> poke memLB (CULong x) >> return memLB) $ resourceStatisticsMemoryLimitBytes s + memFB' <- maybe (return nullPtr) (\x -> poke memFB (CULong x) >> return memFB) $ resourceStatisticsMemoryFileBytes s + memAB' <- maybe (return nullPtr) (\x -> poke memAB (CULong x) >> return memAB) $ resourceStatisticsMemoryAnonymousBytes s + memMB' <- maybe (return nullPtr) (\x -> poke memMB (CULong x) >> return memMB) $ resourceStatisticsMemoryMappedFileBytes s + perf <- case resourceStatisticsPerformanceStatistics s of Nothing -> return nullPtr Just p -> cppValue p let allocMStat = allocMaybe . fmap CULong - netRXP <- allocMStat $ resourceNetRxPackets s - netRXB <- allocMStat $ resourceNetRxBytes s - netRXE <- allocMStat $ resourceNetRxErrors s - netRXD <- allocMStat $ resourceNetRxDropped s - netTXP <- allocMStat $ resourceNetTxPackets s - netTXB <- allocMStat $ resourceNetTxBytes s - netTXE <- allocMStat $ resourceNetTxErrors s - netTXD <- allocMStat $ resourceNetTxDropped s + netRXP <- allocMStat $ resourceStatisticsNetRxPackets s + netRXB <- allocMStat $ resourceStatisticsNetRxBytes s + netRXE <- allocMStat $ resourceStatisticsNetRxErrors s + netRXD <- allocMStat $ resourceStatisticsNetRxDropped s + netTXP <- allocMStat $ resourceStatisticsNetTxPackets s + netTXB <- allocMStat $ resourceStatisticsNetTxBytes s + netTXE <- allocMStat $ resourceStatisticsNetTxErrors s + netTXD <- allocMStat $ resourceStatisticsNetTxDropped s liftIO $ c_toResourceStatistics (CDouble $ resourceStatisticsTimestamp s) cpuUTS' cpuSTS' - (CDouble $ resourceCPUsLimit s) + (CDouble $ resourceStatisticsCpusLimit s) cpuPs' cpuT' cpuTTS' diff --git a/src/System/Mesos/Raw/SlaveId.hs b/src/System/Mesos/Raw/SlaveId.hs --- a/src/System/Mesos/Raw/SlaveId.hs +++ b/src/System/Mesos/Raw/SlaveId.hs @@ -11,7 +11,7 @@ instance CPPValue SlaveID where marshal x = do - (strp, l) <- cstring $ fromSlaveID x + (strp, l) <- cstring $ slaveIDId' x liftIO $ c_toSlaveID strp $ fromIntegral l unmarshal p = fmap SlaveID $ do diff --git a/src/System/Mesos/Raw/SlaveInfo.hs b/src/System/Mesos/Raw/SlaveInfo.hs --- a/src/System/Mesos/Raw/SlaveInfo.hs +++ b/src/System/Mesos/Raw/SlaveInfo.hs @@ -44,7 +44,7 @@ cp <- allocMaybe (toCBool <$> slaveInfoCheckpoint i) (rp, rl) <- arrayLen =<< mapM cppValue (slaveInfoResources i) (ap, al) <- arrayLen =<< mapM (cppValue . toAttribute) (slaveInfoAttributes i) - sidp <- maybe (return nullPtr) cppValue $ slaveInfoSlaveID i + sidp <- maybe (return nullPtr) cppValue $ slaveInfoSlaveId i liftIO $ c_toSlaveInfo hp (fromIntegral hl) pp rp (fromIntegral rl) ap (fromIntegral al) sidp cp unmarshal i = do diff --git a/src/System/Mesos/Raw/TaskId.hs b/src/System/Mesos/Raw/TaskId.hs --- a/src/System/Mesos/Raw/TaskId.hs +++ b/src/System/Mesos/Raw/TaskId.hs @@ -11,7 +11,7 @@ instance CPPValue TaskID where marshal x = do - (strp, l) <- cstring $ fromTaskID x + (strp, l) <- cstring $ taskIDId' x liftIO $ c_toTaskID strp $ fromIntegral l unmarshal p = fmap TaskID $ do diff --git a/src/System/Mesos/Raw/TaskInfo.hs b/src/System/Mesos/Raw/TaskInfo.hs --- a/src/System/Mesos/Raw/TaskInfo.hs +++ b/src/System/Mesos/Raw/TaskInfo.hs @@ -48,20 +48,20 @@ instance CPPValue TaskInfo where marshal t = do - (np, nl) <- cstring $ taskName t - rps <- mapM cppValue (taskResources t) - tid <- cppValue $ taskID t - sid <- cppValue $ taskSlaveID t - eip <- maybe (return nullPtr) cppValue $ case taskImplementation t of + (np, nl) <- cstring $ taskInfoName t + rps <- mapM cppValue (taskInfoResources t) + tid <- cppValue $ taskInfoId' t + sid <- cppValue $ taskInfoSlaveId t + eip <- maybe (return nullPtr) cppValue $ case taskInfoImplementation t of TaskExecutor e -> Just e _ -> Nothing - cip <- maybe (return nullPtr) cppValue $ case taskImplementation t of + cip <- maybe (return nullPtr) cppValue $ case taskInfoImplementation t of TaskCommand c -> Just c _ -> Nothing - (tdp, tdl) <- maybeCString $ taskData t + (tdp, tdl) <- maybeCString $ taskInfoData t (rpp, rl) <- arrayLen rps - ctrp <- maybe (return nullPtr) cppValue $ taskContainer t - hcp <- maybe (return nullPtr) cppValue $ taskHealthCheck t + ctrp <- maybe (return nullPtr) cppValue $ taskInfoContainer t + hcp <- maybe (return nullPtr) cppValue $ taskInfoHealthCheck t liftIO $ c_toTaskInfo np (fromIntegral nl) tid sid rpp (fromIntegral rl) eip cip tdp (fromIntegral tdl) ctrp hcp unmarshal t = do diff --git a/src/System/Mesos/Raw/TaskStatus.hs b/src/System/Mesos/Raw/TaskStatus.hs --- a/src/System/Mesos/Raw/TaskStatus.hs +++ b/src/System/Mesos/Raw/TaskStatus.hs @@ -42,11 +42,11 @@ instance CPPValue TaskStatus where marshal s = do - tidP <- cppValue $ taskStatusTaskID s - sidP <- maybe (return nullPtr) cppValue $ taskStatusSlaveID s + tidP <- cppValue $ taskStatusTaskId s + sidP <- maybe (return nullPtr) cppValue $ taskStatusSlaveId s (tmp, tml) <- maybeCString $ taskStatusMessage s (tsd, tsl) <- maybeCString $ taskStatusData s - eidP <- maybe (return nullPtr) cppValue $ taskStatusExecutorID s + eidP <- maybe (return nullPtr) cppValue $ taskStatusExecutorId s tsp <- alloc tsp' <- maybe (return nullPtr) (\x -> poke tsp (CDouble x) >> return tsp) $ taskStatusTimestamp s hp <- allocMaybe $ fmap toCBool $ taskStatusHealthy s diff --git a/src/System/Mesos/Resources.hs b/src/System/Mesos/Resources.hs --- a/src/System/Mesos/Resources.hs +++ b/src/System/Mesos/Resources.hs @@ -27,7 +27,7 @@ Nothing -> False Just gs -> b && (sumOf (traverse . value . scalar) res <= sumOf (traverse . value . scalar) gs) - +{- class HasResources a where resources :: Lens' a [Resource] @@ -45,6 +45,7 @@ instance HasResources TaskInfo where resources = lens taskResources (\t rs -> t { taskResources = rs }) +-} value :: Lens' Resource Value value = lens resourceValue $ \r v -> r { resourceValue = v } diff --git a/src/System/Mesos/Scheduler.hs b/src/System/Mesos/Scheduler.hs --- a/src/System/Mesos/Scheduler.hs +++ b/src/System/Mesos/Scheduler.hs @@ -42,10 +42,10 @@ import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -- import Foreign.C import Foreign.Ptr -import System.Mesos.Internal hiding (marshal) +import System.Mesos.Internal hiding (marshal, requestResources) import System.Mesos.Raw import System.Mesos.Raw.Scheduler -import System.Mesos.Types +import System.Mesos.Types hiding (requestResources) -- | Callback interface to be implemented by frameworks' -- schedulers. Note that only one callback will be invoked at a time, diff --git a/src/System/Mesos/Types.hs b/src/System/Mesos/Types.hs --- a/src/System/Mesos/Types.hs +++ b/src/System/Mesos/Types.hs @@ -118,28 +118,28 @@ toEnum _ = error "Unsupported status" -- | A unique ID assigned to a framework. A framework can reuse this ID in order to do failover. -newtype FrameworkID = FrameworkID { fromFrameworkID :: ByteString } +newtype FrameworkID = FrameworkID { frameworkIDId' :: ByteString } deriving (Show, Eq, IsString) -- | A unique ID assigned to an offer. -newtype OfferID = OfferID { fromOfferID :: ByteString } +newtype OfferID = OfferID { offerIDId' :: ByteString } deriving (Show, Eq, IsString) -- | A unique ID assigned to a slave. Currently, a slave gets a new ID whenever it (re)registers with Mesos. Framework writers shouldn't assume any binding between a slave ID and and a hostname. -newtype SlaveID = SlaveID { fromSlaveID :: ByteString } +newtype SlaveID = SlaveID { slaveIDId' :: ByteString } deriving (Show, Eq, IsString) -- | A framework generated ID to distinguish a task. The ID must remain -- unique while the task is active. However, a framework can reuse an -- ID _only_ if a previous task with the same ID has reached a -- terminal state (e.g., 'Finished', 'Lost', 'Killed', etc.). See 'isTerminal' for a utility function to simplify checking task state. -newtype TaskID = TaskID { fromTaskID :: ByteString } +newtype TaskID = TaskID { taskIDId' :: ByteString } deriving (Show, Eq, IsString) -- | A framework generated ID to distinguish an executor. Only one -- executor with the same ID can be active on the same slave at a -- time. -newtype ExecutorID = ExecutorID { fromExecutorID :: ByteString } +newtype ExecutorID = ExecutorID { executorIDId' :: ByteString } deriving (Show, Eq, IsString) @@ -147,7 +147,7 @@ -- between any active or completed containers on the slave. In particular, -- containers for different runs of the same (framework, executor) pair must be -- unique. -newtype ContainerID = ContainerID { fromContainerID :: ByteString } +newtype ContainerID = ContainerID { containerIDId' :: ByteString } deriving (Show, Eq, IsString) -- | Describes a framework. If the user field is set to an empty string @@ -167,14 +167,14 @@ -- If the 'frameworkHostname' field is set to an empty string Mesos will -- automagically set it to the current hostname. data FrameworkInfo = FrameworkInfo - { frameworkUser :: !ByteString - , frameworkName :: !ByteString - , frameworkID :: !(Maybe FrameworkID) - , frameworkFailoverTimeout :: !(Maybe Double) - , frameworkCheckpoint :: !(Maybe Bool) - , frameworkRole :: !(Maybe ByteString) - , frameworkHostname :: !(Maybe ByteString) - , frameworkPrincipal :: !(Maybe ByteString) + { frameworkInfoUser :: !ByteString + , frameworkInfoName :: !ByteString + , frameworkInfoId' :: !(Maybe FrameworkID) + , frameworkInfoFailoverTimeout :: !(Maybe Double) + , frameworkInfoCheckpoint :: !(Maybe Bool) + , frameworkInfoRole :: !(Maybe ByteString) + , frameworkInfoHostname :: !(Maybe ByteString) + , frameworkInfoPrincipal :: !(Maybe ByteString) } deriving (Show, Eq) @@ -183,12 +183,12 @@ data HealthCheckStrategy = HTTPCheck - { httpCheckPort :: !Word32 -- ^ Port to send the HTTP request. - , httpCheckPath :: !(Maybe ByteString) -- ^ HTTP request path. (defaults to @"/"@. - , httpCheckStatuses :: ![Word32] -- ^ Expected response statuses. Not specifying any statuses implies that any returned status is acceptable. + { healthCheckStrategyPort :: !Word32 -- ^ Port to send the HTTP request. + , healthCheckStrategyPath :: !(Maybe ByteString) -- ^ HTTP request path. (defaults to @"/"@. + , healthCheckStrategyStatuses :: ![Word32] -- ^ Expected response statuses. Not specifying any statuses implies that any returned status is acceptable. } | CommandCheck - { commandCheckCommand :: !CommandInfo -- ^ Command health check. + { healthCheckStrategyCommand :: !CommandInfo -- ^ Command health check. } deriving (Show, Eq) data HealthCheck = HealthCheck @@ -211,16 +211,16 @@ -- working directory. In addition, any environment variables are set before -- executing the command (so they can be used to "parameterize" your command). data CommandInfo = CommandInfo - { commandInfoURIs :: ![CommandURI] - , commandEnvironment :: !(Maybe [(ByteString, ByteString)]) - , commandValue :: !CommandValue + { commandInfoUris :: ![CommandURI] + , commandInfoEnvironment :: !(Maybe [(ByteString, ByteString)]) + , commandInfoValue :: !CommandValue -- TODO: Existing field in 0.20, but doesn't actually work -- , commandContainer :: !(Maybe ContainerInfo) -- | Enables executor and tasks to run as a specific user. If the user -- field is present both in 'FrameworkInfo' and here, the 'CommandInfo' -- user value takes precedence. - , commandUser :: !(Maybe ByteString) + , commandInfoUser :: !(Maybe ByteString) } deriving (Show, Eq) @@ -252,16 +252,16 @@ -- Describes information about an executor. The 'executorData' field can be -- used to pass arbitrary bytes to an executor. data ExecutorInfo = ExecutorInfo - { executorInfoExecutorID :: !ExecutorID - , executorInfoFrameworkID :: !FrameworkID + { executorInfoExecutorId :: !ExecutorID + , executorInfoFrameworkId :: !FrameworkID , executorInfoCommandInfo :: !CommandInfo , executorInfoContainerInfo :: !(Maybe ContainerInfo) -- ^ Executor provided with a container will launch the container -- with the executor's 'CommandInfo' and we expect the container to -- act as a Mesos executor. , executorInfoResources :: ![Resource] - , executorName :: !(Maybe ByteString) - , executorSource :: !(Maybe ByteString) + , executorInfoName :: !(Maybe ByteString) + , executorInfoSource :: !(Maybe ByteString) -- ^ Source is an identifier style string used by frameworks to track -- the source of an executor. This is useful when it's possible for -- different executor ids to be related semantically. @@ -269,7 +269,7 @@ -- NOTE: Source is exposed alongside the resource usage of the -- executor via JSON on the slave. This allows users to import -- usage information into a time series database for monitoring. - , executorData :: !(Maybe ByteString) + , executorInfoData :: !(Maybe ByteString) } deriving (Show, Eq) @@ -280,10 +280,10 @@ -- future which might be used, for example, to link a framework web UI -- to a master web UI. data MasterInfo = MasterInfo - { masterInfoID :: !ByteString - , masterInfoIP :: !Word32 + { masterInfoId' :: !ByteString + , masterInfoIp :: !Word32 , masterInfoPort :: !(Maybe Word32) -- ^ Defaults to 5050 - , masterInfoPID :: !(Maybe ByteString) + , masterInfoPid :: !(Maybe ByteString) , masterInfoHostname :: !(Maybe ByteString) } deriving (Show, Eq) @@ -301,7 +301,7 @@ , slaveInfoPort :: !(Maybe Word32) , slaveInfoResources :: ![Resource] , slaveInfoAttributes :: ![(ByteString, Value)] - , slaveInfoSlaveID :: !(Maybe SlaveID) + , slaveInfoSlaveId :: !(Maybe SlaveID) , slaveInfoCheckpoint :: !(Maybe Bool) } deriving (Show, Eq) @@ -310,7 +310,7 @@ slaveInfo hn rs as = SlaveInfo hn Nothing rs as Nothing Nothing newtype Filters = Filters - { refuseSeconds :: Maybe Double + { filtersRefuseSeconds :: Maybe Double -- ^ Time to consider unused resources refused. Note that all unused -- resources will be considered refused and use the default value -- (below) regardless of whether Filters was passed to @@ -353,34 +353,34 @@ data ResourceStatistics = ResourceStatistics { resourceStatisticsTimestamp :: !Double - , resourceStatisticsCPUsUserTimeSecs :: !(Maybe Double) + , resourceStatisticsCpusUserTimeSecs :: !(Maybe Double) -- ^ Total CPU time spent in user mode - , resourceStatisticsCPUsSystemTimeSecs :: !(Maybe Double) + , resourceStatisticsCpusSystemTimeSecs :: !(Maybe Double) -- ^ Total CPU time spent in kernel mode. - , resourceCPUsLimit :: !Double + , resourceStatisticsCpusLimit :: !Double -- ^ Number of CPUs allocated. - , resourceCPUsPeriods :: !(Maybe Word32) + , resourceStatisticsCpusPeriods :: !(Maybe Word32) -- ^ cpu.stat on process throttling (for contention issues). - , resourceCPUsThrottled :: !(Maybe Word32) + , resourceStatisticsCpusThrottled :: !(Maybe Word32) -- ^ cpu.stat on process throttling (for contention issues). - , resourceCPUsThrottledTimeSecs :: !(Maybe Double) + , resourceStatisticsCpusThrottledTimeSecs :: !(Maybe Double) -- ^ cpu.stat on process throttling (for contention issues). - , resourceMemoryResidentSetSize :: !(Maybe Word64) + , resourceStatisticsMemoryResidentSetSize :: !(Maybe Word64) -- ^ Resident set size - , resourceMemoryLimitBytes :: !(Maybe Word64) + , resourceStatisticsMemoryLimitBytes :: !(Maybe Word64) -- ^ Amount of memory resources allocated. - , resourceMemoryFileBytes :: !(Maybe Word64) - , resourceMemoryAnonymousBytes :: !(Maybe Word64) - , resourceMemoryMappedFileBytes :: !(Maybe Word64) - , resourcePerformanceStatistics :: !(Maybe PerformanceStatistics) - , resourceNetRxPackets :: !(Maybe Word64) - , resourceNetRxBytes :: !(Maybe Word64) - , resourceNetRxErrors :: !(Maybe Word64) - , resourceNetRxDropped :: !(Maybe Word64) - , resourceNetTxPackets :: !(Maybe Word64) - , resourceNetTxBytes :: !(Maybe Word64) - , resourceNetTxErrors :: !(Maybe Word64) - , resourceNetTxDropped :: !(Maybe Word64) + , resourceStatisticsMemoryFileBytes :: !(Maybe Word64) + , resourceStatisticsMemoryAnonymousBytes :: !(Maybe Word64) + , resourceStatisticsMemoryMappedFileBytes :: !(Maybe Word64) + , resourceStatisticsPerformanceStatistics :: !(Maybe PerformanceStatistics) + , resourceStatisticsNetRxPackets :: !(Maybe Word64) + , resourceStatisticsNetRxBytes :: !(Maybe Word64) + , resourceStatisticsNetRxErrors :: !(Maybe Word64) + , resourceStatisticsNetRxDropped :: !(Maybe Word64) + , resourceStatisticsNetTxPackets :: !(Maybe Word64) + , resourceStatisticsNetTxBytes :: !(Maybe Word64) + , resourceStatisticsNetTxErrors :: !(Maybe Word64) + , resourceStatisticsNetTxDropped :: !(Maybe Word64) } deriving (Show, Eq) @@ -392,11 +392,11 @@ -- used. In this case, we provide the task id here instead, in -- order to make this message easier for schedulers to work with. data ResourceUsage = ResourceUsage - { resourceUsageSlaveID :: !SlaveID - , resourceUsageFrameworkID :: !FrameworkID - , resourceUsageExecutorID :: !(Maybe ExecutorID) -- ^ If present, this executor was explicitly specified. + { resourceUsageSlaveId :: !SlaveID + , resourceUsageFrameworkId :: !FrameworkID + , resourceUsageExecutorId :: !(Maybe ExecutorID) -- ^ If present, this executor was explicitly specified. , resourceUsageExecutorName :: !(Maybe ByteString) -- ^ If present, this executor was explicitly specified. - , resourceUsageTaskID :: !(Maybe TaskID) -- ^ If present, this task did not have an executor. + , resourceUsageTaskId :: !(Maybe TaskID) -- ^ If present, this task did not have an executor. , resourceUsageStatistics :: !(Maybe ResourceStatistics) -- ^ If missing, the isolation module cannot provide resource usage. } @@ -467,21 +467,21 @@ -- | Describes a request for resources that can be used by a framework -- to proactively influence the allocator. data Request = Request - { requestSlaveID :: !(Maybe SlaveID) -- ^ If value is provided, then this request is assumed to only apply to resources on the given slave. - , reqResources :: ![Resource] + { requestSlaveId :: !(Maybe SlaveID) -- ^ If value is provided, then this request is assumed to only apply to resources on the given slave. + , requestResources :: ![Resource] } deriving (Show, Eq) -- | Describes some resources available on a slave. An offer only -- contains resources from a single slave. data Offer = Offer - { offerID :: !OfferID - , offerFrameworkID :: !FrameworkID - , offerSlaveID :: !SlaveID + { offerId' :: !OfferID + , offerFrameworkId :: !FrameworkID + , offerSlaveId :: !SlaveID , offerHostname :: !ByteString , offerResources :: ![Resource] , offerAttributes :: ![(ByteString, Value)] - , offerExecutorIDs :: ![ExecutorID] + , offerExecutorIds :: ![ExecutorID] } deriving (Show, Eq) @@ -497,18 +497,18 @@ -- A different executor can be used to launch this task, and subsequent tasks -- meant for the same executor can reuse the same ExecutorInfo struct. data TaskInfo = TaskInfo - { taskName :: !ByteString - , taskID :: !TaskID - , taskSlaveID :: !SlaveID - , taskResources :: ![Resource] - , taskImplementation :: !TaskExecutionInfo - , taskData :: !(Maybe ByteString) + { taskInfoName :: !ByteString + , taskInfoId' :: !TaskID + , taskInfoSlaveId :: !SlaveID + , taskInfoResources :: ![Resource] + , taskInfoImplementation :: !TaskExecutionInfo + , taskInfoData :: !(Maybe ByteString) -- | Task provided with a container will launch the container as part -- of this task paired with the task's CommandInfo. - , taskContainer :: !(Maybe ContainerInfo) + , taskInfoContainer :: !(Maybe ContainerInfo) -- | A health check for the task (currently in *alpha* and initial -- support will only be for TaskInfo's that have a CommandInfo). - , taskHealthCheck :: !(Maybe HealthCheck) + , taskInfoHealthCheck :: !(Maybe HealthCheck) } deriving (Show, Eq) @@ -517,12 +517,12 @@ -- | Describes the current status of a task. data TaskStatus = TaskStatus - { taskStatusTaskID :: !TaskID + { taskStatusTaskId :: !TaskID , taskStatusState :: !TaskState , taskStatusMessage :: !(Maybe ByteString) -- ^ Possible message explaining state. , taskStatusData :: !(Maybe ByteString) - , taskStatusSlaveID :: !(Maybe SlaveID) - , taskStatusExecutorID :: !(Maybe ExecutorID) + , taskStatusSlaveId :: !(Maybe SlaveID) + , taskStatusExecutorId :: !(Maybe ExecutorID) , taskStatusTimestamp :: !(Maybe Double) -- | Describes whether the task has been determined to be healthy -- (true) or unhealthy (false) according to the HealthCheck field in @@ -552,9 +552,9 @@ | Any | None deriving (Show, Eq) -data RegisterFrameworkACL = RegisterFrameworkACL { registerFrameworkPrincipals :: ACLEntity, registerFrameworkRoles :: ACLEntity } deriving (Show, Eq) -data RunTaskACL = RunTaskACL { runTaskPrincipals :: ACLEntity, runTaskUsers :: ACLEntity } deriving (Show, Eq) -data ShutdownFrameworkACL = ShutdownFrameworkACL { shutdownFrameworkPrincipals :: ACLEntity, shutdownFrameworkFrameworkPrincipals :: ACLEntity } deriving (Show, Eq) +data RegisterFrameworkACL = RegisterFrameworkACL { registerFrameworkACLPrincipals :: ACLEntity, registerFrameworkACLRoles :: ACLEntity } deriving (Show, Eq) +data RunTaskACL = RunTaskACL { runTaskACLPrincipals :: ACLEntity, runTaskACLUsers :: ACLEntity } deriving (Show, Eq) +data ShutdownFrameworkACL = ShutdownFrameworkACL { shutdownFrameworkACLPrincipals :: ACLEntity, shutdownFrameworkACLFrameworkPrincipals :: ACLEntity } deriving (Show, Eq) data ACLSettings = ACLSettings { aclSettingsPermissive :: !(Maybe Bool) @@ -570,7 +570,7 @@ } deriving (Show, Eq) data RateLimits = RateLimits - { rateLimits :: ![RateLimit] + { rateLimitsRateLimits :: ![RateLimit] , rateLimitsAggregateDefaultQPS :: !(Maybe Double) , rateLimitsAggregateDefaultCapacity :: !(Maybe Double) } deriving (Show, Eq) diff --git a/test/TestExecutor.hs b/test/TestExecutor.hs --- a/test/TestExecutor.hs +++ b/test/TestExecutor.hs @@ -1,9 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} module Main where +import Control.Lens import Control.Monad import Data.Monoid import System.Exit import System.Mesos.Executor +import System.Mesos.Lens import System.Mesos.TaskStatus import System.Mesos.Types @@ -12,10 +14,10 @@ registered _ _ _ _ s = print $ "Registered executor on " <> slaveInfoHostname s reRegistered _ _ s = print $ "Re-registered executor on " <> slaveInfoHostname s launchTask _ d t = void $ do - print $ "Starting task " <> fromTaskID (taskID t) - sendStatusUpdate d $ taskStatus (taskID t) TaskRunning + print $ "Starting task " <> (t^.id'.id') + sendStatusUpdate d $ taskStatus (t^.id') TaskRunning -- this is where one would perform the requested task - sendStatusUpdate d $ taskStatus (taskID t) Finished + sendStatusUpdate d $ taskStatus (t^.id') Finished main = do r <- withExecutorDriver TestExecutor $ \e -> do diff --git a/test/TestFramework.hs b/test/TestFramework.hs --- a/test/TestFramework.hs +++ b/test/TestFramework.hs @@ -7,9 +7,11 @@ import Data.IORef import Data.Monoid ((<>)) import System.Exit +import System.Mesos.Lens import System.Mesos.Resources import System.Mesos.Scheduler -import System.Mesos.Types +import System.Mesos.Types hiding (commandInfo) +import qualified System.Mesos.Types as T -- import Text.Groom cpusPerTask :: Double @@ -22,14 +24,14 @@ requiredResources = [cpusPerTask ^. re cpus, memPerTask ^. re mem] data TestScheduler = TestScheduler - { role :: C.ByteString + { schedulerRole :: C.ByteString , totalTasks :: Int , tasksLaunched :: IORef Int , tasksFinished :: IORef Int } -executorSettings fid = e { executorName = Just "Test Executor (Haskell)"} - where e = executorInfo (ExecutorID "default") fid (commandInfo $ ShellCommand "/Users/ian/Code/personal/hs-mesos/dist/build/test-executor/test-executor") requiredResources +executorSettings fid = e & name ?~ "Test Executor (Haskell)" + where e = executorInfo (ExecutorID "default") fid (T.commandInfo $ ShellCommand "/Users/ian/Code/personal/hs-mesos/dist/build/test-executor/test-executor") requiredResources instance ToScheduler TestScheduler where registered _ _ _ _ = putStrLn "Registered!" @@ -37,26 +39,23 @@ resourceOffers s driver offers = do finishedCount <- readIORef $ tasksFinished s if totalTasks s == finishedCount - then forM_ offers $ \offer -> declineOffer driver (offerID offer) filters + then forM_ offers $ \offer -> declineOffer driver (offer^.id') filters else forM_ offers $ \offer -> do - putStrLn ("Starting task on " <> show (offerHostname offer)) + putStrLn ("Starting task on " <> show (offer^.hostname)) status <- launchTasks driver - [ offerID offer ] - [ TaskInfo "Task foo" (TaskID "foo") (offerSlaveID offer) requiredResources - (TaskExecutor $ executorSettings $ offerFrameworkID offer) - Nothing - Nothing - Nothing + [ offer^.id' ] + [ taskInfo "Task foo" (TaskID "foo") (offer^.slaveId) requiredResources + (TaskExecutor $ executorSettings $ (offer^.frameworkId)) ] (Filters Nothing) putStrLn "Launched tasks" return () statusUpdate s driver status = do - putStrLn $ "Task " <> show (taskStatusTaskID status) <> " is in state " <> show (taskStatusState status) + putStrLn $ "Task " <> show (status^.taskId) <> " is in state " <> show (status^.state) print status - when (taskStatusState status == Finished) $ do + when ((status^.state) == Finished) $ do count <- atomicModifyIORef' (tasksFinished s) (\x -> let x' = succ x in (x', x')) when (count == totalTasks s) $ void $ do getLine @@ -65,9 +64,9 @@ errorMessage _ _ message = C.putStrLn message main = do - role <- return "*" -- role to use when registering + r <- return "*" -- role to use when registering master <- return "127.0.0.1:5050" -- ip:port of master to connect to - let info = (frameworkInfo "" "Test Framework (Haskell)") { frameworkRole = Just role } + let info = (frameworkInfo "" "Test Framework (Haskell)") & role ?~ r scheduler <- TestScheduler "master" 5 <$> newIORef 0 <*> newIORef 0 status <- withSchedulerDriver scheduler info master Nothing $ \d -> do status <- run d