DOH 0.1.1.1 → 0.1.2.0

raw patch · 5 files changed

+53/−20 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• DOH.cabal +1/−1
• README.md +1/−1
• src/Network/DigitalOcean.hs +6/−4
• src/Network/DigitalOcean/Http.hs +29/−11
• src/Network/DigitalOcean/Types.hs +16/−3

@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/  name:                DOH-version:             0.1.1.1+version:             0.1.2.0 synopsis:            Complete API bindings for DigitalOcean API V2 description:         Complete API bindings for DigitalOcean API V2                      .

@@ -41,7 +41,7 @@   forM_ droplets $ \dropletId -> performDropletAction dropletId (TakeSnapshot (Just "bulk snapshot")) ``` -For full documentation and reference, see: http://hackage.haskell.org/package/DOH-0.1.1.0/docs/Network-DigitalOcean.html+For full documentation and reference, see: http://hackage.haskell.org/package/DOH-0.1.2.0  # Contributing What can you do?

@@ -64,6 +64,7 @@ import           Control.Monad.Except import           Data.Bool                 (bool) import qualified Data.Set                  as Set+import qualified Data.Text                 as T ----------------------------------------------------------------- import           Network.DigitalOcean.Types import           Network.DigitalOcean.Http@@ -300,10 +301,11 @@  -} performDropletActionOnTag :: String -> DropletAction -> DO [Action] performDropletActionOnTag tag action = do-  unless (actionAllowedAsBulk action) $-    throwError $-      "Action " ++ show action ++ " not allowed as bulk. See \-      \https://developers.digitalocean.com/documentation/v2/#acting-on-tagged-droplets"+  unless (actionAllowedAsBulk action) $ throwError+    DoErr { errType  = ActionNotAllowed+          , errTitle = T.pack $ "Action " <> show action <> " not allowed as bulk"+          , errBody  = "See https://developers.digitalocean.com/documentation/v2/#acting-on-tagged-droplets"+          }   unResponse <$> post DropletsActionsEndpoint (Just [("tag_name", tag)]) action  getDropletAction :: DropletId -> ActionId -> DO Action

@@ -6,22 +6,23 @@ module Network.DigitalOcean.Http where    ------------------------------------------------------------------import qualified Data.Text                 as T-import qualified Data.ByteString           as BS-import qualified Data.ByteString.Char8     as BSC-import qualified Data.ByteString.Lazy      as LBS-import           Network.HTTP.Client       hiding (Proxy)+import qualified Data.Text                  as T+import qualified Data.ByteString            as BS+import qualified Data.ByteString.Char8      as BSC+import qualified Data.ByteString.Lazy       as LBS+import qualified Data.ByteString.Lazy.Char8 as LBSC+import           Network.HTTP.Client        hiding (Proxy) import           Network.HTTP.Client.TLS-import           System.FilePath           ((</>))+import           System.FilePath            ((</>)) import           Data.Aeson import           Data.Proxy import           Data.Monoid-import           Data.Bool                 (bool)+import           Data.Bool                  (bool) import           Control.Monad import           Control.Monad.Reader import           Control.Monad.Except import           Data.Maybe-import           Network.HTTP.Types.Status (statusCode)+import           Network.HTTP.Types.Status  (statusCode) import           Text.URI ----------------------------------------------------------------- import           Network.DigitalOcean.Types@@ -38,7 +39,11 @@ makeRequest method uri queryParams mbPayload = do   client <- ask   let uri' = uri <> maybe mempty showQueryParams queryParams-  when (isNothing $ parseURI uri') $ throwError $ "URI cannot be parsed: " <> uri'+  when (isNothing $ parseURI uri') $ throwError +    DoErr { errType  = InternalError+          , errTitle = "URI cannot be parsed:"+          , errBody  = T.pack uri'+          }   manager <- liftIO newTlsManager   initialRequest <- liftIO $ parseRequest uri'   let request = initialRequest { method = BSC.pack $ show method@@ -49,10 +54,23 @@   let request' = maybe request (\payload -> request { requestBody = RequestBodyLBS (encode payload) }) mbPayload   response <- liftIO $ httpLbs request' manager   let respStatus = statusCode $ responseStatus response-  when (respStatus < 200 || respStatus > 300) $ throwError $ "Non-success response: " <> show respStatus <> "Body:" <> show (responseBody response)+  when (respStatus == 401) $ throwError+    DoErr { errType  = AuthenticationError+          , errTitle = "Your API token is invalid"+          , errBody  = ""+          }+  when (respStatus < 200 || respStatus > 300) $ throwError+    DoErr { errType  = HttpError+          , errTitle = "Non-success response received"+          , errBody  = T.pack $ LBSC.unpack (responseBody response)+          }   let body = bool (responseBody response) "[]" (respStatus == 204)   case (eitherDecode body :: Either String a) of-    Left err -> throwError $ "Error occured for response body:" <> BSC.unpack (LBS.toStrict $ responseBody response) <> err+    Left err -> throwError+      DoErr { errType  = JSONConversionError+            , errTitle = "Error occured for response body"+            , errBody  = T.pack $ BSC.unpack (LBS.toStrict $ responseBody response) <> err+            }     Right resource -> return resource  {- `get` that is working with absolute uris -}

@@ -65,12 +65,25 @@ defaultPaginationConfig :: PaginationConfig defaultPaginationConfig = PaginationConfig 25 100 -newtype DO a = DO { runDO :: ReaderT Client (ExceptT String IO) a }-  deriving (Functor, Applicative, Monad, MonadIO, MonadError String, MonadReader Client)+newtype DO a = DO { runDO :: ReaderT Client (ExceptT DoErr IO) a }+  deriving (Functor, Applicative, Monad, MonadIO, MonadError DoErr, MonadReader Client)  newtype Client = Client { apiKey :: BS.ByteString } -type DoErr = T.Text+data DoErrType =+    HttpError+  | JSONConversionError+  | InternalError+  | ActionNotAllowed+  | AuthenticationError+  | UnknownError+  deriving Show++data DoErr = DoErr+  { errType :: DoErrType+  , errTitle :: T.Text+  , errBody :: T.Text+  } deriving Show  newtype Response a = Response { unResponse :: a } deriving (Generic, Show)