hdo 0.1 → 0.2

raw patch · 9 files changed

+75/−28 lines, 9 filesdep ~base

Dependency ranges changed: base

Files

• README.md +33/−0
• hdo.cabal +3/−3
• main/hdo.hs +4/−6
• src/Network/DO/Commands.hs +9/−3
• src/Network/DO/Droplets/Net.hs +1/−2
• src/Network/DO/Net.hs +10/−0
• src/Network/DO/Pairing.hs +12/−12
• src/Network/DO/Pretty.hs +2/−1
• stack.yaml +1/−1

@@ -6,3 +6,36 @@  This is a [Digital Ocean](https://www.digitalocean.com/) client written in [Haskell](http://haskell.org). It can be used either as a library or as command-line utility.+++## Compile+`stack setup`+`stack build`++## Usage+First export the AUTH_TOKEN:+`export AUTH_TOKEN=2342342341234eaf`++List existing droplets:+`stack exec docean -- droplets list`++List existing regions:+`stack exec docean -- regions list`++## Implemented commands:+```+droplets create+droplets destroy <dropletId>+droplets list+droplets power_off <dropletId>+droplets power_on  <dropletId>+droplets snapshot  <dropletId> <snapshotName>+droplets action    <dropletId> <actionId>+droplets <dropletId> snapshots+droplets <dropletId>+droplets ssh <dropletId or Name>+images list+regions list+keys list+sizes list+```

@@ -1,5 +1,5 @@ Name: hdo-Version: 0.1+Version: 0.2 Cabal-Version: >= 1.18 Maintainer: Arnaud Bailly <arnaud.oqube@gmail.com> Author: Arnaud Bailly@@ -28,7 +28,7 @@                  , Network.DO.Names, Network.DO.Pairing                  , Network.REST, Network.DO.Pretty   Build-Depends: aeson-               , base < 5+               , base >= 4 && < 5                , bytestring                , comonad                , data-default@@ -53,7 +53,7 @@   Main-Is: hdo.hs   GHC-Options:  -Wall -fno-warn-orphans -rtsopts -threaded   Hs-Source-Dirs:  main-  Build-depends: base < 5+  Build-depends: base >= 4 && < 5                , hdo                , comonad                , iproute

@@ -8,7 +8,7 @@ import           Control.Exception            (catch, throw) import           Control.Monad.IO.Class       (MonadIO (..)) import           Control.Monad.Trans.Free     (FreeT)-import           Data.Functor.Coproduct+import           Data.Functor.Sum import           Data.Maybe import           Data.Monoid                  ((<>)) import           Prelude                      as P hiding (error)@@ -16,7 +16,6 @@ import           System.Environment import           System.IO import           System.IO.Error              (isDoesNotExistError)- import           Network.DO.Commands import           Network.DO.Droplets.Commands import           Network.DO.Droplets.Utils@@ -93,7 +92,7 @@   (opts, cmds) <- parseOptions args   runWreq $ pairEffectM (\ _ b -> return b) (mkDOClient opts) (parseCommandOptions cmds) -parseCommandOptions :: (MonadIO m) => [String] -> FreeT (Coproduct DO DropletCommands) (RESTT m) ()+parseCommandOptions :: (MonadIO m) => [String] -> FreeT (Sum DO DropletCommands) (RESTT m) () parseCommandOptions ("droplets":"create":args) = do   b <- liftIO defaultBox   case getOpt Permute createDropletOptions args of@@ -121,8 +120,7 @@                                                                  []      -> return (error $ "no droplet with id or name " <> dropletIdOrName)                                                             ) >>= outputResult parseCommandOptions ("images":"list":_)                  = injl listImages >>= outputResult+parseCommandOptions ("regions":"list":_)                 = injl listRegions >>= outputResult parseCommandOptions ("keys":"list":_)                    = injl listKeys >>= outputResult parseCommandOptions ("sizes":"list":_)                   = injl listSizes >>= outputResult-parseCommandOptions e                                    = fail $ "I don't know how to interpret commands " ++ unwords e--+parseCommandOptions e                                    = fail $ "I don't know how to interpret commands " ++ unwords e ++ "\n" ++ usage

@@ -13,6 +13,7 @@ data DO a = ListKeys ([Key] -> a)           | ListSizes ([Size] -> a)           | ListImages ([Image] -> a)+          | ListRegions ([Region] -> a)           deriving (Functor)  -- free transformer to embed effects@@ -28,10 +29,14 @@ listImages  :: DO [Image] listImages = ListImages P.id +listRegions :: DO [Region]+listRegions = ListRegions P.id+ -- dual type, for creating interpreters data CoDO m k = CoDO { listKeysH   :: (m [Key], k)                      , listSizesH  :: (m [Size], k)                      , listImagesH :: (m [Image], k)+                     , listRegionsH :: (m [Region], k)                      } deriving Functor  -- Cofree closure of CoDO functor@@ -39,6 +44,7 @@  -- pair DSL with interpreter within some monadic context instance (Monad m) => PairingM (CoDO m) DO m where-  pairM f (CoDO ks _   _)  (ListKeys k)   = pairM f ks k-  pairM f (CoDO _ szs  _)  (ListSizes k)  = pairM f szs k-  pairM f (CoDO _ _ imgs)  (ListImages k) = pairM f imgs k+  pairM f (CoDO ks _  _ _)  (ListKeys k)   = pairM f ks k+  pairM f (CoDO _ szs _ _)  (ListSizes k)  = pairM f szs k+  pairM f (CoDO _ _ imgs _)  (ListImages k) = pairM f imgs k+  pairM f (CoDO _ _ _ rgns)  (ListRegions k) = pairM f rgns k

