Safe Haskell | None |
---|---|
Language | Haskell2010 |
This module implements commands to communicate with the LXD daemon over its REST API.
More information about LXD: https://github.com/lxc/lxd
This module implements a high-level interface, and is probably what you need. It uses the lower-level interface implemented in Network.LXD.Client.API, but unless you are a power user, you shouldn't need this module.
Accompanying blog post: https://deliquus.com/posts/2017-10-02-using-servant-to-orchestrate-lxd-containers.md
- def :: Default a => a
- module Network.LXD.Client.Remotes
- module Network.LXD.Client.Types
- data Host
- class (MonadIO m, MonadMask m) => HasClient m where
- defaultClientEnv :: HasClient m => m ClientEnv
- data WithLocalHost a
- runWithLocalHost :: LocalHost -> WithLocalHost a -> IO a
- data WithRemoteHost a
- runWithRemoteHost :: RemoteHost -> WithRemoteHost a -> IO a
- lxcApi :: HasClient m => m ApiConfig
- lxcList :: HasClient m => m [ContainerName]
- lxcCreate :: HasClient m => ContainerCreateRequest -> m ()
- lxcDelete :: HasClient m => ContainerName -> m ()
- lxcInfo :: HasClient m => ContainerName -> m Container
- lxcStart :: HasClient m => ContainerName -> m ()
- lxcStop :: HasClient m => ContainerName -> Bool -> m ()
- lxcRestart :: HasClient m => ContainerName -> Bool -> m ()
- lxcFreeze :: HasClient m => ContainerName -> m ()
- lxcUnfreeze :: HasClient m => ContainerName -> m ()
- lxcExec :: HasClient m => ContainerName -> String -> [String] -> ByteString -> m ByteString
- lxcExecEnv :: HasClient m => ContainerName -> String -> [String] -> Map String String -> ByteString -> m ByteString
- lxcExecRaw :: HasClient m => ContainerName -> String -> [String] -> Map String String -> MVar (Maybe ByteString) -> MVar ByteString -> MVar ByteString -> m (Async ())
- lxcFileDelete :: HasClient m => ContainerName -> FilePath -> m ()
- lxcFilePull :: HasClient m => ContainerName -> FilePath -> FilePath -> m ()
- lxcFilePullRaw :: HasClient m => ContainerName -> FilePath -> m ByteString
- lxcFilePush :: HasClient m => ContainerName -> FilePath -> FilePath -> m ()
- lxcFilePushAttrs :: HasClient m => ContainerName -> FilePath -> FilePath -> Maybe Uid -> Maybe Gid -> m ()
- lxcFilePushRaw :: HasClient m => ContainerName -> FilePath -> ByteString -> m ()
- lxcFilePushRawAttrs :: HasClient m => ContainerName -> FilePath -> Maybe Uid -> Maybe Gid -> Maybe FileMode -> FileType -> Maybe WriteMode -> ByteString -> m ()
- lxcFileListDir :: HasClient m => ContainerName -> FilePath -> m [String]
- lxcFileMkdir :: HasClient m => ContainerName -> String -> Bool -> m ()
- lxcFileMkdirTemplate :: HasClient m => ContainerName -> FilePath -> FilePath -> m ()
- lxcFileMkdirAttrs :: HasClient m => ContainerName -> String -> Bool -> Maybe Uid -> Maybe Gid -> Maybe FileMode -> m ()
- lxcFilePullRecursive :: HasClient m => ContainerName -> FilePath -> FilePath -> m ()
- lxcFilePushRecursive :: HasClient m => ContainerName -> FilePath -> FilePath -> m ()
- lxcFilePushRecursiveAttrs :: HasClient m => ContainerName -> FilePath -> FilePath -> Maybe Uid -> Maybe Gid -> m ()
- lxcImageList :: HasClient m => m [ImageId]
- lxcImageAliases :: HasClient m => m [ImageAliasName]
- lxcImageInfo :: HasClient m => ImageId -> m Image
- lxcImageAlias :: HasClient m => ImageAliasName -> m ImageAlias
- lxcImageCreate :: HasClient m => ImageCreateRequest -> m ()
- lxcImageDelete :: HasClient m => ImageId -> m ()
- lxcNetworkList :: HasClient m => m [NetworkName]
- lxcNetworkCreate :: HasClient m => NetworkCreateRequest -> m ()
- lxcNetworkInfo :: HasClient m => NetworkName -> m Network
- lxcNetworkConfig :: HasClient m => NetworkName -> NetworkConfigRequest -> m ()
- lxcNetworkDelete :: HasClient m => NetworkName -> m ()
- lxcProfileList :: HasClient m => m [ProfileName]
- lxcProfileCreate :: HasClient m => ProfileCreateRequest -> m ()
- lxcProfileInfo :: HasClient m => ProfileName -> m Profile
- lxcProfileConfig :: HasClient m => ProfileName -> ProfileConfigRequest -> m ()
- lxcProfileDelete :: HasClient m => ProfileName -> m ()
- lxcStorageList :: HasClient m => m [PoolName]
- lxcStorageCreate :: HasClient m => PoolCreateRequest -> m ()
- lxcStorageInfo :: HasClient m => PoolName -> m Pool
- lxcStorageConfig :: HasClient m => PoolName -> PoolConfigRequest -> m ()
- lxcStorageDelete :: HasClient m => PoolName -> m ()
- lxcVolumeList :: HasClient m => PoolName -> m [VolumeName]
- lxcVolumeCreate :: HasClient m => PoolName -> VolumeCreateRequest -> m ()
- lxcVolumeInfo :: HasClient m => PoolName -> VolumeName -> m Volume
- lxcVolumeConfig :: HasClient m => PoolName -> VolumeName -> VolumeConfigRequest -> m ()
- lxcVolumeDelete :: HasClient m => PoolName -> VolumeName -> m ()
How to use this library
All commands take place in the HasClient
monad. The WithLocalHost
and WithRemoteHost
monads can be used directly for fast access to
an LXD daemon, but you can also make your own monad stack an instance
of HasClient
.
You can connect to an LXD daemon over a unix-socket on the local host, or over HTTPS. For more information about these connection types see Network.LXD.Client.
An example using these command to conncet to the LXD instance on your local host (should work out of the box).
{-# LANGUAGE OverloadedStrings #-} module Main where import Control.Monad.IO.Class (liftIO) import Network.LXD.Client.Commands main :: IO () main = runWithLocalHost def $ do liftIO $ putStrLn "Creating my-container" lxcCreate . containerCreateRequest "my-container" . ContainerSourceRemote $ remoteImage imagesRemote "ubuntu/xenial/amd64" liftIO $ putStrLn "Starting my-container" lxcStart "my-container" liftIO $ putStrLn "Stopping my-container" lxcStop "my-container" False liftIO $ putStrLn "Deleting my-container" lxcDelete "my-container"
Re-exports
module Network.LXD.Client.Remotes
module Network.LXD.Client.Types
Running commands
class (MonadIO m, MonadMask m) => HasClient m where Source #
Monad with access to a ClientEnv
.
Return the LXD remote host to connect to.
askClientEnv :: m ClientEnv Source #
Return the ClientEnv
to use when connecting to the LXD host.
Returns defaultClientEnv
by default.
data WithLocalHost a Source #
Monad with access to a local host.
runWithLocalHost :: LocalHost -> WithLocalHost a -> IO a Source #
Run a WithLocalHost
monad
data WithRemoteHost a Source #
Monad with access to a remote host.
runWithRemoteHost :: RemoteHost -> WithRemoteHost a -> IO a Source #
Run a WithRemoteHost
monad
API
Containers
lxcList :: HasClient m => m [ContainerName] Source #
List all container names.
lxcCreate :: HasClient m => ContainerCreateRequest -> m () Source #
Create a new container.
lxcDelete :: HasClient m => ContainerName -> m () Source #
Delete a container.
lxcStart :: HasClient m => ContainerName -> m () Source #
Start a contianer.
lxcStop :: HasClient m => ContainerName -> Bool -> m () Source #
Stop a container.
The second flag forces the action.
lxcRestart :: HasClient m => ContainerName -> Bool -> m () Source #
Restart a container.
The second flag forces the action.
lxcFreeze :: HasClient m => ContainerName -> m () Source #
Freeze a container.
lxcUnfreeze :: HasClient m => ContainerName -> m () Source #
Unfreeze a container.
Exec
:: HasClient m | |
=> ContainerName | Container name |
-> String | Command name |
-> [String] | Command arguments |
-> ByteString | Standard input |
-> m ByteString |
Execute a command, catch standard output, print stderr.
:: HasClient m | |
=> ContainerName | Container name |
-> String | Command name |
-> [String] | Command arguments |
-> Map String String | Environment variables |
-> ByteString | Standard input |
-> m ByteString |
Execute a command, provide environment variables, catch standard output, print stderr.
:: HasClient m | |
=> ContainerName | Container name |
-> String | Command name |
-> [String] | Command arguments |
-> Map String String | Environment variables |
-> MVar (Maybe ByteString) | Stream of standard input, pass |
-> MVar ByteString | Standard output |
-> MVar ByteString | Standard error |
-> m (Async ()) |
Execute a command, with given environment variables.
Files and directories
Deletion
lxcFileDelete :: HasClient m => ContainerName -> FilePath -> m () Source #
Delete a file or empty directory from an LXD container.
Files
:: HasClient m | |
=> ContainerName | Container name |
-> FilePath | Source path, in the container |
-> FilePath | Destination path, in the host |
-> m () |
Pull the file contents from an LXD container.
lxcFilePullRaw :: HasClient m => ContainerName -> FilePath -> m ByteString Source #
Pull the file contents from an LXD container, return the lazy bytestring.
:: HasClient m | |
=> ContainerName | Container name |
-> FilePath | Source path, in the host |
-> FilePath | Destination path, in the container |
-> m () |
Push the file contents to an LXD container.
:: HasClient m | |
=> ContainerName | Container name |
-> FilePath | Source path, in the host |
-> FilePath | Destination path, in the container |
-> Maybe Uid | |
-> Maybe Gid | |
-> m () |
Push the fole contents to an LXD container, with the given attributes.
lxcFilePushRaw :: HasClient m => ContainerName -> FilePath -> ByteString -> m () Source #
Write the lazy bytestring to a file in an LXD container.
lxcFilePushRawAttrs :: HasClient m => ContainerName -> FilePath -> Maybe Uid -> Maybe Gid -> Maybe FileMode -> FileType -> Maybe WriteMode -> ByteString -> m () Source #
Write the lazy bytestring to a file in an LXD container, with given file attributes.
Directories
lxcFileListDir :: HasClient m => ContainerName -> FilePath -> m [String] Source #
List all entries in a directory, without .
or ..
.
:: HasClient m | |
=> ContainerName | |
-> String | |
-> Bool | Create parent directories |
-> m () |
Create a directory.
:: HasClient m | |
=> ContainerName | Container name |
-> FilePath | Source path, in the host |
-> FilePath | Destination path, in the container |
-> m () |
Create a directory using a host directory as a template.
Note that this function doesn't copy the directory contents. Use
lxcFilePushRecursive
if you want to copy the directory contents as well.
:: HasClient m | |
=> ContainerName | |
-> String | |
-> Bool | Create parent directories |
-> Maybe Uid | |
-> Maybe Gid | |
-> Maybe FileMode | |
-> m () |
Create a directory, with given attributes.
Recursive
:: HasClient m | |
=> ContainerName | Container name |
-> FilePath | Source path, in the container |
-> FilePath | Destination path, in the host |
-> m () |
Recursively pull a directory (or file) from a container.
:: HasClient m | |
=> ContainerName | Container name |
-> FilePath | Source path, in the host |
-> FilePath | Destination path, in the container |
-> m () |
Recursively push a directory (or file) to a container.
lxcFilePushRecursiveAttrs Source #
:: HasClient m | |
=> ContainerName | |
-> FilePath | Souce path, in the host |
-> FilePath | Destination path, in the container |
-> Maybe Uid | |
-> Maybe Gid | |
-> m () |
Recursively push a directory (or file) to a container, with given file attributes.
Images
lxcImageList :: HasClient m => m [ImageId] Source #
List all image IDs.
lxcImageAliases :: HasClient m => m [ImageAliasName] Source #
List al image aliases.
lxcImageAlias :: HasClient m => ImageAliasName -> m ImageAlias Source #
Get image alias information.
lxcImageCreate :: HasClient m => ImageCreateRequest -> m () Source #
Create an image.
lxcImageDelete :: HasClient m => ImageId -> m () Source #
Delete an image.
Networks
lxcNetworkList :: HasClient m => m [NetworkName] Source #
List all networks
lxcNetworkCreate :: HasClient m => NetworkCreateRequest -> m () Source #
Create a network.
lxcNetworkInfo :: HasClient m => NetworkName -> m Network Source #
Get network information.
lxcNetworkConfig :: HasClient m => NetworkName -> NetworkConfigRequest -> m () Source #
Configure a network.
lxcNetworkDelete :: HasClient m => NetworkName -> m () Source #
Delete a network
Profiles
lxcProfileList :: HasClient m => m [ProfileName] Source #
List all profiles
lxcProfileCreate :: HasClient m => ProfileCreateRequest -> m () Source #
Create a profile.
lxcProfileInfo :: HasClient m => ProfileName -> m Profile Source #
Get profile information.
lxcProfileConfig :: HasClient m => ProfileName -> ProfileConfigRequest -> m () Source #
Configure a profile.
lxcProfileDelete :: HasClient m => ProfileName -> m () Source #
Delete a profile
Storage
lxcStorageList :: HasClient m => m [PoolName] Source #
List all storage pools
lxcStorageCreate :: HasClient m => PoolCreateRequest -> m () Source #
Create a storage pool.
lxcStorageConfig :: HasClient m => PoolName -> PoolConfigRequest -> m () Source #
Configure a storage pool.
lxcStorageDelete :: HasClient m => PoolName -> m () Source #
Delete a storage pool
Volume
lxcVolumeList :: HasClient m => PoolName -> m [VolumeName] Source #
List all volumes
lxcVolumeCreate :: HasClient m => PoolName -> VolumeCreateRequest -> m () Source #
Create a volume.
lxcVolumeInfo :: HasClient m => PoolName -> VolumeName -> m Volume Source #
Get volume information.
lxcVolumeConfig :: HasClient m => PoolName -> VolumeName -> VolumeConfigRequest -> m () Source #
Configure a volume.
lxcVolumeDelete :: HasClient m => PoolName -> VolumeName -> m () Source #
Delete a volume