git.iko.soy/docker-hs
on 2bf4a5c help sign in
docker-hs/src/Docker/Types.hs
284 lines 11 kB history raw
1module Docker.Types where
3import Control.Monad (mzero)
4import Control.Monad.Except (ExceptT, runExceptT)
5import Control.Monad.Reader (ReaderT, runReaderT)
6import Data.Aeson (FromJSON, ToJSON, decode, encode,
7 genericParseJSON, genericToJSON, object,
8 parseJSON, toJSON, (.:), (.=))
9import qualified Data.Aeson as JSON
10import Data.Aeson.Types (defaultOptions, fieldLabelModifier)
11import qualified Data.ByteString.Lazy as BL
12import Data.Char (toUpper)
13import qualified Data.Map as M
14import Data.Text (Text)
15import qualified Data.Text as T
16import GHC.Generics (Generic)
17import qualified Network.HTTP.Client as HTTP
19type Endpoint = Text
20type URL = Text
21type ApiVersion = Text
22type ContainerID = Text
23type ImageID = Text
24type Timeout = Integer
26type Request = HTTP.Request
27type Response = HTTP.Response BL.ByteString
29data Signal = SIGINT | SIGKILL deriving (Eq, Show)
31data DockerClientOpts m = DockerClientOpts {
32 http :: Request -> m Response
33 , apiVer :: ApiVersion
34 , baseUrl :: URL
35 }
37type DockerT m a = ReaderT (DockerClientOpts m) (ExceptT String m) a
39runDockerT :: (Monad m) => DockerClientOpts m -> DockerT m a -> m (Either String a)
40runDockerT opts a = runExceptT $ runReaderT a opts
41-- runDockerT opts a = (runExceptT .) . flip runReaderT opts a
43data ListOpts = ListOpts { all :: Bool } deriving (Eq, Show)
45defaultClientOpts :: DockerClientOpts IO
46defaultClientOpts = DockerClientOpts {
47 http = undefined
48 , apiVer = "v1.22"
49 , baseUrl = "http://127.0.0.1:2375/"
50 }
52data DockerVersion = DockerVersion {
53 version :: Text
54 , apiVersion :: ApiVersion
55 , gitCommit :: Text
56 , goVersion :: Text
57 , os :: Text
58 , arch :: Text
59 , kernelVersion :: Text
60 , buildTime :: Text
61 } deriving (Show, Eq, Generic)
64instance ToJSON DockerVersion where
65 toJSON = genericToJSON defaultOptions {
66 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
68instance FromJSON DockerVersion where
69 parseJSON = genericParseJSON defaultOptions {
70 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
72data Container = Container
74type Digest = Text
75newtype Labels = Labels (M.Map Name Value) deriving (Eq, Show)
77instance FromJSON Labels where
78 parseJSON val = Labels <$> parseJSON val
80instance ToJSON Labels where
81 toJSON (Labels kvs) = object [k .= v | (k,v) <- (M.toList kvs)]
83type Tag = Text
85data Image = DockerImage {
86 imageId :: ImageID
87 , imageCreated :: Integer
88 , imageParentId :: Maybe ImageID
89 , imageRepoTags :: [Tag]
90 , imageRepoDigests :: [Digest]
91 , imageSize :: Integer
92 , imageVirtualSize :: Integer
93 , imageLabels :: Labels
94 } deriving (Show, Eq, Generic)
96dropImagePrefix = drop 5
98instance FromJSON Image where
99 parseJSON = genericParseJSON defaultOptions {
100 fieldLabelModifier = dropImagePrefix}
102data CreateOpts = CreateOpts
103data StartOpts = StartOpts
105data DeleteOpts = DeleteOpts {
106 deleteVolumes :: Bool
107 , force :: Bool
108 } deriving (Eq, Show)
110type Timestamp = Integer
111data TailLogOpt = Tail Integer | All deriving (Eq, Show)
113data LogOpts = LogOpts {
114 follow :: Bool
115 , stdout :: Bool
116 , stderr :: Bool
117 , since :: Timestamp
118 , timestamps :: Bool
119 , tail :: TailLogOpt
120 } deriving (Eq, Show)
122data BindMountMode = Rw | Ro deriving (Eq, Show, Generic)
124instance ToJSON BindMountMode
125instance FromJSON BindMountMode
127data BindMount = BindMount {
128 hostSrc :: Text
129 , containerDest :: Text
130 , mountMode :: Maybe BindMountMode
131 } deriving (Eq, Show)
133data Volume = Volume {
134 containerName :: Text
135 , volumeMode :: Maybe BindMountMode
136 } deriving (Eq, Show)
138-- BindMount "/tmp" "/tmp2" (Just Rw)
139-- instance FromJSON BindMount where
140-- parseJSON (JSON.Object v) = TODO
143instance ToJSON BindMount where
144 toJSON (BindMount s d mode) = toJSON $ case mode of
145 Nothing -> T.concat[s, ":", d]
146 Just m -> T.concat[s, ":", d, ":", (T.pack $ show m)]
148data Link = Link Text (Maybe Text) deriving (Eq, Show)
150instance ToJSON Link where
151 toJSON (Link n1 n2) = toJSON $ case n2 of
152 Nothing -> T.concat[n1, ":", n1]
153 Just n -> T.concat[n1, ":", n]
155-- { "Type": "<driver_name>", "Config": {"key1": "val1"} }
156data LogDriverType = JsonFile | Syslog | Journald | Gelf | AwsLogs | Splunk | LoggingDisabled deriving (Eq, Show)
158data LogDriverOptions = Map Text Text deriving (Eq, Show)
160data LogDriverConfig = LogDriverConfig LogDriverType (Maybe LogDriverOptions) deriving (Eq, Show)
162-- TODO: Add container:<name|id> mode
163data NetworkMode = Bridge | Host | NetworkDisabled deriving (Eq, Show)
165data PortType = TCP | UDP deriving (Eq, Show)
167newtype NetworkInterface = NetworkInterface Text deriving (Eq, Show)
169-- { <port>/<protocol>: [{ "HostPort": "<port>" }] }
170data PortBinding = PortBinding {
171 containerPort :: Integer
172 , portType :: PortType
173 , hostPort :: [HostPort]
174 } deriving (Eq, Show)
176data HostPort = HostPort NetworkInterface Port deriving (Eq, Show)
178-- { "Name": "on-failure" , "MaximumRetryCount": 2}
179type RetryCount = Integer
180data RestartPolicy = RestartAlways | RestartUnlessStopped | RestartOnFailure RetryCount | RestartOff deriving (Eq, Show)
182data Isolation = Default | Process | Hyperv deriving (Eq, Show)
184newtype UTSMode = UTSMode Text deriving (Eq, Show)
186-- TODO: Add Tmpfs : List of tmpfs (mounts) used for the container
187-- TODO: Add UTSMode : UTS namespace to use for the container
188data HostConfig = HostConfig
189 { binds :: [BindMount]
190 , containerIDFile :: FilePath
191 , logConfig :: LogDriverConfig
192 , networkMode :: NetworkMode
193 , portBindings :: [PortBinding]
194 , restartPolicy :: RestartPolicy
195 , volumeDriver :: Text
196 , volumesFrom :: Volume
197 , capAdd :: [Text]
198 , capDrop :: [Text]
199 , dns :: [Text]
200 , dnsOptions :: [Text]
201 , dnsSearch :: [Text]
202 , extraHosts :: [Text]
203 , groupAdd :: [Integer]
204 , ipcMode :: Text
205 , links :: [Link]
206 , oomScoreAdj :: Integer
207 , pidMode :: Text
208 , privileged :: Bool
209 , publishAllPorts :: Bool
210 , readOnlyRootfs :: Bool
211 , securityOpt :: [Text]
212 , storageOpt :: [Text]
213 , utsMode :: UTSMode
214 , shmSize :: Integer
215 , consoleSize :: Integer
216 , isolation :: Isolation
217 , resources :: ContainerResources
218 } deriving (Eq, Show, Generic)
220-- { "Name": <name>, "Soft": <soft limit>, "Hard": <hard limit> }
221-- { "Name": "nofile", "Soft": 1024, "Hard": 2048 }
222data Ulimit = Ulimit {
223 ulimitName :: Text
224 , ulimitSoft :: Integer
225 , ulimitHard :: Integer
226 } deriving (Eq, Show)
228data ContainerResources = ContainerResources {
229 cpuShares :: Integer
230 , cgroupParent :: Text
231 , blkioWeight :: Text
232 , blkioWeightDevice :: Text
233 , blkioDeviceReadBps :: Text
234 , blkioDeviceWriteBps :: Text
235 , blkioDeviceReadIOps :: Text
236 , blkioDeviceWriteIOps :: Text
237 , cpuPeriod :: Integer
238 , cpuQuota :: Integer
239 , cpusetCpus :: Integer
240 , cpusetMems :: Text
241 , devices :: [BindMount]
242 , diskQuota :: Integer
243 , kernelMemory :: Integer
244 , memory :: Integer
245 , memoryReservation :: Integer
246 , memorySwap :: Integer
247 , memorySwappiness :: Integer
248 , oomKillDisable :: Bool
249 , pidsLimit :: Integer
250 , ulimits :: [Ulimit]
251 } deriving (Eq, Show)
253type Port = Integer
255type Name = Text
256type Value = Text
258data EnvVar = EnvVar Name Value deriving (Eq, Show)
260data ContainerConfig = ContainerConfig {
261 hostname :: Text
262 , domainname :: Text
263 , user :: Text
264 , attachStdin :: Bool
265 , attachStdout :: Bool
266 , attachStderr :: Bool
267 , exposedPorts :: [Port]
268 , publishService :: Text
269 , tty :: Bool
270 , openStdin :: Bool
271 , stdinOnce :: Bool
272 , env :: [EnvVar]
273 , cmd :: Text
274 , argsEscaped :: Bool
275 , image :: Text
276 , volumes :: [BindMount]
277 , workingDir :: FilePath
278 , entrypoint :: Text
279 , networkDisabled :: Bool
280 , macAddress :: Text
281 , onBuild :: Text
282 , labels :: Labels
283 , stopSignal :: Signal
284 } deriving (Eq, Show)