@@ -11,7 +11,6 @@ import           Control.Applicative import           Control.Comonad.Env.Class    (ComonadEnv, ask) import           Control.Exception            (IOException)-import           Control.Monad                (when) import           Control.Monad.Trans          (MonadIO) import           Data.Aeson                   as A hiding (Result) import qualified Data.Aeson.Types             as A@@ -92,7 +91,7 @@                                     in (r, w))                             (authToken (ask w)) -doSshInDroplet :: (ComonadEnv ToolConfiguration w, MonadIO m) => w a -> Droplet -> (RESTT m (Result ()), w a)+doSshInDroplet :: (MonadIO m) => w a -> Droplet -> (RESTT m (Result ()), w a) doSshInDroplet w droplet =   let r = maybe (return $ error ("droplet " <> show droplet <> " has no public IP"))                                      (\ip -> do                                          s <- ssh ["root@" <> show ip ]

@@ -36,6 +36,9 @@ accountURI :: String accountURI = "account" +regionsURI :: String+regionsURI = "regions"+ keysEndpoint :: String keysEndpoint = rootURI </> apiVersion </> accountURI </> keysURI @@ -45,6 +48,8 @@ imagesEndpoint :: String imagesEndpoint = rootURI </> apiVersion </> imagesURI +regionsEndpoint :: String+regionsEndpoint = rootURI </> apiVersion </> regionsURI  instance Listable Key where   listEndpoint _ = keysEndpoint@@ -58,11 +63,16 @@   listEndpoint _ = imagesEndpoint   listField _    = "images" +instance Listable Region where+  listEndpoint _ = regionsEndpoint+  listField _    = "regions"+ genericCommands :: (Monad m, ComonadEnv ToolConfiguration w) => w a -> CoDO (RESTT m) (w a) genericCommands = CoDO                   <$> queryList (Proxy :: Proxy Key)                   <*> queryList (Proxy :: Proxy Size)                   <*> queryList (Proxy :: Proxy Image)+                  <*> queryList (Proxy :: Proxy Region)  mkDOClient :: (MonadIO m) => ToolConfiguration -> CofreeT (Product (CoDO (RESTT m)) (CoDropletCommands (RESTT m))) (Env ToolConfiguration) (RESTT m ()) mkDOClient config = coiterT next start

@@ -16,7 +16,7 @@ import           Control.Comonad.Trans.Cofree (CofreeT, unwrap) import           Control.Monad.Trans.Free     (FreeF (..), FreeT, liftF,                                                runFreeT)-import           Data.Functor.Coproduct+import           Data.Functor.Sum import           Data.Functor.Identity        (Identity (..)) import           Data.Functor.Product @@ -38,19 +38,19 @@ instance (Monad m) => PairingM ((,) (m a)) ((->) a) m where   pairM p (ma, b) g = ma >>= \ a -> p b (g a) -instance (Monad m, PairingM f h m, PairingM g k m) => PairingM (Coproduct f g) (Product h k) m where-  pairM p (Coproduct (Left f)) (Pair h _)  = pairM p f h-  pairM p (Coproduct (Right g)) (Pair _ k) = pairM p g k+instance (Monad m, PairingM f h m, PairingM g k m) => PairingM (Sum f g) (Product h k) m where+  pairM p (InL f) (Pair h _)  = pairM p f h+  pairM p (InR g) (Pair _ k) = pairM p g k -instance (Monad m, PairingM h f m, PairingM k g m) => PairingM (Product h k) (Coproduct f g) m where-  pairM p (Pair h _) (Coproduct (Left f))  = pairM p h f-  pairM p (Pair _ k) (Coproduct (Right g)) = pairM p k g+instance (Monad m, PairingM h f m, PairingM k g m) => PairingM (Product h k) (Sum f g) m where+  pairM p (Pair h _) (InL f)  = pairM p h f+  pairM p (Pair _ k) (InR g) = pairM p k g -injl :: (Monad m, Functor f, Functor g) => f a -> FreeT (Coproduct f g) m a-injl = liftF . Coproduct . Left+injl :: (Monad m, Functor f, Functor g) => f a -> FreeT (Sum f g) m a+injl = liftF . InL -injr :: (Monad m, Functor f, Functor g) => g a -> FreeT (Coproduct f g) m a-injr = liftF . Coproduct . Right+injr :: (Monad m, Functor f, Functor g) => g a -> FreeT (Sum f g) m a+injr = liftF . InR  pairEffect :: (Pairing f g, Comonad w, Monad m)            => (a -> b -> r) -> CofreeT f w a -> FreeT g m b -> m r@@ -68,7 +68,7 @@     Pure x -> p (extract s) x     Free gs -> pair (pairEffect' p) (unwrap s) gs -pairEffectM :: (PairingM f g m, Comonad w, Monad m)+pairEffectM :: (PairingM f g m, Comonad w)            => (a -> b -> m r) -> CofreeT f w (m a) -> FreeT g m b -> m r pairEffectM p s c = do   ma <- extract s

@@ -43,7 +43,8 @@ instance Pretty IP  instance Pretty Region where-  pretty Region{..}     = text regionSlug+  pretty Region{..}     = text (regionSlug ++ ": "+                                ++regionName)   pretty (RegionSlug s) = text s   pretty NoRegion       = empty 

@@ -1,4 +1,4 @@ flags: {} packages: - '.'-resolver: lts-3.3+resolver: lts-7.3