docker (empty) → 0.1.0.0
raw patch · 8 files changed
+407/−0 lines, 8 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, containers, data-default, lens, network-uri, pipes, pipes-bytestring, pipes-http, pipes-text, text, wreq
Files
- Docker.hs +92/−0
- Docker/Options.hs +16/−0
- Docker/Types.hs +234/−0
- Docker/Utils.hs +6/−0
- LICENSE +30/−0
- README.md +1/−0
- Setup.hs +2/−0
- docker.cabal +26/−0
+ Docker.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}++module Docker where++import Control.Applicative ((<$>), (<*>))+import Control.Lens+import Data.Aeson (FromJSON, ToJSON, decode, eitherDecode,+ encode)+import Data.Aeson.Lens (key, _String)+import Data.Aeson.TH+import qualified Data.ByteString.Lazy as L+import Data.Char+import qualified Data.Text as T+import Docker.Options+import Docker.Types+import Network.Wreq+import Pipes+import qualified Pipes.ByteString as PB+import qualified Pipes.HTTP as PH+import Text.Printf (printf)+++defaultClientOpts :: DockerClientOpts+defaultClientOpts = DockerClientOpts+ { apiVersion = "v1.12"+ , baseUrl = "http://127.0.0.1:3128/"+ }++constructUrl :: URL -> ApiVersion -> Endpoint -> URL+constructUrl url apiVersion endpoint = printf "%s%s%s" url apiVersion endpoint++constructRelativeUrl url = url :: String++decodeResponse r = decode <$> (^. responseBody) <$> r++getOutOfResponse k r = (^? responseBody . key k . _String) r++getResponseStatusCode r = (^. responseStatus) r++fullUrl :: DockerClientOpts -> Endpoint -> URL+fullUrl clientOpts endpoint = constructUrl (baseUrl clientOpts) (apiVersion clientOpts) endpoint++_dockerGetQuery :: Endpoint -> DockerClientOpts -> IO(Response L.ByteString)+_dockerGetQuery endpoint clientOpts = get (fullUrl clientOpts endpoint)++_dockerPostQuery :: ToJSON a => Endpoint -> DockerClientOpts -> a -> IO (Response L.ByteString)+_dockerPostQuery endpoint clientOpts postObject = post (fullUrl clientOpts endpoint) (encode postObject)++emptyPost = "" :: String+_dockerEmptyPostQuery endpoint clientOpts = post (fullUrl clientOpts endpoint) (encode emptyPost)++getDockerVersion :: DockerClientOpts -> IO (Maybe DockerVersion)+getDockerVersion = decodeResponse . _dockerGetQuery "/version"++getDockerContainers :: DockerClientOpts -> IO (Maybe [DockerContainer])+getDockerContainers = decodeResponse . _dockerGetQuery "/containers/json"++getDockerImages :: DockerClientOpts -> IO (Maybe [DockerImage])+getDockerImages = decodeResponse . _dockerGetQuery "/images/json"++createContainer :: DockerClientOpts -> CreateContainerOpts -> IO(Maybe T.Text)+createContainer clientOpts createOpts = getOutOfResponse "Id" <$> (_dockerPostQuery "/containers/create" clientOpts createOpts)++startContainer :: DockerClientOpts -> String -> StartContainerOpts -> IO(Status)+startContainer clientOpts containerId startOpts = (^. responseStatus) <$> _dockerPostQuery (printf "/containers/%s/start" containerId) clientOpts startOpts++stopContainer :: DockerClientOpts -> String -> IO (Status)+stopContainer clientOpts containerId = (^. responseStatus) <$> _dockerEmptyPostQuery (printf "/containers/%s/stop" containerId) clientOpts++killContainer :: DockerClientOpts -> String -> IO (Status)+killContainer clientOpts containerId = (^. responseStatus) <$> _dockerEmptyPostQuery (printf "/containers/%s/kill" containerId) clientOpts++restartContainer :: DockerClientOpts -> String -> IO (Status)+restartContainer clientOpts containerId = (^. responseStatus) <$> _dockerEmptyPostQuery (printf "/containers/%s/restart" containerId) clientOpts++pauseContainer :: DockerClientOpts -> String -> IO (Status)+pauseContainer clientOpts containerId = (^. responseStatus) <$> _dockerEmptyPostQuery (printf "/containers/%s/pause" containerId) clientOpts++unpauseContainer :: DockerClientOpts -> String -> IO (Status)+unpauseContainer clientOpts containerId = (^. responseStatus) <$> _dockerEmptyPostQuery (printf "/containers/%s/unpause" containerId) clientOpts++getContainerLogsStream :: DockerClientOpts -> String -> IO ()+getContainerLogsStream clientOpts containerId = do+ req <- PH.parseUrl (fullUrl clientOpts url)+ let req' = req {PH.method = "GET"}+ PH.withManager PH.defaultManagerSettings $ \m -> PH.withHTTP req' m $ \resp -> runEffect $ PH.responseBody resp >-> PB.stdout+ where url = (printf "/containers/%s/logs?stdout=1&stderr=1&follow=1" containerId)++getContainerLogs :: DockerClientOpts -> String -> IO (L.ByteString)+getContainerLogs clientOpts containerId = (^. responseBody) <$> _dockerGetQuery url clientOpts+ where url = (printf "/containers/%s/logs?stdout=1&stderr=1" containerId)+
+ Docker/Options.hs view
@@ -0,0 +1,16 @@+module Docker.Options where++import Data.Aeson.TH+import Docker.Utils++dopts :: Options+dopts = Options {+ fieldLabelModifier = strip_underscore+ , constructorTagModifier = id+ , allNullaryToStringTag = True+ , omitNothingFields = True+ , sumEncoding = defaultTaggedObject+ }+++
+ Docker/Types.hs view
@@ -0,0 +1,234 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++module Docker.Types where++import Control.Applicative+import Control.Lens.TH+import Control.Lens.TH+import Data.Aeson+import Data.Aeson.TH+import Data.Bool+import qualified Data.ByteString.Lazy as BS+import Data.Default+import qualified Data.Map as Map+import qualified Data.Text as T+import Docker.Options+import GHC.Generics+import Network.Wreq.Types (Postable)+++type URL = String+type ApiVersion = String+type Endpoint = String++type Tag = String+type IP = String+type Port = Int+type PortType = String++data DockerClientOpts = DockerClientOpts {+ apiVersion :: ApiVersion+ , baseUrl :: URL+ } deriving (Show)+++data ResourceId = ResourceId { _id :: String } deriving (Show, Eq)+++data DockerImage = DockerImage+ { _imageId :: ResourceId+ , _imageCreatedAt :: Int+ , _parentId :: Maybe String+ , _repoTags :: [Tag]+ , _size :: Int+ , _virtualSize :: Int+ } deriving (Show, Eq)+++data DockerVersion = DockerVersion+ { _Version :: String+ , _GitCommit :: String+ , _GoVersion :: String+ , _Arch :: String+ , _KernelVersion :: String+ } deriving (Show, Eq)+++-- The JSON looks likes this:+-- "Ports":[{"IP":"0.0.0.0","PrivatePort":55555,"PublicPort":55555,"Type":"tcp"}]++data PortMap = PortMap+ { _ip :: IP+ , _privatePort :: Port+ , _publicPort :: Port+ , _type :: PortType+ } deriving (Show, Eq)+++data DockerContainer = DockerContainer+ { _containerId :: ResourceId+ , _containerImageId :: ResourceId+ , _command :: String+ , _containerCreatedAt :: Int+ , _names :: [String]+ , _status :: String+ , _ports :: Maybe [PortMap]+ } deriving (Show, Eq)+++data CreateContainerOpts = CreateContainerOpts+ { _hostname :: String+ , _user :: String+ , _memory :: Int+ , _memorySwap :: Int+ , _attachStdin :: Bool+ , _attachStdout :: Bool+ , _attachStderr :: Bool+ , _portSpecs :: Maybe Object+ , _tty :: Bool+ , _openStdin :: Bool+ , _stdinOnce :: Bool+ , _env :: Maybe Object+ , _cmd :: [String]+ , _image :: String+ , _volumes :: Maybe Object+ , _volumesFrom :: Maybe Object+ , _workingDir :: String+ , _disableNetwork :: Bool+ , _exposedPorts :: Maybe Object+ } deriving (Show)++defaultCreateOpts = CreateContainerOpts {+ _hostname = ""+ , _user = ""+ , _memory = 0+ , _memorySwap = 0+ , _attachStdin = False+ , _attachStdout = False+ , _attachStderr = False+ , _portSpecs = Nothing+ , _tty = False+ , _openStdin = False+ , _stdinOnce = False+ , _env = Nothing+ , _cmd = []+ , _image = "debian"+ , _volumes = Nothing+ , _volumesFrom = Nothing+ , _workingDir = ""+ , _disableNetwork = False+ , _exposedPorts = Nothing+ }++instance ToJSON CreateContainerOpts where+ toJSON (CreateContainerOpts {..}) = object+ [ "Hostname" .= _hostname+ , "User" .= _user+ , "Memory" .= _memory+ , "MemorySwap" .= _memorySwap+ , "AttachStdin" .= _attachStdin+ , "AttachStdout" .= _attachStdout+ , "AttachStderr" .= _attachStderr+ , "PortSpecs" .= _portSpecs+ , "Tty" .= _tty+ , "OpenStdin" .= _openStdin+ , "StdinOnce" .= _stdinOnce+ , "Env" .= _env+ , "Cmd" .= _cmd+ , "Image" .= _image+ , "Volumes" .= _volumes+ , "VolumesFrom" .= _volumesFrom+ , "WrokingDir" .= _workingDir+ , "DisableNetwork" .= _disableNetwork+ , "ExposedPorts" .= _exposedPorts+ ]++-- data CreateContainerResponse = CreateContainerResponse+-- { _createdContainerId :: String+-- , _warnings :: Maybe [T.Text]+-- } deriving (Show)++data StartContainerOpts = StartContainerOpts+ { _Binds :: [T.Text]+ , _Links :: [T.Text]+ , _LxcConf :: [(T.Text, T.Text)]+ , _PortBindings :: [(T.Text, [(T.Text, T.Text)])]+ , _PublishAllPorts :: Bool+ , _Privileged :: Bool+ , _Dns :: [T.Text]+ , _VolumesFrom :: [T.Text]+ } deriving (Show)++defaultStartOpts = StartContainerOpts+ { _Binds = []+ , _Links = []+ , _LxcConf = []+ , _PortBindings = []+ , _PublishAllPorts = False+ , _Privileged = False+ , _Dns = []+ , _VolumesFrom = []+ }++instance ToJSON StartContainerOpts where+ toJSON (StartContainerOpts {..}) = object+ [ "Binds" .= _Binds+ , "Links" .= _Links+ , "LxcConf" .= _LxcConf+ , "PortBindings" .= _PortBindings+ , "PublishAllPorts" .= _PublishAllPorts+ , "Privileged" .= _Privileged+ , "Dns" .= _Dns+ , "VolumesFrom" .= _VolumesFrom+ ]++makeClassy ''ResourceId++-- makeLenses ''CreateContainerResponse+makeLenses ''DockerImage+makeLenses ''DockerContainer+makeLenses ''CreateContainerOpts++instance HasResourceId DockerImage where+ resourceId = imageId++instance FromJSON DockerImage where+ parseJSON (Object v) =+ DockerImage <$> ResourceId <$> (v .: "Id")+ <*> (v .: "Created")+ <*> (v .:? "ParentId")+ <*> (v .: "RepoTags")+ <*> (v .: "Size")+ <*> (v .: "VirtualSize")++instance FromJSON PortMap where+ parseJSON (Object v) =+ PortMap <$> (v .: "IP")+ <*> (v .: "PrivatePort")+ <*> (v .: "PublicPort")+ <*> (v .: "Type")++instance HasResourceId DockerContainer where+ resourceId = containerId++instance FromJSON DockerContainer where+ parseJSON (Object v) =+ DockerContainer <$> (ResourceId <$> (v .: "Id"))+ <*> (ResourceId <$> (v .: "Id"))+ <*> (v .: "Command")+ <*> (v .: "Created")+ <*> (v .: "Names")+ <*> (v .: "Status")+ <*> (v .:? "Ports")++-- instance FromJSON CreateContainerResponse where+-- parseJSON (Object v) =+-- CreateContainerResponse <$> (v .: "Id")+-- <*> (v .:? "warnings")++$(deriveJSON dopts ''DockerVersion)+
+ Docker/Utils.hs view
@@ -0,0 +1,6 @@+module Docker.Utils where++import Data.Char++strip_underscore :: String -> String+strip_underscore (_:xs) = xs
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Deni Bertovic++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Deni Bertovic nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+playing around with haskell - don't use will be rebasing/force pushing alot
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ docker.cabal view
@@ -0,0 +1,26 @@+-- Initial docker.cabal generated by cabal init. For further+-- documentation, see http://haskell.org/cabal/users-guide/++name: docker+version: 0.1.0.0+synopsis: Haskell wrapper for Docker Remote API+-- description:+homepage: https://github.com/denibertovic/docker-hs+license: BSD3+license-file: LICENSE+author: Deni Bertovic+maintainer: deni@denibertovic.com+-- copyright:+category: Network+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10+stability: experimental++library+ exposed-modules: Docker, Docker.Options, Docker.Types, Docker.Utils+ -- other-modules:+ other-extensions: OverloadedStrings, DeriveFunctor, FlexibleContexts, TemplateHaskell+ build-depends: base >=4.7 && <4.8, lens >=4.2 && <4.3, aeson >=0.7 && <0.8, bytestring >=0.10 && <0.11, text >=1.1 && <1.2, wreq >=0.1 && <0.2, containers >=0.5 && <0.6, data-default >= 0.5.3, network-uri >= 2.6.0.1, pipes-http >= 1.0.0, pipes >= 4.1.2, pipes-text >= 0.0.0.12, pipes-bytestring >= 2.1.0+ -- hs-source-dirs:+ default-language: Haskell2010