git.iko.soy/docker-hs
on master help sign in
Delete everything. Start from scratch.
2d06414Deni Bertovic
Network/Docker.hsdeleted−105
compare with master
unifiedsplit
@@ -1,105 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE FlexibleContexts #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE TypeFamilies #-}
5−
6−module Network.Docker where
7−
8−import Control.Applicative ((<$>), (<*>))
9−import Control.Lens
10−import Control.Monad.Free
11−import Control.Monad.Reader (ask)
12−import Data.Aeson (FromJSON, ToJSON, Value, decode,
13− eitherDecode, toJSON)
14−import Data.Aeson.Lens (key, _String)
15−import qualified Data.ByteString.Lazy as L
16−import Data.Char
17−import qualified Data.Text as T
18−import Network.Wreq
19−import Pipes
20−import Pipes
21−import qualified Pipes.ByteString as PB
22−import qualified Pipes.HTTP as PH
23−import Text.Printf (printf)
24−
25−import Network.Docker.Internal
26−import Network.Docker.Types
27−
28−getDockerVersion :: DockerM IO (Maybe DockerVersion)
29−getDockerVersion = do
30− clientOpts <- ask
31− decodeResponse <$> runDocker (getDockerVersionM clientOpts SVersionEndpoint)
32−
33−listContainers :: DockerM IO (Maybe [DockerContainer])
34−listContainers = do
35− clientOpts <- ask
36− decodeResponse <$> runDocker (listContainersM clientOpts SListContainersEndpoint)
37−
38−listImages :: DockerM IO (Maybe [DockerImage])
39−listImages = do
40− clientOpts <- ask
41− decodeResponse <$> runDocker (listImagesM clientOpts SListImagesEndpoint)
42−
43−createContainer :: CreateContainerOpts -> DockerM IO (Maybe T.Text)
44−createContainer createOpts = do
45− clientOpts <- ask
46− getElemFromResponse "Id" <$> runDocker (createContainerM clientOpts (SCreateContainerEndpoint) createOpts)
47−
48−startContainer :: ContainerID -> StartContainerOpts -> DockerM IO (Status)
49−startContainer cid startOpts = do
50− clientOpts <- ask
51− (^. responseStatus) <$> runDocker (startContainerM clientOpts (SStartContainerEndpoint cid) startOpts)
52−
53−stopContainer :: ContainerID -> DockerM IO (Status)
54−stopContainer cid = do
55− clientOpts <- ask
56− (^. responseStatus) <$> runDocker (stopContainerM clientOpts (SStopContainerEndpoint cid))
57−
58−killContainer :: ContainerID -> DockerM IO (Status)
59−killContainer cid = do
60− clientOpts <- ask
61− (^. responseStatus) <$> runDocker (killContainerM clientOpts (SKillContainerEndpoint cid))
62−
63−restartContainer :: ContainerID -> DockerM IO (Status)
64−restartContainer cid = do
65− clientOpts <- ask
66− (^. responseStatus) <$> runDocker (restartContainerM clientOpts (SRestartContainerEndpoint cid))
67−
68−pauseContainer :: ContainerID -> DockerM IO (Status)
69−pauseContainer cid = do
70− clientOpts <- ask
71− (^. responseStatus) <$> runDocker (pauseContainerM clientOpts (SPauseContainerEndpoint cid))
72−
73−unpauseContainer :: ContainerID -> DockerM IO (Status)
74−unpauseContainer cid = do
75− clientOpts <- ask
76− (^. responseStatus) <$> runDocker (unpauseContainerM clientOpts (SUnpauseContainerEndpoint cid))
77−
78−deleteContainer :: ContainerID -> DockerM IO (Status)
79−deleteContainer cid = do
80− c <- ask
81− deleteContainerWithOpts defaultDeleteOpts cid
82−
83−deleteContainerWithOpts :: DeleteOpts -> ContainerID -> DockerM IO (Status)
84−deleteContainerWithOpts deleteOpts cid = do
85− clientOpts <- ask
86− (^. responseStatus) <$> runDocker (deleteContainerM clientOpts (SDeleteContainerEndpoint cid deleteOpts))
87−
88−getContainerLogsWithOpts :: LogOpts -> ContainerID -> DockerM IO (L.ByteString)
89−getContainerLogsWithOpts l cid = do
90− clientOpts <- ask
91− (^. responseBody) <$> runDocker (getContainerLogsM clientOpts (SContainerLogsEndpoint cid l))
92−
93−getContainerLogs :: ContainerID -> DockerM IO (L.ByteString)
94−getContainerLogs cid = do
95− clientOpts <- ask
96− (^. responseBody) <$> runDocker (getContainerLogsM clientOpts (SContainerLogsEndpoint cid defaultLogOpts))
97−
98−getContainerLogsStream :: ContainerID -> DockerM IO ()
99−getContainerLogsStream cid = do
100− clientOpts <- ask
101− req <- PH.parseUrl (fullUrl clientOpts url)
102− let req' = req {PH.method = "GET"}
103− liftIO $ PH.withManager PH.defaultManagerSettings $ \m -> PH.withHTTP req' m $ \resp -> runEffect $ PH.responseBody resp >-> PB.stdout
104− where url = SContainerLogsEndpoint cid defaultLogOpts{follow=True}
105−
Network/Docker/Internal.hsdeleted−190
@@ -1,190 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE TypeFamilies #-}
3−
4−module Network.Docker.Internal where
5−
6−import Control.Lens
7−import Control.Monad.Free
8−import Control.Monad.Reader (liftIO)
9−import Data.Aeson (FromJSON, ToJSON, Value, decode,
10− eitherDecode, toJSON)
11−import Data.Aeson.Lens (key, _String)
12−import qualified Data.ByteString.Lazy as L
13−import Network.HTTP.Client.OpenSSL
14−import Network.Wreq
15−import OpenSSL (withOpenSSL)
16−import OpenSSL.Session (SSLContext, context)
17−import qualified OpenSSL.Session as SSL
18−import Text.Printf (printf)
19−
20−import Network.Docker.Types
21−
22−emptyPost = "" :: String
23−
24−runDocker :: HttpRequestM r -> DockerM IO (Response L.ByteString)
25−runDocker (Free (Get url)) = liftIO $ get url
26−runDocker (Free (GetSSL sslOpts url)) = liftIO $ getSSL sslOpts url
27−runDocker (Free (Post url body)) = liftIO $ post url body
28−runDocker (Free (PostSSL sslOpts url body)) = liftIO $ postSSL sslOpts url body
29−runDocker (Free (Delete url)) = liftIO $ delete url
30−runDocker (Free (DeleteSSL sslOpts url)) = liftIO $ deleteSSL sslOpts url
31−
32−constructUrl :: URL -> ApiVersion -> String -> URL
33−constructUrl url apiVersion endpoint = printf "%s%s%s" url apiVersion endpoint
34−
35−-- decodeResponse :: Response L.ByteString -> a
36−decodeResponse r = decode (r ^. responseBody)
37−
38−getElemFromResponse k r = (^? responseBody . key k . _String) r
39−
40−getResponseStatusCode r = (^. responseStatus) r
41−
42−getEndpoint :: SEndpoint a -> String
43−getEndpoint SVersionEndpoint = "/version"
44−getEndpoint SListContainersEndpoint = "/containers/json"
45−getEndpoint SListImagesEndpoint = "/images/json"
46−getEndpoint SCreateContainerEndpoint = "/containers/create"
47−getEndpoint (SStartContainerEndpoint cid) = printf "/containers/%s/start" cid
48−getEndpoint (SStopContainerEndpoint cid) = printf "/containers/%s/stop" cid
49−getEndpoint (SKillContainerEndpoint cid) = printf "/containers/%s/kill" cid
50−getEndpoint (SRestartContainerEndpoint cid) = printf "/containers/%s/restart" cid
51−getEndpoint (SPauseContainerEndpoint cid) = printf "/containers/%s/pause" cid
52−getEndpoint (SUnpauseContainerEndpoint cid) = printf "/containers/%s/unpause" cid
53−getEndpoint (SContainerLogsEndpoint cid (LogOpts stdout stderr follow )) =
54− printf "/containers/%s/logs?stdout=%s&stderr=%s&follow=%s" cid (show stdout) (show stderr) (show follow)
55−getEndpoint (SDeleteContainerEndpoint cid (DeleteOpts removeVolumes force)) =
56− printf "/containers/%s?v=%s;force=%s" cid (show removeVolumes) (show force)
57−
58−setupSSLCtx :: SSLOptions -> IO SSLContext
59−setupSSLCtx (SSLOptions key cert) = do
60− ctx <- SSL.context
61− SSL.contextSetPrivateKeyFile ctx key
62− SSL.contextSetCertificateFile ctx cert
63− SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv3
64− SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv2
65− return ctx
66−
67−mkOpts c = defaults & manager .~ Left (opensslManagerSettings c)
68−
69−getSSL
70− :: SSLOptions
71− -> String
72− -> IO (Response L.ByteString)
73−getSSL sopts url = withOpenSSL $ getWith (mkOpts $ setupSSLCtx sopts) url
74−
75−postSSL
76− :: ToJSON a
77− => SSLOptions
78− -> String
79− -> a
80− -> IO (Response L.ByteString)
81−postSSL sopts url = withOpenSSL . postWith (mkOpts $ setupSSLCtx sopts) url . toJSON
82−
83−deleteSSL
84− :: SSLOptions
85− -> String
86− -> IO (Response L.ByteString)
87−deleteSSL sopts url = withOpenSSL $ deleteWith (mkOpts $ setupSSLCtx sopts) url
88−
89−fullUrl :: DockerClientOpts -> SEndpoint a -> URL
90−fullUrl clientOpts endpoint =
91− constructUrl (baseUrl clientOpts) (apiVersion clientOpts) (getEndpoint endpoint)
92−
93−_dockerGetQuery :: DockerClientOpts -> SEndpoint a -> HttpRequestM (SEndpoint a)
94−_dockerGetQuery clientOpts@DockerClientOpts{ssl = NoSSL} endpoint =
95− Free (Get (fullUrl clientOpts endpoint))
96−_dockerGetQuery clientOpts@DockerClientOpts{ssl = SSL sslOpts} endpoint =
97− Free (GetSSL sslOpts (fullUrl clientOpts endpoint))
98−
99−_dockerPostQuery :: ToJSON b => DockerClientOpts -> SEndpoint a -> b -> HttpRequestM (SEndpoint a)
100−_dockerPostQuery clientOpts@DockerClientOpts{ssl = NoSSL} endpoint postObject =
101− Free (Post (fullUrl clientOpts endpoint) (toJSON postObject))
102−_dockerPostQuery clientOpts@DockerClientOpts{ssl = SSL sslOpts} endpoint postObject =
103− Free (PostSSL sslOpts (fullUrl clientOpts endpoint) (toJSON postObject))
104−
105−_dockerEmptyPostQuery :: DockerClientOpts -> SEndpoint a -> HttpRequestM (SEndpoint a)
106−_dockerEmptyPostQuery clientOpts@DockerClientOpts{ssl = NoSSL} endpoint =
107− Free (Post (fullUrl clientOpts endpoint) (toJSON emptyPost))
108−_dockerEmptyPostQuery clientOpts@DockerClientOpts{ssl = SSL sslOpts} endpoint =
109− Free (PostSSL sslOpts (fullUrl clientOpts endpoint) (toJSON emptyPost))
110−
111−_dockerDeleteQuery :: DockerClientOpts -> SEndpoint a -> HttpRequestM (SEndpoint a)
112−_dockerDeleteQuery clientOpts@DockerClientOpts{ssl = NoSSL} endpoint =
113− Free (Delete (fullUrl clientOpts endpoint))
114−_dockerDeleteQuery clientOpts@DockerClientOpts{ssl = SSL sslOpts} endpoint =
115− Free (DeleteSSL sslOpts (fullUrl clientOpts endpoint))
116−
117−getDockerVersionM
118− :: DockerClientOpts
119− -> SEndpoint VersionEndpoint
120− -> HttpRequestM (SEndpoint VersionEndpoint)
121−getDockerVersionM clientOpts e = _dockerGetQuery clientOpts e
122−
123−stopContainerM
124− :: DockerClientOpts
125− -> SEndpoint StopContainerEndpoint
126− -> HttpRequestM (SEndpoint StopContainerEndpoint)
127−stopContainerM clientOpts e = _dockerEmptyPostQuery clientOpts e
128−
129−listContainersM
130− :: DockerClientOpts
131− -> SEndpoint ListContainersEndpoint
132− -> HttpRequestM (SEndpoint ListContainersEndpoint)
133−listContainersM clientOpts e = _dockerGetQuery clientOpts e
134−
135−listImagesM
136− :: DockerClientOpts
137− -> SEndpoint ListImagesEndpoint
138− -> HttpRequestM (SEndpoint ListImagesEndpoint)
139−listImagesM clientOpts e = _dockerGetQuery clientOpts e
140−
141−killContainerM
142− :: DockerClientOpts
143− -> SEndpoint KillContainerEndpoint
144− -> HttpRequestM (SEndpoint KillContainerEndpoint)
145−killContainerM clientOpts e = _dockerEmptyPostQuery clientOpts e
146−
147−restartContainerM
148− :: DockerClientOpts
149− -> SEndpoint RestartContainerEndpoint
150− -> HttpRequestM (SEndpoint RestartContainerEndpoint)
151−restartContainerM clientOpts e = _dockerEmptyPostQuery clientOpts e
152−
153−pauseContainerM
154− :: DockerClientOpts
155− -> SEndpoint PauseContainerEndpoint
156− -> HttpRequestM (SEndpoint PauseContainerEndpoint)
157−pauseContainerM clientOpts e = _dockerEmptyPostQuery clientOpts e
158−
159−unpauseContainerM
160− :: DockerClientOpts
161− -> SEndpoint UnpauseContainerEndpoint
162− -> HttpRequestM (SEndpoint UnpauseContainerEndpoint)
163−unpauseContainerM clientOpts e = _dockerEmptyPostQuery clientOpts e
164−
165−createContainerM
166− :: DockerClientOpts
167− -> SEndpoint CreateContainerEndpoint
168− -> CreateContainerOpts
169− -> HttpRequestM (SEndpoint CreateContainerEndpoint)
170−createContainerM clientOpts e c = _dockerPostQuery clientOpts e c
171−
172−startContainerM
173− :: DockerClientOpts
174− -> SEndpoint StartContainerEndpoint
175− -> StartContainerOpts
176− -> HttpRequestM (SEndpoint StartContainerEndpoint)
177−startContainerM clientOpts e c = _dockerPostQuery clientOpts e c
178−
179−deleteContainerM
180− :: DockerClientOpts
181− -> SEndpoint DeleteContainerEndpoint
182− -> HttpRequestM (SEndpoint DeleteContainerEndpoint)
183−deleteContainerM clientOpts e = _dockerDeleteQuery clientOpts e
184−
185−getContainerLogsM
186− :: DockerClientOpts
187− -> SEndpoint ContainerLogsEndpoint
188− -> HttpRequestM (SEndpoint ContainerLogsEndpoint)
189−getContainerLogsM clientOpts e = _dockerGetQuery clientOpts e
190−
Network/Docker/Types.hsdeleted−306
@@ -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−
docker.cabal+11−27
@@ -1,16 +1,13 @@
1−-- Initial docker.cabal generated by cabal init. For further
2−-- documentation, see http://haskell.org/cabal/users-guide/
3−
4name: docker
1name: docker
5version: 0.2.0.4
2version: 0.2.0.4
6synopsis: Haskell wrapper for Docker Remote API
3synopsis: Haskell wrapper for Docker Remote API
7−-- description:
4+description: See README.md
8homepage: https://github.com/denibertovic/docker-hs
5homepage: https://github.com/denibertovic/docker-hs
9license: BSD3
6license: BSD3
10license-file: LICENSE
7license-file: LICENSE
11author: Deni Bertovic
8author: Deni Bertovic
12maintainer: deni@denibertovic.com
9maintainer: deni@denibertovic.com
13−-- copyright:
10+copyright: BSD3
14category: Network
11category: Network
15build-type: Simple
12build-type: Simple
16extra-source-files: README.md
13extra-source-files: README.md
@@ -18,9 +15,10 @@ cabal-version: >=1.10
18stability: experimental
15stability: experimental
19
16
20library
17library
18+ default-extensions: DeriveGeneric, OverloadedStrings
19+ hs-source-dirs: src
21− exposed-modules: Network.Docker, Network.Docker.Types
20+ exposed-modules: Docker, Docker.Types
22− other-modules: Network.Docker.Internal
21+ -- other-modules: Network.Docker.Internal
23− other-extensions: OverloadedStrings, DeriveFunctor, FlexibleContexts
24 build-depends: base >= 4.7 && < 4.9
22 build-depends: base >= 4.7 && < 4.9
25 , lens >= 4.2
23 , lens >= 4.2
26 , aeson >= 0.7
24 , aeson >= 0.7
@@ -29,7 +27,6 @@ library
29 , text >= 1.1
27 , text >= 1.1
30 , wreq >= 0.3
28 , wreq >= 0.3
31 , containers >= 0.5
29 , containers >= 0.5
32− , data-default >= 0.5.3
33 , network-uri >= 2.6.0.1
30 , network-uri >= 2.6.0.1
34 , pipes-http >= 1.0.0
31 , pipes-http >= 1.0.0
35 , pipes >= 4.1.2
32 , pipes >= 4.1.2
@@ -37,36 +34,23 @@ library
37 , pipes-bytestring >= 2.1.0
34 , pipes-bytestring >= 2.1.0
38 , HsOpenSSL
35 , HsOpenSSL
39 , http-client-openssl
36 , http-client-openssl
40− , free >= 4.9
41 , mtl
37 , mtl
42− -- hs-source-dirs:
43 default-language: Haskell2010
38 default-language: Haskell2010
44
39
45−test-suite tests
40+test-suite docker-hs-tests
46 build-depends: base >= 4.7 && < 4.9
41 build-depends: base >= 4.7 && < 4.9
47 , docker
42 , docker
48− , lens >= 4.2
49− , aeson >= 0.7
50− , lens-aeson
51− , bytestring >= 0.10
52− , text >= 1.1
53− , wreq >= 0.3
54− , containers >= 0.5
55− , data-default >= 0.5.3
56− , pipes >= 4.1.2
57− , pipes-http >= 1.0.0
58− , pipes-text >= 0.0.0.12
59− , pipes-bytestring >= 2.1.0
60 , tasty >= 0.10.1
43 , tasty >= 0.10.1
61 , tasty-quickcheck >= 0.8.2
44 , tasty-quickcheck >= 0.8.2
62 , QuickCheck >= 2.7
45 , QuickCheck >= 2.7
63 , tasty-hunit >= 0.8
46 , tasty-hunit >= 0.8
64 , process
47 , process
65− , http-types
66− , HsOpenSSL
67− , http-client-openssl
68 type: exitcode-stdio-1.0
48 type: exitcode-stdio-1.0
69 main-is: tests.hs
49 main-is: tests.hs
70 hs-source-dirs: tests
50 hs-source-dirs: tests
71 default-language: Haskell2010
51 default-language: Haskell2010
72
52
53+source-repository head
54+ type: git
55+ location: https://github.com/denibertovic/docker-hs
56+
src/Docker.hsnew file+2
@@ -0,0 +1,2 @@
1+module Docker where
2+
src/Docker/Types.hsnew file+40
@@ -0,0 +1,40 @@
1+module Docker.Types where
2+
3+import Data.Aeson (FromJSON, ToJSON, genericParseJSON,
4+ genericToJSON, parseJSON, toJSON)
5+import Data.Aeson.Types (defaultOptions, fieldLabelModifier)
6+import Data.Char (toUpper)
7+import Data.Text (Text)
8+import GHC.Generics (Generic)
9+
10+type URL = Text
11+type ApiVersion = Text
12+
13+data DockerClientOpts = DockerClientOpts {
14+ apiVersion :: ApiVersion
15+ , baseUrl :: URL
16+ } deriving (Show)
17+
18+defaultClientOpts :: DockerClientOpts
19+defaultClientOpts = DockerClientOpts
20+ { apiVersion = "v1.22"
21+ , baseUrl = "http://127.0.0.1:2375/"
22+ }
23+
24+data DockerVersion = DockerVersion
25+ { version :: Text
26+ , gitCommit :: Text
27+ , goVersion :: Text
28+ , arch :: Text
29+ , kernelVersion :: Text
30+ } deriving (Show, Eq, Generic)
31+
32+
33+instance ToJSON DockerVersion where
34+ toJSON = genericToJSON defaultOptions {
35+ fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
36+
37+instance FromJSON DockerVersion where
38+ parseJSON = genericParseJSON defaultOptions {
39+ fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
40+