a88532e · docker-hs · git.iko.soy

git.iko.soy/docker-hs

on master help sign in

Moves to Docker.Client namespace.

a88532eDeni Bertovic10 years ago

README.md+1−1

compare with master

unifiedsplit

@@ -1,4 +1,4 @@

1−# Docker Remote API wrapper for Haskell

1+# An API client for docker written in Haskell

3Travis CI : [![Build Status](https://travis-ci.org/denibertovic/docker-hs.svg?branch=master)](https://travis-ci.org/denibertovic/docker-hs)

docker.cabal+2−2

@@ -1,6 +1,6 @@

1name: docker

2version: 0.3.0.0

3−synopsis: Haskell wrapper for Docker Remote API

3+synopsis: An API client for docker written in Haskell

4description: See README.md

5homepage: https://github.com/denibertovic/docker-hs

6license: BSD3

@@ -17,7 +17,7 @@ stability: experimental

17library

18 default-extensions: DeriveGeneric, OverloadedStrings, ScopedTypeVariables, ExplicitForAll, MultiParamTypeClasses, FlexibleContexts, GeneralizedNewtypeDeriving, RankNTypes, DeriveFunctor, FlexibleInstances

19 hs-source-dirs: src

20− exposed-modules: Docker, Docker.Client, Docker.Client.Types, Docker.Client.Internal, Docker.Client.Http

20+ exposed-modules: Docker.Client, Docker.Client.Api, Docker.Client.Types, Docker.Client.Internal, Docker.Client.Http

21 -- other-modules: Docker.Internal

22 build-depends: base >= 4.7 && < 5

23 , aeson

src/Docker.hsdeleted−13

@@ -1,13 +0,0 @@

1−{-# LANGUAGE ExplicitForAll #-}

2−{-# LANGUAGE ScopedTypeVariables #-}

3−

4−module Docker (

5− module Docker.Client

6− , module Docker.Client.Types

7− , module Docker.Client.Http

8− ) where

9−

10−import Docker.Client

11−import Docker.Client.Http

12−import Docker.Client.Types

13−

src/Docker/Client.hs+4−109

@@ -2,117 +2,12 @@

2{-# LANGUAGE ScopedTypeVariables #-}

4module Docker.Client (

5− runDockerT

5+ module Docker.Client.Api

6− , DockerT

6+ , module Docker.Client.Types

7− , DockerError(..)

7+ , module Docker.Client.Http

8− , DockerClientOpts(..)

9− , defaultClientOpts

10− , HttpHandler

11− , defaultHttpHandler

12− , httpHandler

13− , unixHttpHandler

14− , clientParamsWithClientAuthentication

15− , clientParamsSetCA

16− , getDockerVersion

17− , listContainers

18− , listImages

19− , createContainer

20− , startContainer

21− , stopContainer

22− , killContainer

23− , restartContainer

24− , pauseContainer

25− , unpauseContainer

26− , deleteContainer

27− , inspectContainer

28− , getContainerLogs

29 ) where

8 ) where

31−import Control.Monad.Except (ExceptT (..), runExceptT, throwError)

10+import Docker.Client.Api

32−import Control.Monad.Reader (ask, lift)

33−import Data.Aeson (FromJSON, eitherDecode')

34−import qualified Data.ByteString.Lazy as BSL

35−import qualified Data.Text as Text

36−import Network.HTTP.Client (responseBody, responseStatus)

37−import Network.HTTP.Types (StdMethod (..))

38−

39import Docker.Client.Http

11import Docker.Client.Http

40import Docker.Client.Types

12import Docker.Client.Types

42−requestUnit :: (Monad m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError ())

43−requestUnit verb endpoint = const (Right ()) <$> requestHelper verb endpoint

44−

45−requestHelper :: (Monad m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError Response)

46−requestHelper verb endpoint = runExceptT $ do

47− (opts, httpHandler) <- lift ask

48− case mkHttpRequest verb endpoint opts of

49− Nothing ->

50− throwError $ DockerInvalidRequest endpoint

51− Just request -> do

52− response <- ExceptT $ lift $ httpHandler request

53−

54− -- Check status code.

55− let status = responseStatus response

56− maybe (return ()) throwError $

57− statusCodeToError endpoint status

58−

59− return response

60−

61−parseResponse :: (FromJSON a, Monad m) => Either DockerError Response -> DockerT m (Either DockerError a)

62−parseResponse (Left err) =

63− return $ Left err

64−parseResponse (Right response) =

65− -- Parse request body.

66− case eitherDecode' $ responseBody response of

67− Left err ->

68− return $ Left $ DockerClientDecodeError $ Text.pack err

69− Right r ->

70− return $ Right r

71−

72−getDockerVersion :: forall m. Monad m => DockerT m (Either DockerError DockerVersion)

73−getDockerVersion = requestHelper GET VersionEndpoint >>= parseResponse

74−

75−listContainers :: forall m. Monad m => ListOpts -> DockerT m (Either DockerError [Container])

76−listContainers opts = requestHelper GET (ListContainersEndpoint opts) >>= parseResponse

77−

78−listImages :: forall m. Monad m => ListOpts -> DockerT m (Either DockerError [Image])

79−listImages opts = requestHelper GET (ListImagesEndpoint opts) >>= parseResponse

80−

81−createContainer :: forall m. Monad m => CreateOpts -> DockerT m (Either DockerError ContainerID)

82−createContainer opts = requestHelper POST (CreateContainerEndpoint opts) >>= parseResponse

83−

84−-- TODO: Is this the correct return type? XXX

85−-- convert status code to unit or error

86−startContainer :: forall m. Monad m => StartOpts -> ContainerID -> DockerT m (Either DockerError ())

87−startContainer sopts cid = requestUnit POST $ StartContainerEndpoint sopts cid

88−

89−stopContainer :: forall m. Monad m => Timeout -> ContainerID -> DockerT m (Either DockerError ())

90−stopContainer t cid = requestUnit POST $ StopContainerEndpoint t cid

91−

92−killContainer :: forall m. Monad m => Signal -> ContainerID -> DockerT m (Either DockerError ())

93−killContainer s cid = requestUnit POST $ KillContainerEndpoint s cid

94−

95−restartContainer :: forall m. Monad m => Timeout -> ContainerID -> DockerT m (Either DockerError ())

96−restartContainer t cid = requestUnit POST $ RestartContainerEndpoint t cid

97−

98−pauseContainer :: forall m. Monad m => ContainerID -> DockerT m (Either DockerError ())

99−pauseContainer cid = requestUnit POST $ PauseContainerEndpoint cid

100−

101−unpauseContainer :: forall m. Monad m => ContainerID -> DockerT m (Either DockerError ())

102−unpauseContainer cid = requestUnit GET $ UnpauseContainerEndpoint cid

103−

104−deleteContainer :: forall m. Monad m => DeleteOpts -> ContainerID -> DockerT m (Either DockerError ())

105−deleteContainer dopts cid = requestUnit DELETE $ DeleteContainerEndpoint dopts cid

106−

107−inspectContainer :: forall m . Monad m => ContainerID -> DockerT m (Either DockerError ContainerDetails)

108−inspectContainer cid = requestHelper GET (InspectContainerEndpoint cid) >>= parseResponse

109−

110−getContainerLogs :: forall m. Monad m => LogOpts -> ContainerID -> DockerT m (Either DockerError BSL.ByteString)

111−getContainerLogs logopts cid = fmap responseBody <$> requestHelper GET (ContainerLogsEndpoint logopts False cid)

112−

113−-- TODO: Use http-conduit to output to a sink.

114−-- getContainerLogsStream :: forall m. Monad m => Sink BSL.ByteString m b -> LogOpts -> ContainerID -> DockerT m (Either DockerError b)

115−-- getContainerLogsStream sink logopts cid = runResourceT $ do

116−-- response <- http request manager

117−-- responseBody response C.$$+- sink

118−

src/Docker/Client/Api.hsnew file+107

@@ -0,0 +1,107 @@

1+{-# LANGUAGE ExplicitForAll #-}

2+{-# LANGUAGE ScopedTypeVariables #-}

4+module Docker.Client.Api (

5+ getDockerVersion

6+ , listContainers

7+ , listImages

8+ , createContainer

9+ , startContainer

10+ , stopContainer

11+ , killContainer

12+ , restartContainer

13+ , pauseContainer

14+ , unpauseContainer

15+ , deleteContainer

16+ , inspectContainer

17+ , getContainerLogs

18+ ) where

19+

20+import Control.Monad.Except (ExceptT (..), runExceptT, throwError)

21+import Control.Monad.Reader (ask, lift)

22+import Data.Aeson (FromJSON, eitherDecode')

23+import qualified Data.ByteString.Lazy as BSL

24+import qualified Data.Text as Text

25+import Network.HTTP.Client (responseBody, responseStatus)

26+import Network.HTTP.Types (StdMethod (..))

27+

28+import Docker.Client.Http

29+import Docker.Client.Types

30+

31+requestUnit :: (Monad m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError ())

32+requestUnit verb endpoint = const (Right ()) <$> requestHelper verb endpoint

33+

34+requestHelper :: (Monad m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError Response)

35+requestHelper verb endpoint = runExceptT $ do

36+ (opts, httpHandler) <- lift ask

37+ case mkHttpRequest verb endpoint opts of

38+ Nothing ->

39+ throwError $ DockerInvalidRequest endpoint

40+ Just request -> do

41+ response <- ExceptT $ lift $ httpHandler request

42+

43+ -- Check status code.

44+ let status = responseStatus response

45+ maybe (return ()) throwError $

46+ statusCodeToError endpoint status

47+

48+ return response

49+

50+parseResponse :: (FromJSON a, Monad m) => Either DockerError Response -> DockerT m (Either DockerError a)

51+parseResponse (Left err) =

52+ return $ Left err

53+parseResponse (Right response) =

54+ -- Parse request body.

55+ case eitherDecode' $ responseBody response of

56+ Left err ->

57+ return $ Left $ DockerClientDecodeError $ Text.pack err

58+ Right r ->

59+ return $ Right r

60+

61+getDockerVersion :: forall m. Monad m => DockerT m (Either DockerError DockerVersion)

62+getDockerVersion = requestHelper GET VersionEndpoint >>= parseResponse

63+

64+listContainers :: forall m. Monad m => ListOpts -> DockerT m (Either DockerError [Container])

65+listContainers opts = requestHelper GET (ListContainersEndpoint opts) >>= parseResponse

66+

67+listImages :: forall m. Monad m => ListOpts -> DockerT m (Either DockerError [Image])

68+listImages opts = requestHelper GET (ListImagesEndpoint opts) >>= parseResponse

69+

70+createContainer :: forall m. Monad m => CreateOpts -> DockerT m (Either DockerError ContainerID)

71+createContainer opts = requestHelper POST (CreateContainerEndpoint opts) >>= parseResponse

72+

73+-- TODO: Is this the correct return type? XXX

74+-- convert status code to unit or error

75+startContainer :: forall m. Monad m => StartOpts -> ContainerID -> DockerT m (Either DockerError ())

76+startContainer sopts cid = requestUnit POST $ StartContainerEndpoint sopts cid

77+

78+stopContainer :: forall m. Monad m => Timeout -> ContainerID -> DockerT m (Either DockerError ())

79+stopContainer t cid = requestUnit POST $ StopContainerEndpoint t cid

80+

81+killContainer :: forall m. Monad m => Signal -> ContainerID -> DockerT m (Either DockerError ())

82+killContainer s cid = requestUnit POST $ KillContainerEndpoint s cid

83+

84+restartContainer :: forall m. Monad m => Timeout -> ContainerID -> DockerT m (Either DockerError ())

85+restartContainer t cid = requestUnit POST $ RestartContainerEndpoint t cid

86+

87+pauseContainer :: forall m. Monad m => ContainerID -> DockerT m (Either DockerError ())

88+pauseContainer cid = requestUnit POST $ PauseContainerEndpoint cid

89+

90+unpauseContainer :: forall m. Monad m => ContainerID -> DockerT m (Either DockerError ())

91+unpauseContainer cid = requestUnit GET $ UnpauseContainerEndpoint cid

92+

93+deleteContainer :: forall m. Monad m => DeleteOpts -> ContainerID -> DockerT m (Either DockerError ())

94+deleteContainer dopts cid = requestUnit DELETE $ DeleteContainerEndpoint dopts cid

95+

96+inspectContainer :: forall m . Monad m => ContainerID -> DockerT m (Either DockerError ContainerDetails)

97+inspectContainer cid = requestHelper GET (InspectContainerEndpoint cid) >>= parseResponse

98+

99+getContainerLogs :: forall m. Monad m => LogOpts -> ContainerID -> DockerT m (Either DockerError BSL.ByteString)

100+getContainerLogs logopts cid = fmap responseBody <$> requestHelper GET (ContainerLogsEndpoint logopts False cid)

101+

102+-- TODO: Use http-conduit to output to a sink.

103+-- getContainerLogsStream :: forall m. Monad m => Sink BSL.ByteString m b -> LogOpts -> ContainerID -> DockerT m (Either DockerError b)

104+-- getContainerLogsStream sink logopts cid = runResourceT $ do

105+-- response <- http request manager

106+-- responseBody response C.$$+- sink

107+

tests/tests.hs+1−1

@@ -28,7 +28,7 @@ import Network.HTTP.Client.TLS

28import Network.HTTP.Types.Status

29import System.Process (system)

31−import Docker

31+import Docker.Client

33-- opts = defaultClientOpts