diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2014 SaneApp + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/ext/executor.cpp b/ext/executor.cpp new file mode 100644 --- /dev/null +++ b/ext/executor.cpp @@ -0,0 +1,154 @@ +#include "executor.h" + +using namespace mesos; +namespace HsFFI { +class HsExecutor : public Executor +{ +public: + HsExecutor( + OnExecutorRegisteredCallback* registeredCb, + OnExecutorReRegisteredCallback* reRegisteredCb, + OnExecutorDisconnectedCallback* disconnectedCb, + OnExecutorLaunchTaskCallback* launchTaskCb, + OnExecutorTaskKilledCallback* taskKilledCb, + OnExecutorFrameworkMessageCallback* frameworkMessageCb, + OnExecutorShutdownCallback* shutdownCb, + OnExecutorErrorCallback* errorCb + ) + { + this->registeredCb = registeredCb; + this->reRegisteredCb = reRegisteredCb; + this->disconnectedCb = disconnectedCb; + this->launchTaskCb = launchTaskCb; + this->taskKilledCb = taskKilledCb; + this->frameworkMessageCb = frameworkMessageCb; + this->shutdownCb = shutdownCb; + this->errorCb = errorCb; + } + + void registered(ExecutorDriver* driver, + const ExecutorInfo& executorInfo, + const FrameworkInfo& frameworkInfo, + const SlaveInfo& slaveInfo) + { + this->registeredCb(driver, &executorInfo, &frameworkInfo, &slaveInfo); + } + + void reregistered(ExecutorDriver* driver, + const SlaveInfo& slaveInfo) + { + this->reRegisteredCb(driver, &slaveInfo); + } + + void disconnected(ExecutorDriver* driver) + { + this->disconnectedCb(driver); + } + + void launchTask(ExecutorDriver* driver, + const TaskInfo& taskInfo) + { + this->launchTaskCb(driver, &taskInfo); + } + + void killTask(ExecutorDriver* driver, + const TaskID& taskId) + { + this->taskKilledCb(driver, &taskId); + } + + void frameworkMessage(ExecutorDriver* driver, + const std::string& str) + { + this->frameworkMessageCb(driver, str.size(), str.data()); + } + + void shutdown(ExecutorDriver* driver) + { + this->shutdownCb(driver); + } + + void error(ExecutorDriver* driver, + const std::string& str) + { + this->errorCb(driver, str.size(), str.data()); + } +private: + OnExecutorRegisteredCallback* registeredCb; + OnExecutorReRegisteredCallback* reRegisteredCb; + OnExecutorDisconnectedCallback* disconnectedCb; + OnExecutorLaunchTaskCallback* launchTaskCb; + OnExecutorTaskKilledCallback* taskKilledCb; + OnExecutorFrameworkMessageCallback* frameworkMessageCb; + OnExecutorShutdownCallback* shutdownCb; + OnExecutorErrorCallback* errorCb; +}; +} + +// Executor +Executor* createExecutor( + OnExecutorRegisteredCallback* registeredCb, + OnExecutorReRegisteredCallback* reRegisteredCb, + OnExecutorDisconnectedCallback* disconnectedCb, + OnExecutorLaunchTaskCallback* launchTaskCb, + OnExecutorTaskKilledCallback* taskKilledCb, + OnExecutorFrameworkMessageCallback* frameworkMessageCb, + OnExecutorShutdownCallback* shutdownCb, + OnExecutorErrorCallback* errorCb + ) +{ + return new HsFFI::HsExecutor(registeredCb, reRegisteredCb, disconnectedCb, launchTaskCb, taskKilledCb, frameworkMessageCb, shutdownCb, errorCb); +} + +void destroyExecutor(mesos::Executor* executor) +{ + delete executor; +} + +// ExecutorDriver +ExecutorDriver* createExecutorDriver(Executor* executor) +{ + return new MesosExecutorDriver(executor); +} + +void destroyExecutorDriver(ExecutorDriver* driver) +{ + delete driver; +} + +int startExecutorDriver(ExecutorDriver* driver) +{ + return driver->start(); +} + +int stopExecutorDriver(ExecutorDriver* driver) +{ + return driver->stop(); +} + +int abortExecutorDriver(ExecutorDriver* driver) +{ + return driver->abort(); +} + +int joinExecutorDriver(ExecutorDriver* driver) +{ + return driver->join(); +} + +int runExecutorDriver(ExecutorDriver* driver) +{ + return driver->run(); +} + +int sendExecutorDriverStatusUpdate(ExecutorDriver* driver, TaskStatus* status) +{ + return driver->sendStatusUpdate(*status); +} + +int sendExecutorDriverFrameworkMessage(ExecutorDriver* driver, int stringLength, char* stringData) +{ + std::string message(stringData, stringLength); + return driver->sendFrameworkMessage(message); +} + diff --git a/ext/scheduler.cpp b/ext/scheduler.cpp new file mode 100644 --- /dev/null +++ b/ext/scheduler.cpp @@ -0,0 +1,249 @@ +#include +#include "scheduler.h" + +using namespace mesos; +namespace HsFFI { + +class HsScheduler : public Scheduler +{ +public: + HsScheduler( + OnSchedulerRegisteredCallback* registeredCb, + OnSchedulerReRegisteredCallback* reRegisteredCb, + OnSchedulerDisconnectedCallback* disconnectedCb, + OnSchedulerResourceOffers* resourceOffersCb, + OnOfferRescinded* offerRescindedCb, + OnStatusUpdate* statusUpdateCb, + OnFrameworkMessage* frameworkMessageCb, + OnSlaveLost* slaveLostCb, + OnExecutorLost* executorLostCb, + OnSchedulerError* schedulerErrorCb) + { + this->registeredCb = registeredCb; + this->reRegisteredCb = reRegisteredCb; + this->disconnectedCb = disconnectedCb; + this->resourceOffersCb = resourceOffersCb; + this->offerRescindedCb = offerRescindedCb; + this->statusUpdateCb = statusUpdateCb; + this->frameworkMessageCb = frameworkMessageCb; + this->slaveLostCb = slaveLostCb; + this->executorLostCb = executorLostCb; + this->schedulerErrorCb = schedulerErrorCb; + } + + ~HsScheduler(){} + + virtual void registered (SchedulerDriver* driver, + const FrameworkID& frameworkId, + const MasterInfo& masterInfo) + { + registeredCb(driver, &frameworkId, &masterInfo); + } + + virtual void reregistered (SchedulerDriver* driver, + const MasterInfo& masterInfo) + { + reRegisteredCb(driver, &masterInfo); + } + + virtual void disconnected (SchedulerDriver* driver) + { + disconnectedCb(driver); + } + + virtual void resourceOffers (SchedulerDriver* driver, + const std::vector& offers) + { + std::vector pointerized = std::vector(offers.size()); + for (int i = 0; i < offers.size(); ++i) + pointerized[i] = (Offer*) &offers[i]; + + resourceOffersCb(driver, pointerized.data(), pointerized.size()); + } + + virtual void offerRescinded (SchedulerDriver* driver, + const OfferID& offerId) + { + offerRescindedCb(driver, &offerId); + } + + virtual void statusUpdate (SchedulerDriver* driver, + const TaskStatus& status) + { + statusUpdateCb(driver, &status); + } + + virtual void frameworkMessage (SchedulerDriver* driver, + const ExecutorID& executorId, + const SlaveID& slaveId, + const std::string& data) + { + frameworkMessageCb(driver, &executorId, &slaveId, data.data(), data.size()); + } + + virtual void slaveLost (SchedulerDriver* driver, + const SlaveID& slaveId) + { + slaveLostCb(driver, &slaveId); + } + + virtual void executorLost (SchedulerDriver* driver, + const ExecutorID& executorId, + const SlaveID& slaveId, + int status) + { + executorLostCb(driver, &executorId, &slaveId, status); + } + + virtual void error (SchedulerDriver* driver, const std::string& message) + { + schedulerErrorCb(driver, message.data(), message.size()); + } + +private: + OnSchedulerRegisteredCallback* registeredCb; + OnSchedulerReRegisteredCallback* reRegisteredCb; + OnSchedulerDisconnectedCallback* disconnectedCb; + OnSchedulerResourceOffers* resourceOffersCb; + OnOfferRescinded* offerRescindedCb; + OnStatusUpdate* statusUpdateCb; + OnFrameworkMessage* frameworkMessageCb; + OnSlaveLost* slaveLostCb; + OnExecutorLost* executorLostCb; + OnSchedulerError* schedulerErrorCb; +}; +} + +SchedulerPtr createScheduler(OnSchedulerRegisteredCallback* registeredCb, + OnSchedulerReRegisteredCallback* reRegisteredCb, + OnSchedulerDisconnectedCallback* disconnectedCb, + OnSchedulerResourceOffers* resourceOffersCb, + OnOfferRescinded* offerRescindedCb, + OnStatusUpdate* statusUpdateCb, + OnFrameworkMessage* frameworkMessageCb, + OnSlaveLost* slaveLostCb, + OnExecutorLost* executorLostCb, + OnSchedulerError* schedulerErrorCb) +{ + return new HsFFI::HsScheduler(registeredCb, + reRegisteredCb, + disconnectedCb, + resourceOffersCb, + offerRescindedCb, + statusUpdateCb, + frameworkMessageCb, + slaveLostCb, + executorLostCb, + schedulerErrorCb + ); +} + +void destroyScheduler(SchedulerPtr scheduler) +{ + delete scheduler; +} + +void exerciseMethods(SchedulerPtr scheduler) +{ + scheduler->registered(NULL, FrameworkID(), MasterInfo()); + scheduler->reregistered(NULL, MasterInfo()); + scheduler->disconnected(NULL); + scheduler->resourceOffers(NULL, std::vector()); + scheduler->offerRescinded(NULL, OfferID()); + scheduler->statusUpdate(NULL, TaskStatus()); + scheduler->frameworkMessage(NULL, ExecutorID(), SlaveID(), std::string()); + scheduler->slaveLost(NULL, SlaveID()); + scheduler->executorLost(NULL, ExecutorID(), SlaveID(), 0); + scheduler->error(NULL, std::string()); +} + +SchedulerDriverPtr createSchedulerDriver(SchedulerPtr scheduler, FrameworkInfoPtr framework, char* master, int masterLength) +{ + return new MesosSchedulerDriver(scheduler, *framework, std::string(master, masterLength)); +} + +SchedulerDriverPtr createSchedulerDriverWithCredentials(SchedulerPtr scheduler, FrameworkInfoPtr framework, char* master, int masterLength, CredentialPtr credential) +{ + return new MesosSchedulerDriver(scheduler, *framework, std::string(master, masterLength), *credential); +} + +void destroySchedulerDriver(SchedulerDriverPtr schedulerDriver) +{ + delete schedulerDriver; +} + +int startSchedulerDriver(SchedulerDriverPtr schedulerDriver) +{ + return schedulerDriver->start(); +} + +int stopSchedulerDriver(SchedulerDriverPtr schedulerDriver, bool failover) +{ + return schedulerDriver->stop(failover); +} + +int abortSchedulerDriver(SchedulerDriverPtr schedulerDriver) +{ + return schedulerDriver->abort(); +} + +int joinSchedulerDriver(SchedulerDriverPtr schedulerDriver) +{ + return schedulerDriver->join(); +} + +int runSchedulerDriver(SchedulerDriverPtr schedulerDriver) +{ + return schedulerDriver->run(); +} + +int requestResources(SchedulerDriverPtr schedulerDriver, RequestPtr* request, int requestCount) +{ + std::vector requests = std::vector(requestCount); + for(int i = 0; i < requestCount; ++i) + requests[i] = *request[i]; + + return schedulerDriver->requestResources(requests); +} + +int launchTasks(SchedulerDriverPtr schedulerDriver, OfferIDPtr* offer, int offerCount, TaskInfoPtr* taskInfo, int infoCount, FiltersPtr filters) +{ + std::vector offers = std::vector(offerCount); + for(int i = 0; i < offerCount; ++i) + offers[i] = *offer[i]; + + std::vector tasks = std::vector(infoCount); + for(int i = 0; i < infoCount; ++i) + tasks[i] = *taskInfo[i]; + + return schedulerDriver->launchTasks(offers, tasks, *filters); +} + +int killTask(SchedulerDriverPtr schedulerDriver, TaskIDPtr task) +{ + return schedulerDriver->killTask(*task); +} + +int declineOffer(SchedulerDriverPtr schedulerDriver, OfferIDPtr offerId, FiltersPtr filters) +{ + return schedulerDriver->declineOffer(*offerId, *filters); +} + +int reviveOffers(SchedulerDriverPtr schedulerDriver) +{ + return schedulerDriver->reviveOffers(); +} + +int schedulerDriverSendFrameworkMessage(SchedulerDriverPtr schedulerDriver, ExecutorIDPtr executor, SlaveIDPtr slave, char* msg, int msgLength) +{ + return schedulerDriver->sendFrameworkMessage(*executor, *slave, std::string(msg, msgLength)); +} + +int reconcileTasks(SchedulerDriverPtr schedulerDriver, TaskStatusPtr* statuses, int statusCount) +{ + std::vector tasks = std::vector(statusCount); + for(int i = 0; i < statusCount; ++i) + tasks[i] = *statuses[i]; + + return schedulerDriver->reconcileTasks(tasks); +} diff --git a/ext/types/attribute.cpp b/ext/types/attribute.cpp new file mode 100644 --- /dev/null +++ b/ext/types/attribute.cpp @@ -0,0 +1,50 @@ +#include +#include "types.h" + +using namespace mesos; + +AttributePtr toAttribute(char* name, + int nameLen, + ValuePtr value) +{ + AttributePtr attribute = new Attribute(); + attribute->set_name(name, nameLen); + attribute->set_type(value->type()); + if (value->has_scalar()) + *attribute->mutable_scalar() = *value->mutable_scalar(); + if (value->has_ranges()) + *attribute->mutable_ranges() = *value->mutable_ranges(); + if (value->has_set()) + *attribute->mutable_set() = *value->mutable_set(); + if (value->has_text()) + *attribute->mutable_text() = *value->mutable_text(); + return attribute; +} + +void fromAttribute(AttributePtr attribute, + char** name, + int* nameLen, + ValuePtr* vp) +{ + std::string* n = attribute->mutable_name(); + *name = (char*) n->data(); + *nameLen = n->size(); + + ValuePtr value = new Value(); + value->set_type(attribute->type()); + if (attribute->has_scalar()) + *value->mutable_scalar() = *attribute->mutable_scalar(); + if (attribute->has_ranges()) + *value->mutable_ranges() = *attribute->mutable_ranges(); + if (attribute->has_set()) + *value->mutable_set() = *attribute->mutable_set(); + if (attribute->has_text()) + *value->mutable_text() = *attribute->mutable_text(); + + *vp = value; +} + +void destroyAttribute(AttributePtr attribute) +{ + delete attribute; +} diff --git a/ext/types/command_info.cpp b/ext/types/command_info.cpp new file mode 100644 --- /dev/null +++ b/ext/types/command_info.cpp @@ -0,0 +1,78 @@ +#include +#include "types.h" + +using namespace mesos; + +CommandInfoPtr toCommandInfo(CommandInfo_URIPtr* uris, + int urisLen, + EnvironmentPtr environment, + bool shell, + char* value, + int valueLen, + StdStringPtr* args, + int argsLen, + char* username, + int usernameLen + ) +{ + CommandInfoPtr info = new CommandInfo(); + + for (int i = 0; i < urisLen; ++i) + *info->add_uris() = *uris[i]; + + if (environment != NULL) + *info->mutable_environment() = *environment; + + info->set_shell(shell); + + info->set_value(value, valueLen); + + for (int i = 0; i < argsLen; ++i) + *info->add_arguments() = *args[i]; + + if (username != NULL) + info->set_user(username, usernameLen); + + return info; +} + +void fromCommandInfo(CommandInfoPtr info, + CommandInfo_URIPtr** uris, + int* urisLen, + EnvironmentPtr* environment, + bool* shell, + char** value, + int* valueLen, + StdStringPtr** args, + int* argsLen, + char** username, + int* usernameLen) +{ + + *uris = info->mutable_uris()->mutable_data(); + *urisLen = info->uris_size(); + + if (info->has_environment()) + *environment = info->mutable_environment(); + + *value = (char*) info->mutable_value()->data(); + *valueLen = info->mutable_value()->size(); + + *shell = info->shell(); + if (!*shell) + { + *args = info->mutable_arguments()->mutable_data(); + *argsLen = info->arguments_size(); + } + + if (info->has_user()) + { + *username = (char*) info->mutable_user()->data(); + *usernameLen = info->mutable_user()->size(); + } +} + +void destroyCommandInfo(CommandInfoPtr info) +{ + delete info; +} diff --git a/ext/types/command_uri.cpp b/ext/types/command_uri.cpp new file mode 100644 --- /dev/null +++ b/ext/types/command_uri.cpp @@ -0,0 +1,52 @@ +#include +#include "types.h" + +using namespace mesos; + +CommandURIPtr toCommandURI(char* cmd, + int cmdLen, + bool* executable, + bool* extract) +{ + CommandURIPtr uri = new mesos::CommandInfo_URI(); + uri->set_value(cmd, cmdLen); + + if (executable != NULL) + uri->set_executable(*executable); + + if (extract != NULL) + uri->set_extract(*extract); + + return uri; +} + +void fromCommandURI(CommandURIPtr commandURI, + char** cmd, + int* cmdLen, + bool* executableSet, + bool* executable, + bool* extractSet, + bool* extract) +{ + std::string* cmdStr = commandURI->mutable_value(); + + *cmd = (char*) cmdStr->data(); + *cmdLen = cmdStr->size(); + + if (commandURI->has_executable()) + { + *executableSet = true; + *executable = commandURI->executable(); + } + + if (commandURI->has_extract()) + { + *extractSet = true; + *extract = commandURI->extract(); + } +} + +void destroyCommandURI(CommandURIPtr commandURI) +{ + delete commandURI; +} diff --git a/ext/types/container_id.cpp b/ext/types/container_id.cpp new file mode 100644 --- /dev/null +++ b/ext/types/container_id.cpp @@ -0,0 +1,23 @@ +#include +#include "types.h" + +using namespace mesos; + +ContainerIDPtr toContainerID(char* bs, int len) +{ + ContainerIDPtr val = new ContainerID(); + val->set_value(bs, len); + return val; +} + +int fromContainerID(ContainerIDPtr p, char** poke) +{ + *poke = (char*) p->mutable_value()->data(); + return p->mutable_value()->size(); +} + +void destroyContainerID(ContainerIDPtr p) +{ + delete p; +} + diff --git a/ext/types/container_info.cpp b/ext/types/container_info.cpp new file mode 100644 --- /dev/null +++ b/ext/types/container_info.cpp @@ -0,0 +1,49 @@ +#include +#include "types.h" + +using namespace mesos; + +ContainerInfoPtr toContainerInfo (int type, + char* image, + int imageLen, + VolumePtr* volumes, + int volumesLen) +{ + ContainerInfoPtr p = new ContainerInfo; + p->set_type((ContainerInfo_Type) type); + if (type == ContainerInfo_Type_DOCKER) + { + ContainerInfo_DockerInfo d; + d.set_image(image, imageLen); + *p->mutable_docker() = d; + } + + for (int i = 0; i < volumesLen; ++i) + *p->add_volumes() = *volumes[i]; + + return p; +} + +void fromContainerInfo (ContainerInfoPtr info, + int* type, + char** image, + int* imageLen, + VolumePtr** volumes, + int* volumesLen) +{ + *type = info->type(); + + if (info->type() == 1) // DOCKER + { + *image = (char*) info->mutable_docker()->mutable_image()->data(); + *imageLen = info->mutable_docker()->mutable_image()->size(); + } + + *volumes = (VolumePtr*) info->mutable_volumes()->data(); + *volumesLen = info->mutable_volumes()->size(); +} + +void destroyContainerInfo (ContainerInfoPtr containerInfo) +{ + delete containerInfo; +} diff --git a/ext/types/credential.cpp b/ext/types/credential.cpp new file mode 100644 --- /dev/null +++ b/ext/types/credential.cpp @@ -0,0 +1,44 @@ +#include +#include "types.h" + +using namespace mesos; + +CredentialPtr toCredential(char* principal, + int principalLen, + char* secret, + int secretLen) +{ + CredentialPtr credential = new Credential(); + credential->set_principal(principal, principalLen); + if (secret != NULL) + credential->set_secret(secret, secretLen); + return credential; +} + +void fromCredential( + CredentialPtr credential, + char** principal, + int* principalLen, + char** secret, + int* secretLen) +{ + std::string* p = credential->mutable_principal(); + *principal = (char*) p->data(); + *principalLen = p->size(); + if (credential->has_secret()) + { + std::string* s = credential->mutable_secret(); + *secret = (char*) s->data(); + *secretLen = s->size(); + } + else + { + *secret = NULL; + *secretLen = 0; + } +} + +void destroyCredential(CredentialPtr credential) +{ + delete credential; +} diff --git a/ext/types/environment.cpp b/ext/types/environment.cpp new file mode 100644 --- /dev/null +++ b/ext/types/environment.cpp @@ -0,0 +1,31 @@ +#include +#include "types.h" + +using namespace mesos; + +EnvironmentPtr toEnvironment(EnvironmentVariablePtr* envVars, + int envLen) +{ + EnvironmentPtr env = new Environment(); + if (envVars != NULL) + { + ::google::protobuf::RepeatedPtrField* vs = env->mutable_variables(); + for (int i = 0; i < envLen; ++i) + *vs->Add() = *envVars[i]; + } + + return env; +} + +void fromEnvironment(EnvironmentPtr env, + EnvironmentVariablePtr** vars, + int* varLen) +{ + *vars = env->mutable_variables()->mutable_data(); + *varLen = env->variables_size(); +} + +void destroyEnvironment(EnvironmentPtr env) +{ + delete env; +} diff --git a/ext/types/environment_variable.cpp b/ext/types/environment_variable.cpp new file mode 100644 --- /dev/null +++ b/ext/types/environment_variable.cpp @@ -0,0 +1,34 @@ +#include +#include "types.h" + +using namespace mesos; + +EnvironmentVariablePtr toEnvironmentVariable(char* key, + int keyLen, + char* value, + int valueLen) +{ + EnvironmentVariablePtr var = new Environment_Variable(); + var->set_name(key, keyLen); + var->set_value(value, valueLen); + return var; +} + +void fromEnvironmentVariable(EnvironmentVariablePtr env, + char** key, + int* keyLen, + char** value, + int* valueLen) +{ + std::string* k = env->mutable_name(); + std::string* v = env->mutable_value(); + *key = (char*) k->data(); + *keyLen = k->size(); + *value = (char*) v->data(); + *valueLen = v->size(); +}; + +void destroyEnvironmentVariable(EnvironmentVariablePtr env) +{ + delete env; +} diff --git a/ext/types/executor_id.cpp b/ext/types/executor_id.cpp new file mode 100644 --- /dev/null +++ b/ext/types/executor_id.cpp @@ -0,0 +1,22 @@ +#include +#include "types.h" + +using namespace mesos; + +ExecutorIDPtr toExecutorID(char* bs, int len) +{ + ExecutorIDPtr val = new ExecutorID(); + val->set_value(bs, len); + return val; +} + +int fromExecutorID(ExecutorIDPtr p, char** poke) +{ + *poke = (char*) p->mutable_value()->data(); + return p->mutable_value()->size(); +} + +void destroyExecutorID(ExecutorIDPtr p) +{ + delete p; +} diff --git a/ext/types/executor_info.cpp b/ext/types/executor_info.cpp new file mode 100644 --- /dev/null +++ b/ext/types/executor_info.cpp @@ -0,0 +1,92 @@ +#include +#include "types.h" + +using namespace mesos; + +ExecutorInfoPtr toExecutorInfo(ExecutorIDPtr executorID, + FrameworkIDPtr frameworkID, + CommandInfoPtr commandInfo, + ContainerInfoPtr containerInfo, + ResourcePtr* resources, + int resourceLen, + char* name, + int nameLen, + char* source, + int sourceLen, + char* data, + int dataLen) +{ + ExecutorInfoPtr info = new ExecutorInfo(); + *info->mutable_executor_id() = *executorID; + *info->mutable_framework_id() = *frameworkID; + *info->mutable_command() = *commandInfo; + if (containerInfo != NULL) + *info->mutable_container() = *containerInfo; + + for (int i = 0; i < resourceLen; ++i) + *info->add_resources() = *resources[i]; + + if (name != NULL) + info->set_name(name, nameLen); + + if (source != NULL) + info->set_source(source, sourceLen); + + if (data != NULL) + info->set_data(data, dataLen); + + return info; +} + +void fromExecutorInfo(ExecutorInfoPtr info, + ExecutorIDPtr* executorID, + FrameworkIDPtr* frameworkID, + CommandInfoPtr* commandInfo, + ContainerInfoPtr* containerInfo, + ResourcePtr** resources, + int* resourcesLen, + char** name, + int* nameLen, + char** source, + int* sourceLen, + char** data, + int* dataLen) +{ + *executorID = info->mutable_executor_id(); + + *frameworkID = info->mutable_framework_id(); + + *commandInfo = info->mutable_command(); + + *resources = info->mutable_resources()->mutable_data(); + *resourcesLen = info->resources_size(); + + if (info->has_container()) + *containerInfo = info->mutable_container(); + + if (info->has_name()) + { + std::string* n = info->mutable_name(); + *name = (char*) n->data(); + *nameLen = n->size(); + } + + if (info->has_source()) + { + std::string* s = info->mutable_source(); + *source = (char*) s->data(); + *sourceLen = s->size(); + } + + if (info->has_data()) + { + std::string* d = info->mutable_data(); + *data = (char*) d->data(); + *dataLen = d->size(); + } +} + +void destroyExecutorInfo(ExecutorInfoPtr info) +{ + delete info; +} diff --git a/ext/types/filters.cpp b/ext/types/filters.cpp new file mode 100644 --- /dev/null +++ b/ext/types/filters.cpp @@ -0,0 +1,29 @@ +#include +#include "types.h" + +using namespace mesos; + +FiltersPtr toFilters(double* refuseSeconds) +{ + FiltersPtr filters = new Filters(); + if (refuseSeconds != NULL) + filters->set_refuse_seconds(*refuseSeconds); + return filters; +} + +void fromFilters(FiltersPtr filters, + bool* refusalSet, + double* refuseSeconds) +{ + *refusalSet = false; + if (filters->has_refuse_seconds()) + { + *refusalSet = true; + *refuseSeconds = filters->refuse_seconds(); + } +} + +void destroyFilters(FiltersPtr filters) +{ + delete filters; +} diff --git a/ext/types/framework_id.cpp b/ext/types/framework_id.cpp new file mode 100644 --- /dev/null +++ b/ext/types/framework_id.cpp @@ -0,0 +1,22 @@ +#include +#include "types.h" + +using namespace mesos; + +FrameworkIDPtr toFrameworkID(char* bs, int len) +{ + FrameworkIDPtr val = new FrameworkID(); + val->set_value(bs, len); + return val; +} + +int fromFrameworkID(FrameworkIDPtr p, char** poke) +{ + *poke = (char*) p->mutable_value()->data(); + return p->mutable_value()->size(); +} + +void destroyFrameworkID(FrameworkIDPtr p) +{ + delete p; +} diff --git a/ext/types/framework_info.cpp b/ext/types/framework_info.cpp new file mode 100644 --- /dev/null +++ b/ext/types/framework_info.cpp @@ -0,0 +1,113 @@ +#include +#include "types.h" + +using namespace mesos; + +FrameworkInfoPtr toFrameworkInfo(char* user, + int userLen, + char* name, + int nameLen, + FrameworkIDPtr* frameworkID, + double* failoverTimeout, + bool* checkpoint, + char* role, + int roleLen, + char* hostname, + int hostLen, + char* principal, + int principalLen) +// char* hostname, +// int hostLen) +{ + FrameworkInfoPtr info = new FrameworkInfo(); + info->set_user(user, userLen); + info->set_name(name, nameLen); + if (frameworkID != NULL) + info->mutable_id()->MergeFrom(**frameworkID); + if (failoverTimeout != NULL) + info->set_failover_timeout(*failoverTimeout); + if (checkpoint != NULL) + { + info->set_checkpoint(*checkpoint); + } + if (role != NULL) + info->set_role(role, roleLen); + + if (hostname != NULL) + info->set_hostname(hostname, hostLen); + + if (principal != NULL) + info->set_principal(principal, principalLen); + + return info; +} + +void fromFrameworkInfo(FrameworkInfoPtr info, + char** user, + int* userLen, + char** name, + int* nameLen, + FrameworkIDPtr* frameworkID, + bool* failoverSet, + double* failoverTimeout, + bool* checkpointSet, + bool* checkpoint, + char** role, + int* roleLen, + char** hostname, + int* hostLen, + char** principal, + int* principalLen) +{ + *failoverSet = false; + *checkpointSet = false; + + std::string* u = info->mutable_user(); + *user = (char*) u->data(); + *userLen = u->size(); + std::string* n = info->mutable_name(); + *name = (char*) n->data(); + *nameLen = n->size(); + + if (info->has_failover_timeout()) + { + double timeout = info->failover_timeout(); + *failoverTimeout = timeout; + *failoverSet = true; + } + if (info->has_checkpoint()) + { + bool cp = info->checkpoint(); + *checkpoint = cp; + *checkpointSet = true; + } + if (info->has_id()) + { + *frameworkID = info->mutable_id(); + } + if (info->has_role()) + { + std::string* r = info->mutable_role(); + *role = (char*) r->data(); + *roleLen = r->size(); + } + + if (info->has_hostname()) + { + std::string* h = info->mutable_hostname(); + *hostname = (char*) h->data(); + *hostLen = h->size(); + } + + if (info->has_principal()) + { + std::string* p = info->mutable_principal(); + *principal = (char*) p->data(); + *principalLen = p->size(); + } +} + +void destroyFrameworkInfo(FrameworkInfoPtr info) +{ + delete info; +} diff --git a/ext/types/health_check.cpp b/ext/types/health_check.cpp new file mode 100644 --- /dev/null +++ b/ext/types/health_check.cpp @@ -0,0 +1,137 @@ +#include +#include "types.h" + +using namespace mesos; + +HealthCheckPtr toHealthCheck (bool hasHTTP, + int port, + char* httpPath, + int httpPathSize, + unsigned int* statuses, + int statusesSize, + double* delaySeconds, + double* intervalSeconds, + double* timeoutSeconds, + unsigned int* consecutiveFailures, + double* gracePeriodSeconds, + CommandInfoPtr command) +{ + HealthCheckPtr hc = new HealthCheck; + if (hasHTTP) + { + HealthCheck_HTTP http; + + http.set_port(port); + + for (int i = 0; i < statusesSize; ++i) + { + http.add_statuses(statuses[i]); + } + + if (httpPath != NULL) + http.set_path(httpPath, httpPathSize); + + *hc->mutable_http() = http; + } + + if (delaySeconds != NULL) + hc->set_delay_seconds(*delaySeconds); + + if (intervalSeconds != NULL) + hc->set_interval_seconds(*intervalSeconds); + + if (timeoutSeconds != NULL) + hc->set_timeout_seconds(*timeoutSeconds); + + if (consecutiveFailures != NULL) + hc->set_consecutive_failures(*consecutiveFailures); + + if (gracePeriodSeconds != NULL) + hc->set_grace_period_seconds(*gracePeriodSeconds); + + if (command != NULL) + *hc->mutable_command() = *command; + + return hc; +} + +void fromHealthCheck (HealthCheckPtr p, + bool* hasHTTP, + int* port, + char** httpPath, + int* httpPathSize, + unsigned int** statuses, + int* statusesSize, + double* delaySeconds, + bool* delaySecondsSet, + double* intervalSeconds, + bool* intervalSecondsSet, + double* timeoutSeconds, + bool* timeoutSecondsSet, + unsigned int* consecutiveFailures, + bool* consecutiveFailuresSet, + double* gracePeriodSeconds, + bool* gracePeriodSecondsSet, + CommandInfoPtr* command) +{ + *hasHTTP = false; + *httpPath = NULL; + *delaySecondsSet = false; + *intervalSecondsSet = false; + *timeoutSecondsSet = false; + *consecutiveFailuresSet = false; + *gracePeriodSecondsSet = false; + + if (p->has_http()) + { + *hasHTTP = true; + *port = p->mutable_http()->port(); + + if (p->mutable_http()->has_path()) + { + *httpPath = (char*) p->mutable_http()->mutable_path()->data(); + *httpPathSize = p->mutable_http()->mutable_path()->size(); + } + + *statuses = p->mutable_http()->mutable_statuses()->mutable_data(); + *statusesSize = p->mutable_http()->mutable_statuses()->size(); + } + + if (p->has_delay_seconds()) + { + *delaySecondsSet = true; + *delaySeconds = p->delay_seconds(); + } + + if (p->has_interval_seconds()) + { + *intervalSecondsSet = true; + *intervalSeconds = p->interval_seconds(); + } + + if (p->has_timeout_seconds()) + { + *timeoutSecondsSet = true; + *timeoutSeconds = p->timeout_seconds(); + } + + if (p->has_consecutive_failures()) + { + *consecutiveFailuresSet = true; + *consecutiveFailures = p->consecutive_failures(); + } + + if (p->has_grace_period_seconds()) + { + *gracePeriodSecondsSet = true; + *gracePeriodSeconds = p->grace_period_seconds(); + } + + if (p->has_command()) + *command = p->mutable_command(); +} + +void destroyHealthCheck (HealthCheckPtr p) +{ + delete p; +} diff --git a/ext/types/master_info.cpp b/ext/types/master_info.cpp new file mode 100644 --- /dev/null +++ b/ext/types/master_info.cpp @@ -0,0 +1,64 @@ +#include +#include "types.h" + +using namespace mesos; + +MasterInfoPtr toMasterInfo(char* infoID, + int infoIDLen, + unsigned int infoIP, + unsigned int* infoPort, + char* pid, + int pidLen, + char* hostname, + int hostnameLen) +{ + MasterInfoPtr masterInfo = new MasterInfo(); + masterInfo->set_id(infoID, infoIDLen); + masterInfo->set_ip(infoIP); + if (infoPort != NULL) + masterInfo->set_port(*infoPort); + + if (pid != NULL) + masterInfo->set_pid(pid, pidLen); + + if (hostname != NULL) + masterInfo->set_hostname(hostname, hostnameLen); + + return masterInfo; +} + +void fromMasterInfo(MasterInfoPtr info, + char** infoID, + int* infoIDLen, + unsigned int* infoIP, + unsigned int* infoPort, + char** pid, + int* pidLen, + char** hostname, + int* hostnameLen) +{ + std::string* i = info->mutable_id(); + *infoID = (char*) i->data(); + *infoIDLen = i->size(); + *infoIP = info->ip(); + *infoPort = info->port(); + + if (info->has_pid()) + { + std::string* p = info->mutable_pid(); + *pid = (char*) p->data(); + *pidLen = p->size(); + } + + if (info->has_hostname()) + { + std::string* h = info->mutable_hostname(); + *hostname = (char*) h->data(); + *hostnameLen = h->size(); + } +} + +void destroyMasterInfo(MasterInfoPtr info) +{ + delete info; +} diff --git a/ext/types/offer.cpp b/ext/types/offer.cpp new file mode 100644 --- /dev/null +++ b/ext/types/offer.cpp @@ -0,0 +1,79 @@ +#include +#include "types.h" + +using namespace mesos; + +OfferPtr toOffer(OfferIDPtr offerID, + FrameworkIDPtr frameworkID, + SlaveIDPtr slaveID, + char* hostname, + int hostnameLen, + ResourcePtr* resources, + int resourcesLen, + AttributePtr* attributes, + int attributesLen, + ExecutorIDPtr* executorIDs, + int idsLen) +{ + OfferPtr offer = new Offer(); + + *offer->mutable_id() = *offerID; + + *offer->mutable_framework_id() = *frameworkID; + + *offer->mutable_slave_id() = *slaveID; + + offer->set_hostname(hostname, hostnameLen); + + for (int i = 0; i < resourcesLen; ++i) + *offer->add_resources() = *resources[i]; + + for (int i = 0; i < attributesLen; ++i) + *offer->add_attributes() = *attributes[i]; + + for (int i = 0; i < idsLen; ++i) + *offer->add_executor_ids() = *executorIDs[i]; + + return offer; +} + +void fromOffer(OfferPtr offer, + OfferIDPtr* offerID, + FrameworkIDPtr* frameworkID, + SlaveIDPtr* slaveID, + char** hostname, + int* hostnameLen, + ResourcePtr** resources, + int* resourcesLen, + AttributePtr** attributes, + int* attributesLen, + ExecutorIDPtr** executorIDs, + int* idsLen) +{ + *offerID = offer->mutable_id(); + + *frameworkID = offer->mutable_framework_id(); + + *slaveID = offer->mutable_slave_id(); + + *hostname = (char*) offer->mutable_hostname()->data(); + + *hostnameLen = offer->mutable_hostname()->size(); + + *resources = offer->mutable_resources()->mutable_data(); + + *resourcesLen = offer->resources_size(); + + *attributes = offer->mutable_attributes()->mutable_data(); + + *attributesLen = offer->attributes_size(); + + *executorIDs = offer->mutable_executor_ids()->mutable_data(); + + *idsLen = offer->executor_ids_size(); +} + +void destroyOffer(OfferPtr offer) +{ + delete offer; +} diff --git a/ext/types/offer_id.cpp b/ext/types/offer_id.cpp new file mode 100644 --- /dev/null +++ b/ext/types/offer_id.cpp @@ -0,0 +1,22 @@ +#include +#include "types.h" + +using namespace mesos; + +OfferIDPtr toOfferID(char* bs, int len) +{ + OfferIDPtr val = new OfferID(); + val->set_value(bs, len); + return val; +} + +int fromOfferID(OfferIDPtr p, char** poke) +{ + *poke = (char*) p->mutable_value()->data(); + return p->value().size(); +} + +void destroyOfferID(OfferIDPtr p) +{ + delete p; +} diff --git a/ext/types/parameter.cpp b/ext/types/parameter.cpp new file mode 100644 --- /dev/null +++ b/ext/types/parameter.cpp @@ -0,0 +1,34 @@ +#include +#include "types.h" + +using namespace mesos; + +ParameterPtr toParameter(char* keyP, + int keyLen, + char* valP, + int valLen) +{ + ParameterPtr parameter = new Parameter(); + parameter->set_key(keyP, keyLen); + parameter->set_value(valP, valLen); + return parameter; +} + +void fromParameter(ParameterPtr parameter, + char** keyP, + int* keyLenP, + char** valueP, + int* valueLenP) +{ + std::string* k = parameter->mutable_key(); + std::string* v = parameter->mutable_value(); + *keyP = (char*) k->data(); + *keyLenP = k->size(); + *valueP = (char*) v->data(); + *valueLenP = v->size(); +} + +void destroyParameter(ParameterPtr parameter) +{ + delete parameter; +} diff --git a/ext/types/parameters.cpp b/ext/types/parameters.cpp new file mode 100644 --- /dev/null +++ b/ext/types/parameters.cpp @@ -0,0 +1,26 @@ +#include +#include "types.h" + +using namespace mesos; + +ParametersPtr toParameters(ParameterPtr* parameters, + int pLen) +{ + ParametersPtr params = new Parameters(); + for (int i = 0; i < pLen; ++i) + *params->add_parameter() = *parameters[i]; + return params; +} + +void fromParameters(ParametersPtr params, + ParameterPtr** parameters, + int* pLen) +{ + *parameters = params->mutable_parameter()->mutable_data(); + *pLen = params->parameter_size(); +} + +void destroyParameters(ParametersPtr params) +{ + delete params; +} diff --git a/ext/types/performance_statistics.cpp b/ext/types/performance_statistics.cpp new file mode 100644 --- /dev/null +++ b/ext/types/performance_statistics.cpp @@ -0,0 +1,744 @@ +#include +#include "types.h" + +using namespace mesos; + +PerfStatisticsPtr toPerfStatistics( + double timestamp, + double duration, + unsigned long* cycles, + unsigned long* stalledCyclesFrontend, + unsigned long* stalledCyclesBackend, + unsigned long* instructions, + unsigned long* cacheReferences, + unsigned long* cacheMisses, + unsigned long* branches, + unsigned long* branchMisses, + unsigned long* busCycles, + unsigned long* refCycles, + double* cpuClock, + double* taskClock, + unsigned long* pageFaults, + unsigned long* minorFaults, + unsigned long* majorFaults, + unsigned long* contextSwitches, + unsigned long* cpuMigrations, + unsigned long* alignmentFaults, + unsigned long* emulationFaults, + unsigned long* l1DcacheLoads, + unsigned long* l1DcacheLoadMisses, + unsigned long* l1DcacheStores, + unsigned long* l1DcacheStoreMisses, + unsigned long* l1DcachePrefetches, + unsigned long* l1DcachePrefetchMisses, + unsigned long* l1IcacheLoads, + unsigned long* l1IcacheLoadMisses, + unsigned long* l1IcachePrefetches, + unsigned long* l1IcachePrefetchMisses, + unsigned long* llcLoads, + unsigned long* llcLoadMisses, + unsigned long* llcStores, + unsigned long* llcStoreMisses, + unsigned long* llcPrefetches, + unsigned long* llcPrefetchMisses, + unsigned long* dtlbLoads, + unsigned long* dtlbLoadMisses, + unsigned long* dtlbStores, + unsigned long* dtlbStoreMisses, + unsigned long* dtlbPrefetches, + unsigned long* dtlbPrefetchMisses, + unsigned long* itlbLoads, + unsigned long* itlbLoadMisses, + unsigned long* branchLoads, + unsigned long* branchLoadMisses, + unsigned long* nodeLoads, + unsigned long* nodeLoadMisses, + unsigned long* nodeStores, + unsigned long* nodeStoreMisses, + unsigned long* nodePrefetches, + unsigned long* nodePrefetchMisses + ) +{ + PerfStatisticsPtr perf = new PerfStatistics(); + + perf->set_timestamp(timestamp); + perf->set_duration(duration); + + if (cycles != NULL) + { + perf->set_cycles(*cycles); + } + + if (stalledCyclesFrontend != NULL) + { + perf->set_stalled_cycles_frontend(*stalledCyclesFrontend); + } + + if (stalledCyclesBackend != NULL) + { + perf->set_stalled_cycles_backend(*stalledCyclesBackend); + } + + if (instructions != NULL) + { + perf->set_instructions(*instructions); + } + + if (cacheReferences != NULL) + { + perf->set_cache_references(*cacheReferences); + } + + if (cacheMisses != NULL) + { + perf->set_cache_misses(*cacheMisses); + } + + if (branches != NULL) + { + perf->set_branches(*branches); + } + + if (branchMisses != NULL) + { + perf->set_branch_misses(*branchMisses); + } + + if (busCycles != NULL) + { + perf->set_bus_cycles(*busCycles); + } + + if (refCycles != NULL) + { + perf->set_ref_cycles(*refCycles); + } + + if (cpuClock != NULL) + { + perf->set_cpu_clock(*cpuClock); + } + + if (taskClock != NULL) + { + perf->set_task_clock(*taskClock); + } + + if (pageFaults != NULL) + { + perf->set_page_faults(*pageFaults); + } + + if (minorFaults != NULL) + { + perf->set_minor_faults(*minorFaults); + } + + if (majorFaults != NULL) + { + perf->set_major_faults(*majorFaults); + } + + if (contextSwitches != NULL) + { + perf->set_context_switches(*contextSwitches); + } + + if (cpuMigrations != NULL) + { + perf->set_cpu_migrations(*cpuMigrations); + } + + if (alignmentFaults != NULL) + { + perf->set_alignment_faults(*alignmentFaults); + } + + if (emulationFaults != NULL) + { + perf->set_emulation_faults(*emulationFaults); + } + + if (l1DcacheLoads != NULL) + { + perf->set_l1_dcache_loads(*l1DcacheLoads); + } + + if (l1DcacheLoadMisses != NULL) + { + perf->set_l1_dcache_load_misses(*l1DcacheLoadMisses); + } + + if (l1DcacheStores != NULL) + { + perf->set_l1_dcache_stores(*l1DcacheStores); + } + + if (l1DcacheStoreMisses != NULL) + { + perf->set_l1_dcache_store_misses(*l1DcacheStoreMisses); + } + + if (l1DcachePrefetches != NULL) + { + perf->set_l1_dcache_prefetches(*l1DcachePrefetches); + } + + if (l1DcachePrefetchMisses != NULL) + { + perf->set_l1_dcache_prefetch_misses(*l1DcachePrefetchMisses); + } + + if (l1IcacheLoads != NULL) + { + perf->set_l1_icache_loads(*l1IcacheLoads); + } + + if (l1IcacheLoadMisses != NULL) + { + perf->set_l1_icache_load_misses(*l1IcacheLoadMisses); + } + + if (l1IcachePrefetches != NULL) + { + perf->set_l1_icache_prefetches(*l1IcachePrefetches); + } + + if (l1IcachePrefetchMisses != NULL) + { + perf->set_l1_icache_prefetch_misses(*l1IcachePrefetchMisses); + } + + if (llcLoads != NULL) + { + perf->set_llc_loads(*llcLoads); + } + + if (llcLoadMisses != NULL) + { + perf->set_llc_load_misses(*llcLoadMisses); + } + + if (llcStores != NULL) + { + perf->set_llc_stores(*llcStores); + } + + if (llcStoreMisses != NULL) + { + perf->set_llc_store_misses(*llcStoreMisses); + } + + if (llcPrefetches != NULL) + { + perf->set_llc_prefetches(*llcPrefetches); + } + + if (llcPrefetchMisses != NULL) + { + perf->set_llc_prefetch_misses(*llcPrefetchMisses); + } + + if (dtlbLoads != NULL) + { + perf->set_dtlb_loads(*dtlbLoads); + } + + if (dtlbLoadMisses != NULL) + { + perf->set_dtlb_load_misses(*dtlbLoadMisses); + } + + if (dtlbStores != NULL) + { + perf->set_dtlb_stores(*dtlbStores); + } + + if (dtlbStoreMisses != NULL) + { + perf->set_dtlb_store_misses(*dtlbStoreMisses); + } + + if (dtlbPrefetches != NULL) + { + perf->set_dtlb_prefetches(*dtlbPrefetches); + } + + if (dtlbPrefetchMisses != NULL) + { + perf->set_dtlb_prefetch_misses(*dtlbPrefetchMisses); + } + + if (itlbLoads != NULL) + { + perf->set_itlb_loads(*itlbLoads); + } + + if (itlbLoadMisses != NULL) + { + perf->set_itlb_load_misses(*itlbLoadMisses); + } + + if (branchLoads != NULL) + { + perf->set_branch_loads(*branchLoads); + } + + if (branchLoadMisses != NULL) + { + perf->set_branch_load_misses(*branchLoadMisses); + } + + if (nodeLoads != NULL) + { + perf->set_node_loads(*nodeLoads); + } + + if (nodeLoadMisses != NULL) + { + perf->set_node_load_misses(*nodeLoadMisses); + } + + if (nodeStores != NULL) + { + perf->set_node_stores(*nodeStores); + } + + if (nodeStoreMisses != NULL) + { + perf->set_node_store_misses(*nodeStoreMisses); + } + + if (nodePrefetches != NULL) + { + perf->set_node_prefetches(*nodePrefetches); + } + + if (nodePrefetchMisses != NULL) + { + perf->set_node_prefetch_misses(*nodePrefetchMisses); + } + + return perf; +} + +void fromPerfStatistics(PerfStatisticsPtr perf, + double* timestamp, + double* duration, + unsigned long* cycles, + bool* cyclesSet, + unsigned long* stalledCyclesFrontend, + bool* stalledCyclesFrontendSet, + unsigned long* stalledCyclesBackend, + bool* stalledCyclesBackendSet, + unsigned long* instructions, + bool* instructionsSet, + unsigned long* cacheReferences, + bool* cacheReferencesSet, + unsigned long* cacheMisses, + bool* cacheMissesSet, + unsigned long* branches, + bool* branchesSet, + unsigned long* branchMisses, + bool* branchMissesSet, + unsigned long* busCycles, + bool* busCyclesSet, + unsigned long* refCycles, + bool* refCyclesSet, + double* cpuClock, + bool* cpuClockSet, + double* taskClock, + bool* taskClockSet, + unsigned long* pageFaults, + bool* pageFaultsSet, + unsigned long* minorFaults, + bool* minorFaultsSet, + unsigned long* majorFaults, + bool* majorFaultsSet, + unsigned long* contextSwitches, + bool* contextSwitchesSet, + unsigned long* cpuMigrations, + bool* cpuMigrationsSet, + unsigned long* alignmentFaults, + bool* alignmentFaultsSet, + unsigned long* emulationFaults, + bool* emulationFaultsSet, + unsigned long* l1DcacheLoads, + bool* l1DcacheLoadsSet, + unsigned long* l1DcacheLoadMisses, + bool* l1DcacheLoadMissesSet, + unsigned long* l1DcacheStores, + bool* l1DcacheStoresSet, + unsigned long* l1DcacheStoreMisses, + bool* l1DcacheStoreMissesSet, + unsigned long* l1DcachePrefetches, + bool* l1DcachePrefetchesSet, + unsigned long* l1DcachePrefetchMisses, + bool* l1DcachePrefetchMissesSet, + unsigned long* l1IcacheLoads, + bool* l1IcacheLoadsSet, + unsigned long* l1IcacheLoadMisses, + bool* l1IcacheLoadMissesSet, + unsigned long* l1IcachePrefetches, + bool* l1IcachePrefetchesSet, + unsigned long* l1IcachePrefetchMisses, + bool* l1IcachePrefetchMissesSet, + unsigned long* llcLoads, + bool* llcLoadsSet, + unsigned long* llcLoadMisses, + bool* llcLoadMissesSet, + unsigned long* llcStores, + bool* llcStoresSet, + unsigned long* llcStoreMisses, + bool* llcStoreMissesSet, + unsigned long* llcPrefetches, + bool* llcPrefetchesSet, + unsigned long* llcPrefetchMisses, + bool* llcPrefetchMissesSet, + unsigned long* dtlbLoads, + bool* dtlbLoadsSet, + unsigned long* dtlbLoadMisses, + bool* dtlbLoadMissesSet, + unsigned long* dtlbStores, + bool* dtlbStoresSet, + unsigned long* dtlbStoreMisses, + bool* dtlbStoreMissesSet, + unsigned long* dtlbPrefetches, + bool* dtlbPrefetchesSet, + unsigned long* dtlbPrefetchMisses, + bool* dtlbPrefetchMissesSet, + unsigned long* itlbLoads, + bool* itlbLoadsSet, + unsigned long* itlbLoadMisses, + bool* itlbLoadMissesSet, + unsigned long* branchLoads, + bool* branchLoadsSet, + unsigned long* branchLoadMisses, + bool* branchLoadMissesSet, + unsigned long* nodeLoads, + bool* nodeLoadsSet, + unsigned long* nodeLoadMisses, + bool* nodeLoadMissesSet, + unsigned long* nodeStores, + bool* nodeStoresSet, + unsigned long* nodeStoreMisses, + bool* nodeStoreMissesSet, + unsigned long* nodePrefetches, + bool* nodePrefetchesSet, + unsigned long* nodePrefetchMisses, + bool* nodePrefetchMissesSet) +{ + *timestamp = perf->timestamp(); + *duration = perf->duration(); + + if (perf->has_cycles()) + { + *cyclesSet = true; + *cycles = perf->cycles(); + } + + if (perf->has_stalled_cycles_frontend()) + { + *stalledCyclesFrontendSet = true; + *stalledCyclesFrontend = perf->stalled_cycles_frontend(); + } + + if (perf->has_stalled_cycles_backend()) + { + *stalledCyclesBackendSet = true; + *stalledCyclesBackend = perf->stalled_cycles_backend(); + } + + if (perf->has_instructions()) + { + *instructionsSet = true; + *instructions = perf->instructions(); + } + + if (perf->has_cache_references()) + { + *cacheReferencesSet = true; + *cacheReferences = perf->cache_references(); + } + + if (perf->has_cache_misses()) + { + *cacheMissesSet = true; + *cacheMisses = perf->cache_misses(); + } + + if (perf->has_branches()) + { + *branchesSet = true; + *branches = perf->branches(); + } + + if (perf->has_branch_misses()) + { + *branchMissesSet = true; + *branchMisses = perf->branch_misses(); + } + + if (perf->has_bus_cycles()) + { + *busCyclesSet = true; + *busCycles = perf->bus_cycles(); + } + + if (perf->has_ref_cycles()) + { + *refCyclesSet = true; + *refCycles = perf->ref_cycles(); + } + + if (perf->has_cpu_clock()) + { + *cpuClockSet = true; + *cpuClock = perf->cpu_clock(); + } + + if (perf->has_task_clock()) + { + *taskClockSet = true; + *taskClock = perf->task_clock(); + } + + if (perf->has_page_faults()) + { + *pageFaultsSet = true; + *pageFaults = perf->page_faults(); + } + + if (perf->has_minor_faults()) + { + *minorFaultsSet = true; + *minorFaults = perf->minor_faults(); + } + + if (perf->has_major_faults()) + { + *majorFaultsSet = true; + *majorFaults = perf->major_faults(); + } + + if (perf->has_context_switches()) + { + *contextSwitchesSet = true; + *contextSwitches = perf->context_switches(); + } + + if (perf->has_cpu_migrations()) + { + *cpuMigrationsSet = true; + *cpuMigrations = perf->cpu_migrations(); + } + + if (perf->has_alignment_faults()) + { + *alignmentFaultsSet = true; + *alignmentFaults = perf->alignment_faults(); + } + + if (perf->has_emulation_faults()) + { + *emulationFaultsSet = true; + *emulationFaults = perf->emulation_faults(); + } + + if (perf->has_l1_dcache_loads()) + { + *l1DcacheLoadsSet = true; + *l1DcacheLoads = perf->l1_dcache_loads(); + } + + if (perf->has_l1_dcache_load_misses()) + { + *l1DcacheLoadMissesSet = true; + *l1DcacheLoadMisses = perf->l1_dcache_load_misses(); + } + + if (perf->has_l1_dcache_stores()) + { + *l1DcacheStoresSet = true; + *l1DcacheStores = perf->l1_dcache_stores(); + } + + if (perf->has_l1_dcache_store_misses()) + { + *l1DcacheStoreMissesSet = true; + *l1DcacheStoreMisses = perf->l1_dcache_store_misses(); + } + + if (perf->has_l1_dcache_prefetches()) + { + *l1DcachePrefetchesSet = true; + *l1DcachePrefetches = perf->l1_dcache_prefetches(); + } + + if (perf->has_l1_dcache_prefetch_misses()) + { + *l1DcachePrefetchMissesSet = true; + *l1DcachePrefetchMisses = perf->l1_dcache_prefetch_misses(); + } + + if (perf->has_l1_icache_loads()) + { + *l1IcacheLoadsSet = true; + *l1IcacheLoads = perf->l1_icache_loads(); + } + + if (perf->has_l1_icache_load_misses()) + { + *l1IcacheLoadMissesSet = true; + *l1IcacheLoadMisses = perf->l1_icache_load_misses(); + } + + if (perf->has_l1_icache_prefetches()) + { + *l1IcachePrefetchesSet = true; + *l1IcachePrefetches = perf->l1_icache_prefetches(); + } + + if (perf->has_l1_icache_prefetch_misses()) + { + *l1IcachePrefetchMissesSet = true; + *l1IcachePrefetchMisses = perf->l1_icache_prefetch_misses(); + } + + if (perf->has_llc_loads()) + { + *llcLoadsSet = true; + *llcLoads = perf->llc_loads(); + } + + if (perf->has_llc_load_misses()) + { + *llcLoadMissesSet = true; + *llcLoadMisses = perf->llc_load_misses(); + } + + if (perf->has_llc_stores()) + { + *llcStoresSet = true; + *llcStores = perf->llc_stores(); + } + + if (perf->has_llc_store_misses()) + { + *llcStoreMissesSet = true; + *llcStoreMisses = perf->llc_store_misses(); + } + + if (perf->has_llc_prefetches()) + { + *llcPrefetchesSet = true; + *llcPrefetches = perf->llc_prefetches(); + } + + if (perf->has_llc_prefetch_misses()) + { + *llcPrefetchMissesSet = true; + *llcPrefetchMisses = perf->llc_prefetch_misses(); + } + + if (perf->has_dtlb_loads()) + { + *dtlbLoadsSet = true; + *dtlbLoads = perf->dtlb_loads(); + } + + if (perf->has_dtlb_load_misses()) + { + *dtlbLoadMissesSet = true; + *dtlbLoadMisses = perf->dtlb_load_misses(); + } + + if (perf->has_dtlb_stores()) + { + *dtlbStoresSet = true; + *dtlbStores = perf->dtlb_stores(); + } + + if (perf->has_dtlb_store_misses()) + { + *dtlbStoreMissesSet = true; + *dtlbStoreMisses = perf->dtlb_store_misses(); + } + + if (perf->has_dtlb_prefetches()) + { + *dtlbPrefetchesSet = true; + *dtlbPrefetches = perf->dtlb_prefetches(); + } + + if (perf->has_dtlb_prefetch_misses()) + { + *dtlbPrefetchMissesSet = true; + *dtlbPrefetchMisses = perf->dtlb_prefetch_misses(); + } + + if (perf->has_itlb_loads()) + { + *itlbLoadsSet = true; + *itlbLoads = perf->itlb_loads(); + } + + if (perf->has_itlb_load_misses()) + { + *itlbLoadMissesSet = true; + *itlbLoadMisses = perf->itlb_load_misses(); + } + + if (perf->has_branch_loads()) + { + *branchLoadsSet = true; + *branchLoads = perf->branch_loads(); + } + + if (perf->has_branch_load_misses()) + { + *branchLoadMissesSet = true; + *branchLoadMisses = perf->branch_load_misses(); + } + + if (perf->has_node_loads()) + { + *nodeLoadsSet = true; + *nodeLoads = perf->node_loads(); + } + + if (perf->has_node_load_misses()) + { + *nodeLoadMissesSet = true; + *nodeLoadMisses = perf->node_load_misses(); + } + + if (perf->has_node_stores()) + { + *nodeStoresSet = true; + *nodeStores = perf->node_stores(); + } + + if (perf->has_node_store_misses()) + { + *nodeStoreMissesSet = true; + *nodeStoreMisses = perf->node_store_misses(); + } + + if (perf->has_node_prefetches()) + { + *nodePrefetchesSet = true; + *nodePrefetches = perf->node_prefetches(); + } + + if (perf->has_node_prefetch_misses()) + { + *nodePrefetchMissesSet = true; + *nodePrefetchMisses = perf->node_prefetch_misses(); + } +} + +void destroyPerfStatistics(PerfStatisticsPtr perf) +{ + delete perf; +} diff --git a/ext/types/range.cpp b/ext/types/range.cpp new file mode 100644 --- /dev/null +++ b/ext/types/range.cpp @@ -0,0 +1,26 @@ +#include +#include "types.h" + +using namespace mesos; + +ValueRangePtr toRange(unsigned long low, + unsigned long high) +{ + ValueRangePtr range = new Value_Range(); + range->set_begin(low); + range->set_end(high); + return range; +} + +void fromRange(ValueRangePtr range, + unsigned long* lowP, + unsigned long* highP) +{ + *lowP = range->begin(); + *highP = range->end(); +} + +void destroyRange(ValueRangePtr range) +{ + delete range; +} diff --git a/ext/types/request.cpp b/ext/types/request.cpp new file mode 100644 --- /dev/null +++ b/ext/types/request.cpp @@ -0,0 +1,35 @@ +#include +#include "types.h" + +using namespace mesos; + +RequestPtr toRequest(SlaveIDPtr slaveID, + ResourcePtr* resources, + int resourceLen) +{ + RequestPtr request = new Request(); + if (slaveID != NULL) + *request->mutable_slave_id() = *slaveID; + + ::google::protobuf::RepeatedPtrField* rs = request->mutable_resources(); + for (int i = 0; i < resourceLen; ++i) + *rs->Add() = *resources[i]; + return request; +} + +void fromRequest(RequestPtr request, + SlaveIDPtr* slaveID, + ResourcePtr** resources, + int* resourceLen) +{ + if (request->has_slave_id()) + *slaveID = request->mutable_slave_id(); + + *resources = request->mutable_resources()->mutable_data(); + *resourceLen = request->resources_size(); +} + +void destroyRequest(RequestPtr request) +{ + delete request; +} diff --git a/ext/types/resource.cpp b/ext/types/resource.cpp new file mode 100644 --- /dev/null +++ b/ext/types/resource.cpp @@ -0,0 +1,72 @@ +#include +#include "types.h" + +using namespace mesos; + +ResourcePtr toResource(char* name, + int nameLen, + ValuePtr value, + char* role, + int roleLen) +{ + ResourcePtr resource = new Resource(); + resource->set_name(name, nameLen); + resource->set_type(value->type()); + + if (value->has_scalar()) + *(resource->mutable_scalar()) = *value->mutable_scalar(); + + if (value->has_ranges()) + *(resource->mutable_ranges()) = *value->mutable_ranges(); + + if (value->has_set()) + *(resource->mutable_set()) = *value->mutable_set(); + + if (value->has_text()) + *resource->mutable_set()->add_item() = value->mutable_text()->value(); + + if (role != NULL) + resource->set_role(role, roleLen); + + return resource; +} + +void fromResource(ResourcePtr resource, + char** name, + int* nameLen, + ValuePtr* value, + char** role, + int* roleLen) +{ + std::string* n = resource->mutable_name(); + *name = (char*) n->data(); + *nameLen = n->size(); + + Value* v = new Value(); + if (resource->has_scalar()) + { + v->set_type(Value_Type_SCALAR); + *v->mutable_scalar() = resource->scalar(); + } + if (resource->has_ranges()) + { + v->set_type(Value_Type_RANGES); + *v->mutable_ranges() = resource->ranges(); + } + if (resource->has_set()) + { + v->set_type(Value_Type_SET); + *v->mutable_set() = resource->set(); + } + + *value = v; + + std::string* r = resource->mutable_role(); + *role = (char*) r->data(); + *roleLen = r->size(); +} + +void destroyResource(ResourcePtr resource) +{ + delete resource; +} diff --git a/ext/types/resource_statistics.cpp b/ext/types/resource_statistics.cpp new file mode 100644 --- /dev/null +++ b/ext/types/resource_statistics.cpp @@ -0,0 +1,263 @@ +#include +#include "types.h" + +using namespace mesos; + +ResourceStatisticsPtr toResourceStatistics(double timestamp, + double* cpusUserTimeSecs, + double* cpusSystemTimeSecs, + double cpusLimit, + unsigned int* cpusPeriods, + unsigned int* cpusThrottled, + double* cpusThrottledTimeSecs, + unsigned long* memoryResidentSetSize, + unsigned long* memoryLimitBytes, + unsigned long* memoryFileBytes, + unsigned long* memoryAnonymousBytes, + unsigned long* memoryMappedFileBytes, + PerfStatistics* perfStatistics, + unsigned long* netRxPackets, + unsigned long* netRxBytes, + unsigned long* netRxErrors, + unsigned long* netRxDropped, + unsigned long* netTxPackets, + unsigned long* netTxBytes, + unsigned long* netTxErrors, + unsigned long* netTxDropped + ) +{ + ResourceStatisticsPtr stats = new ResourceStatistics(); + stats->set_timestamp(timestamp); + if (cpusUserTimeSecs != NULL) + stats->set_cpus_user_time_secs(*cpusUserTimeSecs); + if (cpusSystemTimeSecs != NULL) + stats->set_cpus_system_time_secs(*cpusSystemTimeSecs); + stats->set_cpus_limit(cpusLimit); + if (cpusPeriods != NULL) + stats->set_cpus_nr_periods(*cpusPeriods); + if (cpusThrottled != NULL) + stats->set_cpus_nr_throttled(*cpusThrottled); + if (cpusThrottledTimeSecs != NULL) + stats->set_cpus_throttled_time_secs(*cpusThrottledTimeSecs); + if (memoryResidentSetSize != NULL) + stats->set_mem_rss_bytes(*memoryResidentSetSize); + if (memoryLimitBytes != NULL) + stats->set_mem_limit_bytes(*memoryLimitBytes); + if (memoryFileBytes != NULL) + stats->set_mem_file_bytes(*memoryFileBytes); + if (memoryAnonymousBytes != NULL) + stats->set_mem_anon_bytes(*memoryAnonymousBytes); + if (memoryMappedFileBytes != NULL) + stats->set_mem_mapped_file_bytes(*memoryMappedFileBytes); + if (perfStatistics != NULL) + *stats->mutable_perf() = *perfStatistics; + + if (netRxPackets != NULL) + stats->set_net_rx_packets(*netRxPackets); + + if (netRxBytes != NULL) + stats->set_net_rx_bytes(*netRxBytes); + + if (netRxErrors != NULL) + stats->set_net_rx_errors(*netRxErrors); + + if (netRxDropped != NULL) + stats->set_net_rx_dropped(*netRxDropped); + + if (netTxPackets != NULL) + stats->set_net_tx_packets(*netTxPackets); + + if (netTxBytes != NULL) + stats->set_net_tx_bytes(*netTxBytes); + + if (netTxErrors != NULL) + stats->set_net_tx_errors(*netTxErrors); + + if (netTxDropped != NULL) + stats->set_net_tx_dropped(*netTxDropped); + + return stats; +} + +void fromResourceStatistics(ResourceStatisticsPtr stats, + double* timestamp, + double* cpusUserTimeSecs, + bool* cpusUserTimeSecsSet, + double* cpusSystemTimeSecs, + bool* cpusSystemTimeSecsSet, + double* cpusLimit, + unsigned int* cpusPeriods, + bool* cpusPeriodsSet, + unsigned int* cpusThrottled, + bool* cpusThrottledSet, + double* cpusThrottledTimeSecs, + bool* cpusThrottledTimeSecsSet, + unsigned long* memoryResidentSetSize, + bool* memoryResidentSetSizeSet, + unsigned long* memoryLimitBytes, + bool* memoryLimitBytesSet, + unsigned long* memoryFileBytes, + bool* memoryFileBytesSet, + unsigned long* memoryAnonymousBytes, + bool* memoryAnonymousBytesSet, + unsigned long* memoryMappedFileBytes, + bool* memoryMappedFileBytesSet, + PerfStatisticsPtr* perfStatistics, + unsigned long* netRxPackets, + bool* netRxPacketsSet, + unsigned long* netRxBytes, + bool* netRxBytesSet, + unsigned long* netRxErrors, + bool* netRxErrorsSet, + unsigned long* netRxDropped, + bool* netRxDroppedSet, + unsigned long* netTxPackets, + bool* netTxPacketsSet, + unsigned long* netTxBytes, + bool* netTxBytesSet, + unsigned long* netTxErrors, + bool* netTxErrorsSet, + unsigned long* netTxDropped, + bool* netTxDroppedSet + ) +{ + *cpusUserTimeSecsSet = false; + *cpusSystemTimeSecsSet = false; + *cpusPeriodsSet = false; + *cpusThrottledSet = false; + *cpusThrottledTimeSecsSet = false; + *memoryResidentSetSizeSet = false; + *memoryLimitBytesSet = false; + *memoryFileBytesSet = false; + *memoryAnonymousBytesSet = false; + *memoryMappedFileBytesSet = false; + *netRxPacketsSet = false; + *netRxBytesSet = false; + *netRxErrorsSet = false; + *netRxDroppedSet = false; + *netTxPacketsSet = false; + *netTxBytesSet = false; + *netTxErrorsSet = false; + *netTxDroppedSet = false; + *perfStatistics = NULL; + + *timestamp = stats->timestamp(); + *cpusLimit = stats->cpus_limit(); + + if (stats->has_cpus_user_time_secs()) + { + *cpusUserTimeSecs = stats->cpus_user_time_secs(); + *cpusUserTimeSecsSet = true; + } + + if (stats->has_cpus_system_time_secs()) + { + *cpusSystemTimeSecs = stats->cpus_system_time_secs(); + *cpusSystemTimeSecsSet = true; + } + + if (stats->has_cpus_nr_periods()) + { + *cpusPeriods = stats->cpus_nr_periods(); + *cpusPeriodsSet = true; + } + + if (stats->has_cpus_nr_throttled()) + { + *cpusThrottled = stats->cpus_nr_throttled(); + *cpusThrottledSet = true; + } + + if (stats->has_cpus_throttled_time_secs()) + { + *cpusThrottledTimeSecs = stats->cpus_throttled_time_secs(); + *cpusThrottledTimeSecsSet = true; + } + + if (stats->has_mem_rss_bytes()) + { + *memoryResidentSetSize = stats->mem_rss_bytes(); + *memoryResidentSetSizeSet = true; + } + + if (stats->has_mem_limit_bytes()) + { + *memoryLimitBytes = stats->mem_limit_bytes(); + *memoryLimitBytesSet = true; + } + + if (stats->has_mem_file_bytes()) + { + *memoryFileBytes = stats->mem_file_bytes(); + *memoryFileBytesSet = true; + } + + if (stats->has_mem_anon_bytes()) + { + *memoryAnonymousBytes = stats->mem_anon_bytes(); + *memoryAnonymousBytesSet = true; + } + + if (stats->has_mem_mapped_file_bytes()) + { + *memoryMappedFileBytes = stats->mem_mapped_file_bytes(); + *memoryMappedFileBytesSet = true; + } + + if (stats->has_perf()) + { + *perfStatistics = stats->mutable_perf(); + } + + if (stats->has_net_rx_packets()) + { + *netRxPackets = stats->net_rx_packets(); + *netRxPacketsSet = true; + } + + if (stats->has_net_rx_bytes()) + { + *netRxBytes = stats->net_rx_bytes(); + *netRxBytesSet = true; + } + if (stats->has_net_rx_errors()) + { + *netRxErrors = stats->net_rx_errors(); + *netRxErrorsSet = true; + } + + if (stats->has_net_rx_dropped()) + { + *netRxDropped = stats->net_rx_dropped(); + *netRxDroppedSet = true; + } + + if (stats->has_net_tx_packets()) + { + *netTxPackets = stats->net_tx_packets(); + *netTxPacketsSet = true; + } + + if (stats->has_net_tx_bytes()) + { + *netTxBytes = stats->net_tx_bytes(); + *netTxBytesSet = true; + } + + if (stats->has_net_tx_errors()) + { + *netTxErrors = stats->net_tx_errors(); + *netTxErrorsSet = true; + } + + if (stats->has_net_tx_dropped()) + { + *netTxDropped = stats->net_tx_dropped(); + *netTxDroppedSet = true; + } +} + +void destroyResourceStatistics(ResourceStatisticsPtr statistics) +{ + delete statistics; +} diff --git a/ext/types/resource_usage.cpp b/ext/types/resource_usage.cpp new file mode 100644 --- /dev/null +++ b/ext/types/resource_usage.cpp @@ -0,0 +1,57 @@ +#include +#include "types.h" + +using namespace mesos; + +ResourceUsagePtr toResourceUsage(SlaveIDPtr slaveID, + FrameworkIDPtr frameworkID, + ExecutorIDPtr executorID, + char* executorName, + int nameLen, + TaskIDPtr taskID, + ResourceStatisticsPtr statistics) +{ + ResourceUsagePtr usage = new ResourceUsage(); + *usage->mutable_slave_id() = *slaveID; + *usage->mutable_framework_id() = *frameworkID; + if (executorID != NULL) + *usage->mutable_executor_id() = *executorID; + if (executorName != NULL) + usage->set_executor_name(executorName, nameLen); + if (taskID != NULL) + *usage->mutable_task_id() = *taskID; + if (statistics != NULL) + *usage->mutable_statistics() = *statistics; + + return usage; +} + +void fromResourceUsage(ResourceUsagePtr usage, + SlaveIDPtr* slaveID, + FrameworkIDPtr* frameworkID, + ExecutorIDPtr* executorID, + char** executorName, + int* nameLen, + TaskIDPtr* taskID, + ResourceStatisticsPtr* statistics) +{ + *slaveID = usage->mutable_slave_id(); + *frameworkID = usage->mutable_framework_id(); + if (usage->has_executor_id()) + *executorID = usage->mutable_executor_id(); + if (usage->has_executor_name()) + { + std::string* n = usage->mutable_executor_name(); + *executorName = (char*) n->data(); + *nameLen = n->size(); + } + if (usage->has_task_id()) + *taskID = usage->mutable_task_id(); + if (usage->has_statistics()) + *statistics = usage->mutable_statistics(); +} + +void destroyResourceUsage(ResourceUsagePtr usage) +{ + delete usage; +} diff --git a/ext/types/slave_id.cpp b/ext/types/slave_id.cpp new file mode 100644 --- /dev/null +++ b/ext/types/slave_id.cpp @@ -0,0 +1,22 @@ +#include +#include "types.h" + +using namespace mesos; + +SlaveIDPtr toSlaveID(char* bs, int len) +{ + SlaveIDPtr val = new SlaveID(); + val->set_value(bs, len); + return val; +} + +int fromSlaveID(SlaveIDPtr p, char** poke) +{ + *poke = (char*) p->mutable_value()->data(); + return p->mutable_value()->size(); +} + +void destroySlaveID(SlaveIDPtr p) +{ + delete p; +} diff --git a/ext/types/slave_info.cpp b/ext/types/slave_info.cpp new file mode 100644 --- /dev/null +++ b/ext/types/slave_info.cpp @@ -0,0 +1,86 @@ +#include +#include "types.h" + +using namespace mesos; + +SlaveInfoPtr toSlaveInfo(char* hostname, + int hostnameLen, + unsigned int* port, + ResourcePtr* resources, + int resourcesLen, + AttributePtr* attributes, + int attributesLen, + SlaveIDPtr slaveID, + bool* checkpoint) +{ + SlaveInfoPtr info = new SlaveInfo(); + info->set_hostname(hostname, hostnameLen); + if (port != NULL) + info->set_port(*port); + if (resourcesLen > 0) + { + ::google::protobuf::RepeatedPtrField* rs = info->mutable_resources(); + for (int i = 0; i < resourcesLen; ++i) + *rs->Add() = *resources[i]; + } + if (attributesLen > 0) + { + ::google::protobuf::RepeatedPtrField* as = info->mutable_attributes(); + for (int i = 0; i < attributesLen; ++i) + *as->Add() = *attributes[i]; + } + if (slaveID != NULL) + *info->mutable_id() = *slaveID; + + if (checkpoint != NULL) + info->set_checkpoint(*checkpoint); + + return info; +} + +void fromSlaveInfo(SlaveInfoPtr slaveInfo, + char** hostname, + int* hostnameLen, + bool* portSet, + unsigned int* port, + ResourcePtr** resources, + int* resourcesLen, + AttributePtr** attributes, + int* attributeLen, + SlaveIDPtr* slaveID, + bool* checkpointSet, + bool* checkpoint) +{ + *portSet = false; + *checkpointSet = false; + + std::string h = slaveInfo->hostname(); + *hostname = (char*) h.data(); + *hostnameLen = h.size(); + + if (slaveInfo->has_port()) + { + *port = slaveInfo->port(); + *portSet = true; + } + + *resourcesLen = slaveInfo->resources_size(); + *resources = slaveInfo->mutable_resources()->mutable_data(); + + *attributeLen = slaveInfo->attributes_size(); + *attributes = slaveInfo->mutable_attributes()->mutable_data(); + + if (slaveInfo->has_id()) + *slaveID = slaveInfo->mutable_id(); + + if (slaveInfo->has_checkpoint()) + { + *checkpoint = slaveInfo->checkpoint(); + *checkpointSet = true; + } +} + +void destroySlaveInfo(SlaveInfoPtr slaveInfo) +{ + delete slaveInfo; +} diff --git a/ext/types/std_string.cpp b/ext/types/std_string.cpp new file mode 100644 --- /dev/null +++ b/ext/types/std_string.cpp @@ -0,0 +1,21 @@ +#include +#include "types.h" + +using namespace mesos; + +StdStringPtr toStdString(char* str, + int strLen) +{ + return new std::string(str, strLen); +} + +void fromStdString(StdStringPtr sp, char** str, int* strLen) +{ + *str = (char*) sp->data(); + *strLen = sp->size(); +} + +void destroyStdString(StdStringPtr sp) +{ + delete sp; +} diff --git a/ext/types/task_id.cpp b/ext/types/task_id.cpp new file mode 100644 --- /dev/null +++ b/ext/types/task_id.cpp @@ -0,0 +1,22 @@ +#include +#include "types.h" + +using namespace mesos; + +TaskIDPtr toTaskID(char* bs, int len) +{ + TaskIDPtr val = new TaskID(); + val->set_value(bs, len); + return val; +} + +int fromTaskID(TaskIDPtr p, char** poke) +{ + *poke = (char*) p->mutable_value()->data(); + return p->mutable_value()->size(); +} + +void destroyTaskID(TaskIDPtr p) +{ + delete p; +} diff --git a/ext/types/task_info.cpp b/ext/types/task_info.cpp new file mode 100644 --- /dev/null +++ b/ext/types/task_info.cpp @@ -0,0 +1,91 @@ +#include +#include "types.h" + +using namespace mesos; + +TaskInfoPtr toTaskInfo(char* infoName, + int infoNameLen, + TaskIDPtr taskID, + SlaveIDPtr slaveID, + ResourcePtr* resources, + int resourcesLen, + ExecutorInfoPtr executorInfo, + CommandInfoPtr commandInfo, + char* data, + int dataLen, + ContainerInfoPtr containerInfo, + HealthCheckPtr healthCheck) +{ + TaskInfoPtr info = new TaskInfo(); + + info->set_name(infoName, infoNameLen); + + *info->mutable_task_id() = *taskID; + + *info->mutable_slave_id() = *slaveID; + + for (int i = 0; i < resourcesLen; ++i) + *info->add_resources() = *resources[i]; + + if (executorInfo != NULL) + info->mutable_executor()->MergeFrom(*executorInfo); + + if (commandInfo != NULL) + info->mutable_command()->MergeFrom(*commandInfo); + + if (data != NULL) + info->set_data(data, dataLen); + + if (containerInfo != NULL) + info->mutable_container()->MergeFrom(*containerInfo); + + if (healthCheck != NULL) + info->mutable_health_check()->MergeFrom(*healthCheck); + + return info; +} + +void fromTaskInfo(TaskInfoPtr taskInfo, + char** infoName, + int* infoNameLen, + TaskIDPtr* taskID, + SlaveIDPtr* slaveID, + ResourcePtr** resources, + int* resourcesLen, + ExecutorInfoPtr* executorInfo, + CommandInfoPtr* commandInfo, + char** data, + int* dataLen, + ContainerInfoPtr* containerInfo, + HealthCheckPtr* healthCheck) +{ + std::string* in = taskInfo->mutable_name(); + *infoName = (char*) in->data(); + *infoNameLen = in->size(); + *taskID = taskInfo->mutable_task_id(); + *slaveID = taskInfo->mutable_slave_id(); + *resources = taskInfo->mutable_resources()->mutable_data(); + *resourcesLen = taskInfo->resources_size(); + if (taskInfo->has_executor()) + *executorInfo = taskInfo->mutable_executor(); + + if (taskInfo->has_command()) + *commandInfo = taskInfo->mutable_command(); + + if (taskInfo->has_data()) + { + *data = (char*) taskInfo->mutable_data()->data(); + *dataLen = taskInfo->mutable_data()->size(); + } + + if (taskInfo->has_container()) + *containerInfo = taskInfo->mutable_container(); + + if (taskInfo->has_health_check()) + *healthCheck = taskInfo->mutable_health_check(); +} + +void destroyTaskInfo(TaskInfoPtr taskInfo) +{ + delete taskInfo; +} diff --git a/ext/types/task_status.cpp b/ext/types/task_status.cpp new file mode 100644 --- /dev/null +++ b/ext/types/task_status.cpp @@ -0,0 +1,99 @@ +#include +#include "types.h" + +using namespace mesos; + +TaskStatusPtr toTaskStatus(TaskIDPtr taskID, + int state, + char* message, + int messageLen, + char* data, + int dataLen, + SlaveIDPtr slaveID, + ExecutorIDPtr executorID, + double* timestamp, + bool* healthCheck) +{ + TaskStatusPtr status = new TaskStatus(); + status->mutable_task_id()->MergeFrom(*taskID); + status->set_state((TaskState) state); + + if (message != NULL) + status->set_message(message, messageLen); + + if (data != NULL) + status->set_data(data, dataLen); + + if (slaveID != NULL) + *status->mutable_slave_id() = *slaveID; + + if (executorID != NULL) + *status->mutable_executor_id() = *executorID; + + if (timestamp != NULL) + status->set_timestamp(*timestamp); + + if (healthCheck != NULL) + status->set_healthy(*healthCheck); + + return status; +} + +void fromTaskStatus(TaskStatusPtr status, + TaskIDPtr* taskID, + int* state, + char** message, + int* messageLen, + char** data, + int* dataLen, + SlaveIDPtr* slaveID, + ExecutorIDPtr* executorID, + bool* timestampSet, + double* timestamp, + bool* healthCheckSet, + bool* healthCheck) +{ + *timestampSet = false; + *healthCheckSet = false; + *slaveID = NULL; + *executorID = NULL; + + *taskID = status->mutable_task_id(); + *state = status->state(); + if (status->has_message()) + { + std::string* m = status->mutable_message(); + *message = (char*) m->data(); + *messageLen = m->size(); + } + + if (status->has_data()) + { + std::string* d = status->mutable_data(); + *data = (char*) d->data(); + *dataLen = d->size(); + } + + if (status->has_slave_id()) + *slaveID = status->mutable_slave_id(); + + if (status->has_executor_id()) + *executorID = status->mutable_executor_id(); + + if (status->has_timestamp()) + { + *timestampSet = true; + *timestamp = status->timestamp(); + } + + if (status->has_healthy()) + { + *healthCheckSet = true; + *healthCheck = status->healthy(); + } +} + +void destroyTaskStatus(TaskStatusPtr taskStatus) +{ + delete taskStatus; +} diff --git a/ext/types/value.cpp b/ext/types/value.cpp new file mode 100644 --- /dev/null +++ b/ext/types/value.cpp @@ -0,0 +1,82 @@ +#include +#include "types.h" + +using namespace mesos; + +ValuePtr toValue(int type, + double scalar, + ValueRangePtr* ranges, + int rangeLen, + StdStringPtr* strings, + int stringsLen, + char* text, + int textLen) +{ + ValuePtr value = new Value(); + value->set_type((Value_Type) type); + if (type == Value_Type_SCALAR) + { + Value_Scalar s; + s.set_value(scalar); + *value->mutable_scalar() = s; + } + else if (type == Value_Type_RANGES) + { + Value_RangesPtr rs = value->mutable_ranges(); + for (int i = 0; i < rangeLen; ++i) + *rs->add_range() = *ranges[i]; + } + else if (type == Value_Type_SET) + { + Value_SetPtr set = value->mutable_set(); + for (int i = 0; i < stringsLen; ++i) + set->add_item(*strings[i]); + } + else if (type == Value_Type_TEXT) + { + Value_Text t; + t.set_value(text, textLen); + *value->mutable_text() = t; + } + + return value; +} + +void fromValue(ValuePtr value, + int* type, + double* scalar, + ValueRangePtr** ranges, + int* rangeLen, + StdStringPtr** strings, + int* stringsLen, + char** text, + int* textLen) +{ + Value_Type t = value->type(); + *type = (int) t; + if (t == Value_Type_SCALAR) + { + *scalar = value->mutable_scalar()->value(); + } + else if (t == Value_Type_RANGES) + { + *rangeLen = value->mutable_ranges()->range_size(); + *ranges = value->mutable_ranges()->mutable_range()->mutable_data(); + } + else if (t == Value_Type_SET) + { + *stringsLen = value->set().item_size(); + *strings = value->mutable_set()->mutable_item()->mutable_data(); + } + else if (t == Value_Type_TEXT) + { + std::string* txt = value->mutable_text()->mutable_value(); + *text = (char*) txt->data(); + *textLen = txt->size(); + } +} + +void destroyValue(ValuePtr value) +{ + delete value; +} diff --git a/ext/types/volume.cpp b/ext/types/volume.cpp new file mode 100644 --- /dev/null +++ b/ext/types/volume.cpp @@ -0,0 +1,47 @@ +#include +#include "types.h" + +using namespace mesos; + +VolumePtr toVolume (char* containerPath, + int containerPathLen, + char* hostPath, + int hostPathLen, + int mode) +{ + VolumePtr p = new Volume; + p->set_mode((Volume_Mode) mode); + p->set_container_path(containerPath, containerPathLen); + if (hostPath != NULL) + { + p->set_host_path(hostPath, hostPathLen); + } + + return p; +} + +void fromVolume (VolumePtr p, + char** containerPath, + int* containerPathLen, + char** hostPath, + int* hostPathLen, + int* mode) +{ + *containerPath = (char*) p->mutable_container_path()->data(); + *containerPathLen = p->mutable_container_path()->size(); + + *hostPath = NULL; + + if (p->has_host_path()) + { + *hostPath = (char*) p->mutable_host_path()->data(); + *hostPathLen = p->mutable_host_path()->size(); + } + + *mode = p->mode(); +} + +void destroyVolume(VolumePtr volume) +{ + delete volume; +} diff --git a/hs-mesos.cabal b/hs-mesos.cabal new file mode 100644 --- /dev/null +++ b/hs-mesos.cabal @@ -0,0 +1,126 @@ +name: hs-mesos +version: 0.20.0.0 + +description: Bindings to the Apache Mesos platform. + . + is a cluster manager that simplifies the complexity of running applications on a shared pool of servers. + . + Note that this package currently requires 'libmesos' to be installed on your development system in order to build. +license: MIT +license-file: LICENSE +author: Ian Duncan +maintainer: ian@iankduncan.com +-- copyright: +category: System +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +library + exposed-modules: System.Mesos.Executor, + System.Mesos.Scheduler, + System.Mesos.Resources, + System.Mesos.Types, + System.Mesos.Internal, + System.Mesos.TaskStatus, + System.Mesos.Raw, + System.Mesos.Raw.Attribute, + System.Mesos.Raw.CommandInfo, + System.Mesos.Raw.CommandUri, + System.Mesos.Raw.ContainerId, + System.Mesos.Raw.ContainerInfo, + System.Mesos.Raw.Credential, + System.Mesos.Raw.Environment, + System.Mesos.Raw.EnvironmentVariable, + System.Mesos.Raw.Executor, + System.Mesos.Raw.ExecutorId, + System.Mesos.Raw.ExecutorInfo, + System.Mesos.Raw.Filters, + System.Mesos.Raw.FrameworkId, + System.Mesos.Raw.FrameworkInfo, + System.Mesos.Raw.HealthCheck, + System.Mesos.Raw.MasterInfo, + System.Mesos.Raw.Offer, + System.Mesos.Raw.OfferId, + System.Mesos.Raw.Parameter, + System.Mesos.Raw.Parameters, + System.Mesos.Raw.PerformanceStatistics, + System.Mesos.Raw.Request, + System.Mesos.Raw.Resource, + System.Mesos.Raw.ResourceStatistics, + System.Mesos.Raw.ResourceUsage, + System.Mesos.Raw.Scheduler, + System.Mesos.Raw.SlaveId, + System.Mesos.Raw.SlaveInfo, + System.Mesos.Raw.StdString, + System.Mesos.Raw.TaskId, + System.Mesos.Raw.TaskInfo, + System.Mesos.Raw.TaskStatus, + System.Mesos.Raw.Value, + System.Mesos.Raw.Volume + -- other-extensions: + build-depends: base >=4.7 && < 5, bytestring, lens, managed + hs-source-dirs: src + default-language: Haskell2010 + include-dirs: ext, /usr/include, /usr/local/include/mesos + c-sources: ext/executor.cpp, + ext/scheduler.cpp, + ext/types/attribute.cpp, + ext/types/command_info.cpp, + ext/types/command_uri.cpp, + ext/types/container_id.cpp, + ext/types/container_info.cpp, + ext/types/credential.cpp, + ext/types/environment.cpp, + ext/types/environment_variable.cpp, + ext/types/executor_id.cpp, + ext/types/executor_info.cpp, + ext/types/filters.cpp, + ext/types/framework_id.cpp, + ext/types/framework_info.cpp, + ext/types/health_check.cpp, + ext/types/master_info.cpp, + ext/types/offer.cpp, + ext/types/offer_id.cpp, + ext/types/parameter.cpp, + ext/types/parameters.cpp, + ext/types/performance_statistics.cpp, + ext/types/range.cpp, + ext/types/request.cpp, + ext/types/resource.cpp, + ext/types/resource_statistics.cpp, + ext/types/resource_usage.cpp, + ext/types/slave_id.cpp, + ext/types/slave_info.cpp, + ext/types/std_string.cpp, + ext/types/task_id.cpp, + ext/types/task_info.cpp, + ext/types/task_status.cpp, + ext/types/value.cpp, + ext/types/volume.cpp + + extra-libraries: mesos stdc++ + extra-lib-dirs: /usr/local/lib + cc-options: -fPIC -std=c++11 + ghc-options: -fPIC + +test-suite test + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + build-depends: base, hs-mesos, QuickCheck, bytestring, lens, managed + default-language: Haskell2010 + +executable test-executor + main-is: TestExecutor.hs + hs-source-dirs: test + build-depends: base, hs-mesos, bytestring + default-language: Haskell2010 + extra-libraries: mesos stdc++ + +executable test-framework + main-is: TestFramework.hs + hs-source-dirs: test + build-depends: base, hs-mesos, bytestring, lens + default-language: Haskell2010 + extra-libraries: mesos stdc++ diff --git a/src/System/Mesos/Executor.hs b/src/System/Mesos/Executor.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Executor.hs @@ -0,0 +1,228 @@ +-- | +-- Module : System.Mesos.Executor +-- Copyright : (c) Ian Duncan 2014 +-- License : MIT +-- +-- Maintainer : ian@iankduncan.com +-- Stability : unstable +-- Portability : non-portable +-- +-- Mesos executor interface and executor driver. An executor is +-- responsible for launching tasks in a framework specific way (i.e., +-- creating new threads, new processes, etc). One or more executors +-- from the same framework may run concurrently on the same +-- machine. Note that we use the term "executor" fairly loosely to +-- refer to the code that implements an instance of the 'ToExecutor' type class (see +-- below) as well as the program that is responsible for instantiating +-- a new 'ExecutorDriver' (also below). +-- +-- In fact, while a Mesos +-- slave is responsible for (forking and) executing the "executor", +-- there is no reason why whatever the slave executed might itself +-- actually execute another program which actually instantiates and +-- runs the 'SchedulerDriver'. The only contract with the slave is +-- that the program that it invokes does not exit until the "executor" +-- has completed. Thus, what the slave executes may be nothing more +-- than a script which actually executes (or forks and waits) the +-- "real" executor. +module System.Mesos.Executor ( + -- * Implementing an executor + ToExecutor(..), + -- * Creating an executor + ExecutorDriver, + withExecutorDriver, + -- * Interacting with Mesos + start, + stop, + abort, + await, + run, + sendStatusUpdate, + sendFrameworkMessage, + -- * Primitive executor management + Executor, + createExecutor, + destroyExecutor, + withExecutor, + createDriver, + destroyDriver +) where +import Control.Monad.Managed +import Data.ByteString (ByteString, packCStringLen) +import Data.ByteString.Unsafe (unsafeUseAsCStringLen) +import Foreign.C +import Foreign.Marshal.Safe hiding (with) +import Foreign.Ptr +import Foreign.Storable +import System.Mesos.Internal +import System.Mesos.Raw +import System.Mesos.Raw.Executor +import System.Mesos.Types + +withExecutor :: ToExecutor a => a -> (Executor -> IO b) -> IO b +withExecutor e f = do + executor <- createExecutor e + result <- f executor + destroyExecutor executor + return result + +withExecutorDriver :: ToExecutor a => a -> (ExecutorDriver -> IO b) -> IO b +withExecutorDriver e f = withExecutor e $ \executor -> do + driver <- createDriver executor + result <- f driver + destroyDriver driver + return result + +-- | Callback interface to be implemented by frameworks' executors. Note +-- that only one callback will be invoked at a time, so it is not +-- recommended that you block within a callback because it may cause a +-- deadlock. +class ToExecutor a where + -- | Invoked once the executor driver has been able to successfully + -- connect with Mesos. + registered :: a -> ExecutorDriver -> ExecutorInfo -> FrameworkInfo -> SlaveInfo -> IO () + registered _ _ _ _ _ = return () + + -- | Invoked when the executor re-registers with a restarted slave. + reRegistered :: a -> ExecutorDriver -> SlaveInfo -> IO () + reRegistered _ _ _ = return () + + -- | Invoked when the executor becomes "disconnected" from the slave + -- (e.g., the slave is being restarted due to an upgrade). + disconnected :: a -> ExecutorDriver -> IO () + disconnected _ _ = return () + + -- | Invoked when a task has been launched on this executor (initiated + -- via 'launchTasks'). Note that this task can be realized + -- with a thread, a process, or some simple computation, however, no + -- other callbacks will be invoked on this executor until this + -- callback has returned. + launchTask :: a -> ExecutorDriver -> TaskInfo -> IO () + launchTask _ _ _ = return () + + -- | Invoked when a task running within this executor has been killed + -- (via 'killTask'). Note that no status update will + -- be sent on behalf of the executor, the executor is responsible + -- for creating a new 'TaskStatus' (i.e., with 'Killed') and + -- invoking 'sendStatusUpdate'. + + taskKilled :: a -> ExecutorDriver -> TaskID -> IO () + taskKilled _ _ _ = return () + + -- | Invoked when a framework message has arrived for this + -- executor. These messages are best effort; do not expect a + -- framework message to be retransmitted in any reliable fashion. + frameworkMessage :: a -> ExecutorDriver -> ByteString -> IO () + frameworkMessage _ _ _ = return () + + -- | Invoked when the executor should terminate all of its currently + -- running tasks. Note that after a Mesos has determined that an + -- executor has terminated any tasks that the executor did not send + -- terminal status updates for (e.g., 'Killed', 'Finished', + -- 'Failed', etc.) a 'Lost' status update will be created. + shutdown :: a -> ExecutorDriver -> IO () + shutdown _ _ = return () + + -- | Invoked when a fatal error has occured with the executor and/or + -- executor driver. The driver will be aborted *before* invoking this + -- callback. + errorMessage :: a + -> ExecutorDriver + -> ByteString -- ^ error message + -> IO () + errorMessage _ _ _ = return () + +createExecutor :: ToExecutor a => a -> IO Executor +createExecutor c = do + registeredFun <- wrapExecutorRegistered $ \edp eip fip sip -> runManaged $ do + ei <- unmarshal eip + fi <- unmarshal fip + si <- unmarshal sip + liftIO $ registered c (ExecutorDriver edp) ei fi si + reRegisteredFun <- wrapExecutorReRegistered $ \edp sip -> runManaged $ do + si <- unmarshal sip + liftIO $ reRegistered c (ExecutorDriver edp) si + disconnectedFun <- wrapExecutorDisconnected $ \edp -> disconnected c (ExecutorDriver edp) + launchTaskFun <- wrapExecutorLaunchTask $ \edp tip -> runManaged $ do + ti <- unmarshal tip + liftIO $ launchTask c (ExecutorDriver edp) ti + taskKilledFun <- wrapExecutorTaskKilled $ \edp tip -> runManaged $ do + ti <- unmarshal tip + liftIO $ taskKilled c (ExecutorDriver edp) ti + frameworkMessageFun <- wrapExecutorFrameworkMessage $ \edp mcp mlp -> do + bs <- packCStringLen (mcp, fromIntegral mlp) + frameworkMessage c (ExecutorDriver edp) bs + shutdownFun <- wrapExecutorShutdown $ \edp -> shutdown c (ExecutorDriver edp) + errorCallback <- wrapExecutorError $ \edp mcp mlp -> do + bs <- packCStringLen (mcp, fromIntegral mlp) + errorMessage c (ExecutorDriver edp) bs + e <- c_createExecutor registeredFun reRegisteredFun disconnectedFun launchTaskFun taskKilledFun frameworkMessageFun shutdownFun errorCallback + return $ Executor e registeredFun reRegisteredFun disconnectedFun launchTaskFun taskKilledFun frameworkMessageFun shutdownFun errorCallback + +destroyExecutor :: Executor -> IO () +destroyExecutor e = do + c_destroyExecutor $ executorImpl e + freeHaskellFunPtr $ rawExecutorRegistered e + freeHaskellFunPtr $ rawExecutorReRegistered e + freeHaskellFunPtr $ rawExecutorDisconnected e + freeHaskellFunPtr $ rawExecutorLaunchTask e + freeHaskellFunPtr $ rawExecutorTaskKilled e + freeHaskellFunPtr $ rawExecutorFrameworkMessage e + freeHaskellFunPtr $ rawExecutorShutdown e + freeHaskellFunPtr $ rawExecutorErrorCallback e + +createDriver :: Executor -> IO ExecutorDriver +createDriver = fmap ExecutorDriver . c_createExecutorDriver . executorImpl + +destroyDriver :: ExecutorDriver -> IO () +destroyDriver = c_destroyExecutorDriver . fromExecutorDriver + +-- | Starts the executor driver. This needs to be called before any +-- other driver calls are made. +start :: ExecutorDriver -> IO Status +start = fmap toStatus . c_startExecutorDriver . fromExecutorDriver + +-- | Stops the 'ExecutorDriver'. +stop :: ExecutorDriver -> IO Status +stop = fmap toStatus . c_stopExecutorDriver . fromExecutorDriver + +-- | Aborts the driver so that no more callbacks can be made to the +-- executor. The semantics of abort and stop have deliberately been +-- separated so that code can detect an aborted driver (i.e., via +-- the return status of @abort@, see below), and +-- instantiate and start another driver if desired (from within the +-- same process ... although this functionality is currently not +-- supported for executors). +abort :: ExecutorDriver -> IO Status +abort = fmap toStatus . c_abortExecutorDriver . fromExecutorDriver + +-- | Waits for the driver to be stopped or aborted, possibly + -- *blocking* the current thread indefinitely. The return status of + -- this function can be used to determine if the driver was aborted + -- (see mesos.proto for a description of Status). +await :: ExecutorDriver -> IO Status +await = fmap toStatus . c_joinExecutorDriver . fromExecutorDriver + +-- | 'start's and immediately @await@s (i.e., blocks on) the driver. +run :: ExecutorDriver -> IO Status +run = fmap toStatus . c_runExecutorDriver . fromExecutorDriver + +-- | Sends a status update to the framework scheduler, retrying as +-- necessary until an acknowledgement has been received or the + -- executor is terminated (in which case, a 'Lost' status update + -- will be sent). See 'System.Mesos.Scheduler.statusUpdate' for more information + -- about status update acknowledgements. +sendStatusUpdate :: ExecutorDriver -> TaskStatus -> IO Status +sendStatusUpdate (ExecutorDriver d) s = with (cppValue s) $ \sp -> do + result <- c_sendExecutorDriverStatusUpdate d sp + return $ toStatus result + +-- | Sends a message to the framework scheduler. These messages are +-- best effort; do not expect a framework message to be +-- retransmitted in any reliable fashion. +sendFrameworkMessage :: ExecutorDriver + -> ByteString -- ^ message + -> IO Status +sendFrameworkMessage (ExecutorDriver d) s = with (cstring s) $ \(sp, sl) -> do + result <- c_sendExecutorDriverFrameworkMessage d sp (fromIntegral sl) + return $ toStatus result diff --git a/src/System/Mesos/Internal.hs b/src/System/Mesos/Internal.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Internal.hs @@ -0,0 +1,169 @@ +{-# LANGUAGE OverloadedStrings #-} +module System.Mesos.Internal ( + module Control.Applicative, + module Data.Word, + module Foreign.C, + module System.Mesos.Types, + runManaged, + Managed, + CPPValue (..), + ByteString, + Ptr.Ptr, + Ptr.FunPtr, + Ptr.nullPtr, + alloc, + allocMaybe, + arrayPair, + peek, + poke, + pokeMaybe, + arrayLen, + cstring, + maybeCString, + peekArray, + peekArray', + peekCString, + peekCString', + peekMaybeCString, + cppValue, + peekCPP, + peekMaybeCPP, + CBool, + toCBool, + fromCBool, + toStatus, + peekMaybe, + peekMaybeBS, + peekMaybePrim, + Ptr.Storable, + liftIO, + ToID, + FromID, + defEq +) where +import Control.Monad.Managed + + +import Control.Applicative +import Data.ByteString (ByteString, packCStringLen) +import Data.ByteString.Unsafe (unsafeUseAsCStringLen) +import Data.Word +import Foreign.C hiding (peekCString) +import qualified Foreign.Marshal as Ptr +import qualified Foreign.Ptr as Ptr +import qualified Foreign.Storable as Ptr +import System.Mesos.Types + +class CPPValue a where + marshal :: a -> Managed (Ptr.Ptr a) + unmarshal :: Ptr.Ptr a -> Managed a + destroy :: Ptr.Ptr a -> IO () + equalExceptDefaults :: Eq a => a -> a -> Bool + equalExceptDefaults = (==) + +alloc :: Ptr.Storable a => Managed (Ptr.Ptr a) +alloc = managed Ptr.alloca + +allocMaybe :: Ptr.Storable a => Maybe a -> Managed (Ptr.Ptr a) +allocMaybe = maybe (return Ptr.nullPtr) (\x -> alloc >>= \p -> poke p x >> return p) + +arrayPair :: Ptr.Storable a => Managed (Ptr.Ptr a, Ptr.Ptr CInt) +arrayPair = (,) <$> alloc <*> alloc + +peek :: Ptr.Storable a => Ptr.Ptr a -> Managed a +peek = liftIO . Ptr.peek + +poke :: Ptr.Storable a => Ptr.Ptr a -> a -> Managed () +poke p x = liftIO $ Ptr.poke p x + +pokeMaybe :: Ptr.Storable a => Ptr.Ptr a -> (Maybe a) -> Managed () +pokeMaybe p m = maybe (return ()) (System.Mesos.Internal.poke p) m +-- pokeMaybe' :: Storable a => Ptr.Ptr (Ptr.Ptr a) -> (Maybe a) + +arrayLen :: Ptr.Storable a => [a] -> Managed (Ptr.Ptr a, Int) +arrayLen xs = managed $ Ptr.withArrayLen xs . flip . curry + +cstring :: ByteString -> Managed (Ptr.Ptr CChar, Int) +cstring bs = managed $ unsafeUseAsCStringLen bs + +peekCString :: (Ptr.Ptr (Ptr.Ptr CChar), Ptr.Ptr CInt) -> Managed ByteString +peekCString (pp, lp) = do + p <- peek pp + l <- peek lp + liftIO $ packCStringLen (p, fromIntegral l) + +peekArray :: (Ptr.Ptr (Ptr.Ptr a), Ptr.Ptr CInt) -> Managed [Ptr.Ptr a] +peekArray (pp, lp) = do + l <- peek lp + liftIO $ Ptr.peekArray (fromIntegral l) pp + +peekArray' :: (Ptr.Ptr (Ptr.Ptr a), Int) -> Managed [Ptr.Ptr a] +peekArray' (pp, l) = liftIO $ Ptr.peekArray l pp + +peekCString' :: (Ptr.Ptr (Ptr.Ptr CChar), CInt) -> Managed ByteString +peekCString' (pp, l) = do + p <- System.Mesos.Internal.peek pp + liftIO $ packCStringLen (p, fromIntegral l) + +peekMaybeCString :: (Ptr.Ptr (Ptr.Ptr CChar), Ptr.Ptr CInt) -> Managed (Maybe ByteString) +peekMaybeCString (pp, lp) = do + p <- System.Mesos.Internal.peek pp + if p == Ptr.nullPtr + then return Nothing + else do + l <- System.Mesos.Internal.peek lp + fmap Just $ liftIO $ packCStringLen (p, fromIntegral l) + +cppValue :: CPPValue a => a -> Managed (Ptr.Ptr a) +cppValue y = managed $ (\x f -> with (marshal x) $ \p -> f p >>= \r -> destroy p >> return r) y + +peekCPP :: CPPValue a => Ptr.Ptr a -> Managed a +peekCPP = unmarshal + +peekMaybeCPP pp = do + p <- peek pp + if p == Ptr.nullPtr + then return Nothing + else fmap Just $ peekCPP p + +type CBool = CUChar + +toCBool :: Bool -> CBool +toCBool b = if b then 1 else 0 + +fromCBool :: CBool -> Bool +fromCBool b = b /= 0 + +toStatus :: CInt -> Status +toStatus = toEnum . fromIntegral + +peekMaybe :: (Ptr.Storable a) => Ptr.Ptr (Ptr.Ptr a) -> Managed (Maybe a) +peekMaybe p = do + pInner <- System.Mesos.Internal.peek p + if pInner == Ptr.nullPtr + then return Nothing + else System.Mesos.Internal.peek pInner >>= return . Just + +peekMaybeBS :: Ptr.Ptr (Ptr.Ptr CChar) -> Ptr.Ptr CInt -> Managed (Maybe ByteString) +peekMaybeBS sp slp = do + sl <- System.Mesos.Internal.peek slp + spInner <- System.Mesos.Internal.peek sp + if spInner == Ptr.nullPtr + then return Nothing + else liftIO (packCStringLen (spInner, fromIntegral sl)) >>= return . Just + +peekMaybePrim :: Ptr.Storable a => Ptr.Ptr a -> Ptr.Ptr CBool -> Managed (Maybe a) +peekMaybePrim p vsp = do + set <- System.Mesos.Internal.peek vsp + if set /= 0 + then fmap Just $ System.Mesos.Internal.peek p + else return Nothing + +maybeCString (Just bs) = cstring bs +maybeCString Nothing = return (Ptr.nullPtr, 0) + +defEq :: Eq a => a -> Maybe a -> Maybe a -> Bool +defEq d x x' = x == x' || ((x == Nothing || x == Just d) && (x' == Nothing || x' == Just d)) + +type ToID a = Ptr.Ptr CChar -> CInt -> IO a +type FromID a = a -> Ptr.Ptr (Ptr.Ptr CChar) -> IO CInt diff --git a/src/System/Mesos/Raw.hs b/src/System/Mesos/Raw.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw.hs @@ -0,0 +1,63 @@ +module System.Mesos.Raw ( + module System.Mesos.Raw.Attribute, + module System.Mesos.Raw.CommandInfo, + module System.Mesos.Raw.CommandUri, + module System.Mesos.Raw.ContainerId, + module System.Mesos.Raw.Credential, + module System.Mesos.Raw.Environment, + module System.Mesos.Raw.EnvironmentVariable, + module System.Mesos.Raw.Executor, + module System.Mesos.Raw.ExecutorId, + module System.Mesos.Raw.ExecutorInfo, + module System.Mesos.Raw.Filters, + module System.Mesos.Raw.FrameworkId, + module System.Mesos.Raw.FrameworkInfo, + module System.Mesos.Raw.MasterInfo, + module System.Mesos.Raw.Offer, + module System.Mesos.Raw.OfferId, + module System.Mesos.Raw.Parameter, + module System.Mesos.Raw.Parameters, + module System.Mesos.Raw.Request, + module System.Mesos.Raw.Resource, + module System.Mesos.Raw.ResourceStatistics, + module System.Mesos.Raw.ResourceUsage, + module System.Mesos.Raw.Scheduler, + module System.Mesos.Raw.SlaveId, + module System.Mesos.Raw.SlaveInfo, + module System.Mesos.Raw.StdString, + module System.Mesos.Raw.TaskId, + module System.Mesos.Raw.TaskInfo, + module System.Mesos.Raw.TaskStatus, + module System.Mesos.Raw.Value +) where +import System.Mesos.Raw.Attribute +import System.Mesos.Raw.CommandInfo +import System.Mesos.Raw.CommandUri +import System.Mesos.Raw.ContainerId +import System.Mesos.Raw.ContainerInfo +import System.Mesos.Raw.Credential +import System.Mesos.Raw.Environment +import System.Mesos.Raw.EnvironmentVariable +import System.Mesos.Raw.Executor +import System.Mesos.Raw.ExecutorId +import System.Mesos.Raw.ExecutorInfo +import System.Mesos.Raw.Filters +import System.Mesos.Raw.FrameworkId +import System.Mesos.Raw.FrameworkInfo +import System.Mesos.Raw.MasterInfo +import System.Mesos.Raw.Offer +import System.Mesos.Raw.OfferId +import System.Mesos.Raw.Parameter +import System.Mesos.Raw.Parameters +import System.Mesos.Raw.Request +import System.Mesos.Raw.Resource +import System.Mesos.Raw.ResourceStatistics +import System.Mesos.Raw.ResourceUsage +import System.Mesos.Raw.Scheduler +import System.Mesos.Raw.SlaveId +import System.Mesos.Raw.SlaveInfo +import System.Mesos.Raw.StdString +import System.Mesos.Raw.TaskId +import System.Mesos.Raw.TaskInfo +import System.Mesos.Raw.TaskStatus +import System.Mesos.Raw.Value diff --git a/src/System/Mesos/Raw/Attribute.hs b/src/System/Mesos/Raw/Attribute.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/Attribute.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} +module System.Mesos.Raw.Attribute where +import System.Mesos.Internal +import System.Mesos.Raw.Value + +type AttributePtr = Ptr Attribute + +data Attribute = Attribute + { attributeName :: !ByteString + , attributeValue :: !Value + } deriving (Show, Eq) + +toAttribute :: (ByteString, Value) -> Attribute +toAttribute (k, v) = Attribute k v + +fromAttribute :: Attribute -> (ByteString, Value) +fromAttribute (Attribute k v) = (k, v) + +foreign import ccall unsafe "ext/types.h toAttribute" c_toAttribute + :: Ptr CChar + -> CInt + -> ValuePtr + -> IO AttributePtr + +foreign import ccall unsafe "ext/types.h fromAttribute" c_fromAttribute + :: AttributePtr + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr ValuePtr + -> IO () + +foreign import ccall unsafe "ext/types.h destroyAttribute" c_destroyAttribute + :: AttributePtr + -> IO () + +instance CPPValue Attribute where + + marshal a = do + (np, nl) <- cstring $ attributeName a + vp <- cppValue $ attributeValue a + p <- liftIO $ c_toAttribute np (fromIntegral nl) vp + return p + + unmarshal ap = do + nps@(npp, nlp) <- arrayPair + vpp <- alloc + liftIO $ c_fromAttribute ap npp nlp vpp + vp <- peek vpp + n <- peekCString nps + v <- peekCPP vp + return $ Attribute n v + + destroy = c_destroyAttribute diff --git a/src/System/Mesos/Raw/CommandInfo.hs b/src/System/Mesos/Raw/CommandInfo.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/CommandInfo.hs @@ -0,0 +1,82 @@ +module System.Mesos.Raw.CommandInfo where +import System.Mesos.Internal +import System.Mesos.Raw.CommandUri +import System.Mesos.Raw.Environment +import System.Mesos.Raw.StdString + +type CommandInfoPtr = Ptr CommandInfo + +foreign import ccall unsafe "ext/types.h toCommandInfo" c_toCommandInfo + :: Ptr CommandURIPtr + -> CInt + -> EnvironmentPtr + -> CBool + -> Ptr CChar + -> CInt + -> Ptr StdStringPtr + -> CInt + -> Ptr CChar + -> CInt + -> IO CommandInfoPtr + +foreign import ccall unsafe "ext/types.h fromCommandInfo" c_fromCommandInfo + :: CommandInfoPtr + -> Ptr (Ptr CommandURIPtr) + -> Ptr CInt + -> Ptr EnvironmentPtr + -> Ptr CBool + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr (Ptr StdStringPtr) + -> Ptr CInt + -> Ptr (Ptr CChar) + -> Ptr CInt + -> IO () + +foreign import ccall unsafe "ext/types.h destroyCommandInfo" c_destroyCommandInfo + :: CommandInfoPtr + -> IO () + +instance CPPValue CommandInfo where + + marshal i = do + envP <- maybe (return nullPtr) (cppValue . toEnvironment) $ commandEnvironment i + uriPs <- mapM cppValue $ commandInfoURIs i + (upp, upl) <- arrayLen uriPs + (up, ul) <- maybeCString $ commandUser i + case commandValue 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) + (RawCommand cmd args) -> do + (vp, vl) <- cstring cmd + (ap, al) <- arrayLen =<< mapM (cppValue . StdString) args + liftIO $ c_toCommandInfo upp (fromIntegral upl) envP (toCBool False) vp (fromIntegral vl) ap (fromIntegral al) up (fromIntegral ul) + + unmarshal i = do + upp <- alloc + ulp <- alloc + vl@(vpp, vlp) <- arrayPair + epp <- alloc + poke epp nullPtr + aspp <- alloc + asl <- alloc + u@(up, ul) <- arrayPair + poke up nullPtr + sp <- alloc + liftIO $ c_fromCommandInfo i upp ulp epp sp vpp vlp aspp asl up ul + ups <- peek upp + us <- mapM unmarshal =<< peekArray (ups, ulp) + e <- peekMaybeCPP epp + s <- fmap fromCBool $ peek sp + val <- peekCString vl + v <- if s + then return $ ShellCommand val + else do + asp <- peek aspp + args <- mapM unmarshal =<< peekArray (asp, asl) + return $ RawCommand val $ fmap fromStdString args + user <- peekMaybeCString u + return $ CommandInfo us (fmap fromEnvironment e) v user + + destroy = c_destroyCommandInfo diff --git a/src/System/Mesos/Raw/CommandUri.hs b/src/System/Mesos/Raw/CommandUri.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/CommandUri.hs @@ -0,0 +1,56 @@ +module System.Mesos.Raw.CommandUri where +import System.Mesos.Internal + +type CommandURIPtr = Ptr CommandURI + +foreign import ccall unsafe "ext/types.h toCommandURI" c_toCommandURI + :: Ptr CChar + -> CInt + -> Ptr CBool + -> Ptr CBool + -> IO CommandURIPtr + +foreign import ccall unsafe "ext/types.h fromCommandURI" c_fromCommandURI + :: CommandURIPtr + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr CBool + -> Ptr CBool + -> Ptr CBool + -> Ptr CBool + -> IO () + +foreign import ccall unsafe "ext/types.h destroyCommandURI" c_destroyCommandURI + :: CommandURIPtr + -> IO () + +instance CPPValue CommandURI where + + marshal cu = do + (vp, vl) <- cstring $ commandURIValue cu + exec <- allocMaybe $ fmap toCBool $ commandURIExecutable cu + extract <- allocMaybe $ fmap toCBool $ commandURIExtract cu + liftIO $ c_toCommandURI vp (fromIntegral vl) exec extract + + unmarshal cup = do + (uriPP, uriLenP) <- arrayPair + + exeSetP <- alloc + poke exeSetP 0 + exeP <- alloc + + extractSetP <- alloc + poke extractSetP 0 + extractP <- alloc + + liftIO $ c_fromCommandURI cup uriPP uriLenP exeSetP exeP extractSetP extractP + uri <- peekCString (uriPP, uriLenP) + + mset <- peekMaybePrim exeP exeSetP + mextract <- peekMaybePrim extractP extractSetP + + return $ CommandURI uri (fmap fromCBool mset) (fmap fromCBool mextract) + + destroy = c_destroyCommandURI + + equalExceptDefaults (CommandURI uri ms mx) (CommandURI uri' ms' mx') = uri == uri' && ms == ms' && defEq True mx mx' diff --git a/src/System/Mesos/Raw/ContainerId.hs b/src/System/Mesos/Raw/ContainerId.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/ContainerId.hs @@ -0,0 +1,23 @@ +module System.Mesos.Raw.ContainerId where +import System.Mesos.Internal + +type ContainerIDPtr = Ptr ContainerID + +foreign import ccall unsafe "ext/types.h toContainerID" c_toContainerID :: ToID ContainerIDPtr + +foreign import ccall unsafe "ext/types.h fromContainerID" c_fromContainerID :: FromID ContainerIDPtr + +foreign import ccall unsafe "ext/types.h destroyContainerID" c_destroyContainerID :: ContainerIDPtr -> IO () + +instance CPPValue ContainerID where + + marshal x = do + (strp, l) <- cstring $ fromContainerID x + liftIO $ c_toContainerID strp $ fromIntegral l + + unmarshal p = fmap ContainerID $ do + ptrPtr <- alloc + len <- liftIO $ c_fromContainerID p ptrPtr + peekCString' (ptrPtr, len) + + destroy = c_destroyContainerID diff --git a/src/System/Mesos/Raw/ContainerInfo.hs b/src/System/Mesos/Raw/ContainerInfo.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/ContainerInfo.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE OverloadedStrings #-} +module System.Mesos.Raw.ContainerInfo where + +import System.Mesos.Internal +import System.Mesos.Raw.Volume + +type ContainerInfoPtr = Ptr ContainerInfo + +foreign import ccall unsafe "ext/types.h toContainerInfo" c_toContainerInfo + :: CInt -- ^ type + -> Ptr CChar -- ^ image + -> CInt -- ^ image length + -> Ptr VolumePtr -- ^ volumes + -> CInt -- ^ volumes length + -> IO ContainerInfoPtr + +foreign import ccall unsafe "ext/types.h fromContainerInfo" c_fromContainerInfo + :: ContainerInfoPtr + -> Ptr CInt -- ^ type + -> Ptr (Ptr CChar) -- ^ image + -> Ptr CInt -- ^ image length + -> Ptr (Ptr VolumePtr) + -> Ptr CInt -- ^ volumes length + -> IO () + +foreign import ccall unsafe "ext/types.h destroyContainerInfo" c_destroyContainerInfo + :: ContainerInfoPtr -> IO () + +instance CPPValue ContainerInfo where + marshal ci = do + (ip, il) <- cstring $ dockerImage $ containerInfoContainerType ci + (vp, vl) <- mapM marshal (containerInfoVolumes ci) >>= arrayLen + liftIO $ c_toContainerInfo 1 ip (fromIntegral il) vp (fromIntegral vl) + + unmarshal p = do + tyP <- alloc + (iP, ilP) <- arrayPair + vPP <- alloc + vlP <- alloc + liftIO $ c_fromContainerInfo p tyP iP ilP vPP vlP + ty <- peek tyP + im <- peekMaybeCString (iP, ilP) + vP <- peek vPP + vps <- peekArray (vP, vlP) + vs <- mapM unmarshal vps + if ty == 1 + then return $ ContainerInfo (Docker $ maybe "" id im) vs + else return $ ContainerInfo (Unknown $ fromIntegral ty) vs + + destroy = c_destroyContainerInfo diff --git a/src/System/Mesos/Raw/Credential.hs b/src/System/Mesos/Raw/Credential.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/Credential.hs @@ -0,0 +1,44 @@ +module System.Mesos.Raw.Credential where +import System.Mesos.Internal + +type CredentialPtr = Ptr Credential + +foreign import ccall unsafe "ext/types.h toCredential" c_toCredential + :: Ptr CChar + -> CInt + -> Ptr CChar + -> CInt + -> IO CredentialPtr + +foreign import ccall unsafe "ext/types.h fromCredential" c_fromCredential + :: CredentialPtr + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr (Ptr CChar) + -> Ptr CInt + -> IO () + +foreign import ccall unsafe "ext/types.h destroyCredential" c_destroyCredential + :: CredentialPtr + -> IO () + +instance CPPValue Credential where + + marshal c = do + (pp, pl) <- cstring $ credentialPrincipal c + let call p l = liftIO $ c_toCredential pp (fromIntegral pl) p l + case credentialSecret c of + Nothing -> call nullPtr 0 + Just s -> do + (sp, sl) <- cstring s + call sp (fromIntegral sl) + + unmarshal cp = do + p@(pp, plp) <- arrayPair + s@(sp, slp) <- arrayPair + liftIO $ c_fromCredential cp pp plp sp slp + ps <- peekCString p + ss <- peekMaybeCString s + return $ Credential ps ss + + destroy = c_destroyCredential diff --git a/src/System/Mesos/Raw/Environment.hs b/src/System/Mesos/Raw/Environment.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/Environment.hs @@ -0,0 +1,48 @@ +module System.Mesos.Raw.Environment where +import System.Mesos.Internal +import System.Mesos.Raw.EnvironmentVariable + +type EnvironmentPtr = Ptr Environment + +newtype Environment = Environment + { environmentVariables :: [(ByteString, ByteString)] + } + deriving (Show, Eq) + +fromEnvironment :: Environment -> [(ByteString, ByteString)] +fromEnvironment = environmentVariables + +toEnvironment :: [(ByteString, ByteString)] -> Environment +toEnvironment = Environment + +foreign import ccall unsafe "ext/types.h toEnvironment" c_toEnvironment + :: Ptr EnvironmentVariablePtr + -> CInt + -> IO EnvironmentPtr + +foreign import ccall unsafe "ext/types.h fromEnvironment" c_fromEnvironment + :: EnvironmentPtr + -> Ptr (Ptr EnvironmentVariablePtr) + -> Ptr CInt + -> IO () + +foreign import ccall unsafe "ext/types.h destroyEnvironment" c_destroyEnvironment + :: EnvironmentPtr + -> IO () + +instance CPPValue Environment where + marshal e = do + es <- mapM (cppValue . toEnvVar) $ environmentVariables e + (esp, eLen) <- arrayLen es + liftIO $ c_toEnvironment esp (fromIntegral eLen) + + unmarshal ep = Environment <$> do + evpp <- alloc + evlp <- alloc + liftIO $ c_fromEnvironment ep evpp evlp + ev <- peek evpp + evs <- peekArray (ev, evlp) + l <- mapM peekCPP evs + return $ map fromEnvVar l + + destroy = c_destroyEnvironment diff --git a/src/System/Mesos/Raw/EnvironmentVariable.hs b/src/System/Mesos/Raw/EnvironmentVariable.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/EnvironmentVariable.hs @@ -0,0 +1,51 @@ +module System.Mesos.Raw.EnvironmentVariable where +import System.Mesos.Internal + +toEnvVar :: (ByteString, ByteString) -> EnvironmentVariable +toEnvVar (k, v) = EnvironmentVariable k v + +fromEnvVar :: EnvironmentVariable -> (ByteString, ByteString) +fromEnvVar (EnvironmentVariable k v) = (k, v) + +type EnvironmentVariablePtr = Ptr EnvironmentVariable + +data EnvironmentVariable = EnvironmentVariable + { environmentVariableKey :: !ByteString + , environmentVariableValue :: !ByteString + } deriving (Show, Eq) + +foreign import ccall unsafe "ext/types.h toEnvironmentVariable" c_toEnvironmentVariable + :: Ptr CChar + -> CInt + -> Ptr CChar + -> CInt + -> IO EnvironmentVariablePtr + +foreign import ccall unsafe "ext/types.h fromEnvironmentVariable" c_fromEnvironmentVariable + :: EnvironmentVariablePtr + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr (Ptr CChar) + -> Ptr CInt + -> IO () + +foreign import ccall unsafe "ext/types.h destroyEnvironmentVariable" c_destroyEnvironmentVariable + :: EnvironmentVariablePtr + -> IO () + +instance CPPValue EnvironmentVariable where + + marshal e = do + (kp, kl) <- cstring $ environmentVariableKey e + (vp, vl) <- cstring $ environmentVariableValue e + liftIO $ c_toEnvironmentVariable kp (fromIntegral kl) vp (fromIntegral vl) + + unmarshal e = do + kp@(kpp, klp) <- arrayPair + vp@(vpp, vlp) <- arrayPair + liftIO $ c_fromEnvironmentVariable e kpp klp vpp vlp + k <- peekCString kp + v <- peekCString vp + return $ EnvironmentVariable k v + + destroy = c_destroyEnvironmentVariable diff --git a/src/System/Mesos/Raw/Executor.hs b/src/System/Mesos/Raw/Executor.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/Executor.hs @@ -0,0 +1,134 @@ +module System.Mesos.Raw.Executor where +import System.Mesos.Internal +import System.Mesos.Raw.ExecutorId +import System.Mesos.Raw.ExecutorInfo +import System.Mesos.Raw.FrameworkId +import System.Mesos.Raw.FrameworkInfo +import System.Mesos.Raw.SlaveId +import System.Mesos.Raw.SlaveInfo +import System.Mesos.Raw.TaskId +import System.Mesos.Raw.TaskInfo +import System.Mesos.Raw.TaskStatus + +type ExecutorPtr = Ptr Executor + +-- | A data structure of the underlying executor & the callbacks that are triggered via the Mesos C++ API. +data Executor = Executor + { executorImpl :: Ptr Executor + , rawExecutorRegistered :: FunPtr RawExecutorRegistered + , rawExecutorReRegistered :: FunPtr RawExecutorReRegistered + , rawExecutorDisconnected :: FunPtr RawExecutorDisconnected + , rawExecutorLaunchTask :: FunPtr RawExecutorLaunchTask + , rawExecutorTaskKilled :: FunPtr RawExecutorTaskKilled + , rawExecutorFrameworkMessage :: FunPtr RawExecutorFrameworkMessage + , rawExecutorShutdown :: FunPtr RawExecutorShutdown + , rawExecutorErrorCallback :: FunPtr RawExecutorError + } + +type ExecutorDriverPtr = Ptr ExecutorDriver + +-- | A handle that allows an Executor to trigger lifecycle & status update events (e.g. starting & stopping the executor and sending messages to the Scheduler that invoked the executor). +newtype ExecutorDriver = ExecutorDriver { fromExecutorDriver :: ExecutorDriverPtr } + +type RawExecutorRegistered = ExecutorDriverPtr -> ExecutorInfoPtr -> FrameworkInfoPtr -> SlaveInfoPtr -> IO () + +type RawExecutorReRegistered = ExecutorDriverPtr -> SlaveInfoPtr -> IO () + +type RawExecutorDisconnected = ExecutorDriverPtr -> IO () + +type RawExecutorLaunchTask = ExecutorDriverPtr -> TaskInfoPtr -> IO () + +type RawExecutorTaskKilled = ExecutorDriverPtr -> TaskIDPtr -> IO () + +type RawExecutorFrameworkMessage = ExecutorDriverPtr -> Ptr CChar -> CInt -> IO () + +type RawExecutorShutdown = ExecutorDriverPtr -> IO () + +type RawExecutorError = ExecutorDriverPtr -> Ptr CChar -> CInt -> IO () + +foreign import ccall "wrapper" wrapExecutorRegistered + :: RawExecutorRegistered + -> IO (FunPtr RawExecutorRegistered) + +foreign import ccall "wrapper" wrapExecutorReRegistered + :: RawExecutorReRegistered + -> IO (FunPtr RawExecutorReRegistered) + +foreign import ccall "wrapper" wrapExecutorDisconnected + :: RawExecutorDisconnected + -> IO (FunPtr RawExecutorDisconnected) + +foreign import ccall "wrapper" wrapExecutorLaunchTask + :: RawExecutorLaunchTask + -> IO (FunPtr RawExecutorLaunchTask) + +foreign import ccall "wrapper" wrapExecutorTaskKilled + :: RawExecutorTaskKilled + -> IO (FunPtr RawExecutorTaskKilled) + +foreign import ccall "wrapper" wrapExecutorFrameworkMessage + :: RawExecutorFrameworkMessage + -> IO (FunPtr RawExecutorFrameworkMessage) + +foreign import ccall "wrapper" wrapExecutorShutdown + :: RawExecutorShutdown + -> IO (FunPtr RawExecutorShutdown) + +foreign import ccall "wrapper" wrapExecutorError + :: RawExecutorError + -> IO (FunPtr RawExecutorError) + +foreign import ccall safe "createExecutor" c_createExecutor + :: FunPtr RawExecutorRegistered + -> FunPtr RawExecutorReRegistered + -> FunPtr RawExecutorDisconnected + -> FunPtr RawExecutorLaunchTask + -> FunPtr RawExecutorTaskKilled + -> FunPtr RawExecutorFrameworkMessage + -> FunPtr RawExecutorShutdown + -> FunPtr RawExecutorError + -> IO ExecutorPtr + +foreign import ccall safe "destroyExecutor" c_destroyExecutor + :: ExecutorPtr + -> IO () + +foreign import ccall safe "ext/executor.h createExecutorDriver" c_createExecutorDriver + :: ExecutorPtr + -> IO ExecutorDriverPtr + +foreign import ccall safe "ext/executor.h destroyExecutorDriver" c_destroyExecutorDriver + :: ExecutorDriverPtr + -> IO () + +foreign import ccall safe "ext/executor.h startExecutorDriver" c_startExecutorDriver + :: ExecutorDriverPtr + -> IO CInt + +foreign import ccall safe "ext/executor.h stopExecutorDriver" c_stopExecutorDriver + :: ExecutorDriverPtr + -> IO CInt + +foreign import ccall safe "ext/executor.h abortExecutorDriver" c_abortExecutorDriver + :: ExecutorDriverPtr + -> IO CInt + +foreign import ccall safe "ext/executor.h joinExecutorDriver" c_joinExecutorDriver + :: ExecutorDriverPtr + -> IO CInt + +foreign import ccall safe "ext/executor.h runExecutorDriver" c_runExecutorDriver + :: ExecutorDriverPtr + -> IO CInt + +foreign import ccall safe "ext/executor.h sendExecutorDriverStatusUpdate" c_sendExecutorDriverStatusUpdate + :: ExecutorDriverPtr + -> TaskStatusPtr + -> IO CInt + +foreign import ccall safe "ext/executor.h sendExecutorDriverFrameworkMessage" c_sendExecutorDriverFrameworkMessage + :: ExecutorDriverPtr + -> Ptr CChar + -> CInt + -> IO CInt + diff --git a/src/System/Mesos/Raw/ExecutorId.hs b/src/System/Mesos/Raw/ExecutorId.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/ExecutorId.hs @@ -0,0 +1,22 @@ +module System.Mesos.Raw.ExecutorId where +import System.Mesos.Internal + +type ExecutorIDPtr = Ptr ExecutorID + +foreign import ccall unsafe "ext/types.h toExecutorID" c_toExecutorID :: ToID ExecutorIDPtr + +foreign import ccall unsafe "ext/types.h fromExecutorID" c_fromExecutorID :: FromID ExecutorIDPtr + +foreign import ccall unsafe "ext/types.h destroyExecutorID" c_destroyExecutorID :: ExecutorIDPtr -> IO () + +instance CPPValue ExecutorID where + marshal x = do + (strp, l) <- cstring $ fromExecutorID x + liftIO $ c_toExecutorID strp $ fromIntegral l + + unmarshal p = fmap ExecutorID $ do + ptrPtr <- alloc + len <- liftIO $ c_fromExecutorID p ptrPtr + peekCString' (ptrPtr, len) + + destroy = c_destroyExecutorID diff --git a/src/System/Mesos/Raw/ExecutorInfo.hs b/src/System/Mesos/Raw/ExecutorInfo.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/ExecutorInfo.hs @@ -0,0 +1,96 @@ +module System.Mesos.Raw.ExecutorInfo where +import System.Mesos.Internal +import System.Mesos.Raw.CommandInfo +import System.Mesos.Raw.ContainerInfo +import System.Mesos.Raw.ExecutorId +import System.Mesos.Raw.FrameworkId +import System.Mesos.Raw.Resource + +type ExecutorInfoPtr = Ptr ExecutorInfo + +foreign import ccall unsafe "ext/types.h toExecutorInfo" c_toExecutorInfo + :: ExecutorIDPtr + -> FrameworkIDPtr + -> CommandInfoPtr + -> ContainerInfoPtr + -> Ptr ResourcePtr -- ^ resources + -> CInt -- ^ resource count + -> Ptr CChar -- ^ name + -> CInt -- ^ name length + -> Ptr CChar -- ^ source + -> CInt -- ^ source length + -> Ptr CChar -- ^ data + -> CInt -- ^ data length + -> IO ExecutorInfoPtr + +foreign import ccall unsafe "ext/types.h fromExecutorInfo" c_fromExecutorInfo + :: ExecutorInfoPtr + -> Ptr ExecutorIDPtr + -> Ptr FrameworkIDPtr + -> Ptr CommandInfoPtr + -> Ptr ContainerInfoPtr + -> Ptr (Ptr ResourcePtr) + -> Ptr CInt + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr (Ptr CChar) + -> Ptr CInt + -> IO () + +foreign import ccall unsafe "ext/types.h destroyExecutorInfo" c_destroyExecutorInfo + :: ExecutorInfoPtr + -> IO () + +instance CPPValue ExecutorInfo where + + marshal i = do + 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 + (rs, rLen) <- arrayLen rps + liftIO $ c_toExecutorInfo eidP fidP ciP ctrP rs (fromIntegral rLen) np (fromIntegral nl) sp (fromIntegral sl) dp (fromIntegral dl) + + unmarshal ip = do + eidP <- alloc + fidP <- alloc + ciP <- alloc + cntP <- alloc + rpP <- alloc + rpL <- alloc + enP <- alloc + enL <- alloc + esP <- alloc + esL <- alloc + edP <- alloc + edL <- alloc + poke enP nullPtr + poke esP nullPtr + poke edP nullPtr + poke cntP nullPtr + liftIO $ c_fromExecutorInfo ip eidP fidP ciP cntP rpP rpL enP enL esP esL edP edL + eid <- unmarshal =<< peek eidP + fid <- unmarshal =<< peek fidP + ci <- unmarshal =<< peek ciP + cnt <- peekMaybeCPP cntP + rl <- peek rpL + rp <- peek rpP + rps <- peekArray' (rp, fromIntegral rl) + rs <- mapM unmarshal rps + en <- peekMaybeBS enP enL + es <- peekMaybeBS esP esL + ed <- peekMaybeBS edP edL + return $ ExecutorInfo eid fid ci cnt rs en es ed + + destroy = c_destroyExecutorInfo + + equalExceptDefaults (ExecutorInfo id fid ci cnt rs n s d) (ExecutorInfo id' fid' ci' cnt' rs' n' s' d') = + id == id' && fid == fid' && equalExceptDefaults ci ci' && and (zipWith equalExceptDefaults rs rs') && n == n' && s == s' && d == d' && cnt == cnt' diff --git a/src/System/Mesos/Raw/Filters.hs b/src/System/Mesos/Raw/Filters.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/Filters.hs @@ -0,0 +1,37 @@ +module System.Mesos.Raw.Filters where +import System.Mesos.Internal + +type FiltersPtr = Ptr Filters + +foreign import ccall unsafe "ext/types.h toFilters" c_toFilters + :: Ptr CDouble + -> IO FiltersPtr + +foreign import ccall unsafe "ext/types.h fromFilters" c_fromFilters + :: FiltersPtr + -> Ptr CBool + -> Ptr CDouble + -> IO () + +foreign import ccall unsafe "ext/types.h destroyFilters" c_destroyFilters + :: FiltersPtr + -> IO () + +instance CPPValue Filters where + marshal f = case refuseSeconds f of + Nothing -> liftIO $ c_toFilters nullPtr + Just s -> do + sp <- alloc + poke sp (CDouble s) + liftIO $ c_toFilters sp + + unmarshal fp = do + rsc <- alloc + rsp <- alloc + liftIO $ c_fromFilters fp rsc rsp + ms <- peekMaybePrim rsp rsc + return $ Filters $ fmap (\(CDouble d) -> d) ms + + destroy = c_destroyFilters + + equalExceptDefaults (Filters f) (Filters f') = defEq 5.0 f f' diff --git a/src/System/Mesos/Raw/FrameworkId.hs b/src/System/Mesos/Raw/FrameworkId.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/FrameworkId.hs @@ -0,0 +1,22 @@ +module System.Mesos.Raw.FrameworkId where +import System.Mesos.Internal + +type FrameworkIDPtr = Ptr FrameworkID + +foreign import ccall unsafe "ext/types.h toFrameworkID" c_toFrameworkID :: ToID FrameworkIDPtr + +foreign import ccall unsafe "ext/types.h fromFrameworkID" c_fromFrameworkID :: FromID FrameworkIDPtr + +foreign import ccall unsafe "ext/types.h destroyFrameworkID" c_destroyFrameworkID :: FrameworkIDPtr -> IO () + +instance CPPValue FrameworkID where + marshal x = do + (strp, l) <- cstring $ fromFrameworkID x + liftIO $ c_toFrameworkID strp (fromIntegral l) + + unmarshal p = fmap FrameworkID $ do + ptrPtr <- alloc + len <- liftIO $ c_fromFrameworkID p ptrPtr + peekCString' (ptrPtr, len) + + destroy = c_destroyFrameworkID diff --git a/src/System/Mesos/Raw/FrameworkInfo.hs b/src/System/Mesos/Raw/FrameworkInfo.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/FrameworkInfo.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE OverloadedStrings #-} +module System.Mesos.Raw.FrameworkInfo where +import System.Mesos.Internal +import System.Mesos.Raw.FrameworkId + +type FrameworkInfoPtr = Ptr FrameworkInfo + +foreign import ccall "ext/types.h toFrameworkInfo" c_toFrameworkInfo + :: Ptr CChar + -> CInt + -> Ptr CChar + -> CInt + -> Ptr FrameworkIDPtr + -> Ptr CDouble + -> Ptr CBool + -> Ptr CChar + -> CInt + -> Ptr CChar + -> CInt + -> Ptr CChar + -> CInt + -> IO FrameworkInfoPtr + +foreign import ccall "ext/types.h fromFrameworkInfo" c_fromFrameworkInfo + :: FrameworkInfoPtr + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr FrameworkIDPtr + -> Ptr CBool + -> Ptr CDouble + -> Ptr CBool + -> Ptr CBool + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr (Ptr CChar) + -> Ptr CInt + -> IO () + +foreign import ccall "ext/types.h destroyFrameworkInfo" c_destroyFrameworkInfo + :: FrameworkInfoPtr + -> IO () + +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 + Nothing -> f nullPtr + Just r -> do + p <- alloc + fidp <- cppValue r + poke p fidp + f p + fidFun $ \fidp -> liftIO $ c_toFrameworkInfo up + (fromIntegral ul) + np + (fromIntegral nl) + fidp + fp' + cp' + rp + (fromIntegral rl) + hp + (fromIntegral hl) + pp + (fromIntegral pl) + + unmarshal fp = do + (up, ul) <- arrayPair + (np, nl) <- arrayPair + idp <- alloc + tps <- alloc + tp <- alloc + cps <- alloc + cp <- alloc + (rp, rl) <- arrayPair + (hp, hl) <- arrayPair + (pp, pl) <- arrayPair + + poke up nullPtr + poke ul 0 + poke np nullPtr + poke nl 0 + poke idp nullPtr + poke rp nullPtr + poke rl 0 + poke hp nullPtr + poke hl 0 + poke pp nullPtr + poke pl 0 + liftIO $ c_fromFrameworkInfo fp up ul np nl idp tps tp cps cp rp rl hp hl pp pl + ubs <- peekCString (up, ul) + nbs <- peekCString (np, nl) + mid <- do + midp <- peek idp + if midp == nullPtr + then return Nothing + else fmap Just $ unmarshal midp + mt <- fmap (fmap (\(CDouble d) -> d)) $ peekMaybePrim tp tps + mc <- fmap (fmap (== 1)) $ peekMaybePrim cp cps + mr <- peekMaybeBS rp rl + mh <- peekMaybeBS hp hl + mp <- peekMaybeBS pp pl + return $ FrameworkInfo ubs nbs mid mt mc mr mh mp + + destroy = c_destroyFrameworkInfo + + equalExceptDefaults (FrameworkInfo u n i ft cp r hn p) (FrameworkInfo u' n' i' ft' cp' r' hn' p') = + u == u' && n == n' && i == i' && defEq 0 ft ft' && defEq False cp cp' && defEq "*" r r' && hn == hn' && p == p' diff --git a/src/System/Mesos/Raw/HealthCheck.hs b/src/System/Mesos/Raw/HealthCheck.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/HealthCheck.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE OverloadedStrings #-} +module System.Mesos.Raw.HealthCheck where +import qualified Foreign.Marshal.Array as A +import System.Mesos.Internal +import System.Mesos.Raw.CommandInfo +type HealthCheckPtr = Ptr HealthCheck + +foreign import ccall unsafe "ext/types.h toHealthCheck" c_toHealthCheck + :: CBool -- ^ has_http + -> CInt -- ^ HealthCheck_HTTP.port + -> Ptr CChar -- ^ HealthCheck_HTTP.path + -> CInt -- ^ HealthCheck_HTTP.path size + -> Ptr CUInt -- ^ HealthCheck_HTTP.statuses + -> CInt -- ^ HealthCheck_HTTP.statuses size + -> Ptr CDouble -- ^ delay_seconds + -> Ptr CDouble -- ^ interval_seconds + -> Ptr CDouble -- ^ timeout_seconds + -> Ptr CUInt -- ^ consecutive_failures + -> Ptr CDouble -- ^ grace_period_seconds + -> CommandInfoPtr -- ^ command + -> IO HealthCheckPtr + +foreign import ccall unsafe "ext/types.h fromHealthCheck" c_fromHealthCheck + :: HealthCheckPtr + -> Ptr CBool -- ^ has_http + -> Ptr CInt -- ^ HealthCheck_HTTP.port + -> Ptr (Ptr CChar) -- ^ HealthCheck_HTTP.path + -> Ptr CInt -- ^ HealthCheck_HTTP.path size + -> Ptr (Ptr CUInt) -- ^ HealthCheck_HTTP.statuses + -> Ptr CInt -- ^ HealthCheck_HTTP.statuses size + -> Ptr CDouble -- ^ delay_seconds + -> Ptr CBool -- ^ delay_seconds is set? + -> Ptr CDouble -- ^ interval_seconds + -> Ptr CBool -- ^ interval_seconds is set? + -> Ptr CDouble -- ^ timeout_seconds + -> Ptr CBool -- ^ timeout_seconds is set? + -> Ptr CUInt -- ^ consecutive_failures + -> Ptr CBool -- ^ consecutive_failures is set? + -> Ptr CDouble -- ^ grace_period_seconds + -> Ptr CBool -- ^ grace_period_seconds is set? + -> Ptr CommandInfoPtr -- ^ command + -> IO () + +foreign import ccall unsafe "ext/types.h destroyHealthCheck" c_destroyHealthCheck + :: HealthCheckPtr -> IO () + +instance CPPValue HealthCheck where + + marshal hc = do + ds <- allocMaybe $ fmap CDouble $ healthCheckDelaySeconds hc + is <- allocMaybe $ fmap CDouble $ healthCheckIntervalSeconds hc + ts <- allocMaybe $ fmap CDouble $ healthCheckTimeoutSeconds hc + cf <- allocMaybe $ fmap fromIntegral $ healthCheckConsecutiveFailures hc + gs <- allocMaybe $ fmap CDouble $ healthCheckGracePeriodSeconds hc + case healthCheckStrategy hc of + CommandCheck ci -> do + cp <- cppValue ci + liftIO $ c_toHealthCheck 0 0 nullPtr 0 nullPtr 0 ds is ts cf gs cp + HTTPCheck prt path ss -> do + (pathP, pathLen) <- maybeCString path + (ssP, ssLen) <- arrayLen $ map fromIntegral ss + liftIO $ c_toHealthCheck 1 (fromIntegral prt) pathP (fromIntegral pathLen) ssP (fromIntegral ssLen) ds is ts cf gs nullPtr + + unmarshal p = do + isHttpP <- alloc + portP <- alloc + (pathP, pathL) <- arrayPair + ssPP <- alloc + ssL <- alloc + ds <- alloc + dss <- alloc + is <- alloc + iss <- alloc + ts <- alloc + tss <- alloc + cf <- alloc + cfs <- alloc + gs <- alloc + gss <- alloc + cmdP <- alloc + liftIO $ c_fromHealthCheck p isHttpP portP pathP pathL ssPP ssL ds dss is iss ts tss cf cfs gs gss cmdP + isHttp <- peek isHttpP + dSecs <- peekMaybePrim ds dss + iSecs <- peekMaybePrim is iss + tSecs <- peekMaybePrim ts tss + cFails <- peekMaybePrim cf cfs + gSecs <- peekMaybePrim gs gss + strat <- if fromCBool isHttp + then do + port <- peek portP + path <- peekMaybeCString (pathP, pathL) + sl <- peek ssL + ssP <- peek ssPP + s <- liftIO $ A.peekArray (fromIntegral sl) ssP + return $ HTTPCheck (fromIntegral port) path $ map (\(CUInt w) -> w) s + else do + cmd <- peekCPP =<< peek cmdP + return $ CommandCheck cmd + return $ HealthCheck strat (toDouble <$> dSecs) (toDouble <$> iSecs) (toDouble <$> tSecs) (fromIntegral <$> cFails) (toDouble <$> gSecs) + where + toDouble (CDouble x) = x + + destroy = c_destroyHealthCheck + + equalExceptDefaults (HealthCheck (HTTPCheck port path ss) ds is ts cf gp) (HealthCheck (HTTPCheck port' path' ss') ds' is' ts' cf' gp') = port == port' && defEq "" path path' && ss == ss' && ds == ds' && is == is' && ts == ts' && cf == cf' && gp == gp' + equalExceptDefaults (HealthCheck (CommandCheck c) ds is ts cf gp) (HealthCheck (CommandCheck c') ds' is' ts' cf' gp') = ds == ds' && is == is' && ts == ts' && cf == cf' && gp == gp' && equalExceptDefaults c c' + equalExceptDefaults _ _ = False diff --git a/src/System/Mesos/Raw/MasterInfo.hs b/src/System/Mesos/Raw/MasterInfo.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/MasterInfo.hs @@ -0,0 +1,59 @@ +module System.Mesos.Raw.MasterInfo where +import System.Mesos.Internal + +type MasterInfoPtr = Ptr MasterInfo + +foreign import ccall unsafe "ext/types.h toMasterInfo" c_toMasterInfo + :: Ptr CChar + -> CInt + -> CUInt + -> Ptr CUInt + -> Ptr CChar + -> CInt + -> Ptr CChar + -> CInt + -> IO MasterInfoPtr + +foreign import ccall unsafe "ext/types.h fromMasterInfo" c_fromMasterInfo + :: MasterInfoPtr + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr CUInt + -> Ptr CUInt + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr (Ptr CChar) + -> Ptr CInt + -> IO () + +foreign import ccall unsafe "ext/types.h destroyMasterInfo" c_destroyMasterInfo + :: MasterInfoPtr + -> IO () + +instance CPPValue MasterInfo where + marshal i = do + (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) + + unmarshal i = do + (idpP, idlP) <- arrayPair + ipP <- alloc + portP <- alloc + (pidpP, pidlP) <- arrayPair + (hnpP, hnlP) <- arrayPair + poke pidpP nullPtr + poke hnpP nullPtr + liftIO $ c_fromMasterInfo i idpP idlP ipP portP pidpP pidlP hnpP hnlP + mID <- peekCString (idpP, idlP) + (CUInt ip) <- peek ipP + (CUInt port) <- peek portP + pid <- peekMaybeBS pidpP pidlP + hn <- peekMaybeBS hnpP hnlP + return $ MasterInfo mID ip (Just port) pid hn + + destroy = c_destroyMasterInfo + + equalExceptDefaults (MasterInfo mID ip p pid hn) (MasterInfo mID' ip' p' pid' hn') = mID == mID' && ip == ip' && defEq 5050 p p' && pid == pid' && hn == hn' diff --git a/src/System/Mesos/Raw/Offer.hs b/src/System/Mesos/Raw/Offer.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/Offer.hs @@ -0,0 +1,91 @@ +module System.Mesos.Raw.Offer where +import System.Mesos.Internal +import System.Mesos.Raw.Attribute +import System.Mesos.Raw.ExecutorId +import System.Mesos.Raw.FrameworkId +import System.Mesos.Raw.OfferId +import System.Mesos.Raw.Resource +import System.Mesos.Raw.SlaveId + +type OfferPtr = Ptr Offer + +foreign import ccall unsafe "ext/types.h toOffer" c_toOffer + :: OfferIDPtr + -> FrameworkIDPtr + -> SlaveIDPtr + -> Ptr CChar + -> CInt + -> Ptr ResourcePtr + -> CInt + -> Ptr AttributePtr + -> CInt + -> Ptr ExecutorIDPtr + -> CInt + -> IO OfferPtr + +foreign import ccall unsafe "ext/types.h fromOffer" c_fromOffer + :: OfferPtr + -> Ptr OfferIDPtr + -> Ptr FrameworkIDPtr + -> Ptr SlaveIDPtr + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr (Ptr ResourcePtr) + -> Ptr CInt + -> Ptr (Ptr AttributePtr) + -> Ptr CInt + -> Ptr (Ptr ExecutorIDPtr) + -> Ptr CInt + -> IO () + +foreign import ccall unsafe "ext/types.h destroyOffer" c_destroyOffer + :: OfferPtr + -> IO () + +instance CPPValue Offer where + + marshal (Offer oid fid sid hn rs as es) = do + oidP <- cppValue oid + fidP <- cppValue fid + sidP <- cppValue sid + rPs <- mapM cppValue rs + aPs <- mapM (cppValue . uncurry Attribute) as + ePs <- mapM cppValue es + (hnp, hnl) <- cstring hn + (rPP, rLen) <- arrayLen rPs + (aPP, aLen) <- arrayLen aPs + (ePP, eLen) <- arrayLen ePs + liftIO $ c_toOffer oidP fidP sidP hnp (fromIntegral hnl) rPP (fromIntegral rLen) aPP (fromIntegral aLen) ePP (fromIntegral eLen) + + unmarshal op = do + oidPP <- alloc + fidPP <- alloc + sidPP <- alloc + hnPP <- alloc + hLenP <- alloc + rPPP <- alloc + rLenP <- alloc + aPPP <- alloc + aLenP <- alloc + ePPP <- alloc + eLenP <- alloc + liftIO $ c_fromOffer op oidPP fidPP sidPP hnPP hLenP rPPP rLenP aPPP aLenP ePPP eLenP + oid <- unmarshal =<< peek oidPP + fid <- unmarshal =<< peek fidPP + sid <- unmarshal =<< peek sidPP + hn <- peekCString (hnPP, hLenP) + rPP <- peek rPPP + rs <- mapM unmarshal =<< peekArray (rPP, rLenP) + aPP <- peek aPPP + as <- mapM unmarshal =<< peekArray (aPP, aLenP) + ePP <- peek ePPP + es <- mapM unmarshal =<< peekArray (ePP, eLenP) + return $ Offer oid fid sid hn rs (map (\(Attribute k v) -> (k, v)) as) es + + destroy = c_destroyOffer + + equalExceptDefaults (Offer oid fid sid hn rs as es) (Offer oid' fid' sid' hn' rs' as' es') = + oid == oid' && fid == fid' && sid == sid' && hn == hn' && + and (zipWith equalExceptDefaults rs rs') && + and (zipWith (\l r -> equalExceptDefaults (uncurry Attribute l) (uncurry Attribute r)) as as') && + es == es' diff --git a/src/System/Mesos/Raw/OfferId.hs b/src/System/Mesos/Raw/OfferId.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/OfferId.hs @@ -0,0 +1,23 @@ +module System.Mesos.Raw.OfferId where +import System.Mesos.Internal + +type OfferIDPtr = Ptr OfferID + +foreign import ccall unsafe "ext/types.h toOfferID" c_toOfferID :: ToID OfferIDPtr + +foreign import ccall unsafe "ext/types.h fromOfferID" c_fromOfferID :: FromID OfferIDPtr + +foreign import ccall unsafe "ext/types.h destroyOfferID" c_destroyOfferID :: OfferIDPtr -> IO () + +instance CPPValue OfferID where + + marshal x = do + (strp, l) <- cstring $ fromOfferID x + liftIO $ c_toOfferID strp $ fromIntegral l + + unmarshal p = fmap OfferID $ do + ptrPtr <- alloc + len <- liftIO $ c_fromOfferID p ptrPtr + peekCString' (ptrPtr, len) + + destroy = c_destroyOfferID diff --git a/src/System/Mesos/Raw/Parameter.hs b/src/System/Mesos/Raw/Parameter.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/Parameter.hs @@ -0,0 +1,43 @@ +module System.Mesos.Raw.Parameter where +import System.Mesos.Internal + +type ParameterPtr = Ptr Parameter + +data Parameter = Parameter ByteString ByteString + deriving (Eq, Show) + +foreign import ccall unsafe "ext/types.h toParameter" c_toParameter + :: Ptr CChar + -> CInt + -> Ptr CChar + -> CInt + -> IO ParameterPtr + +foreign import ccall unsafe "ext/types.h fromParameter" c_fromParameter + :: ParameterPtr + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr (Ptr CChar) + -> Ptr CInt + -> IO () + +foreign import ccall unsafe "ext/types.h destroyParameter" c_destroyParameter + :: ParameterPtr + -> IO () + +instance CPPValue Parameter where + + marshal (Parameter key value) = do + k@(kp, kl) <- cstring key + v@(vp, vl) <- cstring value + liftIO $ c_toParameter kp (fromIntegral kl) vp (fromIntegral vl) + + unmarshal p = do + kp@(kpp, klp) <- arrayPair + vp@(vpp, vlp) <- arrayPair + liftIO $ c_fromParameter p kpp klp vpp vlp + k <- peekCString kp + v <- peekCString vp + return $ Parameter k v + + destroy = c_destroyParameter diff --git a/src/System/Mesos/Raw/Parameters.hs b/src/System/Mesos/Raw/Parameters.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/Parameters.hs @@ -0,0 +1,41 @@ +module System.Mesos.Raw.Parameters where +import System.Mesos.Internal +import System.Mesos.Raw.Parameter + +type ParametersPtr = Ptr Parameters + +newtype Parameters = Parameters [Parameter] + deriving (Eq, Show) + +foreign import ccall unsafe "ext/types.h toParameters" c_toParameters + :: Ptr ParameterPtr + -> CInt + -> IO ParametersPtr + +foreign import ccall unsafe "ext/types.h fromParameters" c_fromParameters + :: ParametersPtr + -> Ptr (Ptr ParameterPtr) + -> Ptr CInt + -> IO () + +foreign import ccall unsafe "ext/types.h destroyParameters" c_destroyParameters + :: ParametersPtr + -> IO () + +instance CPPValue Parameters where + + marshal (Parameters ps) = do + pps <- mapM cppValue ps + (pp, pl) <- arrayLen pps + liftIO $ c_toParameters pp (fromIntegral pl) + + unmarshal p = do + ppp <- alloc + plp <- alloc + liftIO $ c_fromParameters p ppp plp + pp <- peek ppp + pl <- peek plp + ps <- peekArray' (pp, fromIntegral pl) + fmap Parameters $ mapM unmarshal ps + + destroy = c_destroyParameters diff --git a/src/System/Mesos/Raw/PerformanceStatistics.hs b/src/System/Mesos/Raw/PerformanceStatistics.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/PerformanceStatistics.hs @@ -0,0 +1,660 @@ +module System.Mesos.Raw.PerformanceStatistics where +import System.Mesos.Internal + +type PerformanceStatisticsPtr = Ptr PerformanceStatistics + +foreign import ccall unsafe "ext/types.h toPerfStatistics" c_toPerfStatistics + :: CDouble -- ^ timestamp + -> CDouble -- ^ duration + -> (Ptr CULong) -- ^ cycles + -> (Ptr CULong) -- ^ stalledCyclesFrontend + -> (Ptr CULong) -- ^ stalledCyclesBackend + -> (Ptr CULong) -- ^ instructions + -> (Ptr CULong) -- ^ cacheReferences + -> (Ptr CULong) -- ^ cacheMisses + -> (Ptr CULong) -- ^ branches + -> (Ptr CULong) -- ^ branchMisses + -> (Ptr CULong) -- ^ busCycles + -> (Ptr CULong) -- ^ refCycles + -> (Ptr CDouble) -- ^ cpuClock + -> (Ptr CDouble) -- ^ taskClock + -> (Ptr CULong) -- ^ pageFaults + -> (Ptr CULong) -- ^ minorFaults + -> (Ptr CULong) -- ^ majorFaults + -> (Ptr CULong) -- ^ contextSwitches + -> (Ptr CULong) -- ^ cpuMigrations + -> (Ptr CULong) -- ^ alignmentFaults + -> (Ptr CULong) -- ^ emulationFaults + -> (Ptr CULong) -- ^ l1DcacheLoads + -> (Ptr CULong) -- ^ l1DcacheLoadMisses + -> (Ptr CULong) -- ^ l1DcacheStores + -> (Ptr CULong) -- ^ l1DcacheStoreMisses + -> (Ptr CULong) -- ^ l1DcachePrefetches + -> (Ptr CULong) -- ^ l1DcachePrefetchMisses + -> (Ptr CULong) -- ^ l1IcacheLoads + -> (Ptr CULong) -- ^ l1IcacheLoadMisses + -> (Ptr CULong) -- ^ l1IcachePrefetches + -> (Ptr CULong) -- ^ l1IcachePrefetchMisses + -> (Ptr CULong) -- ^ llcLoads + -> (Ptr CULong) -- ^ llcLoadMisses + -> (Ptr CULong) -- ^ llcStores + -> (Ptr CULong) -- ^ llcStoreMisses + -> (Ptr CULong) -- ^ llcPrefetches + -> (Ptr CULong) -- ^ llcPrefetchMisses + -> (Ptr CULong) -- ^ dtlbLoads + -> (Ptr CULong) -- ^ dtlbLoadMisses + -> (Ptr CULong) -- ^ dtlbStores + -> (Ptr CULong) -- ^ dtlbStoreMisses + -> (Ptr CULong) -- ^ dtlbPrefetches + -> (Ptr CULong) -- ^ dtlbPrefetchMisses + -> (Ptr CULong) -- ^ itlbLoads + -> (Ptr CULong) -- ^ itlbLoadMisses + -> (Ptr CULong) -- ^ branchLoads + -> (Ptr CULong) -- ^ branchLoadMisses + -> (Ptr CULong) -- ^ nodeLoads + -> (Ptr CULong) -- ^ nodeLoadMisses + -> (Ptr CULong) -- ^ nodeStores + -> (Ptr CULong) -- ^ nodeStoreMisses + -> (Ptr CULong) -- ^ nodePrefetches + -> (Ptr CULong) -- ^ nodePrefetchMisses + -> IO PerformanceStatisticsPtr + +foreign import ccall unsafe "ext/types.h fromPerfStatistics" c_fromPerfStatistics + :: PerformanceStatisticsPtr + -> (Ptr CDouble) -- ^ timestamp + -> (Ptr CDouble) -- ^ duration + -> (Ptr CULong) -- ^ cycles + -> (Ptr CBool) -- ^ cyclesSet + -> (Ptr CULong) -- ^ stalledCyclesFrontend + -> (Ptr CBool) -- ^ stalledCyclesFrontendSet + -> (Ptr CULong) -- ^ stalledCyclesBackend + -> (Ptr CBool) -- ^ stalledCyclesBackendSet + -> (Ptr CULong) -- ^ instructions + -> (Ptr CBool) -- ^ instructionsSet + -> (Ptr CULong) -- ^ cacheReferences + -> (Ptr CBool) -- ^ cacheReferencesSet + -> (Ptr CULong) -- ^ cacheMisses + -> (Ptr CBool) -- ^ cacheMissesSet + -> (Ptr CULong) -- ^ branches + -> (Ptr CBool) -- ^ branchesSet + -> (Ptr CULong) -- ^ branchMisses + -> (Ptr CBool) -- ^ branchMissesSet + -> (Ptr CULong) -- ^ busCycles + -> (Ptr CBool) -- ^ busCyclesSet + -> (Ptr CULong) -- ^ refCycles + -> (Ptr CBool) -- ^ refCyclesSet + -> (Ptr CDouble) -- ^ cpuClock + -> (Ptr CBool) -- ^ cpuClockSet + -> (Ptr CDouble) -- ^ taskClock + -> (Ptr CBool) -- ^ taskClockSet + -> (Ptr CULong) -- ^ pageFaults + -> (Ptr CBool) -- ^ pageFaultsSet + -> (Ptr CULong) -- ^ minorFaults + -> (Ptr CBool) -- ^ minorFaultsSet + -> (Ptr CULong) -- ^ majorFaults + -> (Ptr CBool) -- ^ majorFaultsSet + -> (Ptr CULong) -- ^ contextSwitches + -> (Ptr CBool) -- ^ contextSwitchesSet + -> (Ptr CULong) -- ^ cpuMigrations + -> (Ptr CBool) -- ^ cpuMigrationsSet + -> (Ptr CULong) -- ^ alignmentFaults + -> (Ptr CBool) -- ^ alignmentFaultsSet + -> (Ptr CULong) -- ^ emulationFaults + -> (Ptr CBool) -- ^ emulationFaultsSet + -> (Ptr CULong) -- ^ l1DcacheLoads + -> (Ptr CBool) -- ^ l1DcacheLoadsSet + -> (Ptr CULong) -- ^ l1DcacheLoadMisses + -> (Ptr CBool) -- ^ l1DcacheLoadMissesSet + -> (Ptr CULong) -- ^ l1DcacheStores + -> (Ptr CBool) -- ^ l1DcacheStoresSet + -> (Ptr CULong) -- ^ l1DcacheStoreMisses + -> (Ptr CBool) -- ^ l1DcacheStoreMissesSet + -> (Ptr CULong) -- ^ l1DcachePrefetches + -> (Ptr CBool) -- ^ l1DcachePrefetchesSet + -> (Ptr CULong) -- ^ l1DcachePrefetchMisses + -> (Ptr CBool) -- ^ l1DcachePrefetchMissesSet + -> (Ptr CULong) -- ^ l1IcacheLoads + -> (Ptr CBool) -- ^ l1IcacheLoadsSet + -> (Ptr CULong) -- ^ l1IcacheLoadMisses + -> (Ptr CBool) -- ^ l1IcacheLoadMissesSet + -> (Ptr CULong) -- ^ l1IcachePrefetches + -> (Ptr CBool) -- ^ l1IcachePrefetchesSet + -> (Ptr CULong) -- ^ l1IcachePrefetchMisses + -> (Ptr CBool) -- ^ l1IcachePrefetchMissesSet + -> (Ptr CULong) -- ^ llcLoads + -> (Ptr CBool) -- ^ llcLoadsSet + -> (Ptr CULong) -- ^ llcLoadMisses + -> (Ptr CBool) -- ^ llcLoadMissesSet + -> (Ptr CULong) -- ^ llcStores + -> (Ptr CBool) -- ^ llcStoresSet + -> (Ptr CULong) -- ^ llcStoreMisses + -> (Ptr CBool) -- ^ llcStoreMissesSet + -> (Ptr CULong) -- ^ llcPrefetches + -> (Ptr CBool) -- ^ llcPrefetchesSet + -> (Ptr CULong) -- ^ llcPrefetchMisses + -> (Ptr CBool) -- ^ llcPrefetchMissesSet + -> (Ptr CULong) -- ^ dtlbLoads + -> (Ptr CBool) -- ^ dtlbLoadsSet + -> (Ptr CULong) -- ^ dtlbLoadMisses + -> (Ptr CBool) -- ^ dtlbLoadMissesSet + -> (Ptr CULong) -- ^ dtlbStores + -> (Ptr CBool) -- ^ dtlbStoresSet + -> (Ptr CULong) -- ^ dtlbStoreMisses + -> (Ptr CBool) -- ^ dtlbStoreMissesSet + -> (Ptr CULong) -- ^ dtlbPrefetches + -> (Ptr CBool) -- ^ dtlbPrefetchesSet + -> (Ptr CULong) -- ^ dtlbPrefetchMisses + -> (Ptr CBool) -- ^ dtlbPrefetchMissesSet + -> (Ptr CULong) -- ^ itlbLoads + -> (Ptr CBool) -- ^ itlbLoadsSet + -> (Ptr CULong) -- ^ itlbLoadMisses + -> (Ptr CBool) -- ^ itlbLoadMissesSet + -> (Ptr CULong) -- ^ branchLoads + -> (Ptr CBool) -- ^ branchLoadsSet + -> (Ptr CULong) -- ^ branchLoadMisses + -> (Ptr CBool) -- ^ branchLoadMissesSet + -> (Ptr CULong) -- ^ nodeLoads + -> (Ptr CBool) -- ^ nodeLoadsSet + -> (Ptr CULong) -- ^ nodeLoadMisses + -> (Ptr CBool) -- ^ nodeLoadMissesSet + -> (Ptr CULong) -- ^ nodeStores + -> (Ptr CBool) -- ^ nodeStoresSet + -> (Ptr CULong) -- ^ nodeStoreMisses + -> (Ptr CBool) -- ^ nodeStoreMissesSet + -> (Ptr CULong) -- ^ nodePrefetches + -> (Ptr CBool) -- ^ nodePrefetchesSet + -> (Ptr CULong) -- ^ nodePrefetchMisses + -> (Ptr CBool) -- ^ nodePrefetchMissesSet + -> IO () + +foreign import ccall unsafe "ext/types.h destroyPerfStatistics" c_destroyPerfStatistics + :: PerformanceStatisticsPtr -> IO () + +instance CPPValue PerformanceStatistics where + marshal x = do + cyclesP <- allocMaybe $ fmap CULong $ performanceStatisticsCycles x + stalledCyclesFrontendP <- allocMaybe $ fmap CULong $ performanceStatisticsStalledCyclesFrontend x + stalledCyclesBackendP <- allocMaybe $ fmap CULong $ performanceStatisticsStalledCyclesBackend x + instructionsP <- allocMaybe $ fmap CULong $ performanceStatisticsInstructions x + cacheReferencesP <- allocMaybe $ fmap CULong $ performanceStatisticsCacheReferences x + cacheMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsCacheMisses x + branchesP <- allocMaybe $ fmap CULong $ performanceStatisticsBranches x + branchMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsBranchMisses x + busCyclesP <- allocMaybe $ fmap CULong $ performanceStatisticsBusCycles x + refCyclesP <- allocMaybe $ fmap CULong $ performanceStatisticsRefCycles x + cpuClockP <- allocMaybe $ fmap CDouble $ performanceStatisticsCpuClock x + taskClockP <- allocMaybe $ fmap CDouble $ performanceStatisticsTaskClock x + pageFaultsP <- allocMaybe $ fmap CULong $ performanceStatisticsPageFaults x + minorFaultsP <- allocMaybe $ fmap CULong $ performanceStatisticsMinorFaults x + majorFaultsP <- allocMaybe $ fmap CULong $ performanceStatisticsMajorFaults x + contextSwitchesP <- allocMaybe $ fmap CULong $ performanceStatisticsContextSwitches x + cpuMigrationsP <- allocMaybe $ fmap CULong $ performanceStatisticsCpuMigrations x + alignmentFaultsP <- allocMaybe $ fmap CULong $ performanceStatisticsAlignmentFaults x + emulationFaultsP <- allocMaybe $ fmap CULong $ performanceStatisticsEmulationFaults x + l1DcacheLoadsP <- allocMaybe $ fmap CULong $ performanceStatisticsL1DcacheLoads x + l1DcacheLoadMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsL1DcacheLoadMisses x + l1DcacheStoresP <- allocMaybe $ fmap CULong $ performanceStatisticsL1DcacheStores x + l1DcacheStoreMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsL1DcacheStoreMisses x + l1DcachePrefetchesP <- allocMaybe $ fmap CULong $ performanceStatisticsL1DcachePrefetches x + l1DcachePrefetchMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsL1DcachePrefetchMisses x + l1IcacheLoadsP <- allocMaybe $ fmap CULong $ performanceStatisticsL1IcacheLoads x + l1IcacheLoadMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsL1IcacheLoadMisses x + l1IcachePrefetchesP <- allocMaybe $ fmap CULong $ performanceStatisticsL1IcachePrefetches x + l1IcachePrefetchMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsL1IcachePrefetchMisses x + llcLoadsP <- allocMaybe $ fmap CULong $ performanceStatisticsLlcLoads x + llcLoadMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsLlcLoadMisses x + llcStoresP <- allocMaybe $ fmap CULong $ performanceStatisticsLlcStores x + llcStoreMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsLlcStoreMisses x + llcPrefetchesP <- allocMaybe $ fmap CULong $ performanceStatisticsLlcPrefetches x + llcPrefetchMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsLlcPrefetchMisses x + dtlbLoadsP <- allocMaybe $ fmap CULong $ performanceStatisticsDtlbLoads x + dtlbLoadMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsDtlbLoadMisses x + dtlbStoresP <- allocMaybe $ fmap CULong $ performanceStatisticsDtlbStores x + dtlbStoreMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsDtlbStoreMisses x + dtlbPrefetchesP <- allocMaybe $ fmap CULong $ performanceStatisticsDtlbPrefetches x + dtlbPrefetchMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsDtlbPrefetchMisses x + itlbLoadsP <- allocMaybe $ fmap CULong $ performanceStatisticsItlbLoads x + itlbLoadMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsItlbLoadMisses x + branchLoadsP <- allocMaybe $ fmap CULong $ performanceStatisticsBranchLoads x + branchLoadMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsBranchLoadMisses x + nodeLoadsP <- allocMaybe $ fmap CULong $ performanceStatisticsNodeLoads x + nodeLoadMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsNodeLoadMisses x + nodeStoresP <- allocMaybe $ fmap CULong $ performanceStatisticsNodeStores x + nodeStoreMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsNodeStoreMisses x + nodePrefetchesP <- allocMaybe $ fmap CULong $ performanceStatisticsNodePrefetches x + nodePrefetchMissesP <- allocMaybe $ fmap CULong $ performanceStatisticsNodePrefetchMisses x + liftIO $ c_toPerfStatistics + (CDouble $ performanceStatisticsTimestamp x) + (CDouble $ performanceStatisticsDuration x) + cyclesP + stalledCyclesFrontendP + stalledCyclesBackendP + instructionsP + cacheReferencesP + cacheMissesP + branchesP + branchMissesP + busCyclesP + refCyclesP + cpuClockP + taskClockP + pageFaultsP + minorFaultsP + majorFaultsP + contextSwitchesP + cpuMigrationsP + alignmentFaultsP + emulationFaultsP + l1DcacheLoadsP + l1DcacheLoadMissesP + l1DcacheStoresP + l1DcacheStoreMissesP + l1DcachePrefetchesP + l1DcachePrefetchMissesP + l1IcacheLoadsP + l1IcacheLoadMissesP + l1IcachePrefetchesP + l1IcachePrefetchMissesP + llcLoadsP + llcLoadMissesP + llcStoresP + llcStoreMissesP + llcPrefetchesP + llcPrefetchMissesP + dtlbLoadsP + dtlbLoadMissesP + dtlbStoresP + dtlbStoreMissesP + dtlbPrefetchesP + dtlbPrefetchMissesP + itlbLoadsP + itlbLoadMissesP + branchLoadsP + branchLoadMissesP + nodeLoadsP + nodeLoadMissesP + nodeStoresP + nodeStoreMissesP + nodePrefetchesP + nodePrefetchMissesP + + unmarshal p = do + timestampP <- alloc + durationP <- alloc + cyclesP <- alloc + cyclesSP <- alloc + poke cyclesSP 0 + stalledCyclesFrontendP <- alloc + stalledCyclesFrontendSP <- alloc + poke stalledCyclesFrontendSP 0 + stalledCyclesBackendP <- alloc + stalledCyclesBackendSP <- alloc + poke stalledCyclesBackendSP 0 + instructionsP <- alloc + instructionsSP <- alloc + poke instructionsSP 0 + cacheReferencesP <- alloc + cacheReferencesSP <- alloc + poke cacheReferencesSP 0 + cacheMissesP <- alloc + cacheMissesSP <- alloc + poke cacheMissesSP 0 + branchesP <- alloc + branchesSP <- alloc + poke branchesSP 0 + branchMissesP <- alloc + branchMissesSP <- alloc + poke branchMissesSP 0 + busCyclesP <- alloc + busCyclesSP <- alloc + poke busCyclesSP 0 + refCyclesP <- alloc + refCyclesSP <- alloc + poke refCyclesSP 0 + cpuClockP <- alloc + cpuClockSP <- alloc + poke cpuClockSP 0 + taskClockP <- alloc + taskClockSP <- alloc + poke taskClockSP 0 + pageFaultsP <- alloc + pageFaultsSP <- alloc + poke pageFaultsSP 0 + minorFaultsP <- alloc + minorFaultsSP <- alloc + poke minorFaultsSP 0 + majorFaultsP <- alloc + majorFaultsSP <- alloc + poke majorFaultsSP 0 + contextSwitchesP <- alloc + contextSwitchesSP <- alloc + poke contextSwitchesSP 0 + cpuMigrationsP <- alloc + cpuMigrationsSP <- alloc + poke cpuMigrationsSP 0 + alignmentFaultsP <- alloc + alignmentFaultsSP <- alloc + poke alignmentFaultsSP 0 + emulationFaultsP <- alloc + emulationFaultsSP <- alloc + poke emulationFaultsSP 0 + l1DcacheLoadsP <- alloc + l1DcacheLoadsSP <- alloc + poke l1DcacheLoadsSP 0 + l1DcacheLoadMissesP <- alloc + l1DcacheLoadMissesSP <- alloc + poke l1DcacheLoadMissesSP 0 + l1DcacheStoresP <- alloc + l1DcacheStoresSP <- alloc + poke l1DcacheStoresSP 0 + l1DcacheStoreMissesP <- alloc + l1DcacheStoreMissesSP <- alloc + poke l1DcacheStoreMissesSP 0 + l1DcachePrefetchesP <- alloc + l1DcachePrefetchesSP <- alloc + poke l1DcachePrefetchesSP 0 + l1DcachePrefetchMissesP <- alloc + l1DcachePrefetchMissesSP <- alloc + poke l1DcachePrefetchMissesSP 0 + l1IcacheLoadsP <- alloc + l1IcacheLoadsSP <- alloc + poke l1IcacheLoadsSP 0 + l1IcacheLoadMissesP <- alloc + l1IcacheLoadMissesSP <- alloc + poke l1IcacheLoadMissesSP 0 + l1IcachePrefetchesP <- alloc + l1IcachePrefetchesSP <- alloc + poke l1IcachePrefetchesSP 0 + l1IcachePrefetchMissesP <- alloc + l1IcachePrefetchMissesSP <- alloc + poke l1IcachePrefetchMissesSP 0 + llcLoadsP <- alloc + llcLoadsSP <- alloc + poke llcLoadsSP 0 + llcLoadMissesP <- alloc + llcLoadMissesSP <- alloc + poke llcLoadMissesSP 0 + llcStoresP <- alloc + llcStoresSP <- alloc + poke llcStoresSP 0 + llcStoreMissesP <- alloc + llcStoreMissesSP <- alloc + poke llcStoreMissesSP 0 + llcPrefetchesP <- alloc + llcPrefetchesSP <- alloc + poke llcPrefetchesSP 0 + llcPrefetchMissesP <- alloc + llcPrefetchMissesSP <- alloc + poke llcPrefetchMissesSP 0 + dtlbLoadsP <- alloc + dtlbLoadsSP <- alloc + poke dtlbLoadsSP 0 + dtlbLoadMissesP <- alloc + dtlbLoadMissesSP <- alloc + poke dtlbLoadMissesSP 0 + dtlbStoresP <- alloc + dtlbStoresSP <- alloc + poke dtlbStoresSP 0 + dtlbStoreMissesP <- alloc + dtlbStoreMissesSP <- alloc + poke dtlbStoreMissesSP 0 + dtlbPrefetchesP <- alloc + dtlbPrefetchesSP <- alloc + poke dtlbPrefetchesSP 0 + dtlbPrefetchMissesP <- alloc + dtlbPrefetchMissesSP <- alloc + poke dtlbPrefetchMissesSP 0 + itlbLoadsP <- alloc + itlbLoadsSP <- alloc + poke itlbLoadsSP 0 + itlbLoadMissesP <- alloc + itlbLoadMissesSP <- alloc + poke itlbLoadMissesSP 0 + branchLoadsP <- alloc + branchLoadsSP <- alloc + poke branchLoadsSP 0 + branchLoadMissesP <- alloc + branchLoadMissesSP <- alloc + poke branchLoadMissesSP 0 + nodeLoadsP <- alloc + nodeLoadsSP <- alloc + poke nodeLoadsSP 0 + nodeLoadMissesP <- alloc + nodeLoadMissesSP <- alloc + poke nodeLoadMissesSP 0 + nodeStoresP <- alloc + nodeStoresSP <- alloc + poke nodeStoresSP 0 + nodeStoreMissesP <- alloc + nodeStoreMissesSP <- alloc + poke nodeStoreMissesSP 0 + nodePrefetchesP <- alloc + nodePrefetchesSP <- alloc + poke nodePrefetchesSP 0 + nodePrefetchMissesP <- alloc + nodePrefetchMissesSP <- alloc + poke nodePrefetchMissesSP 0 + liftIO $ c_fromPerfStatistics p + timestampP + durationP + cyclesP + cyclesSP + stalledCyclesFrontendP + stalledCyclesFrontendSP + stalledCyclesBackendP + stalledCyclesBackendSP + instructionsP + instructionsSP + cacheReferencesP + cacheReferencesSP + cacheMissesP + cacheMissesSP + branchesP + branchesSP + branchMissesP + branchMissesSP + busCyclesP + busCyclesSP + refCyclesP + refCyclesSP + cpuClockP + cpuClockSP + taskClockP + taskClockSP + pageFaultsP + pageFaultsSP + minorFaultsP + minorFaultsSP + majorFaultsP + majorFaultsSP + contextSwitchesP + contextSwitchesSP + cpuMigrationsP + cpuMigrationsSP + alignmentFaultsP + alignmentFaultsSP + emulationFaultsP + emulationFaultsSP + l1DcacheLoadsP + l1DcacheLoadsSP + l1DcacheLoadMissesP + l1DcacheLoadMissesSP + l1DcacheStoresP + l1DcacheStoresSP + l1DcacheStoreMissesP + l1DcacheStoreMissesSP + l1DcachePrefetchesP + l1DcachePrefetchesSP + l1DcachePrefetchMissesP + l1DcachePrefetchMissesSP + l1IcacheLoadsP + l1IcacheLoadsSP + l1IcacheLoadMissesP + l1IcacheLoadMissesSP + l1IcachePrefetchesP + l1IcachePrefetchesSP + l1IcachePrefetchMissesP + l1IcachePrefetchMissesSP + llcLoadsP + llcLoadsSP + llcLoadMissesP + llcLoadMissesSP + llcStoresP + llcStoresSP + llcStoreMissesP + llcStoreMissesSP + llcPrefetchesP + llcPrefetchesSP + llcPrefetchMissesP + llcPrefetchMissesSP + dtlbLoadsP + dtlbLoadsSP + dtlbLoadMissesP + dtlbLoadMissesSP + dtlbStoresP + dtlbStoresSP + dtlbStoreMissesP + dtlbStoreMissesSP + dtlbPrefetchesP + dtlbPrefetchesSP + dtlbPrefetchMissesP + dtlbPrefetchMissesSP + itlbLoadsP + itlbLoadsSP + itlbLoadMissesP + itlbLoadMissesSP + branchLoadsP + branchLoadsSP + branchLoadMissesP + branchLoadMissesSP + nodeLoadsP + nodeLoadsSP + nodeLoadMissesP + nodeLoadMissesSP + nodeStoresP + nodeStoresSP + nodeStoreMissesP + nodeStoreMissesSP + nodePrefetchesP + nodePrefetchesSP + nodePrefetchMissesP + nodePrefetchMissesSP + (CDouble timestamp) <- peek timestampP + (CDouble duration) <- peek durationP + cycles <- toWord64 <$> peekMaybePrim cyclesP cyclesSP + stalledCyclesFrontend <- toWord64 <$> peekMaybePrim stalledCyclesFrontendP stalledCyclesFrontendSP + stalledCyclesBackend <- toWord64 <$> peekMaybePrim stalledCyclesBackendP stalledCyclesBackendSP + instructions <- toWord64 <$> peekMaybePrim instructionsP instructionsSP + cacheReferences <- toWord64 <$> peekMaybePrim cacheReferencesP cacheReferencesSP + cacheMisses <- toWord64 <$> peekMaybePrim cacheMissesP cacheMissesSP + branches <- toWord64 <$> peekMaybePrim branchesP branchesSP + branchMisses <- toWord64 <$> peekMaybePrim branchMissesP branchMissesSP + busCycles <- toWord64 <$> peekMaybePrim busCyclesP busCyclesSP + refCycles <- toWord64 <$> peekMaybePrim refCyclesP refCyclesSP + cpuClock <- toDouble <$> peekMaybePrim cpuClockP cpuClockSP + taskClock <- toDouble <$> peekMaybePrim taskClockP taskClockSP + pageFaults <- toWord64 <$> peekMaybePrim pageFaultsP pageFaultsSP + minorFaults <- toWord64 <$> peekMaybePrim minorFaultsP minorFaultsSP + majorFaults <- toWord64 <$> peekMaybePrim majorFaultsP majorFaultsSP + contextSwitches <- toWord64 <$> peekMaybePrim contextSwitchesP contextSwitchesSP + cpuMigrations <- toWord64 <$> peekMaybePrim cpuMigrationsP cpuMigrationsSP + alignmentFaults <- toWord64 <$> peekMaybePrim alignmentFaultsP alignmentFaultsSP + emulationFaults <- toWord64 <$> peekMaybePrim emulationFaultsP emulationFaultsSP + l1DcacheLoads <- toWord64 <$> peekMaybePrim l1DcacheLoadsP l1DcacheLoadsSP + l1DcacheLoadMisses <- toWord64 <$> peekMaybePrim l1DcacheLoadMissesP l1DcacheLoadMissesSP + l1DcacheStores <- toWord64 <$> peekMaybePrim l1DcacheStoresP l1DcacheStoresSP + l1DcacheStoreMisses <- toWord64 <$> peekMaybePrim l1DcacheStoreMissesP l1DcacheStoreMissesSP + l1DcachePrefetches <- toWord64 <$> peekMaybePrim l1DcachePrefetchesP l1DcachePrefetchesSP + l1DcachePrefetchMisses <- toWord64 <$> peekMaybePrim l1DcachePrefetchMissesP l1DcachePrefetchMissesSP + l1IcacheLoads <- toWord64 <$> peekMaybePrim l1IcacheLoadsP l1IcacheLoadsSP + l1IcacheLoadMisses <- toWord64 <$> peekMaybePrim l1IcacheLoadMissesP l1IcacheLoadMissesSP + l1IcachePrefetches <- toWord64 <$> peekMaybePrim l1IcachePrefetchesP l1IcachePrefetchesSP + l1IcachePrefetchMisses <- toWord64 <$> peekMaybePrim l1IcachePrefetchMissesP l1IcachePrefetchMissesSP + llcLoads <- toWord64 <$> peekMaybePrim llcLoadsP llcLoadsSP + llcLoadMisses <- toWord64 <$> peekMaybePrim llcLoadMissesP llcLoadMissesSP + llcStores <- toWord64 <$> peekMaybePrim llcStoresP llcStoresSP + llcStoreMisses <- toWord64 <$> peekMaybePrim llcStoreMissesP llcStoreMissesSP + llcPrefetches <- toWord64 <$> peekMaybePrim llcPrefetchesP llcPrefetchesSP + llcPrefetchMisses <- toWord64 <$> peekMaybePrim llcPrefetchMissesP llcPrefetchMissesSP + dtlbLoads <- toWord64 <$> peekMaybePrim dtlbLoadsP dtlbLoadsSP + dtlbLoadMisses <- toWord64 <$> peekMaybePrim dtlbLoadMissesP dtlbLoadMissesSP + dtlbStores <- toWord64 <$> peekMaybePrim dtlbStoresP dtlbStoresSP + dtlbStoreMisses <- toWord64 <$> peekMaybePrim dtlbStoreMissesP dtlbStoreMissesSP + dtlbPrefetches <- toWord64 <$> peekMaybePrim dtlbPrefetchesP dtlbPrefetchesSP + dtlbPrefetchMisses <- toWord64 <$> peekMaybePrim dtlbPrefetchMissesP dtlbPrefetchMissesSP + itlbLoads <- toWord64 <$> peekMaybePrim itlbLoadsP itlbLoadsSP + itlbLoadMisses <- toWord64 <$> peekMaybePrim itlbLoadMissesP itlbLoadMissesSP + branchLoads <- toWord64 <$> peekMaybePrim branchLoadsP branchLoadsSP + branchLoadMisses <- toWord64 <$> peekMaybePrim branchLoadMissesP branchLoadMissesSP + nodeLoads <- toWord64 <$> peekMaybePrim nodeLoadsP nodeLoadsSP + nodeLoadMisses <- toWord64 <$> peekMaybePrim nodeLoadMissesP nodeLoadMissesSP + nodeStores <- toWord64 <$> peekMaybePrim nodeStoresP nodeStoresSP + nodeStoreMisses <- toWord64 <$> peekMaybePrim nodeStoreMissesP nodeStoreMissesSP + nodePrefetches <- toWord64 <$> peekMaybePrim nodePrefetchesP nodePrefetchesSP + nodePrefetchMisses <- toWord64 <$> peekMaybePrim nodePrefetchMissesP nodePrefetchMissesSP + + return $ PerformanceStatistics + timestamp + duration + cycles + stalledCyclesFrontend + stalledCyclesBackend + instructions + cacheReferences + cacheMisses + branches + branchMisses + busCycles + refCycles + cpuClock + taskClock + pageFaults + minorFaults + majorFaults + contextSwitches + cpuMigrations + alignmentFaults + emulationFaults + l1DcacheLoads + l1DcacheLoadMisses + l1DcacheStores + l1DcacheStoreMisses + l1DcachePrefetches + l1DcachePrefetchMisses + l1IcacheLoads + l1IcacheLoadMisses + l1IcachePrefetches + l1IcachePrefetchMisses + llcLoads + llcLoadMisses + llcStores + llcStoreMisses + llcPrefetches + llcPrefetchMisses + dtlbLoads + dtlbLoadMisses + dtlbStores + dtlbStoreMisses + dtlbPrefetches + dtlbPrefetchMisses + itlbLoads + itlbLoadMisses + branchLoads + branchLoadMisses + nodeLoads + nodeLoadMisses + nodeStores + nodeStoreMisses + nodePrefetches + nodePrefetchMisses + + where + toDouble mx = case mx of + Nothing -> Nothing + Just (CDouble x) -> Just x + toWord64 mx = case mx of + Nothing -> Nothing + Just (CULong x) -> Just x + + destroy = c_destroyPerfStatistics + diff --git a/src/System/Mesos/Raw/Request.hs b/src/System/Mesos/Raw/Request.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/Request.hs @@ -0,0 +1,49 @@ +module System.Mesos.Raw.Request where +import System.Mesos.Internal +import System.Mesos.Raw.Resource +import System.Mesos.Raw.SlaveId + +type RequestPtr = Ptr Request + +foreign import ccall unsafe "ext/types.h toRequest" c_toRequest + :: SlaveIDPtr + -> Ptr ResourcePtr + -> CInt + -> IO RequestPtr + +foreign import ccall unsafe "ext/types.h fromRequest" c_fromRequest + :: RequestPtr + -> Ptr SlaveIDPtr + -> Ptr (Ptr ResourcePtr) + -> Ptr CInt + -> IO () + +foreign import ccall unsafe "ext/types.h destroyRequest" c_destroyRequest + :: RequestPtr + -> IO () + +instance CPPValue Request where + marshal r = do + sp <- maybe (return nullPtr) cppValue $ requestSlaveID r + rps <- mapM cppValue $ reqResources r + (rpp, rl) <- arrayLen rps + liftIO $ c_toRequest sp rpp (fromIntegral rl) + + unmarshal r = do + spp <- alloc + rpp <- alloc + rlp <- alloc + poke spp nullPtr + liftIO $ c_fromRequest r spp rpp rlp + sp <- peek spp + rp <- peek rpp + rps <- peekArray (rp, rlp) + rs <- mapM unmarshal rps + s <- if sp == nullPtr + then return Nothing + else fmap Just $ unmarshal sp + return $ Request s rs + + destroy = c_destroyRequest + + equalExceptDefaults (Request sid rs) (Request sid' rs') = sid == sid' && and (zipWith equalExceptDefaults rs rs') diff --git a/src/System/Mesos/Raw/Resource.hs b/src/System/Mesos/Raw/Resource.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/Resource.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} +module System.Mesos.Raw.Resource where +import System.Mesos.Internal +import System.Mesos.Raw.Value + +type ResourcePtr = Ptr Resource + +foreign import ccall unsafe "ext/types.h toResource" c_toResource + :: Ptr CChar + -> CInt + -> ValuePtr + -> Ptr CChar + -> CInt + -> IO ResourcePtr +foreign import ccall unsafe "ext/types.h fromResource" c_fromResource + :: ResourcePtr + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr ValuePtr + -> Ptr (Ptr CChar) + -> Ptr CInt + -> IO () +foreign import ccall unsafe "ext/types.h destroyResource" c_destroyResource + :: ResourcePtr + -> IO () + +instance CPPValue Resource where + marshal r = do + (np, nl) <- cstring $ resourceName r + (rp, rl) <- maybeCString $ resourceRole r + vp <- cppValue $ resourceValue r + liftIO $ c_toResource np (fromIntegral nl) vp rp (fromIntegral rl) + + unmarshal r = do + np@(npp, nlp) <- arrayPair + vpp <- alloc + rp@(rpp, rlp) <- arrayPair + liftIO $ c_fromResource r npp nlp vpp rpp rlp + n <- peekCString np + vp <- peek vpp + v <- unmarshal vp + r <- peekMaybeCString rp + return $ Resource n v r + + destroy = c_destroyResource + + equalExceptDefaults (Resource n v r) (Resource n' v' r') = (n == n') && + textToSet v v' && + defEq "*" r r' + where + textToSet (Text t) (Set s) = [t] == s + textToSet (Set s) (Text t) = [t] == s + textToSet v v' = equalExceptDefaults v v' diff --git a/src/System/Mesos/Raw/ResourceStatistics.hs b/src/System/Mesos/Raw/ResourceStatistics.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/ResourceStatistics.hs @@ -0,0 +1,249 @@ +module System.Mesos.Raw.ResourceStatistics where +import System.Mesos.Internal +import System.Mesos.Raw.PerformanceStatistics + +type ResourceStatisticsPtr = Ptr ResourceStatistics + +foreign import ccall unsafe "ext/types.h toResourceStatistics" c_toResourceStatistics + :: CDouble + -> Ptr CDouble + -> Ptr CDouble + -> CDouble + -> Ptr CUInt + -> Ptr CUInt + -> Ptr CDouble + -> Ptr CULong + -> Ptr CULong + -> Ptr CULong + -> Ptr CULong + -> Ptr CULong + -> PerformanceStatisticsPtr + -> Ptr CULong + -> Ptr CULong + -> Ptr CULong + -> Ptr CULong + -> Ptr CULong + -> Ptr CULong + -> Ptr CULong + -> Ptr CULong + -> IO ResourceStatisticsPtr + +foreign import ccall unsafe "ext/types.h fromResourceStatistics" c_fromResourceStatistics + :: ResourceStatisticsPtr + -> Ptr CDouble + -> Ptr CDouble + -> Ptr CBool + -> Ptr CDouble + -> Ptr CBool + -> Ptr CDouble + -> Ptr CUInt + -> Ptr CBool + -> Ptr CUInt + -> Ptr CBool + -> Ptr CDouble + -> Ptr CBool + -> Ptr CULong + -> Ptr CBool + -> Ptr CULong + -> Ptr CBool + -> Ptr CULong + -> Ptr CBool + -> Ptr CULong + -> Ptr CBool + -> Ptr CULong + -> Ptr CBool + -> Ptr PerformanceStatisticsPtr + -> Ptr CULong + -> Ptr CBool + -> Ptr CULong + -> Ptr CBool + -> Ptr CULong + -> Ptr CBool + -> Ptr CULong + -> Ptr CBool + -> Ptr CULong + -> Ptr CBool + -> Ptr CULong + -> Ptr CBool + -> Ptr CULong + -> Ptr CBool + -> Ptr CULong + -> Ptr CBool + -> IO () + +foreign import ccall unsafe "ext/types.h destroyResourceStatistics" c_destroyResourceStatistics + :: ResourceStatisticsPtr + -> IO () + +instance CPPValue ResourceStatistics where + + marshal s = do + cpuUTS <- alloc + cpuSTS <- alloc + cpuPs <- alloc + cpuT <- alloc + cpuTTS <- alloc + memRSS <- alloc + memLB <- alloc + 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 + 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 + liftIO $ c_toResourceStatistics (CDouble $ resourceStatisticsTimestamp s) + + cpuUTS' + cpuSTS' + (CDouble $ resourceCPUsLimit s) + cpuPs' + cpuT' + cpuTTS' + memRSS' + memLB' + memFB' + memAB' + memMB' + perf + netRXP + netRXB + netRXE + netRXD + netTXP + netTXB + netTXE + netTXD + + unmarshal s = do + tsP <- alloc + cpuLP <- alloc + cpuUTSP <- alloc + cpuUTSSP <- alloc + cpuSTSP <- alloc + cpuSTSSP <- alloc + cpuPsP <- alloc + cpuPsSP <- alloc + cpuTP <- alloc + cpuTSP <- alloc + cpuTTSP <- alloc + cpuTTSSP <- alloc + memRSSP <- alloc + memRSSSP <- alloc + memLBP <- alloc + memLBSP <- alloc + memFBP <- alloc + memFBSP <- alloc + memABP <- alloc + memABSP <- alloc + memMBP <- alloc + memMBSP <- alloc + perfP <- alloc + netRXPP <- alloc + netRXPSP <- alloc + netRXBP <- alloc + netRXBSP <- alloc + netRXEP <- alloc + netRXESP <- alloc + netRXDP <- alloc + netRXDSP <- alloc + netTXPP <- alloc + netTXPSP <- alloc + netTXBP <- alloc + netTXBSP <- alloc + netTXEP <- alloc + netTXESP <- alloc + netTXDP <- alloc + netTXDSP <- alloc + liftIO $ c_fromResourceStatistics s + tsP + cpuUTSP + cpuUTSSP + cpuSTSP + cpuSTSSP + cpuLP + cpuPsP + cpuPsSP + cpuTP + cpuTSP + cpuTTSP + cpuTTSSP + memRSSP + memRSSSP + memLBP + memLBSP + memFBP + memFBSP + memABP + memABSP + memMBP + memMBSP + perfP + netRXPP + netRXPSP + netRXBP + netRXBSP + netRXEP + netRXESP + netRXDP + netRXDSP + netTXPP + netTXPSP + netTXBP + netTXBSP + netTXEP + netTXESP + netTXDP + netTXDSP + (CDouble ts) <- peek tsP + cpuUTS <- toDouble <$> peekMaybePrim cpuUTSP cpuUTSSP + cpuSTS <- toDouble <$> peekMaybePrim cpuSTSP cpuSTSSP + (CDouble l) <- peek cpuLP + cpuPs <- toWord32 <$> peekMaybePrim cpuPsP cpuPsSP + cpuT <- toWord32 <$> peekMaybePrim cpuTP cpuTSP + cpuTTS <- toDouble <$> peekMaybePrim cpuTTSP cpuTTSSP + memRSS <- toWord64 <$> peekMaybePrim memRSSP memRSSSP + memLB <- toWord64 <$> peekMaybePrim memLBP memLBSP + memFB <- toWord64 <$> peekMaybePrim memFBP memFBSP + memAB <- toWord64 <$> peekMaybePrim memABP memABSP + memMB <- toWord64 <$> peekMaybePrim memMBP memMBSP + perfStats <- peekMaybeCPP perfP + netRXP <- toWord64 <$> peekMaybePrim netRXPP netRXPSP + netRXB <- toWord64 <$> peekMaybePrim netRXBP netRXBSP + netRXE <- toWord64 <$> peekMaybePrim netRXEP netRXESP + netRXD <- toWord64 <$> peekMaybePrim netRXDP netRXDSP + netTXP <- toWord64 <$> peekMaybePrim netTXPP netTXPSP + netTXB <- toWord64 <$> peekMaybePrim netTXBP netTXBSP + netTXE <- toWord64 <$> peekMaybePrim netTXEP netTXESP + netTXD <- toWord64 <$> peekMaybePrim netTXDP netTXDSP + return $ ResourceStatistics ts cpuUTS cpuSTS l cpuPs cpuT cpuTTS memRSS memLB memFB memAB memMB perfStats netRXP netRXB netRXE netRXD netTXP netTXB netTXE netTXD + where + toDouble mx = case mx of + Nothing -> Nothing + Just (CDouble x) -> Just x + toWord32 mx = case mx of + Nothing -> Nothing + Just (CUInt x) -> Just x + toWord64 mx = case mx of + Nothing -> Nothing + Just (CULong x) -> Just x + + destroy = c_destroyResourceStatistics diff --git a/src/System/Mesos/Raw/ResourceUsage.hs b/src/System/Mesos/Raw/ResourceUsage.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/ResourceUsage.hs @@ -0,0 +1,76 @@ +module System.Mesos.Raw.ResourceUsage where +import System.Mesos.Internal +import System.Mesos.Raw.ExecutorId +import System.Mesos.Raw.FrameworkId +import System.Mesos.Raw.ResourceStatistics +import System.Mesos.Raw.SlaveId +import System.Mesos.Raw.TaskId + +type ResourceUsagePtr = Ptr ResourceUsage + +foreign import ccall unsafe "ext/types.h toResourceUsage" c_toResourceUsage + :: SlaveIDPtr + -> FrameworkIDPtr + -> ExecutorIDPtr + -> Ptr CChar + -> CInt + -> TaskIDPtr + -> ResourceStatisticsPtr + -> IO ResourceUsagePtr + +foreign import ccall unsafe "ext/types.h fromResourceUsage" c_fromResourceUsage + :: ResourceUsagePtr + -> Ptr SlaveIDPtr + -> Ptr FrameworkIDPtr + -> Ptr ExecutorIDPtr + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr TaskIDPtr + -> Ptr ResourceStatisticsPtr + -> IO () + +foreign import ccall unsafe "ext/types.h destroyResourceUsage" c_destroyResourceUsage + :: ResourceUsagePtr + -> IO () + +instance CPPValue ResourceUsage where + marshal (ResourceUsage sid fid eid en tid rs) = do + sidP <- cppValue sid + fidP <- cppValue fid + eidP <- maybe (return nullPtr) cppValue eid + tidP <- maybe (return nullPtr) cppValue tid + rsP <- maybe (return nullPtr) cppValue rs + (enP, enL) <- maybeCString en + liftIO $ c_toResourceUsage sidP fidP eidP enP (fromIntegral enL) tidP rsP + + unmarshal up = do + sidPP <- alloc + fidPP <- alloc + eidPP <- alloc + enPP <- alloc + enLP <- alloc + tidPP <- alloc + rsPP <- alloc + poke eidPP nullPtr + poke enPP nullPtr + poke tidPP nullPtr + poke rsPP nullPtr + liftIO $ c_fromResourceUsage up sidPP fidPP eidPP enPP enLP tidPP rsPP + sid <- unmarshal =<< peek sidPP + fid <- unmarshal =<< peek fidPP + eidP <- peek eidPP + eid <- if eidP == nullPtr + then return Nothing + else Just <$> unmarshal eidP + en <- peekMaybeBS enPP enLP + tidP <- peek tidPP + tid <- if tidP == nullPtr + then return Nothing + else Just <$> unmarshal tidP + rsP <- peek rsPP + rs <- if rsP == nullPtr + then return Nothing + else Just <$> unmarshal rsP + return $ ResourceUsage sid fid eid en tid rs + + destroy = c_destroyResourceUsage diff --git a/src/System/Mesos/Raw/Scheduler.hs b/src/System/Mesos/Raw/Scheduler.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/Scheduler.hs @@ -0,0 +1,200 @@ +module System.Mesos.Raw.Scheduler where +import System.Mesos.Internal +import System.Mesos.Raw.Credential +import System.Mesos.Raw.ExecutorId +import System.Mesos.Raw.Filters +import System.Mesos.Raw.FrameworkId +import System.Mesos.Raw.FrameworkInfo +import System.Mesos.Raw.MasterInfo +import System.Mesos.Raw.Offer +import System.Mesos.Raw.OfferId +import System.Mesos.Raw.Request +import System.Mesos.Raw.SlaveId +import System.Mesos.Raw.TaskId +import System.Mesos.Raw.TaskInfo +import System.Mesos.Raw.TaskStatus +type SchedulerPtr = Ptr Scheduler + +data Scheduler = Scheduler + { schedulerImpl :: SchedulerPtr + , rawSchedulerRegistered :: FunPtr RawSchedulerRegistered + , rawSchedulerReRegistered :: FunPtr RawSchedulerReRegistered + , rawSchedulerDisconnected :: FunPtr RawSchedulerDisconnected + , rawSchedulerResourceOffers :: FunPtr RawSchedulerResourceOffers + , rawSchedulerOfferRescinded :: FunPtr RawSchedulerOfferRescinded + , rawSchedulerStatusUpdate :: FunPtr RawSchedulerStatusUpdate + , rawSchedulerFrameworkMessage :: FunPtr RawSchedulerFrameworkMessage + , rawSchedulerSlaveLost :: FunPtr RawSchedulerSlaveLost + , rawSchedulerExecutorLost :: FunPtr RawSchedulerExecutorLost + , rawSchedulerError :: FunPtr RawSchedulerError + } + +-- | Type representing the connection from a scheduler to Mesos. This +-- handle is used both to manage the scheduler's lifecycle (start +-- it, stop it, or wait for it to finish) and to interact with Mesos +-- (e.g., launch tasks, kill tasks, etc.). +newtype SchedulerDriver = SchedulerDriver { fromSchedulerDriver :: SchedulerDriverPtr } + deriving (Show, Eq) + +type SchedulerDriverPtr = Ptr SchedulerDriver + +type RawSchedulerRegistered = SchedulerDriverPtr -> FrameworkIDPtr -> MasterInfoPtr -> IO () + +type RawSchedulerReRegistered = SchedulerDriverPtr -> MasterInfoPtr -> IO () + +type RawSchedulerDisconnected = SchedulerDriverPtr -> IO () + +type RawSchedulerResourceOffers = SchedulerDriverPtr -> Ptr OfferPtr -> CInt -> IO () + +type RawSchedulerOfferRescinded = SchedulerDriverPtr -> OfferIDPtr -> IO () + +type RawSchedulerStatusUpdate = SchedulerDriverPtr -> TaskStatusPtr -> IO () + +type RawSchedulerFrameworkMessage = SchedulerDriverPtr -> ExecutorIDPtr -> SlaveIDPtr -> Ptr CChar -> Int -> IO () + +type RawSchedulerSlaveLost = SchedulerDriverPtr -> SlaveIDPtr -> IO () + +type RawSchedulerExecutorLost = SchedulerDriverPtr -> ExecutorIDPtr -> SlaveIDPtr -> CInt -> IO () + +type RawSchedulerError = SchedulerDriverPtr -> Ptr CChar -> CInt -> IO () + +foreign import ccall "wrapper" wrapSchedulerRegistered + :: RawSchedulerRegistered + -> IO (FunPtr RawSchedulerRegistered) + +foreign import ccall "wrapper" wrapSchedulerReRegistered + :: RawSchedulerReRegistered + -> IO (FunPtr RawSchedulerReRegistered) + +foreign import ccall "wrapper" wrapSchedulerDisconnected + :: RawSchedulerDisconnected + -> IO (FunPtr RawSchedulerDisconnected) + +foreign import ccall "wrapper" wrapSchedulerResourceOffers + :: RawSchedulerResourceOffers + -> IO (FunPtr RawSchedulerResourceOffers) + +foreign import ccall "wrapper" wrapSchedulerOfferRescinded + :: RawSchedulerOfferRescinded + -> IO (FunPtr RawSchedulerOfferRescinded) + +foreign import ccall "wrapper" wrapSchedulerStatusUpdate + :: RawSchedulerStatusUpdate + -> IO (FunPtr RawSchedulerStatusUpdate) + +foreign import ccall "wrapper" wrapSchedulerFrameworkMessage + :: RawSchedulerFrameworkMessage + -> IO (FunPtr RawSchedulerFrameworkMessage) + +foreign import ccall "wrapper" wrapSchedulerSlaveLost + :: RawSchedulerSlaveLost + -> IO (FunPtr RawSchedulerSlaveLost) + +foreign import ccall "wrapper" wrapSchedulerExecutorLost + :: RawSchedulerExecutorLost + -> IO (FunPtr RawSchedulerExecutorLost) + +foreign import ccall "wrapper" wrapSchedulerError + :: RawSchedulerError + -> IO (FunPtr RawSchedulerError) + +foreign import ccall safe "ext/scheduler.h createScheduler" c_createScheduler + :: FunPtr RawSchedulerRegistered + -> FunPtr RawSchedulerReRegistered + -> FunPtr RawSchedulerDisconnected + -> FunPtr RawSchedulerResourceOffers + -> FunPtr RawSchedulerOfferRescinded + -> FunPtr RawSchedulerStatusUpdate + -> FunPtr RawSchedulerFrameworkMessage + -> FunPtr RawSchedulerSlaveLost + -> FunPtr RawSchedulerExecutorLost + -> FunPtr RawSchedulerError + -> IO SchedulerPtr + +foreign import ccall safe "ext/scheduler.h destroyScheduler" c_destroyScheduler + :: SchedulerPtr + -> IO () + +foreign import ccall safe "ext/scheduler.h createSchedulerDriver" c_createSchedulerDriver + :: SchedulerPtr + -> FrameworkInfoPtr + -> Ptr CChar + -> CInt + -> IO SchedulerDriverPtr + +foreign import ccall safe "ext/scheduler.h createSchedulerDriverWithCredentials" c_createSchedulerDriverWithCredentials + :: SchedulerPtr + -> FrameworkInfoPtr + -> Ptr CChar + -> CInt + -> CredentialPtr + -> IO SchedulerDriverPtr + +foreign import ccall safe "ext/scheduler.h destroySchedulerDriver" c_destroySchedulerDriver + :: SchedulerDriverPtr + -> IO () + +foreign import ccall safe "ext/scheduler.h startSchedulerDriver" c_startSchedulerDriver + :: SchedulerDriverPtr + -> IO CInt + +foreign import ccall safe "ext/scheduler.h stopSchedulerDriver" c_stopSchedulerDriver + :: SchedulerDriverPtr + -> CInt + -> IO CInt + +foreign import ccall safe "ext/scheduler.h abortSchedulerDriver" c_abortSchedulerDriver + :: SchedulerDriverPtr + -> IO CInt + +foreign import ccall safe "ext/scheduler.h joinSchedulerDriver" c_joinSchedulerDriver + :: SchedulerDriverPtr + -> IO CInt + +foreign import ccall safe "ext/scheduler.h runSchedulerDriver" c_runSchedulerDriver + :: SchedulerDriverPtr + -> IO CInt + +foreign import ccall safe "ext/scheduler.h requestResources" c_requestResources + :: SchedulerDriverPtr + -> Ptr RequestPtr + -> CInt + -> IO CInt + +foreign import ccall safe "ext/scheduler.h launchTasks" c_launchTasks + :: SchedulerDriverPtr + -> Ptr OfferIDPtr + -> CInt + -> Ptr TaskInfoPtr + -> CInt + -> FiltersPtr + -> IO CInt + +foreign import ccall safe "ext/scheduler.h killTask" c_killTask + :: SchedulerDriverPtr + -> TaskIDPtr + -> IO CInt + +foreign import ccall safe "ext/scheduler.h declineOffer" c_declineOffer + :: SchedulerDriverPtr + -> OfferIDPtr + -> FiltersPtr + -> IO CInt + +foreign import ccall safe "ext/scheduler.h reviveOffers" c_reviveOffers + :: SchedulerDriverPtr + -> IO CInt + +foreign import ccall safe "ext/scheduler.h schedulerDriverSendFrameworkMessage" c_sendFrameworkMessage + :: SchedulerDriverPtr + -> ExecutorIDPtr + -> SlaveIDPtr + -> Ptr CChar + -> CInt + -> IO CInt + +foreign import ccall safe "ext/scheduler.h reconcileTasks" c_reconcileTasks + :: SchedulerDriverPtr + -> Ptr TaskStatusPtr + -> CInt + -> IO CInt diff --git a/src/System/Mesos/Raw/SlaveId.hs b/src/System/Mesos/Raw/SlaveId.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/SlaveId.hs @@ -0,0 +1,22 @@ +module System.Mesos.Raw.SlaveId where +import System.Mesos.Internal + +type SlaveIDPtr = Ptr SlaveID + +foreign import ccall unsafe "ext/types.h toSlaveID" c_toSlaveID :: ToID SlaveIDPtr + +foreign import ccall unsafe "ext/types.h fromSlaveID" c_fromSlaveID :: FromID SlaveIDPtr + +foreign import ccall unsafe "ext/types.h destroySlaveID" c_destroySlaveID :: SlaveIDPtr -> IO () + +instance CPPValue SlaveID where + marshal x = do + (strp, l) <- cstring $ fromSlaveID x + liftIO $ c_toSlaveID strp $ fromIntegral l + + unmarshal p = fmap SlaveID $ do + ptrPtr <- alloc + len <- liftIO $ c_fromSlaveID p ptrPtr + peekCString' (ptrPtr, len) + + destroy = c_destroySlaveID diff --git a/src/System/Mesos/Raw/SlaveInfo.hs b/src/System/Mesos/Raw/SlaveInfo.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/SlaveInfo.hs @@ -0,0 +1,82 @@ +module System.Mesos.Raw.SlaveInfo where +import System.Mesos.Internal +import System.Mesos.Raw.Attribute +import System.Mesos.Raw.Resource +import System.Mesos.Raw.SlaveId + +type SlaveInfoPtr = Ptr SlaveInfo + +foreign import ccall unsafe "ext/types.h toSlaveInfo" c_toSlaveInfo + :: Ptr CChar + -> CInt + -> Ptr CUInt + -> Ptr ResourcePtr + -> CInt + -> Ptr AttributePtr + -> CInt + -> SlaveIDPtr + -> Ptr CBool + -> IO SlaveInfoPtr + +foreign import ccall unsafe "ext/types.h fromSlaveInfo" c_fromSlaveInfo + :: SlaveInfoPtr + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr CBool + -> Ptr CUInt + -> Ptr (Ptr ResourcePtr) + -> Ptr CInt + -> Ptr (Ptr AttributePtr) + -> Ptr CInt + -> Ptr SlaveIDPtr + -> Ptr CBool + -> Ptr CBool + -> IO () + +foreign import ccall unsafe "ext/types.h destroySlaveInfo" c_destroySlaveInfo + :: SlaveInfoPtr + -> IO () + +instance CPPValue SlaveInfo where + marshal i = do + (hp, hl) <- cstring $ slaveInfoHostname i + pp <- allocMaybe (CUInt <$> slaveInfoPort i) + 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 + liftIO $ c_toSlaveInfo hp (fromIntegral hl) pp rp (fromIntegral rl) ap (fromIntegral al) sidp cp + + unmarshal i = do + hstr@(hpp, hlp) <- arrayPair + pps <- alloc + pp <- alloc + (rpp, rlp) <- arrayPair + (app, alp) <- arrayPair + ipp <- alloc + cps <- alloc + cp <- alloc + poke ipp nullPtr + liftIO $ c_fromSlaveInfo i hpp hlp pps pp rpp rlp app alp ipp cps cp + h <- peekCString hstr + p <- peekMaybePrim pp pps + rp <- peek rpp + rs <- mapM unmarshal =<< peekArray (rp, rlp) + ap <- peek app + as <- mapM unmarshal =<< peekArray (ap, alp) + ip <- peek ipp + sid <- if ip == nullPtr + then return Nothing + else fmap Just $ unmarshal ip + c <- peekMaybePrim cp cps + return $ SlaveInfo h (fromIntegral <$> p) rs (map fromAttribute as) sid $ fmap fromCBool c + + destroy = c_destroySlaveInfo + + equalExceptDefaults (SlaveInfo hn p rs as sid cp) (SlaveInfo hn' p' rs' as' sid' cp') = + (hn == hn') && + (p == p' || p == Just 5051) && + (and $ zipWith equalExceptDefaults rs rs') && + (and $ zipWith (\(k, v) (k', v') -> k == k' && equalExceptDefaults v v') as as') && + (sid == sid') && + defEq False cp cp' diff --git a/src/System/Mesos/Raw/StdString.hs b/src/System/Mesos/Raw/StdString.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/StdString.hs @@ -0,0 +1,33 @@ +module System.Mesos.Raw.StdString where +import System.Mesos.Internal + +newtype StdString = StdString { fromStdString :: ByteString } + +type StdStringPtr = Ptr StdString + +foreign import ccall unsafe "ext/types.h toStdString" c_toStdString + :: Ptr CChar + -> CInt + -> IO StdStringPtr +foreign import ccall unsafe "ext/types.h fromStdString" c_fromStdString + :: StdStringPtr + -> Ptr (Ptr CChar) + -> Ptr CInt + -> IO () +foreign import ccall unsafe "ext/types.h destroyStdString" c_destroyStdString + :: StdStringPtr + -> IO () + +instance CPPValue StdString where + + marshal (StdString bs) = do + (sp, sl) <- cstring bs + liftIO $ c_toStdString sp $ fromIntegral sl + + unmarshal p = do + spp <- alloc + slp <- alloc + liftIO $ c_fromStdString p spp slp + StdString <$> peekCString (spp, slp) + + destroy = c_destroyStdString diff --git a/src/System/Mesos/Raw/TaskId.hs b/src/System/Mesos/Raw/TaskId.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/TaskId.hs @@ -0,0 +1,22 @@ +module System.Mesos.Raw.TaskId where +import System.Mesos.Internal + +type TaskIDPtr = Ptr TaskID + +foreign import ccall "ext/types.h toTaskID" c_toTaskID :: ToID TaskIDPtr + +foreign import ccall "ext/types.h fromTaskID" c_fromTaskID :: FromID TaskIDPtr + +foreign import ccall "ext/types.h destroyTaskID" c_destroyTaskID :: TaskIDPtr -> IO () + +instance CPPValue TaskID where + marshal x = do + (strp, l) <- cstring $ fromTaskID x + liftIO $ c_toTaskID strp $ fromIntegral l + + unmarshal p = fmap TaskID $ do + pp <- alloc + len <- liftIO $ c_fromTaskID p pp + peekCString' (pp, len) + + destroy = c_destroyTaskID diff --git a/src/System/Mesos/Raw/TaskInfo.hs b/src/System/Mesos/Raw/TaskInfo.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/TaskInfo.hs @@ -0,0 +1,114 @@ +module System.Mesos.Raw.TaskInfo where +import System.Mesos.Internal +import System.Mesos.Raw.CommandInfo +import System.Mesos.Raw.ContainerInfo +import System.Mesos.Raw.ExecutorInfo +import System.Mesos.Raw.HealthCheck +import System.Mesos.Raw.Resource +import System.Mesos.Raw.SlaveId +import System.Mesos.Raw.TaskId + +type TaskInfoPtr = Ptr TaskInfo + +foreign import ccall unsafe "ext/types.h toTaskInfo" c_toTaskInfo + :: Ptr CChar + -> CInt + -> TaskIDPtr + -> SlaveIDPtr + -> Ptr ResourcePtr + -> CInt + -> ExecutorInfoPtr + -> CommandInfoPtr + -> Ptr CChar + -> CInt + -> ContainerInfoPtr + -> HealthCheckPtr + -> IO TaskInfoPtr + +foreign import ccall unsafe "ext/types.h fromTaskInfo" c_fromTaskInfo + :: TaskInfoPtr + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr TaskIDPtr + -> Ptr SlaveIDPtr + -> Ptr (Ptr ResourcePtr) + -> Ptr CInt + -> Ptr ExecutorInfoPtr + -> Ptr CommandInfoPtr + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr ContainerInfoPtr + -> Ptr HealthCheckPtr + -> IO () + +foreign import ccall unsafe "ext/types.h destroyTaskInfo" c_destroyTaskInfo + :: TaskInfoPtr + -> IO () + +instance CPPValue TaskInfo where + + marshal t = do + (np, nl) <- cstring $ taskInfoName t + rps <- mapM cppValue (taskResources t) + tid <- cppValue $ taskID t + sid <- cppValue $ taskSlaveID t + eip <- maybe (return nullPtr) cppValue $ case taskImplementation t of + TaskExecutor e -> Just e + _ -> Nothing + cip <- maybe (return nullPtr) cppValue $ case taskImplementation t of + TaskCommand c -> Just c + _ -> Nothing + (tdp, tdl) <- maybeCString $ taskData t + (rpp, rl) <- arrayLen rps + ctrp <- maybe (return nullPtr) cppValue $ taskContainer t + hcp <- maybe (return nullPtr) cppValue $ taskHealthCheck t + liftIO $ c_toTaskInfo np (fromIntegral nl) tid sid rpp (fromIntegral rl) eip cip tdp (fromIntegral tdl) ctrp hcp + + unmarshal t = do + npp <- alloc + nlp <- alloc + tpp <- alloc + spp <- alloc + rpp <- alloc + rlp <- alloc + epp <- alloc + cpp <- alloc + dpp <- alloc + dlp <- alloc + cip <- alloc + hcp <- alloc + poke epp nullPtr + poke cpp nullPtr + poke dpp nullPtr + poke cip nullPtr + poke hcp nullPtr + liftIO $ c_fromTaskInfo t npp nlp tpp spp rpp rlp epp cpp dpp dlp cip hcp + n <- peekCString (npp, nlp) + tp <- peek tpp + t <- peekCPP tp + sp <- peek spp + s <- peekCPP sp + rp <- peek rpp + rs <- mapM peekCPP =<< peekArray (rp, rlp) + ep <- peek epp + e <- if ep == nullPtr + then return Nothing + else fmap Just $ unmarshal ep + cp <- peek cpp + c <- if cp == nullPtr + then return Nothing + else fmap Just $ unmarshal cp + -- this shouldn't ever happen, so it's probably ok to just have an error here. + let ei = maybe (maybe (error "FATAL: TaskInfo must have CommandInfo or ExecutorInfo") TaskCommand c) TaskExecutor e + d <- peekMaybeBS dpp dlp + ci <- peekMaybeCPP cip + hc <- peekMaybeCPP hcp + return $ TaskInfo n t s rs ei d ci hc + + destroy = c_destroyTaskInfo + + equalExceptDefaults (TaskInfo n id_ sid rs ei d ci hc) (TaskInfo n' id' sid' rs' ei' d' ci' hc') = + n == n' && id_ == id' && sid == sid' && ci == ci' && hc == hc' && d == d' && and (zipWith equalExceptDefaults rs rs') && case (ei, ei') of + (TaskCommand c, TaskCommand c') -> equalExceptDefaults c c' + (TaskExecutor e, TaskExecutor e') -> equalExceptDefaults e e' + _ -> False diff --git a/src/System/Mesos/Raw/TaskStatus.hs b/src/System/Mesos/Raw/TaskStatus.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/TaskStatus.hs @@ -0,0 +1,84 @@ +module System.Mesos.Raw.TaskStatus where +import System.Mesos.Internal +import System.Mesos.Raw.ExecutorId +import System.Mesos.Raw.SlaveId +import System.Mesos.Raw.TaskId + +type TaskStatusPtr = Ptr TaskStatus + +foreign import ccall unsafe "ext/types.h toTaskStatus" c_toTaskStatus + :: TaskIDPtr + -> CInt + -> Ptr CChar + -> CInt + -> Ptr CChar + -> CInt + -> SlaveIDPtr + -> ExecutorIDPtr + -> Ptr CDouble + -> Ptr CBool + -> IO TaskStatusPtr + +foreign import ccall unsafe "ext/types.h fromTaskStatus" c_fromTaskStatus + :: TaskStatusPtr + -> Ptr TaskIDPtr + -> Ptr CInt + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr (Ptr CChar) + -> Ptr CInt + -> Ptr SlaveIDPtr + -> Ptr ExecutorIDPtr + -> Ptr CBool + -> Ptr CDouble + -> Ptr CBool -- ^ taskStatusHealthy is set? + -> Ptr CBool -- ^ taskStatusHealthy value (if set) + -> IO () + +foreign import ccall unsafe "ext/types.h destroyTaskStatus" c_destroyTaskStatus + :: TaskStatusPtr + -> IO () + +instance CPPValue TaskStatus where + + marshal s = do + 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 + tsp <- alloc + tsp' <- maybe (return nullPtr) (\x -> poke tsp (CDouble x) >> return tsp) $ taskStatusTimestamp s + hp <- allocMaybe $ fmap toCBool $ taskStatusHealthy s + liftIO $ c_toTaskStatus tidP (fromIntegral $ fromEnum $ taskStatusState s) tmp (fromIntegral tml) tsd (fromIntegral tsl) sidP eidP tsp' hp + + unmarshal s = do + tidp <- alloc + sp <- alloc + mpp <- alloc + mlp <- alloc + dpp <- alloc + dlp <- alloc + sidp <- alloc + eidp <- alloc + tssp <- alloc + poke tssp 0 + tsp <- alloc + hp <- alloc + hsp <- alloc + poke mpp nullPtr + poke dpp nullPtr + poke sidp nullPtr + poke eidp nullPtr + liftIO $ c_fromTaskStatus s tidp sp mpp mlp dpp dlp sidp eidp tssp tsp hsp hp + tid <- unmarshal =<< peek tidp + state <- (toEnum . fromIntegral) <$> peek sp + msg <- peekMaybeBS mpp mlp + dat <- peekMaybeBS dpp dlp + sid <- peekMaybeCPP sidp + eid <- peekMaybeCPP eidp + h <- peekMaybePrim hp hsp + ts <- fmap (\(CDouble d) -> d) <$> peekMaybePrim tsp tssp + return $ TaskStatus tid state msg dat sid eid ts (fmap fromCBool h) + + destroy = c_destroyTaskStatus diff --git a/src/System/Mesos/Raw/Value.hs b/src/System/Mesos/Raw/Value.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/Value.hs @@ -0,0 +1,122 @@ +module System.Mesos.Raw.Value where +import System.Mesos.Internal +import System.Mesos.Raw.StdString + +type ValuePtr = Ptr Value + +data ValueType + = SCALAR + | RANGES + | SET + | TEXT + +instance Enum ValueType where + fromEnum SCALAR = 0 + fromEnum RANGES = 1 + fromEnum SET = 2 + fromEnum TEXT = 3 + toEnum 0 = SCALAR + toEnum 1 = RANGES + toEnum 2 = SET + toEnum 3 = TEXT + +data ValueRange = ValueRange Word64 Word64 +type ValueRangePtr = Ptr ValueRange + +foreign import ccall unsafe "ext/types.h toRange" c_toRange + :: CULong + -> CULong + -> IO ValueRangePtr + +foreign import ccall unsafe "ext/types.h fromRange" c_fromRange + :: ValueRangePtr + -> Ptr CULong + -> Ptr CULong + -> IO () + +foreign import ccall unsafe "ext/types.h destroyRange" c_destroyRange + :: ValueRangePtr + -> IO () + +instance CPPValue ValueRange where + marshal (ValueRange l h) = liftIO $ c_toRange (CULong l) (CULong h) + + unmarshal p = do + l <- alloc + h <- alloc + liftIO $ c_fromRange p l h + (CULong l') <- peek l + (CULong r') <- peek h + return $ ValueRange l' r' + + destroy = c_destroyRange + +foreign import ccall unsafe "ext/types.h toValue" c_toValue + :: CInt + -> CDouble + -> Ptr ValueRangePtr + -> CInt + -> Ptr StdStringPtr + -> CInt + -> Ptr CChar + -> CInt + -> IO ValuePtr + +foreign import ccall unsafe "ext/types.h fromValue" c_fromValue + :: ValuePtr + -> Ptr CInt + -> Ptr CDouble + -> Ptr (Ptr ValueRangePtr) + -> Ptr CInt + -> Ptr (Ptr StdStringPtr) + -> Ptr CInt + -> Ptr (Ptr CChar) + -> Ptr CInt + -> IO () + +foreign import ccall unsafe "ext/types.h destroyValue" c_destroyValue + :: ValuePtr + -> IO () + +instance CPPValue Value where + marshal (Scalar x) = liftIO $ c_toValue (fromIntegral $ fromEnum SCALAR) (CDouble x) nullPtr 0 nullPtr 0 nullPtr 0 + + marshal (Ranges rs) = do + ranges <- mapM (cppValue . uncurry ValueRange) rs + (rp, rLen) <- arrayLen ranges + liftIO $ c_toValue (fromIntegral $ fromEnum RANGES) 0 rp (fromIntegral rLen) nullPtr 0 nullPtr 0 + + marshal (Set ts) = do + sps <- mapM (cppValue . StdString) ts + (sp, sl) <- arrayLen sps + liftIO $ c_toValue (fromIntegral $ fromEnum SET) 0 nullPtr 0 sp (fromIntegral sl) nullPtr 0 + + marshal (Text t) = do + (tp, tl) <- cstring t + liftIO $ c_toValue (fromIntegral $ fromEnum TEXT) 0 nullPtr 0 nullPtr 0 tp (fromIntegral tl) + + unmarshal vp = do + typeP <- alloc + scalarP <- alloc + rangePP <- alloc + rangeLenP <- alloc + setStrPP <- alloc + setSizeP <- alloc + t@(textP, textLenP) <- arrayPair + liftIO $ c_fromValue vp typeP scalarP rangePP rangeLenP setStrPP setSizeP textP textLenP + ty <- fmap (toEnum . fromIntegral) $ peek typeP + case ty of + SCALAR -> peek scalarP >>= \(CDouble d) -> return $ Scalar d + RANGES -> do + rangeP <- peek rangePP + rangePs <- peekArray (rangeP, rangeLenP) + rs <- mapM unmarshal rangePs + return $ Ranges $ map (\(ValueRange l h) -> (l, h)) rs + SET -> do + setP <- peek setStrPP + setPs <- peekArray (setP, setSizeP) + setStrs <- mapM unmarshal setPs + return $! Set $ map (\(StdString x) -> x) setStrs + TEXT -> fmap Text $ peekCString t + + destroy = c_destroyValue diff --git a/src/System/Mesos/Raw/Volume.hs b/src/System/Mesos/Raw/Volume.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Raw/Volume.hs @@ -0,0 +1,43 @@ +module System.Mesos.Raw.Volume where + +import System.Mesos.Internal + +type VolumePtr = Ptr Volume + +foreign import ccall unsafe "ext/types.h toVolume" c_toVolume + :: Ptr CChar -- ^ container_path + -> CInt -- ^ container_path length + -> Ptr CChar -- ^ host_path + -> CInt -- ^ host_path length + -> CInt -- ^ mode + -> IO VolumePtr + +foreign import ccall unsafe "ext/types.h fromVolume" c_fromVolume + :: VolumePtr + -> Ptr (Ptr CChar) -- ^ container_path + -> Ptr CInt -- ^ container_path length + -> Ptr (Ptr CChar) -- ^ host_path + -> Ptr CInt -- ^ host_path length + -> Ptr CInt -- ^ mode + -> IO () + +foreign import ccall unsafe "ext/types.h destroyVolume" c_destroyVolume + :: VolumePtr -> IO () + +instance CPPValue Volume where + marshal v = do + (cp, cl) <- cstring $ volumeContainerPath v + (vp, vl) <- maybeCString $ volumeHostPath v + liftIO $ c_toVolume cp (fromIntegral cl) vp (fromIntegral vl) $ fromIntegral $ fromEnum $ volumeMode v + + unmarshal p = do + (cpp, clp) <- arrayPair + (vpp, vlp) <- arrayPair + mp <- alloc + liftIO $ c_fromVolume p cpp clp vpp vlp mp + c <- peekCString (cpp, clp) + v <- peekMaybeCString (vpp, vlp) + m <- fmap (toEnum . fromIntegral) $ peek mp + return $ Volume c v m + + destroy = c_destroyVolume diff --git a/src/System/Mesos/Resources.hs b/src/System/Mesos/Resources.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Resources.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +module System.Mesos.Resources where +import Control.Lens +import Data.ByteString (ByteString) +import Data.List (find, foldl', groupBy) +import Data.Word +import System.Mesos.Types + +newtype Resources = Resources { fromResources :: [Resource] } + deriving (Eq, Show) + +instance Wrapped Resources where + type Unwrapped Resources = [Resource] + _Wrapped' = iso fromResources Resources + +instance (t ~ Resources) => Rewrapped Resources t + +instance Ord Resources where + sub <= super = foldl' go True lgs + where + lgs = groupBy (\x y -> resourceName x == resourceName y) $ fromResources sub + rgs = groupBy (\x y -> resourceName x == resourceName y) $ fromResources super + go b res = case find (\x -> (res ^? traverse . to resourceName) == (x ^? traverse . to resourceName)) rgs of + Nothing -> False + Just gs -> b && (sumOf (traverse . value . scalar) res <= sumOf (traverse . value . scalar) gs) + + +class HasResources a where + resources :: Lens' a [Resource] + +instance HasResources SlaveInfo where + resources = lens slaveInfoResources (\s rs -> s { slaveInfoResources = rs }) + +instance HasResources ExecutorInfo where + resources = lens executorInfoResources (\e rs -> e { executorInfoResources = rs }) + +instance HasResources Request where + resources = lens reqResources (\r rs -> r { reqResources = rs }) + +instance HasResources Offer where + resources = lens offerResources (\o rs -> o { offerResources = rs }) + +instance HasResources TaskInfo where + resources = lens taskResources (\t rs -> t { taskResources = rs }) + +value :: Lens' Resource Value +value = lens resourceValue $ \r v -> r { resourceValue = v } + +scalar :: Prism' Value Double +scalar = prism' Scalar $ \x -> case x of + Scalar d -> Just d + _ -> Nothing + +ranges :: Prism' Value [(Word64, Word64)] +ranges = prism' Ranges $ \x -> case x of + Ranges rs -> Just rs + _ -> Nothing + +set :: Prism' Value [ByteString] +set = prism' Set $ \x -> case x of + Set bs -> Just bs + _ -> Nothing + +text :: Prism' Value ByteString +text = prism' Text $ \x -> case x of + Text t -> Just t + _ -> Nothing + +cpus :: Prism' Resource Double +cpus = prism' (\x -> Resource "cpus" (Scalar x) (Just "*")) $ \r -> + if resourceName r == "cpus" + then r ^? value . scalar + else Nothing + +mem :: Prism' Resource Double +mem = prism' (\x -> Resource "mem" (Scalar x) (Just "*")) $ \r -> + if resourceName r == "mem" + then r ^? value . scalar + else Nothing + +disk :: Prism' Resource Double +disk = prism' (\x -> Resource "disk" (Scalar x) (Just "*")) $ \r -> + if resourceName r == "disk" + then r ^? value . scalar + else Nothing + +ports :: Prism' Resource [(Word64, Word64)] +ports = prism' (\x -> Resource "ports" (Ranges x) (Just "*")) $ \r -> + if resourceName r == "ports" + then r ^? value . ranges + else Nothing + +flattened :: Getter [Resource] [Resource] +flattened = undefined + +{- +extract +find +get +getAll +parse +parse' +isValid +isAllocatable +isZero +-} + diff --git a/src/System/Mesos/Scheduler.hs b/src/System/Mesos/Scheduler.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Scheduler.hs @@ -0,0 +1,327 @@ +-- | +-- Module : System.Mesos.Scheduler +-- Copyright : (c) Ian Duncan 2014 +-- License : MIT +-- +-- Maintainer : ian@iankduncan.com +-- Stability : unstable +-- Portability : non-portable +-- +-- Mesos scheduler interface and scheduler driver. A scheduler is used +-- to interact with Mesos in order run distributed computations. + +module System.Mesos.Scheduler ( + -- * Creating a new 'Scheduler' + ToScheduler(..), + SchedulerDriver, + -- * Managing framework actions with a 'SchedulerDriver' + -- ** 'SchedulerDriver' lifecycle management + withSchedulerDriver, + start, + stop, + abort, + await, + run, + -- ** Managing and interacting with tasks and resources + requestResources, + launchTasks, + killTask, + declineOffer, + reviveOffers, + sendFrameworkMessage, + reconcileTasks, + -- * Low-level lifecycle management + createDriver, + destroyDriver, + Scheduler, + createScheduler, + destroyScheduler +) where +import Control.Monad.Managed +import Data.ByteString (ByteString, packCStringLen) +import Data.ByteString.Unsafe (unsafeUseAsCStringLen) +-- import Foreign.C +import Foreign.Ptr +import System.Mesos.Internal hiding (marshal) +import System.Mesos.Raw +import System.Mesos.Raw.Scheduler +import System.Mesos.Types + +-- | Callback interface to be implemented by frameworks' +-- schedulers. Note that only one callback will be invoked at a time, +-- so it is not recommended that you block within a callback because +-- it may cause a deadlock. +class ToScheduler a where + -- | Invoked when the 'Scheduler' successfully registers with a Mesos + -- master. A unique ID (generated by the master) used for + -- distinguishing this framework from others and 'MasterInfo' + -- with the ip and port of the current master are provided as arguments. + registered :: a -> SchedulerDriver -> FrameworkID -> MasterInfo -> IO () + registered _ _ _ _ = return () + + -- | Invoked when the 'Scheduler' re-registers with a newly elected Mesos master. + -- This is only called when the scheduler has previously been registered. + -- 'MasterInfo' containing the updated information about the elected master + -- is provided as an argument. + reRegistered :: a -> SchedulerDriver -> MasterInfo -> IO () + reRegistered _ _ _ = return () + + -- | Invoked when the 'Scheduler' becomes "disconnected" from the master + -- (e.g., the master fails and another is taking over). + disconnected :: a -> SchedulerDriver -> IO () + disconnected _ _ = return () + + -- | Invoked when resources have been offered to this framework. A + -- single offer will only contain resources from a single slave. + -- Resources associated with an offer will not be re-offered to + -- _this_ framework until either (a) this framework has rejected + -- those resources (see 'launchTasks') or (b) those + -- resources have been rescinded (see 'offerRescinded'). + -- Note that resources may be concurrently offered to more than one + -- framework at a time (depending on the allocator being used). In + -- that case, the first framework to launch tasks using those + -- resources will be able to use them while the other frameworks + -- will have those resources rescinded (or if a framework has + -- already launched tasks with those resources then those tasks will + -- fail with a 'System.Mesos.Types.Lost' status and a message saying as much). + resourceOffers :: a -> SchedulerDriver -> [Offer] -> IO () + resourceOffers _ _ _ = return () + + -- | Invoked when an offer is no longer valid (e.g., the slave was + -- lost or another framework used resources in the offer). If for + -- whatever reason an offer is never rescinded (e.g., dropped + -- message, failing over framework, etc.), a framwork that attempts + -- to launch tasks using an invalid offer will receive 'Lost' + -- status updates for those tasks (see 'resourceOffers'). + offerRescinded :: a -> SchedulerDriver -> OfferID -> IO () + offerRescinded _ _ _ = return () + + -- | Invoked when the status of a task has changed (e.g., a slave is + -- lost and so the task is lost, a task finishes and an executor + -- sends a status update saying so, etc). Note that returning from + -- this callback _acknowledges_ receipt of this status update! If + -- for whatever reason the scheduler aborts during this callback (or + -- the process exits) another status update will be delivered (note, + -- however, that this is currently not true if the slave sending the + -- status update is lost/fails during that time). + statusUpdate :: a -> SchedulerDriver -> TaskStatus -> IO () + statusUpdate _ _ _ = return () + + -- | Invoked when an executor sends a message. These messages are best + -- effort; do not expect a framework message to be retransmitted in + -- any reliable fashion. + frameworkMessage :: a -> SchedulerDriver -> ExecutorID -> SlaveID -> ByteString -> IO () + frameworkMessage _ _ _ _ _ = return () + + -- | Invoked when a slave has been determined unreachable (e.g., + -- machine failure, network partition). Most frameworks will need to + -- reschedule any tasks launched on this slave on a new slave. + slaveLost :: a -> SchedulerDriver -> SlaveID -> IO () + slaveLost _ _ _ = return () + + -- | Invoked when an executor has exited/terminated. Note that any + -- tasks running will have 'Lost' status updates automagically + -- generated. + executorLost :: a -> SchedulerDriver -> ExecutorID -> SlaveID -> Status -> IO () + executorLost _ _ _ _ _ = return () + + -- | Invoked when there is an unrecoverable error in the scheduler or + -- scheduler driver. The driver will be aborted BEFORE invoking this + -- callback. + errorMessage :: a -> SchedulerDriver -> ByteString -> IO () + errorMessage _ _ _ = return () + +createScheduler :: ToScheduler a => a -> IO Scheduler +createScheduler s = do + registeredFun <- wrapSchedulerRegistered $ \sdp fp mp -> runManaged $ do + let sd = SchedulerDriver sdp + f <- peekCPP fp + m <- peekCPP mp + liftIO $ (registered s) sd f m + reRegisteredFun <- wrapSchedulerReRegistered $ \sdp mip -> runManaged $ do + let sd = SchedulerDriver sdp + mi <- unmarshal mip + liftIO $ (reRegistered s) sd mi + disconnectedFun <- wrapSchedulerDisconnected $ \sdp -> runManaged $ do + let sd = SchedulerDriver sdp + liftIO $ (disconnected s) sd + resourceOffersFun <- wrapSchedulerResourceOffers $ \sdp os c -> runManaged $ do + let sd = SchedulerDriver sdp + offers <- mapM unmarshal =<< peekArray' (os, fromIntegral c) + liftIO $ (resourceOffers s) sd offers + offerRescindedFun <- wrapSchedulerOfferRescinded $ \sdp oidp -> do + let sd = SchedulerDriver sdp + with (unmarshal oidp) $ \oid -> + (offerRescinded s) sd oid + statusUpdateFun <- wrapSchedulerStatusUpdate $ \sdp tsp -> runManaged $ do + let sd = SchedulerDriver sdp + ts <- unmarshal tsp + liftIO $ (statusUpdate s) sd ts + frameworkMessageFun <- wrapSchedulerFrameworkMessage $ \sdp eip sip ptr c -> runManaged $ do + let sd = SchedulerDriver sdp + ei <- unmarshal eip + si <- unmarshal sip + bs <- liftIO $ packCStringLen (ptr, c) + liftIO $ (frameworkMessage s) sd ei si bs + slaveLostFun <- wrapSchedulerSlaveLost $ \sdp sip -> runManaged $ do + let sd = SchedulerDriver sdp + si <- unmarshal sip + liftIO $ (slaveLost s) sd si + executorLostFun <- wrapSchedulerExecutorLost $ \sdp eip sip st -> runManaged $ do + let sd = SchedulerDriver sdp + ei <- unmarshal eip + si <- unmarshal sip + liftIO $ (executorLost s) sd ei si (toEnum $ fromIntegral st) + errorFun <- wrapSchedulerError $ \sdp ptr c -> do + let sd = SchedulerDriver sdp + bs <- packCStringLen (ptr, fromIntegral c) + (errorMessage s) sd bs + schedulerPtr <- c_createScheduler registeredFun reRegisteredFun disconnectedFun resourceOffersFun offerRescindedFun statusUpdateFun frameworkMessageFun slaveLostFun executorLostFun errorFun + return $ Scheduler schedulerPtr registeredFun reRegisteredFun disconnectedFun resourceOffersFun offerRescindedFun statusUpdateFun frameworkMessageFun slaveLostFun executorLostFun errorFun + +destroyScheduler :: Scheduler -> IO () +destroyScheduler s = do + c_destroyScheduler $ schedulerImpl s + freeHaskellFunPtr $ rawSchedulerRegistered s + freeHaskellFunPtr $ rawSchedulerReRegistered s + freeHaskellFunPtr $ rawSchedulerDisconnected s + freeHaskellFunPtr $ rawSchedulerResourceOffers s + freeHaskellFunPtr $ rawSchedulerOfferRescinded s + freeHaskellFunPtr $ rawSchedulerStatusUpdate s + freeHaskellFunPtr $ rawSchedulerFrameworkMessage s + freeHaskellFunPtr $ rawSchedulerSlaveLost s + freeHaskellFunPtr $ rawSchedulerExecutorLost s + freeHaskellFunPtr $ rawSchedulerError s + +withDriver :: (SchedulerDriverPtr -> IO CInt) -> SchedulerDriver -> IO Status +withDriver f (SchedulerDriver p) = fmap (toEnum . fromIntegral) $ f p + +withSchedulerDriver :: ToScheduler a => a + -> FrameworkInfo + -> ByteString -- ^ @ip:port@ of the master to connect to. For example: @"127.0.0.1:5050"@ + -> Maybe Credential + -> (SchedulerDriver -> IO b) + -> IO b +withSchedulerDriver s i h c f = do + scheduler <- createScheduler s + driver <- createDriver scheduler i h c + result <- f driver + destroyDriver driver + destroyScheduler scheduler + return result + +createDriver :: Scheduler -> FrameworkInfo -> ByteString -> Maybe Credential -> IO SchedulerDriver +createDriver s i h mc = with (cppValue i) $ \fiP -> + with (cstring h) $ \(hp, hLen) -> + fmap SchedulerDriver $ case mc of + Nothing -> c_createSchedulerDriver (schedulerImpl s) fiP hp (fromIntegral hLen) + Just c -> with (cppValue c) $ \cp -> do + c_createSchedulerDriverWithCredentials (schedulerImpl s) fiP hp (fromIntegral hLen) cp + +destroyDriver :: SchedulerDriver -> IO () +destroyDriver = c_destroySchedulerDriver . fromSchedulerDriver + +-- | Starts the scheduler driver. This needs to be called before any +-- other driver calls are made. +start :: SchedulerDriver -> IO Status +start = withDriver c_startSchedulerDriver + +-- | Stops the scheduler driver. If the 'failover' flag is set to +-- false then it is expected that this framework will never +-- reconnect to Mesos and all of its executors and tasks can be +-- terminated. Otherwise, all executors and tasks will remain +-- running (for some framework specific failover timeout) allowing the +-- scheduler to reconnect (possibly in the same process, or from a +-- different process, for example, on a different machine). +stop :: SchedulerDriver + -> Bool -- ^ should failover? + -> IO Status +stop d f = withDriver (\p -> c_stopSchedulerDriver p fi) d + where + fi = if f then 1 else 0 + +-- | Aborts the driver so that no more callbacks can be made to the +-- scheduler. The semantics of abort and stop have deliberately been +-- separated so that code can detect an aborted driver (i.e., via +-- the return status of 'await', see below), and +-- instantiate and start another driver if desired (from within the +-- same process). Note that 'stop' is not automatically called +-- inside 'abort'. +abort :: SchedulerDriver -> IO Status +abort = withDriver c_abortSchedulerDriver + +-- | Waits for the driver to be stopped or aborted, possibly +-- *blocking the current thread indefinitely*. The return status of +-- this function can be used to determine if the driver was aborted +-- (see 'Status' for more information). +await :: SchedulerDriver -> IO Status +await = withDriver c_joinSchedulerDriver + +-- | Starts and immediately 'await's (blocks on) the driver. +run :: SchedulerDriver -> IO Status +run = withDriver c_runSchedulerDriver + +-- | Requests resources from Mesos. Any resources available are asynchronously offered to the framework via the 'resourceOffers' callback. +requestResources :: SchedulerDriver -> [Request] -> IO Status +requestResources (SchedulerDriver p) rs = do + fmap (toEnum . fromIntegral) $ with (mapM cppValue rs >>= arrayLen) $ \(rp, l) -> do + c_requestResources p rp $ fromIntegral l + +-- | Launches the given set of tasks. Any resources remaining (i.e., +-- not used by the tasks or their executors) will be considered +-- declined. The specified filters are applied on all unused +-- resources (see 'Filters' for more information). +-- +-- Available resources are aggregated when mutiple offers are +-- provided. Note that all offers must belong to the same slave. +-- Invoking this function with an empty collection of tasks declines +-- offers in their entirety (see 'declineOffer'). +launchTasks :: SchedulerDriver -> [OfferID] -> [TaskInfo] -> Filters -> IO Status +launchTasks (SchedulerDriver p) os ts f = with (cppValue f) $ \fp -> + with (mapM cppValue os >>= arrayLen) $ \(op, ol) -> + with (mapM cppValue ts >>= arrayLen) $ \(tp, tl) -> do + res <- c_launchTasks p op (fromIntegral ol) tp (fromIntegral tl) fp + return $ toEnum $ fromIntegral res + +-- | Kills the specified task. Note that attempting to kill a task is +-- currently not reliable. If, for example, a scheduler fails over +-- while it was attempting to kill a task it will need to retry in +-- the future. Likewise, if unregistered / disconnected, the request +-- will be dropped (these semantics may be changed in the future). +killTask :: SchedulerDriver -> TaskID -> IO Status +killTask (SchedulerDriver p) t = with (cppValue t) $ \tid -> do + res <- c_killTask p tid + return $ toEnum $ fromIntegral res + +-- | Declines an offer in its entirety and applies the specified +-- filters on the resources (see 'Filters'). Note that this can be done at any time, it is not +-- necessary to do this within the 'resourceOffers' +-- callback. +declineOffer :: SchedulerDriver -> OfferID -> Filters -> IO Status +declineOffer (SchedulerDriver p) o f = with (cppValue o) $ \oid -> + with (cppValue f) $ \fp -> do + res <- c_declineOffer p oid fp + return $ toEnum $ fromIntegral res + +-- | Removes all filters previously set by the framework (via +-- 'launchTasks'). This enables the framework to receive offers from +-- those filtered slaves. +reviveOffers :: SchedulerDriver -> IO Status +reviveOffers = withDriver c_reviveOffers + +-- | Sends a message from the framework to one of its executors. These +-- messages are best effort; do not expect a framework message to be +-- retransmitted in any reliable fashion. +sendFrameworkMessage :: SchedulerDriver -> ExecutorID -> SlaveID -> ByteString -> IO Status +sendFrameworkMessage (SchedulerDriver p) e s bs = with (cppValue e) $ \ep -> with (cppValue s) $ \sp -> + with (cstring bs) $ \(strp, l) -> do + res <-c_sendFrameworkMessage p ep sp strp (fromIntegral l) + return $ toEnum $ fromIntegral res + +-- | Reconciliation of tasks causes the master to send status updates for tasks +-- whose status differs from the status sent here. +reconcileTasks :: SchedulerDriver -> [TaskStatus] -> IO Status +reconcileTasks (SchedulerDriver p) ts = with (mapM cppValue ts >>= arrayLen) $ \(tp, l) -> do + res <- c_reconcileTasks p tp (fromIntegral l) + return $ toEnum $ fromIntegral res + diff --git a/src/System/Mesos/TaskStatus.hs b/src/System/Mesos/TaskStatus.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/TaskStatus.hs @@ -0,0 +1,7 @@ +module System.Mesos.TaskStatus where +import System.Mesos.Types + +taskStatus :: TaskID -> TaskState -> TaskStatus +taskStatus tid ts = TaskStatus tid ts Nothing Nothing Nothing Nothing Nothing Nothing + + diff --git a/src/System/Mesos/Types.hs b/src/System/Mesos/Types.hs new file mode 100644 --- /dev/null +++ b/src/System/Mesos/Types.hs @@ -0,0 +1,594 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module System.Mesos.Types ( + -- * Core Framework & Executor types + -- ** Masters & Slaves + MasterInfo(..), + masterInfo, + SlaveInfo(..), + slaveInfo, + -- ** Frameworks & Executors + ExecutorInfo(..), + executorInfo, + FrameworkInfo(..), + frameworkInfo, + -- ** Resource allocation + Offer(..), + Request(..), + Filters(..), + filters, + -- ** Launching Tasks + TaskInfo(..), + TaskExecutionInfo(..), + CommandInfo(..), + CommandURI(..), + commandURI, + CommandValue (..), + Value(..), + Resource(..), + resource, + -- ** Task & Executor Status Updates + Status(..), + TaskStatus(..), + TaskState(..), + isTerminal, + -- ** Identifiers + FrameworkID(..), + SlaveID(..), + OfferID(..), + TaskID(..), + ExecutorID(..), + ContainerID(..), + -- ** Containerization Support + ContainerInfo (..), + Volume (..), + Mode (..), + ContainerType (..), + -- ** Health Checks + HealthCheck (..), + HealthCheckStrategy (..), + -- ** Resource Usage & Performance Statistics + ResourceStatistics(..), + ResourceUsage(..), + PerformanceStatistics(..), + -- ** Task Status + -- ** Credentials & ACLs + Credential(..), + credential +) where +import Data.ByteString (ByteString) +import Data.String +import Data.Word + +isTerminal :: TaskState -> Bool +isTerminal s = case s of + Finished -> True + Failed -> True + Killed -> True + Lost -> True + _ -> False + +-- | Describes possible task states. IMPORTANT: Mesos assumes tasks that +-- enter terminal states (see below) imply the task is no longer +-- running and thus clean up any thing associated with the task +-- (ultimately offering any resources being consumed by that task to +-- another task). +data TaskState + = Staging -- ^ Initial state. Framework status updates should not use. + | Starting + | TaskRunning + | Finished -- ^ TERMINAL. + | Failed -- ^ TERMINAL. + | Killed -- ^ TERMINAL. + | Lost -- ^ TERMINAL. + deriving (Show, Eq) + +instance Enum TaskState where + fromEnum Staging = 6 + fromEnum Starting = 0 + fromEnum TaskRunning = 1 + fromEnum Finished = 2 + fromEnum Failed = 3 + fromEnum Killed = 4 + fromEnum Lost = 5 + toEnum 0 = Starting + toEnum 1 = TaskRunning + toEnum 2 = Finished + toEnum 3 = Failed + toEnum 4 = Killed + toEnum 5 = Lost + toEnum 6 = Staging + toEnum _ = error "Unsupported task state" + +-- | Indicates the state of the scheduler and executor driver +-- after function calls. +data Status = NotStarted | Running | Aborted | Stopped + deriving (Show, Eq) + +instance Enum Status where + fromEnum Running = 2 + fromEnum NotStarted = 1 + fromEnum Aborted = 3 + fromEnum Stopped = 4 + toEnum 1 = NotStarted + toEnum 2 = Running + toEnum 3 = Aborted + toEnum 4 = Stopped + 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 } + deriving (Show, Eq, IsString) + +-- | A unique ID assigned to an offer. +newtype OfferID = OfferID { fromOfferID :: 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 } + 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 } + 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 } + deriving (Show, Eq, IsString) + + +-- | A slave generated ID to distinguish a container. The ID must be unique +-- 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 } + deriving (Show, Eq, IsString) + +-- | Describes a framework. If the user field is set to an empty string +-- Mesos will automagically set it to the current user. Note that the +-- ID is only available after a framework has registered, however, it +-- is included here in order to facilitate scheduler failover (i.e., +-- if it is set then the 'System.Mesos.Scheduler.SchedulerDriver' expects the scheduler is +-- performing failover). The amount of time that the master will wait +-- for the scheduler to failover before removing the framework is +-- specified by 'frameworkFailoverTimeout'. +-- If 'frameworkCheckpoint' is set, framework pid, executor pids and status updates +-- are checkpointed to disk by the slaves. +-- Checkpointing allows a restarted slave to reconnect with old executors +-- and recover status updates, at the cost of disk I/O. +-- The 'frameworkRole' field is used to group frameworks for allocation decisions, +-- depending on the allocation policy being used. +-- 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) + } + deriving (Show, Eq) + +frameworkInfo :: ByteString -> ByteString -> FrameworkInfo +frameworkInfo u n = FrameworkInfo u n Nothing Nothing Nothing Nothing Nothing Nothing + +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. + } + | CommandCheck + { commandCheckCommand :: !CommandInfo -- ^ Command health check. + } deriving (Show, Eq) + +data HealthCheck = HealthCheck + { healthCheckStrategy :: !HealthCheckStrategy + , healthCheckDelaySeconds :: !(Maybe Double) -- ^ Amount of time to wait until starting the health checks. + , healthCheckIntervalSeconds :: !(Maybe Double) -- ^ Interval between health checks. + , healthCheckTimeoutSeconds :: !(Maybe Double) -- ^ Amount of time to wait for the health check to complete. + , healthCheckConsecutiveFailures :: !(Maybe Word32) -- ^ Number of consecutive failures until considered unhealthy. + , healthCheckGracePeriodSeconds :: !(Maybe Double) -- ^ Amount of time to allow failed health checks since launch. + } deriving (Show, Eq) + +-- | Describes a command, executed via: +-- +-- > /bin/sh -c value +-- +-- Any URIs specified are fetched before executing the command. If the executable field for an +-- uri is set, executable file permission is set on the downloaded file. +-- Otherwise, if the downloaded file has a recognized archive extension +-- (currently [compressed] tar and zip) it is extracted into the executor's +-- 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 + -- 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) + } + deriving (Show, Eq) + +data CommandURI = CommandURI + { commandURIValue :: !ByteString + , commandURIExecutable :: !(Maybe Bool) + , commandURIExtract :: !(Maybe Bool) + } + deriving (Show, Eq) + +commandURI :: ByteString -> CommandURI +commandURI v = CommandURI v Nothing Nothing + +{- +TODO: not yet supported (0.20) +data CommandContainerInfo = CommandContainerInfo + { commandContainerInfoImage :: !ByteString + , commandContainerInfoOptions :: ![ByteString] + } +-} + +data CommandValue = ShellCommand !ByteString + | RawCommand !ByteString ![ByteString] + deriving (Show, Eq) + +-- 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 + , 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) + -- ^ 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. + -- + -- 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) + } + deriving (Show, Eq) + +executorInfo :: ExecutorID -> FrameworkID -> CommandInfo -> [Resource] -> ExecutorInfo +executorInfo eid fid ci rs = ExecutorInfo eid fid ci Nothing rs Nothing Nothing Nothing + +-- | Describes a master. This will probably have more fields in the +-- 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 + , masterInfoPort :: !(Maybe Word32) -- ^ Defaults to 5050 + , masterInfoPID :: !(Maybe ByteString) + , masterInfoHostname :: !(Maybe ByteString) + } + deriving (Show, Eq) + +masterInfo :: ByteString -> Word32 -> MasterInfo +masterInfo id ip = MasterInfo id ip Nothing Nothing Nothing + +-- | Describes a slave. Note that the 'slaveInfoSlaveID' field is only available after +-- a slave is registered with the master, and is made available here +-- to facilitate re-registration. If checkpoint is set, the slave is +-- checkpointing its own information and potentially frameworks' +-- information (if a framework has checkpointing enabled). +data SlaveInfo = SlaveInfo + { slaveInfoHostname :: !ByteString + , slaveInfoPort :: !(Maybe Word32) + , slaveInfoResources :: ![Resource] + , slaveInfoAttributes :: ![(ByteString, Value)] + , slaveInfoSlaveID :: !(Maybe SlaveID) + , slaveInfoCheckpoint :: !(Maybe Bool) + } + deriving (Show, Eq) + +slaveInfo :: ByteString -> [Resource] -> [(ByteString, Value)] -> SlaveInfo +slaveInfo hn rs as = SlaveInfo hn Nothing rs as Nothing Nothing + +newtype Filters = Filters + { refuseSeconds :: 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 + -- SchedulerDriver::launchTasks. You MUST pass Filters with this + -- field set to change this behavior (i.e., get another offer which + -- includes unused resources sooner or later than the default). + -- + -- Defaults to 5.0 if not set. + } + deriving (Show, Eq) + +filters :: Filters +filters = Filters Nothing + +credential :: ByteString -> Credential +credential p = Credential p Nothing + +data Value + = Scalar !Double + | Ranges ![(Word64, Word64)] + | Set ![ByteString] + | Text !ByteString + deriving (Show, Eq) + +-- | Describes a resource on a machine. A resource can take on one of +-- three types: scalar (double), a list of finite and discrete ranges +-- (e.g., [1-10, 20-30]), or a set of items. +-- +-- N.B. there is a slight deviation from the C++ API: the Haskell bindings convert 'Text' values +-- into a single element 'Set' value in order to avoid having to expose yet another data type. +data Resource = Resource + { resourceName :: !ByteString + , resourceValue :: !Value + , resourceRole :: !(Maybe ByteString) + } + deriving (Show, Eq) + +resource :: ByteString -> Value -> Resource +resource n v = Resource n v Nothing + +data ResourceStatistics = ResourceStatistics + { resourceStatisticsTimestamp :: !Double + , resourceStatisticsCPUsUserTimeSecs :: !(Maybe Double) + -- ^ Total CPU time spent in user mode + , resourceStatisticsCPUsSystemTimeSecs :: !(Maybe Double) + -- ^ Total CPU time spent in kernel mode. + , resourceCPUsLimit :: !Double + -- ^ Number of CPUs allocated. + , resourceCPUsPeriods :: !(Maybe Word32) + -- ^ cpu.stat on process throttling (for contention issues). + , resourceCPUsThrottled :: !(Maybe Word32) + -- ^ cpu.stat on process throttling (for contention issues). + , resourceCPUsThrottledTimeSecs :: !(Maybe Double) + -- ^ cpu.stat on process throttling (for contention issues). + , resourceMemoryResidentSetSize :: !(Maybe Word64) + -- ^ Resident set size + , resourceMemoryLimitBytes :: !(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) + } + deriving (Show, Eq) + +-- | Describes a snapshot of the resource usage for an executor. +-- +-- Resource usage is for an executor. For tasks launched with +-- an explicit executor, the executor id is provided. For tasks +-- launched without an executor, our internal executor will be +-- 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. + , resourceUsageExecutorName :: !(Maybe ByteString) -- ^ If present, this executor was explicitly specified. + , resourceUsageTaskID :: !(Maybe TaskID) -- ^ If present, this task did not have an executor. + , resourceUsageStatistics :: !(Maybe ResourceStatistics) + -- ^ If missing, the isolation module cannot provide resource usage. + } + deriving (Show, Eq) + +data PerformanceStatistics = PerformanceStatistics + { performanceStatisticsTimestamp :: !Double -- ^ Start of sample interval, in seconds since the Epoch. + , performanceStatisticsDuration :: !Double -- ^ Duration of sample interval, in seconds. + + -- | Hardware events + , performanceStatisticsCycles :: !(Maybe Word64) + , performanceStatisticsStalledCyclesFrontend :: !(Maybe Word64) + , performanceStatisticsStalledCyclesBackend :: !(Maybe Word64) + , performanceStatisticsInstructions :: !(Maybe Word64) + , performanceStatisticsCacheReferences :: !(Maybe Word64) + , performanceStatisticsCacheMisses :: !(Maybe Word64) + , performanceStatisticsBranches :: !(Maybe Word64) + , performanceStatisticsBranchMisses :: !(Maybe Word64) + , performanceStatisticsBusCycles :: !(Maybe Word64) + , performanceStatisticsRefCycles :: !(Maybe Word64) + + -- | Software events + , performanceStatisticsCpuClock :: !(Maybe Double) + , performanceStatisticsTaskClock :: !(Maybe Double) + , performanceStatisticsPageFaults :: !(Maybe Word64) + , performanceStatisticsMinorFaults :: !(Maybe Word64) + , performanceStatisticsMajorFaults :: !(Maybe Word64) + , performanceStatisticsContextSwitches :: !(Maybe Word64) + , performanceStatisticsCpuMigrations :: !(Maybe Word64) + , performanceStatisticsAlignmentFaults :: !(Maybe Word64) + , performanceStatisticsEmulationFaults :: !(Maybe Word64) + + -- | Hardware cache events + , performanceStatisticsL1DcacheLoads :: !(Maybe Word64) + , performanceStatisticsL1DcacheLoadMisses :: !(Maybe Word64) + , performanceStatisticsL1DcacheStores :: !(Maybe Word64) + , performanceStatisticsL1DcacheStoreMisses :: !(Maybe Word64) + , performanceStatisticsL1DcachePrefetches :: !(Maybe Word64) + , performanceStatisticsL1DcachePrefetchMisses :: !(Maybe Word64) + , performanceStatisticsL1IcacheLoads :: !(Maybe Word64) + , performanceStatisticsL1IcacheLoadMisses :: !(Maybe Word64) + , performanceStatisticsL1IcachePrefetches :: !(Maybe Word64) + , performanceStatisticsL1IcachePrefetchMisses :: !(Maybe Word64) + , performanceStatisticsLlcLoads :: !(Maybe Word64) + , performanceStatisticsLlcLoadMisses :: !(Maybe Word64) + , performanceStatisticsLlcStores :: !(Maybe Word64) + , performanceStatisticsLlcStoreMisses :: !(Maybe Word64) + , performanceStatisticsLlcPrefetches :: !(Maybe Word64) + , performanceStatisticsLlcPrefetchMisses :: !(Maybe Word64) + , performanceStatisticsDtlbLoads :: !(Maybe Word64) + , performanceStatisticsDtlbLoadMisses :: !(Maybe Word64) + , performanceStatisticsDtlbStores :: !(Maybe Word64) + , performanceStatisticsDtlbStoreMisses :: !(Maybe Word64) + , performanceStatisticsDtlbPrefetches :: !(Maybe Word64) + , performanceStatisticsDtlbPrefetchMisses :: !(Maybe Word64) + , performanceStatisticsItlbLoads :: !(Maybe Word64) + , performanceStatisticsItlbLoadMisses :: !(Maybe Word64) + , performanceStatisticsBranchLoads :: !(Maybe Word64) + , performanceStatisticsBranchLoadMisses :: !(Maybe Word64) + , performanceStatisticsNodeLoads :: !(Maybe Word64) + , performanceStatisticsNodeLoadMisses :: !(Maybe Word64) + , performanceStatisticsNodeStores :: !(Maybe Word64) + , performanceStatisticsNodeStoreMisses :: !(Maybe Word64) + , performanceStatisticsNodePrefetches :: !(Maybe Word64) + , performanceStatisticsNodePrefetchMisses :: !(Maybe Word64) + } deriving (Show, Eq) + +-- | 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] + } + 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 + , offerHostname :: !ByteString + , offerResources :: ![Resource] + , offerAttributes :: ![(ByteString, Value)] + , offerExecutorIDs :: ![ExecutorID] + } + deriving (Show, Eq) + +data TaskExecutionInfo + = TaskCommand !CommandInfo + | TaskExecutor !ExecutorInfo + deriving (Eq, Show) + +-- | Describes a task. Passed from the scheduler all the way to an +-- executor (see SchedulerDriver::launchTasks and +-- Executor::launchTask). +-- +-- 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 + { taskInfoName :: !ByteString + , taskID :: !TaskID + , taskSlaveID :: !SlaveID + , taskResources :: ![Resource] + , taskImplementation :: !TaskExecutionInfo + , taskData :: !(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) + -- | 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) + } + deriving (Show, Eq) + +-- | Describes the current status of a task. +data TaskStatus = TaskStatus + { taskStatusTaskID :: !TaskID + , taskStatusState :: !TaskState + , taskStatusMessage :: !(Maybe ByteString) -- ^ Possible message explaining state. + , taskStatusData :: !(Maybe ByteString) + , 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 + -- the command info. + , taskStatusHealthy :: !(Maybe Bool) + } + deriving (Show, Eq) + +-- | Credential used for authentication. +-- +-- NOTE: 'credentialPrincipal' is used for authenticating the framework with +-- the master. This is different from 'frameworkUser' +-- which is used to determine the user under which the framework's +-- executors/tasks are run. +data Credential = Credential + { credentialPrincipal :: !ByteString + , credentialSecret :: !(Maybe ByteString) + } + deriving (Show, Eq) + + +-- | Entity is used to describe a subject(s) or an object(s) of an ACL. +-- NOTE: +-- To allow everyone access to an Entity set its type to 'ANY'. +-- To deny access to an Entity set its type to 'NONE'. +data ACLEntity = Some ![ByteString] + | 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 ACLSettings = ACLSettings + { aclSettingsPermissive :: !(Maybe Bool) + , aclSettingsRegisterFrameworks :: ![RegisterFrameworkACL] + , aclSettingsRunTasks :: ![RunTaskACL] + , aclSettingsShutdownFramework :: ![ShutdownFrameworkACL] + } deriving (Show, Eq) + +data RateLimit = RateLimit + { rateLimitQPS :: !(Maybe Double) + , rateLimitPrincipal :: !ByteString + , rateLimitCapacity :: !(Maybe Word64) + } deriving (Show, Eq) + +data RateLimits = RateLimits + { rateLimits :: ![RateLimit] + , rateLimitsAggregateDefaultQPS :: !(Maybe Double) + , rateLimitsAggregateDefaultCapacity :: !(Maybe Double) + } deriving (Show, Eq) + +data Mode = ReadWrite -- ^ Mount the volume in R/W mode + | ReadOnly -- ^ Mount the volume as read-only + deriving (Show, Eq) + +instance Enum Mode where + fromEnum ReadWrite = 1 + fromEnum ReadOnly = 2 + toEnum 1 = ReadWrite + toEnum 2 = ReadOnly + toEnum _ = error "Unsupported volume mode" + +data Volume = Volume + { volumeContainerPath :: !ByteString + , volumeHostPath :: !(Maybe ByteString) + , volumeMode :: !Mode + } deriving (Show, Eq) + +data ContainerType = Docker { dockerImage :: ByteString } + | Unknown Int -- ^ Not technically a container type. Represents the 'type' enum field if we get a container type that isn't Docker (e.g. from Mesos releases > 0.20) + deriving (Show, Eq) + +data ContainerInfo = ContainerInfo + { containerInfoContainerType :: !ContainerType + , containerInfoVolumes :: ![Volume] + } deriving (Show, Eq) diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,364 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Main where +import Control.Applicative +import Control.Monad.Managed +import qualified Data.ByteString as ByteString +import Data.IORef +import Foreign.C.Types +import System.Mesos.Internal +import System.Mesos.Raw.Attribute +import System.Mesos.Raw.Environment +import System.Mesos.Raw.Parameter +import System.Mesos.Raw.Parameters +import System.Mesos.Scheduler +import System.Mesos.Types +import Test.QuickCheck +import Test.QuickCheck.Arbitrary +import Test.QuickCheck.Monadic + +markCalled r = modifyIORef r (+1) + +beforeAndAfter :: (Show a, CPPValue a) => a -> IO a +beforeAndAfter x = do + print x + x' <- with (cppValue x >>= unmarshal) return + print x' + return x' + +main :: IO () +main = testIDs + +instance Arbitrary CUInt where + arbitrary = CUInt <$> arbitrary +instance Arbitrary CULong where + arbitrary = CULong <$> arbitrary +instance Arbitrary ByteString.ByteString where + arbitrary = ByteString.pack <$> arbitrary +instance CoArbitrary ByteString.ByteString where + coarbitrary = coarbitrary . ByteString.unpack +deriving instance Arbitrary FrameworkID +deriving instance Arbitrary OfferID +deriving instance Arbitrary SlaveID +deriving instance Arbitrary TaskID +deriving instance Arbitrary ExecutorID +deriving instance Arbitrary ContainerID +instance Arbitrary FrameworkInfo where + arbitrary = FrameworkInfo + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary CommandURI where + arbitrary = CommandURI <$> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary CommandValue where + arbitrary = oneof + [ ShellCommand <$> arbitrary + , RawCommand <$> arbitrary <*> arbitrary + ] + +instance Arbitrary CommandInfo where + arbitrary = CommandInfo <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary ExecutorInfo where + arbitrary = ExecutorInfo + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary MasterInfo where + arbitrary = MasterInfo + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary SlaveInfo where + arbitrary = SlaveInfo + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary Value where + arbitrary = oneof + [ Scalar <$> arbitrary + , Ranges <$> listOf range + , Set <$> listOf arbitrary + , Text <$> arbitrary + ] + where range = arbitrary >>= \l -> arbitrary >>= \r -> return (l, r) + +instance Arbitrary Attribute where + arbitrary = Attribute <$> arbitrary <*> arbitrary + +instance Arbitrary Resource where + arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary PerformanceStatistics where + arbitrary = PerformanceStatistics + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary ResourceStatistics where + arbitrary = ResourceStatistics + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary ResourceUsage where + arbitrary = ResourceUsage + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary Request where + arbitrary = Request + <$> arbitrary + <*> arbitrary + +instance Arbitrary Offer where + arbitrary = Offer + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary TaskExecutionInfo where + arbitrary = oneof + [ TaskCommand <$> arbitrary + , TaskExecutor <$> arbitrary + ] + +instance Arbitrary Mode where + arbitrary = oneof [pure ReadWrite, pure ReadOnly] + +instance Arbitrary Volume where + arbitrary = Volume <$> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary ContainerType where + arbitrary = Docker <$> arbitrary + +instance Arbitrary ContainerInfo where + arbitrary = ContainerInfo <$> arbitrary <*> arbitrary + +instance Arbitrary HealthCheckStrategy where + arbitrary = oneof + [ CommandCheck <$> arbitrary + , HTTPCheck <$> arbitrary <*> arbitrary <*> arbitrary + ] + +instance Arbitrary HealthCheck where + arbitrary = HealthCheck + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary TaskInfo where + arbitrary = TaskInfo + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary TaskState where + arbitrary = elements [Staging, Starting, TaskRunning, Finished, Failed, Killed, Lost] + +instance Arbitrary TaskStatus where + arbitrary = TaskStatus + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary Filters where + arbitrary = Filters <$> arbitrary +instance Arbitrary Environment where + arbitrary = Environment <$> arbitrary +instance Arbitrary Parameter where + arbitrary = Parameter <$> arbitrary <*> arbitrary +instance Arbitrary Parameters where + arbitrary = Parameters <$> arbitrary +instance Arbitrary Credential where + arbitrary = Credential <$> arbitrary <*> arbitrary + +idempotentMarshalling :: (Show a, Eq a, CPPValue a) => a -> IO a +idempotentMarshalling x = with (cppValue x >>= unmarshal) return + +prop_idempotentMarshalling :: (Show a, Eq a, CPPValue a) => Gen a -> Property +prop_idempotentMarshalling g = monadicIO $ forAllM g $ \x -> do + res <- Test.QuickCheck.Monadic.run $ idempotentMarshalling x + -- Test.QuickCheck.Monadic.run $ print x + if equalExceptDefaults x res + then assert True + else do + Test.QuickCheck.Monadic.run $ do + putStrLn "Original" + print x + putStrLn "Unmarshalled" + print res + assert False + +qcIM :: (Show a, Eq a, CPPValue a) => Gen a -> IO () +qcIM = quickCheck . prop_idempotentMarshalling + +testIDs = do + putStrLn "Testing ExecutorInfo" + qcIM (arbitrary :: Gen ExecutorInfo) + putStrLn "Testing TaskInfo" + qcIM (arbitrary :: Gen TaskInfo) + putStrLn "Testing Volume" + qcIM (arbitrary :: Gen Volume) + putStrLn "Testing HealthCheck" + qcIM (arbitrary :: Gen HealthCheck) + putStrLn "Testing ContainerInfo" + qcIM (arbitrary :: Gen ContainerInfo) + putStrLn "Testing Value" + qcIM (arbitrary :: Gen Value) + putStrLn "Testing FrameworkID" + qcIM (arbitrary :: Gen FrameworkID) + putStrLn "Testing OfferID" + qcIM (arbitrary :: Gen OfferID) + putStrLn "Testing SlaveID" + qcIM (arbitrary :: Gen SlaveID) + putStrLn "Testing TaskID" + qcIM (arbitrary :: Gen TaskID) + putStrLn "Testing ExecutorID" + qcIM (arbitrary :: Gen ExecutorID) + putStrLn "Testing ContainerID" + qcIM (arbitrary :: Gen ContainerID) + putStrLn "Testing Filters" + qcIM (arbitrary :: Gen Filters) + putStrLn "Testing Environment" + qcIM (arbitrary :: Gen Environment) + putStrLn "Testing FrameworkInfo" + qcIM (arbitrary :: Gen FrameworkInfo) + putStrLn "Testing CommandURI" + qcIM (arbitrary :: Gen CommandURI) + putStrLn "Testing Credential" + qcIM (arbitrary :: Gen Credential) + putStrLn "Testing TaskStatus" + qcIM (arbitrary :: Gen TaskStatus) + putStrLn "Testing ResourceUsage" + qcIM (arbitrary :: Gen ResourceUsage) + putStrLn "Testing ResourceStatistics" + qcIM (arbitrary :: Gen ResourceStatistics) + putStrLn "Testing Parameters" + qcIM (arbitrary :: Gen Parameters) + putStrLn "Testing Attribute" + qcIM (arbitrary :: Gen Attribute) + putStrLn "Testing Resource" + qcIM (arbitrary :: Gen Resource) + putStrLn "Testing CommandInfo" + qcIM (arbitrary :: Gen CommandInfo) + putStrLn "Testing MasterInfo" + qcIM (arbitrary :: Gen MasterInfo) + putStrLn "Testing Request" + qcIM (arbitrary :: Gen Request) + putStrLn "Testing Offer" + qcIM (arbitrary :: Gen Offer) + putStrLn "Testing SlaveInfo" + qcIM (arbitrary :: Gen SlaveInfo) + diff --git a/test/TestExecutor.hs b/test/TestExecutor.hs new file mode 100644 --- /dev/null +++ b/test/TestExecutor.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where +import Control.Monad +import Data.Monoid +import System.Exit +import System.Mesos.Executor +import System.Mesos.TaskStatus +import System.Mesos.Types + +data TestExecutor = TestExecutor +instance ToExecutor TestExecutor where + 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 + -- this is where one would perform the requested task + sendStatusUpdate d $ taskStatus (taskID t) Finished + +main = do + r <- withExecutorDriver TestExecutor $ \e -> do + run e + if r == Stopped + then exitSuccess + else exitFailure diff --git a/test/TestFramework.hs b/test/TestFramework.hs new file mode 100644 --- /dev/null +++ b/test/TestFramework.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where +import Control.Applicative +import Control.Lens +import Control.Monad +import qualified Data.ByteString.Char8 as C +import Data.IORef +import Data.Monoid ((<>)) +import System.Exit +import System.Mesos.Resources +import System.Mesos.Scheduler +import System.Mesos.Types +-- import Text.Groom + +cpusPerTask :: Double +cpusPerTask = 1 + +memPerTask :: Double +memPerTask = 32 + +requiredResources :: [Resource] +requiredResources = [cpusPerTask ^. re cpus, memPerTask ^. re mem] + +data TestScheduler = TestScheduler + { role :: 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 [] Nothing (ShellCommand "/Users/ian/Code/personal/hs-mesos/dist/build/test-executor/test-executor") Nothing) requiredResources + +instance ToScheduler TestScheduler where + registered _ _ _ _ = putStrLn "Registered!" + + resourceOffers s driver offers = do + finishedCount <- readIORef $ tasksFinished s + if totalTasks s == finishedCount + then forM_ offers $ \offer -> declineOffer driver (offerID offer) filters + else forM_ offers $ \offer -> do + putStrLn ("Starting task on " <> show (offerHostname offer)) + status <- launchTasks + driver + [ offerID offer ] + [ TaskInfo "Task foo" (TaskID "foo") (offerSlaveID offer) requiredResources + (TaskExecutor $ executorSettings $ offerFrameworkID offer) + Nothing + Nothing + Nothing + ] + (Filters Nothing) + putStrLn "Launched tasks" + return () + + statusUpdate s driver status = do + putStrLn $ "Task " <> show (taskStatusTaskID status) <> " is in state " <> show (taskStatusState status) + print status + when (taskStatusState status == Finished) $ do + count <- atomicModifyIORef' (tasksFinished s) (\x -> let x' = succ x in (x', x')) + when (count == totalTasks s) $ void $ do + getLine + stop driver False + + errorMessage _ _ message = C.putStrLn message + +main = do + role <- 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 } + scheduler <- TestScheduler "master" 5 <$> newIORef 0 <*> newIORef 0 + status <- withSchedulerDriver scheduler info master Nothing $ \d -> do + status <- run d + -- Ensure that the driver process terminates + stop d False + if status /= Stopped + then exitFailure + else exitSuccess