packages feed

digitalocean-kzs (empty) → 0.1.0.0

raw patch · 15 files changed

+701/−0 lines, 15 filesdep +HTTPdep +aesondep +basesetup-changed

Dependencies added: HTTP, aeson, base, bytestring, digitalocean-kzs, doctest, hspec, http-conduit, http-types, text, transformers

Files

+ LICENSE view
@@ -0,0 +1,20 @@+The MIT License (MIT)++Copyright (c) 2014 Ryotaro NAKAMURA++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ digitalocean-kzs.cabal view
@@ -0,0 +1,113 @@+-- Initial digitalocean-kzs.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name:                digitalocean-kzs++-- The package version.  See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary:      +-+------- breaking API changes+--                   | | +----- non-breaking API additions+--                   | | | +--- code changes with no API change+version:             0.1.0.0++-- A short (one-line) description of the package.+synopsis:            digitalocean api for haskell+description: DigitalOcean api for haskell+        +-- A longer description of the package.+-- description:         ++-- URL for the project homepage or repository.+homepage:            https://github.com/KazumaSATO/digitalocean-kzs++-- The license under which the package is released.+license:             MIT++-- The file containing the license text.+license-file:        LICENSE++-- The package author(s).+author:              Ryotaro NAKAMURA++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer:          r.nakamura1989@gmail.com++-- A copyright notice.+-- copyright:           ++category:            Web++build-type:          Simple++-- Extra files to be distributed with the package, such as examples or a +-- README.+-- extra-source-files:  ++-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >=1.10++source-repository head+  type: git+  location: https://github.com/KazumaSATO/digitalocean-kzs+                     +library+        +  -- Modules exported by the library.        +  exposed-modules:+                  DigitalOcean+                  DigitalOcean.Account+                  DigitalOcean.Base+                  DigitalOcean.Image+                  DigitalOcean.Droplet+                  DigitalOcean.Region+                  DigitalOcean.SSHKey+                  DigitalOcean.Size+                  DigitalOcean.NewDroplet+                  +  -- Modules included in this library but not exported.                  +  -- other-modules:+  +  -- LANGUAGE extensions used by modules in this package.  +  -- other-extensions:++  +  -- Other library packages from which modules are imported.+  build-depends:+                base >=4.7 && <4.8,+                aeson        >= 0.6  && < 0.9,+                text         >= 0.10 && < 2,+                bytestring   >= 0.10 && < 0.11,+                transformers >= 0.3  && < 0.5,+                HTTP         >= 4000 && < 4001,+                http-conduit >= 2.1  && < 2.2,+                http-types   >= 0.8.6+                +  -- Directories containing source files.+  hs-source-dirs:      src+  Ghc-Options:          -Wall+  -- Base language which the package is written in.  +  default-language:    Haskell2010++Test-Suite spec+  Type:                 exitcode-stdio-1.0+  Default-Language:     Haskell2010+  Hs-Source-Dirs:       test+  Ghc-Options:          -Wall+  Main-Is:              Spec.hs+  Other-Modules:        DigitalOceanSpec+  Build-Depends:        base+                      , hspec >= 1.3+                      , digitalocean-kzs++Test-Suite doctest+  Type:                 exitcode-stdio-1.0+  Default-Language:     Haskell2010+  HS-Source-Dirs:       test+  Ghc-Options:          -threaded -Wall+  Main-Is:              doctests.hs+  Build-Depends:        base+                      , doctest >= 0.9.3+
+ src/DigitalOcean.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module DigitalOcean (+  module DigitalOcean.Base,+  module DigitalOcean.Account,+  module DigitalOcean.Image,+  module DigitalOcean.Droplet,+  module DigitalOcean.Region,+  module DigitalOcean.Size,+  module DigitalOcean.SSHKey,+  module DigitalOcean.NewDroplet+                    ) where+import DigitalOcean.Base+import DigitalOcean.Account+import DigitalOcean.Droplet+import DigitalOcean.Image+import DigitalOcean.Region+import DigitalOcean.Size+import DigitalOcean.SSHKey+import DigitalOcean.NewDroplet+
+ src/DigitalOcean/Account.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}++module DigitalOcean.Account (+  Account(..),+  account+                            ) where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (liftM, mzero)+import Control.Monad.IO.Class+import Data.Aeson ((.:), FromJSON(..), Value(..), decode)++import DigitalOcean.Base(Authentication, requestGet)++-- $setup+-- >>> import System.Environment+-- >>> import DigitalOcean.Base(Authentication(..))+-- >>> import Data.Maybe(isJust)++data Account = Account {+  dropletLimit :: Integer,+  email :: String,+  uuid :: String,+  emailVerified :: Bool+} deriving (Show, Read)++newtype RawAccount = RawAccount Account++instance FromJSON RawAccount where+  parseJSON (Object v) = RawAccount <$> v .: "account"+  parseJSON _ = mzero++instance FromJSON Account where+  parseJSON (Object v) =+    Account <$>+    (v .: "droplet_limit") <*>+    (v .: "email") <*>+    (v .: "uuid") <*>+    (v .: "email_verified")+  parseJSON _ = mzero++-- | Get User Information+-- >>> :{+-- do+--   tkn <- getEnv "DIGITAL_OCEAN_PERSONAL_ACCESS_TOKEN"+--   mayBeAcnt <- account $ Authentication tkn+--   print $ show $ isJust mayBeAcnt+-- :}+-- "True"+account :: Authentication -> (MonadIO m) => m (Maybe Account)+account a = liftM toAccount $ liftM decode (requestGet "account" a)++toAccount :: Maybe RawAccount -> Maybe Account+toAccount = \ra ->  case ra of Just(RawAccount a) -> Just a+                               Nothing            -> Nothing
+ src/DigitalOcean/Base.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module DigitalOcean.Base (+  Authentication(..),+  requestGet,+  requestPost+                         ) where++import Control.Applicative ((<$>))++import Control.Monad.IO.Class+import Data.Aeson ( ToJSON, encode)+import qualified Data.ByteString.Lazy.Char8 as BS+import Data.ByteString.Lazy(ByteString)+import Network.HTTP.Conduit+import Network.HTTP.Types.Header+import Data.ByteString.Char8(pack)+import Network.HTTP.Types.Method(methodPost, methodGet, Method)++-- Authentication "api token"+data Authentication = Authentication {+  token    :: String+} deriving (Show)+++url :: String+url = "https://api.digitalocean.com/v2"++simpleHttp' :: MonadIO m => String -> Authentication -> Method -> Maybe(ByteString) -> m BS.ByteString+simpleHttp' url' auth reqMethod reqBody = liftIO $ withManager $ \man -> do  +  initReq <- liftIO $ parseUrl url'+  let req = initReq {+        method = reqMethod,+        requestHeaders = [(hContentType, Data.ByteString.Char8.pack "application/json"),+                         (hAuthorization,  Data.ByteString.Char8.pack $ "Bearer " ++ (token auth))],+        responseTimeout = Just 10000000, -- 10 seconds+        requestBody = case reqBody of Just b  -> RequestBodyLBS b+                                      Nothing -> requestBody initReq+  }+  responseBody <$> httpLbs req man+++--dumpP :: (ToJSON j) =>  String -> Authentication -> j -> (MonadIO m) => m (BS.ByteString)+--dumpP   suburl auth body = simpleHttp' (url ++ "/" ++ suburl) auth methodPost $ Just (encode body)++--dumpG ::   String -> Authentication -> (MonadIO m) => m (BS.ByteString)+--dumpG   suburl auth = simpleHttp' (url ++ "/" ++ suburl) auth methodGet  Nothing++requestGet ::  String -> Authentication -> (MonadIO m) => m BS.ByteString+requestGet suburl auth = simpleHttp' (url ++ "/" ++ suburl)  auth methodGet Nothing+++requestPost :: (ToJSON b) =>  String -> Authentication -> b -> (MonadIO m) => m BS.ByteString+requestPost suburl auth  body = simpleHttp' (url ++ "/" ++ suburl)  auth methodPost $ Just (encode body)
+ src/DigitalOcean/Droplet.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}++module DigitalOcean.Droplet(+  Droplet(..),+  droplets+                           ) where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (liftM, mzero)+import Control.Monad.IO.Class+import Data.Aeson ((.:),  FromJSON(..), Value(..), decode)+import DigitalOcean.Base++-- $setup+-- >>> import System.Environment+-- >>> import DigitalOcean.Base(Authentication(..))+-- >>> import Data.Maybe(isJust)++data Droplet = Droplet {+  did :: Integer,+  dname :: String,+  dmemory :: Integer,+  dvcpus :: Integer,+  disk :: Integer,+  dlocked :: Bool,+  createdAtv2 :: String,+  dstatus :: String,+  backupIds :: [Integer]+} deriving (Show, Read)++newtype Droplets = Droplets [Droplet]++instance FromJSON Droplets where+  parseJSON (Object v) = Droplets <$> v.: "droplets"+  parseJSON _          = mzero+  ++instance FromJSON Droplet where+  parseJSON (Object v) =+    Droplet <$>+    (v .: "id") <*>+    (v .: "name") <*>+    (v .: "memory") <*>+    (v .: "vcpus") <*>+    (v .: "disk") <*>+    (v .: "locked") <*>+    (v .: "created_at") <*>+    (v .: "status") <*>+    (v .: "backup_ids")+  parseJSON _ = mzero+++-- | List all Droplets+--  :{+-- do+--   tkn <- getEnv "DIGITAL_OCEAN_PERSONAL_ACCESS_TOKEN"+--   maybeDroplets <- droplets $ Authentication tkn+--   print $ show $ isJust maybeDroplets+-- :}+-- "True"+droplets :: Authentication -> (MonadIO m) => m (Maybe [Droplet])+droplets a = liftM toList $ liftM decode (requestGet "droplets?page=1&per_page=100" a)++toList :: Maybe Droplets -> Maybe [Droplet]+toList = \ds ->  case ds of Just(Droplets l) -> Just l+                            Nothing          -> Nothing
+ src/DigitalOcean/Image.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE OverloadedStrings #-}++module DigitalOcean.Image(+  Image(..),+  images,+  listAllDistributionImages+                         ) where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (liftM, mzero)+import Control.Monad.IO.Class+import Data.Aeson ((.:), FromJSON(..), Value(..), decode)+import DigitalOcean.Base(Authentication, requestGet)++-- $setup+-- >>> import System.Environment+-- >>> import DigitalOcean.Base(Authentication(..))+-- >>> import Data.Maybe(isJust)+++data Image = Image {+  imgId :: Integer,+  imgName :: String,+  imgDistribution :: String,+  imgType :: String,+  imgSlug :: Maybe String,+  imgPublic :: Bool,+  imgRegions :: [String],+  imgMinDiskSize :: Integer,+  imgCreatedAt :: String+} deriving(Show, Read)++-- | List all Images+-- >>> :{+-- do+--   tkn <- getEnv "DIGITAL_OCEAN_PERSONAL_ACCESS_TOKEN"+--   maybeImages <- images $ Authentication tkn+--   print $ show $ isJust maybeImages+-- :}+-- "True"+images :: Authentication -> (MonadIO m) => m (Maybe [Image])+images a = liftM toList $ liftM decode (requestGet "images?page=1&per_page=1" a)++-- | List all Distribution Images+-- >>> :{+-- do+--   tkn <- getEnv "DIGITAL_OCEAN_PERSONAL_ACCESS_TOKEN"+--   maybeImages <- listAllDistributionImages $ Authentication tkn+--   print $ show $ isJust maybeImages+-- :}+-- "True"+listAllDistributionImages :: Authentication -> (MonadIO m) => m (Maybe [Image])+listAllDistributionImages a = liftM toList $ liftM decode (requestGet "images?page=1&per_page=100&type=distribution" a)++toList :: Maybe Images -> Maybe [Image]+toList = \ds ->  case ds of Just(Images l) -> Just l+                            Nothing -> Nothing+++newtype Images = Images [Image]++instance FromJSON Images where+  parseJSON (Object v) = Images <$> v.: "images"+  parseJSON _          = mzero++instance FromJSON Image where+  parseJSON (Object v) =+    Image <$>+    (v .: "id") <*>+    (v .: "name") <*>+    (v .: "distribution") <*>+    (v .: "type") <*>+    (v .: "slug") <*>+    (v .: "public") <*>+    (v .: "regions") <*>+    (v .: "min_disk_size") <*>+    (v .: "created_at")+  parseJSON _ = mzero
+ src/DigitalOcean/NewDroplet.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+module DigitalOcean.NewDroplet(+  newDroplet+) where++import Control.Applicative ((<$>))+import Control.Monad (liftM, mzero)+import Control.Monad.IO.Class+import Data.Aeson ((.:),  FromJSON(..), Value(..), ToJSON(..), (.=), object, decode)++import DigitalOcean.Droplet(Droplet(..))+import DigitalOcean.Base++-- $setup+-- >>> {-# LANGUAGE OverloadedStrings #-}+-- >>> import Data.ByteString.Char8+-- >>> import System.Environment+-- >>> import DigitalOcean.Base(Authentication(..))+-- >>> import Data.Maybe(isJust)+++instance ToJSON NewDropletRequest where+  toJSON v = object ["name" .= ndname v,+                     "region" .= region v,+                     "size" .= size v,+                     "image" .= image v,+                     "ssh_keys" .= ndsshKeys v,+                     "backups" .= backups v,+                     "ipv6" .= ipv6 v,+                     "user_data" .= userData v,+                     "private_networking" .= privateNetworking v+             ]++data NewDropletRequest  = NewDropletRequest {+  ndname :: String,+  region :: String, +  size :: String,+  image :: Integer,+  ndsshKeys :: [String],+  backups :: Bool,+  ipv6 :: Bool,+  userData :: Maybe(String),+  privateNetworking :: Bool+} deriving (Show, Read)++newtype OuterDroplet = OuterDroplet Droplet deriving(Show)++instance FromJSON OuterDroplet where+  parseJSON (Object v) = OuterDroplet <$> v .: "droplet"+  parseJSON _          = mzero+++-- | create new Droplet+-- :{+-- do+--   let d = NewDropletRequest {+--     ndname="hoge",+--     region="nyc3",+--     size="512mb",+--     image=12241402,+--     ndsshKeys=[],+--     backups = False,+--     ipv6=True,+--     userData = Nothing,+--     privateNetworking=False+--   }+--   tkn <- getEnv "DIGITAL_OCEAN_PERSONAL_ACCESS_TOKEN"+--   maybeNewDroplet <- newDroplet ( Authentication tkn) d+--   print $ show $ isJust maybeNewDroplet +-- :}+-- "True"+newDroplet :: Authentication -> NewDropletRequest -> (MonadIO m) => m (Maybe Droplet)+newDroplet a d = liftM toDroplet $ liftM decode (requestPost "droplets" a  d)++toDroplet :: Maybe OuterDroplet -> Maybe Droplet+toDroplet = \od -> case od of Just(OuterDroplet d) -> Just d+                              Nothing              -> Nothing
+ src/DigitalOcean/Region.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE OverloadedStrings #-}++module DigitalOcean.Region(+  Region(..),+  regions+                          ) where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (liftM, mzero)+import Control.Monad.IO.Class+import Data.Aeson ((.:), FromJSON(..), Value(..), decode)+import DigitalOcean.Base(Authentication, requestGet)++-- $setup+-- >>> import System.Environment+-- >>> import DigitalOcean.Base(Authentication(..))+-- >>> import Data.Maybe(isJust)++data Region = Region {+  regionName :: String,+  slug :: String,+  available :: Bool+} deriving (Show, Read)+++-- | List all Regions+-- >>> :{+-- do+--   tkn <- getEnv "DIGITAL_OCEAN_PERSONAL_ACCESS_TOKEN"+--   maybeRegions <- regions $ Authentication tkn+--   print $ show $ isJust maybeRegions+-- :}+-- "True"+regions :: Authentication -> (MonadIO m) => m (Maybe [Region])+regions a = liftM toList $ liftM decode (requestGet "regions" a)+++newtype Regions = Regions [Region]++instance FromJSON Regions where+  parseJSON (Object v) = Regions <$> v.: "regions"+  parseJSON _          = mzero++instance FromJSON Region where+  parseJSON (Object v) =+    Region <$>+    (v .: "name") <*>+    (v .: "slug") <*>+    (v .: "available")+  parseJSON _ = mzero+    ++toList :: Maybe Regions -> Maybe [Region]+toList = \rs ->  case rs of Just(Regions l) -> Just l+                            Nothing          -> Nothing
+ src/DigitalOcean/SSHKey.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE OverloadedStrings #-}++module DigitalOcean.SSHKey (+  SSHKey(..),+  listAllKeys+                            ) where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (liftM, mzero)+import Control.Monad.IO.Class+import Data.Aeson ((.:), FromJSON(..), Value(..), decode)+import DigitalOcean.Base(Authentication, requestGet)++-- $setup+-- >>> import System.Environment+-- >>> import DigitalOcean.Base(Authentication(..))+-- >>> import Data.Maybe(isJust)++data SSHKey = SSHKey {+  id :: Integer,+  fingerprint  :: String,+  publicKey :: String,+  sshkeyName :: String+} deriving (Show, Read)++newtype SSHKeys = SSHKeys [SSHKey]++instance FromJSON SSHKeys where+  parseJSON (Object v) = SSHKeys <$> v .: "ssh_keys"+  parseJSON _ = mzero++instance FromJSON SSHKey where+  parseJSON (Object v) =+    SSHKey <$>+    (v .: "id") <*>+    (v .: "fingerprint") <*>+    (v .: "public_key") <*>+    (v .: "name")+  parseJSON _ = mzero++-- | List all Keys+-- >>> :{+-- do+--   tkn <- getEnv "DIGITAL_OCEAN_PERSONAL_ACCESS_TOKEN"+--   maybeKeys <- listAllKeys $ Authentication tkn+--   print $ show $ isJust maybeKeys+-- :}+-- "True"+listAllKeys :: Authentication -> (MonadIO m) => m (Maybe [SSHKey])+listAllKeys a = liftM toList $ liftM decode (requestGet "account/keys" a)++toList :: Maybe SSHKeys -> Maybe [SSHKey]+toList = \sks ->  case sks of Just(SSHKeys l)  -> Just l+                              Nothing          -> Nothing
+ src/DigitalOcean/Size.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}++module DigitalOcean.Size(+  Size(..),+  sizes+                        ) where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (liftM, mzero)+import Control.Monad.IO.Class+import Data.Aeson ((.:), FromJSON(..), Value(..), decode)+import DigitalOcean.Base(Authentication,  requestGet)++-- $setup+-- >>> import System.Environment+-- >>> import DigitalOcean.Base(Authentication(..))+-- >>> import Data.Maybe(isJust)++data Size = Size {+  sizSlug :: String,+  sizAvailable  :: Bool,+  sizTransfer :: Integer,+  sizPriceMonthly :: Float,+  sizHourly :: Float,+  sizMemory :: Integer,+  sizVcpus :: Integer,+  sizDisk :: Integer+} deriving(Show, Read)++newtype Sizes = Sizes [Size]++instance FromJSON Sizes where+  parseJSON (Object v) = Sizes <$> v.: "sizes"+  parseJSON _          = mzero++-- | List all Sizes+-- >>> :{+-- do+--   tkn <- getEnv "DIGITAL_OCEAN_PERSONAL_ACCESS_TOKEN"+--   maybeSizes <- sizes $ Authentication tkn+--   print $ show $ isJust maybeSizes+-- :}+-- "True"+sizes :: Authentication -> (MonadIO m) => m (Maybe [Size])+sizes  a = liftM toList $ liftM decode (requestGet "sizes" a)++instance FromJSON Size where+  parseJSON (Object v) =+    Size <$>+    (v .: "slug") <*>+    (v .: "available") <*>+    (v .: "transfer") <*>+    (v .: "price_monthly") <*>+    (v .: "price_hourly") <*>+    (v .: "memory") <*>+    (v .: "vcpus") <*>+    (v .: "disk")+  parseJSON _ = mzero+   +toList :: Maybe Sizes -> Maybe [Size]+toList = \ss ->  case ss of Just(Sizes l) -> Just l+                            Nothing          -> Nothing
+ test/DigitalOceanSpec.hs view
@@ -0,0 +1,11 @@+module DigitalOceanSpec where++import Test.Hspec++spec :: Spec+spec = do+  describe "TODO" $ do+    it "is empty" $ do+      "foo" `shouldBe` "foo"+      +
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/doctests.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Test.DocTest++main :: IO ()+main = do+  doctest ["-isrc", "src/DigitalOcean.hs"]+{-+  doctest [+             "-isrc",+             "src/DigitalOcean/Droplet.hs",+             "src/DigitalOcean/Account.hs",+             "src/DigitalOcean/SSHKey.hs",+             "src/DigitalOcean/Image.hs",+             "src/DigitalOcean/Region.hs",+             "src/DigitalOcean/Size.hs"+-}+--             "src/DigitalOcean/NewDroplet.hs"+--             ]