@@ -1,306 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE DeriveFunctor #-}
3−{-# LANGUAGE DeriveGeneric #-}
4−{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE GADTs #-}
6−{-# LANGUAGE OverloadedStrings #-}
7−{-# LANGUAGE RankNTypes #-}
8−{-# LANGUAGE RecordWildCards #-}
9−{-# LANGUAGE TypeFamilies #-}
10−
11−module Network.Docker.Types where
12−
13−import Control.Applicative
14−import Control.Monad.Free
15−import Control.Monad.Reader (ReaderT)
16−import Data.Aeson
17−import Data.Aeson.Types
18−import Data.Bool
19−import qualified Data.ByteString.Lazy as L
20−import Data.Default
21−import qualified Data.Map as Map
22−import qualified Data.Text as T
23−import GHC.Generics (Generic)
24−import Network.Wreq.Types (Postable)
25−import OpenSSL.Session (SSLContext)
26−
27−type DockerM m a = ReaderT DockerClientOpts m a
28−
29−type ContainerID = String
30−type ImageID = String
31−
32−type URL = String
33−type ApiVersion = String
34−
35−type Tag = String
36−type IP = String
37−type Port = Int
38−type PortType = String
39−
40−data SSL = NoSSL | SSL SSLOptions deriving Show
41−
42−data DockerClientOpts = DockerClientOpts {
43− apiVersion :: ApiVersion
44− , baseUrl :: URL
45− , ssl :: SSL
46− } deriving (Show)
47−
48−data Endpoint =
49− VersionEndpoint
50− | ListContainersEndpoint
51− | ListImagesEndpoint
52− | CreateContainerEndpoint
53− | StartContainerEndpoint
54− | StopContainerEndpoint
55− | KillContainerEndpoint
56− | RestartContainerEndpoint
57− | PauseContainerEndpoint
58− | UnpauseContainerEndpoint
59− | ContainerLogsEndpoint
60− | DeleteContainerEndpoint
61−
62−
63−data SEndpoint (a :: Endpoint) where
64− SVersionEndpoint :: SEndpoint VersionEndpoint
65− SListContainersEndpoint :: SEndpoint ListContainersEndpoint
66− SListImagesEndpoint :: SEndpoint ListImagesEndpoint
67− SCreateContainerEndpoint :: SEndpoint CreateContainerEndpoint
68− SStartContainerEndpoint :: ContainerID -> SEndpoint StartContainerEndpoint
69− SStopContainerEndpoint :: ContainerID -> SEndpoint StopContainerEndpoint
70− SKillContainerEndpoint :: ContainerID -> SEndpoint KillContainerEndpoint
71− SRestartContainerEndpoint :: ContainerID -> SEndpoint RestartContainerEndpoint
72− SPauseContainerEndpoint :: ContainerID -> SEndpoint PauseContainerEndpoint
73− SUnpauseContainerEndpoint :: ContainerID -> SEndpoint UnpauseContainerEndpoint
74− SContainerLogsEndpoint :: ContainerID -> LogOpts-> SEndpoint ContainerLogsEndpoint
75− SDeleteContainerEndpoint :: ContainerID -> DeleteOpts -> SEndpoint DeleteContainerEndpoint
76−
77−defaultClientOpts :: DockerClientOpts
78−defaultClientOpts = DockerClientOpts
79− { apiVersion = "v1.22"
80− , baseUrl = "http://127.0.0.1:2375/"
81− , ssl = NoSSL
82− }
83−
84−
85−data HttpRequestF a =
86− Get URL
87− | GetSSL SSLOptions URL
88− | Post URL Value
89− | PostSSL SSLOptions URL Value
90− | Delete URL
91− | DeleteSSL SSLOptions URL
92− deriving ( Functor, Show )
93−
94−
95−type HttpRequestM = Free HttpRequestF
96−
97−data SSLOptions = SSLOptions {
98− optionsKey :: FilePath
99− , optionsCert :: FilePath
100− } deriving Show
101−
102−
103−data DockerImage = DockerImage
104− { _imageId :: ImageID
105− , _imageCreatedAt :: Int
106− , _parentId :: Maybe String
107− , _repoTags :: [Tag]
108− , _size :: Int
109− , _virtualSize :: Int
110− } deriving (Show, Eq)
111−
112−data DockerVersion = DockerVersion
113− { _Version :: String
114− , _GitCommit :: String
115− , _GoVersion :: String
116− , _Arch :: String
117− , _KernelVersion :: String
118− } deriving (Show, Eq, Generic)
119−
120−
121−-- The JSON looks likes this:
122−-- "Ports":[{"IP":"0.0.0.0","PrivatePort":55555,"PublicPort":55555,"Type":"tcp"}]
123−
124−data PortMap = PortMap
125− { _ip :: IP
126− , _privatePort :: Port
127− , _publicPort :: Port
128− , _type :: PortType
129− } deriving (Show, Eq)
130−
131−data DeleteOpts = DeleteOpts
132− { removeVolumes :: Bool
133− , force :: Bool
134− }
135−
136−defaultDeleteOpts = DeleteOpts False False
137−
138−data LogOpts = LogOpts
139− { stdout :: Bool
140− , stderr :: Bool
141− , follow :: Bool
142− } deriving (Eq, Show)
143−
144−
145−defaultLogOpts = LogOpts True True False
146−
147−data DockerContainer = DockerContainer
148− { _containerId :: ContainerID
149− , _containerImageId :: ImageID
150− , _command :: String
151− , _containerCreatedAt :: Int
152− , _names :: [String]
153− , _status :: String
154− , _ports :: Maybe [PortMap]
155− } deriving (Show, Eq)
156−
157−
158−data CreateContainerOpts = CreateContainerOpts
159− { _hostname :: String
160− , _user :: String
161− , _memory :: Int
162− , _memorySwap :: Int
163− , _attachStdin :: Bool
164− , _attachStdout :: Bool
165− , _attachStderr :: Bool
166− , _portSpecs :: Maybe Object
167− , _tty :: Bool
168− , _openStdin :: Bool
169− , _stdinOnce :: Bool
170− , _env :: Maybe Object
171− , _cmd :: [String]
172− , _image :: String
173− , _volumes :: Maybe Object
174− , _volumesFrom :: Maybe Object
175− , _workingDir :: String
176− , _disableNetwork :: Bool
177− , _exposedPorts :: Maybe Object
178− } deriving (Show)
179−
180−defaultCreateOpts = CreateContainerOpts {
181− _hostname = ""
182− , _user = ""
183− , _memory = 0
184− , _memorySwap = 0
185− , _attachStdin = False
186− , _attachStdout = False
187− , _attachStderr = False
188− , _portSpecs = Nothing
189− , _tty = False
190− , _openStdin = False
191− , _stdinOnce = False
192− , _env = Nothing
193− , _cmd = []
194− , _image = "debian"
195− , _volumes = Nothing
196− , _volumesFrom = Nothing
197− , _workingDir = ""
198− , _disableNetwork = False
199− , _exposedPorts = Nothing
200− }
201−
202−instance ToJSON CreateContainerOpts where
203− toJSON (CreateContainerOpts {..}) = object
204− [ "Hostname" .= _hostname
205− , "User" .= _user
206− , "Memory" .= _memory
207− , "MemorySwap" .= _memorySwap
208− , "AttachStdin" .= _attachStdin
209− , "AttachStdout" .= _attachStdout
210− , "AttachStderr" .= _attachStderr
211− , "PortSpecs" .= _portSpecs
212− , "Tty" .= _tty
213− , "OpenStdin" .= _openStdin
214− , "StdinOnce" .= _stdinOnce
215− , "Env" .= _env
216− , "Cmd" .= _cmd
217− , "Image" .= _image
218− , "Volumes" .= _volumes
219− , "VolumesFrom" .= _volumesFrom
220− , "WrokingDir" .= _workingDir
221− , "DisableNetwork" .= _disableNetwork
222− , "ExposedPorts" .= _exposedPorts
223− ]
224−
225−data StartContainerOpts = StartContainerOpts
226− { _Binds :: [T.Text]
227− , _Links :: [T.Text]
228− , _LxcConf :: [(T.Text, T.Text)]
229− , _PortBindings :: [((Int,T.Text),Int)]
230− , _PublishAllPorts :: Bool
231− , _Privileged :: Bool
232− , _Dns :: [T.Text]
233− , _VolumesFrom :: [T.Text]
234− , _RestartPolicy :: RestartPolicy
235− } deriving (Show)
236−
237−defaultStartOpts = StartContainerOpts
238− { _Binds = []
239− , _Links = []
240− , _LxcConf = []
241− , _PortBindings = []
242− , _PublishAllPorts = False
243− , _Privileged = False
244− , _Dns = []
245− , _VolumesFrom = []
246− , _RestartPolicy = RestartNever
247− }
248−
249−instance ToJSON StartContainerOpts where
250− toJSON (StartContainerOpts {..}) = object
251− [ "Binds" .= _Binds
252− , "Links" .= _Links
253− , "LxcConf" .= _LxcConf
254− , "PortBindings" .= object (map (\((h,p),c)->T.concat [T.pack (show h),"/",p] .= [object ["HostPort" .= show c]]) _PortBindings)
255− , "PublishAllPorts" .= _PublishAllPorts
256− , "Privileged" .= _Privileged
257− , "Dns" .= _Dns
258− , "VolumesFrom" .= _VolumesFrom
259− , "RestartPolicy" .= _RestartPolicy
260− ]
261−
262−data RestartPolicy = RestartNever
263− | RestartAlways
264− | RestartOnFailure Int
265− deriving (Show)
266−
267−instance ToJSON RestartPolicy where
268− toJSON RestartNever = object ["Name" .= (""::String), "MaximumRetryCount" .= (0::Int) ]
269− toJSON RestartAlways = object ["Name" .= ("always"::String), "MaximumRetryCount" .= (0::Int) ]
270− toJSON (RestartOnFailure n) = object ["Name" .= ("on-failure"::String), "MaximumRetryCount" .= n ]
271−
272−instance FromJSON DockerImage where
273− parseJSON (Object v) =
274− DockerImage <$> (v .: "Id")
275− <*> (v .: "Created")
276− <*> (v .:? "ParentId")
277− <*> (v .: "RepoTags")
278− <*> (v .: "Size")
279− <*> (v .: "VirtualSize")
280−
281−instance FromJSON PortMap where
282− parseJSON (Object v) =
283− PortMap <$> (v .: "IP")
284− <*> (v .: "PrivatePort")
285− <*> (v .: "PublicPort")
286− <*> (v .: "Type")
287−
288−instance FromJSON DockerContainer where
289− parseJSON (Object v) =
290− DockerContainer <$> (v .: "Id")
291− <*> (v .: "Id")
292− <*> (v .: "Command")
293− <*> (v .: "Created")
294− <*> (v .: "Names")
295− <*> (v .: "Status")
296− <*> (v .:? "Ports")
297−
298−
299−instance ToJSON DockerVersion where
300− toJSON = genericToJSON defaultOptions {
301− fieldLabelModifier = drop 1 }
302−
303−instance FromJSON DockerVersion where
304− parseJSON = genericParseJSON defaultOptions {
305− fieldLabelModifier = drop 1 }
306−