201fe06 · docker-hs · git.iko.soy

git.iko.soy/docker-hs

on master help sign in

Move under Docker.Client namespace

201fe06Deni Bertovic10 years ago

docker.cabal+1−1

compare with master

unifiedsplit

@@ -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.Types, Docker.Internal, Docker.Http

20+ exposed-modules: Docker, Docker.Client, 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.hs+6−111

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

2{-# LANGUAGE ScopedTypeVariables #-}

4module Docker (

5− runDockerT

5+ module Docker.Client

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

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

11+import Docker.Client.Http

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−

39−import Docker.Http

40−import Docker.Types

12+import Docker.Client.Types

41−

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.hsnew file+118

@@ -0,0 +1,118 @@

1+{-# LANGUAGE ExplicitForAll #-}

2+{-# LANGUAGE ScopedTypeVariables #-}

4+module Docker.Client (

5+ runDockerT

6+ , DockerT

7+ , DockerError(..)

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

30+

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

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+

39+import Docker.Client.Http

40+import Docker.Client.Types

41+

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/Http.hs → src/Docker/Client/Http.hsrenamed+4−3

@@ -1,7 +1,7 @@

1{-# LANGUAGE RankNTypes #-}

2{-# LANGUAGE ScopedTypeVariables #-}

4−module Docker.Http where

4+module Docker.Client.Http where

6import Control.Monad.Reader (ReaderT, runReaderT)

7import qualified Data.ByteString.Char8 as BSC

@@ -36,9 +36,10 @@ import qualified Network.HTTP.Types as HTTP

36import qualified Network.Socket as S

37import qualified Network.Socket.ByteString as SBS

39+

39−import Docker.Internal (getEndpoint,

40+import Docker.Client.Internal (getEndpoint,

40 getEndpointRequestBody)

41 getEndpointRequestBody)

41−import Docker.Types (DockerClientOpts, Endpoint (..),

42+import Docker.Client.Types (DockerClientOpts, Endpoint (..),

42 baseUrl)

43 baseUrl)

44type Request = HTTP.Request

45type Request = HTTP.Request

src/Docker/Internal.hs → src/Docker/Client/Internal.hsrenamed+4−2

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

1−module Docker.Internal where

1+module Docker.Client.Internal where

4import Blaze.ByteString.Builder (toByteString)

@@ -7,10 +7,12 @@ import Data.ByteString (ByteString)

7import qualified Data.ByteString.Lazy as BSL

8import Data.Text as T

9import Data.Text.Encoding (decodeUtf8, encodeUtf8)

10−import Docker.Types

11import Network.HTTP.Types (Query, encodePath,

10import Network.HTTP.Types (Query, encodePath,

12 encodePathSegments)

11 encodePathSegments)

13+import Docker.Client.Types

14+

15+

14encodeURL :: [T.Text] -> T.Text

16encodeURL :: [T.Text] -> T.Text

15encodeURL ps = decodeUtf8 $ toByteString $ encodePathSegments ps

17encodeURL ps = decodeUtf8 $ toByteString $ encodePathSegments ps

src/Docker/Types.hs → src/Docker/Client/Types.hsrenamed+1−1

@@ -1,7 +1,7 @@

1{-# LANGUAGE RecordWildCards #-}

2{-# LANGUAGE ScopedTypeVariables #-}

4−module Docker.Types (

4+module Docker.Client.Types (

5 Endpoint(..)

6 , URL

7 , ApiVersion

tests/tests.hs−2

@@ -23,8 +23,6 @@ import Network.HTTP.Types.Status

23import System.Process (system)

25import Docker

26−import Docker.Types

27−

29-- opts = defaultClientOpts

27-- opts = defaultClientOpts