hetzner 0.1.1.0 → 0.1.2.0

raw patch · 4 files changed

+204/−5 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• changelog.md +6/−0
• hetzner.cabal +1/−1
• readme.md +6/−0
• src/Hetzner/Cloud.hs +191/−4

@@ -1,3 +1,9 @@+## 0.1.2.0+* New function: `getTokenFromEnv`. This function allows the user+  to obtain a token from the `HETZNER_API_TOKEN` environment variable.+* Support for (private) networks.+* New instances for the `Token` type: `IsString`, `Show`, `Eq`, `Ord`.+ ## 0.1.1.0 * Added support for volumes. * Fixed parsing of HTTP 204 responses.

@@ -2,7 +2,7 @@ category: Cloud synopsis: Hetzner Cloud client library. description: Hetzner Cloud client library. Check the readme and documentation for more details.-version: 0.1.1.0+version: 0.1.2.0 cabal-version: >= 1.10 build-type: Simple author: Daniel Casanueva (daniel.casanueva `at` proton.me)

@@ -1,6 +1,12 @@ # Hetzner Cloud Haskell Library +[![Build Status](https://img.shields.io/github/actions/workflow/status/Daniel-Diaz/hetzner/build.yml?branch=dev&style=for-the-badge)](https://github.com/Daniel-Diaz/hetzner/actions/workflows/build.yml)++## Distributions+ [![Hackage](https://img.shields.io/hackage/v/hetzner?style=for-the-badge)](https://hackage.haskell.org/package/hetzner)+[![Stackage LTS](http://stackage.org/package/hetzner/badge/lts)](http://stackage.org/lts/package/hetzner)+[![Stackage Nightly](http://stackage.org/package/hetzner/badge/nightly)](http://stackage.org/nightly/package/hetzner)  ## Description 

@@ -37,6 +37,7 @@ module Hetzner.Cloud   ( -- * Tokens     Token (..)+  , getTokenFromEnv     -- * Server metadata   , Metadata (..)   , getMetadata@@ -71,12 +72,27 @@   , Image (..)   , getImages   , getImage+    -- ** Load Balancers+  , LoadBalancerID (..)     -- ** Locations   , City (..)   , LocationID (..)   , Location (..)   , getLocations   , getLocation+    -- ** Networks+  , NetworkID (..)+  , Route (..)+  , SubnetType (..)+  , Subnet (..)+  , Network (..)+  , NewNetwork (..)+  , defaultNewNetwork+  , getNetworks+  , getNetwork+  , createNetwork+  , deleteNetwork+  , updateNetwork     -- ** Pricing   , Price (..)   , PriceInLocation (..)@@ -159,15 +175,16 @@ import Control.Concurrent (threadDelay) import GHC.TypeLits (Symbol, KnownSymbol, symbolVal) import Data.Proxy-import Data.String (fromString)+import Data.String (IsString, fromString) import GHC.Fingerprint (Fingerprint (..)) import Data.Void import Control.Applicative (liftA2) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Foldable (forM_) import Data.Maybe (isNothing, fromMaybe)+import System.Environment qualified as System -- ip-import Net.IPv4 (IPv4)+import Net.IPv4 (IPv4, IPv4Range) import Net.IPv6 (IPv6, IPv6Range) -- bytestring import Data.ByteString (ByteString)@@ -208,8 +225,15 @@ --   will have as scope the project where the token was made. -- --   You can obtain one through the [Hetzner Cloud Console](https://console.hetzner.cloud).-newtype Token = Token ByteString+newtype Token = Token ByteString deriving (Show, Eq, Ord) +instance IsString Token where+  fromString = Token . fromString++-- | Lookup 'Token' from the environment variable @HETZNER_API_TOKEN@.+getTokenFromEnv :: IO (Maybe Token)+getTokenFromEnv = fmap fromString <$> System.lookupEnv "HETZNER_API_TOKEN"+ -- | An error returned by Hetzner. data Error = Error   { -- | Error code.@@ -533,7 +557,7 @@ instance (KnownSymbol key, FromJSON a) => FromJSON (WithKey key a) where   parseJSON =     let key = symbolVal (Proxy @key)-    in  JSON.withObject ("WithKey " ++ key) $ \o ->+    in  JSON.withObject ("WithKey:" ++ key) $ \o ->           WithKey <$> o .: fromString key  -- | A value together with response metadata.@@ -828,6 +852,13 @@   cloudQuery "GET" ("/images/" <> fromString (show i)) noBody token Nothing  ----------------------------------------------------------------------------------------------------+-- Load Balancers+----------------------------------------------------------------------------------------------------++-- | Load balancer identifier+newtype LoadBalancerID = LoadBalancerID Int deriving (Eq, Ord, Show, FromJSON, ToJSON)++---------------------------------------------------------------------------------------------------- -- Locations ---------------------------------------------------------------------------------------------------- @@ -884,6 +915,162 @@ getLocation :: Token -> LocationID -> IO Location getLocation token (LocationID i) = withoutKey @"location" <$>   cloudQuery "GET" ("/locations/" <> fromString (show i)) noBody token Nothing++----------------------------------------------------------------------------------------------------+-- Networks+----------------------------------------------------------------------------------------------------++-- | Network identifier.+newtype NetworkID = NetworkID Int deriving (Eq, Ord, Show, FromJSON, ToJSON)++-- | A route that sends all packets for a given destination to+--   a given gateway.+data Route = Route+  { routeDestination :: IPv4Range+  , routeGateway :: IPv4+    } deriving Show++instance FromJSON Route where+  parseJSON = JSON.withObject "Route" $ \o -> Route+    <$> o .: "destination"+    <*> o .: "gateway"++instance ToJSON Route where+  toJSON route = JSON.object+    [ "destination" .= routeDestination route+    , "gateway" .= routeGateway route+      ]++-- | Types of subnetworks.+data SubnetType = SubnetCloud | SubnetServer | SubnetVSwitch deriving (Eq, Show)++instance FromJSON SubnetType where+  parseJSON = JSON.withText "SubnetType" $ \t -> case t of+    "cloud" -> pure SubnetCloud+    "server" -> pure SubnetServer+    "vswitch" -> pure SubnetVSwitch+    _ -> fail $ "Invalid subnet type: " ++ Text.unpack t++instance ToJSON SubnetType where+  toJSON t = case t of+    SubnetCloud -> "cloud"+    SubnetServer -> "server"+    SubnetVSwitch -> "vswitch"++-- | Subnets divide the IP range of a parent 'Network'.+data Subnet = Subnet+  { subnetGateway :: IPv4+  , subnetIPRange :: IPv4Range+  , subnetRegion :: Region+  , subnetType :: SubnetType+    } deriving Show++instance FromJSON Subnet where+  parseJSON = JSON.withObject "Subnet" $ \o -> Subnet+    <$> o .: "gateway"+    <*> o .: "ip_range"+    <*> o .: "network_zone"+    <*> o .: "type"++instance ToJSON Subnet where+  toJSON subnet = JSON.object+    [ "gateway" .= subnetGateway subnet+    , "ip_range" .= subnetIPRange subnet+    , "network_zone" .= subnetRegion subnet+    , "type" .= subnetType subnet+      ]++-- | A private network.+data Network = Network+  { networkCreated :: ZonedTime+  , networkID :: NetworkID+  , networkIPRange :: IPv4Range+  , networkLabels :: LabelMap+  , networkLoadBalancers :: [LoadBalancerID]+  , networkName :: Text+  , networkRoutes :: [Route]+  , networkServers :: [ServerID]+  , networkSubnets :: [Subnet]+    } deriving Show++instance FromJSON Network where+  parseJSON = JSON.withObject "Network" $ \o -> Network+    <$> o .: "created"+    <*> o .: "id"+    <*> o .: "ip_range"+    <*> o .: "labels"+    <*> o .: "load_balancers"+    <*> o .: "name"+    <*> o .: "routes"+    <*> o .: "servers"+    <*> o .: "subnets"++-- | Network creation configuration to be used with 'createNetwork'.+data NewNetwork = NewNetwork+  { newNetworkIPRange :: IPv4Range+  , newNetworkLabels :: [Label]+  , newNetworkName :: Text+  , newNetworkRoutes :: [Route]+  , newNetworkSubnets :: [Subnet]+    }++instance ToJSON NewNetwork where+  toJSON nnetwork = JSON.object+    [ "ip_range" .= newNetworkIPRange nnetwork+    , "labels" .= toLabelMap (newNetworkLabels nnetwork)+    , "name" .= newNetworkName nnetwork+    , "routes" .= newNetworkRoutes nnetwork+    , "subnets" .= newNetworkSubnets nnetwork+      ]++-- | Default network configuration for new networks.+defaultNewNetwork+  :: Text -- ^ Network name.+  -> IPv4Range -- ^ IP range of the network.+  -> NewNetwork+defaultNewNetwork name iprange = NewNetwork+  { newNetworkIPRange = iprange+  , newNetworkLabels = []+  , newNetworkName = name+  , newNetworkRoutes = []+  , newNetworkSubnets = []+    }++-- | Get networks.+getNetworks+  :: Token+  -> Maybe Int -- ^ Page.+  -> IO (WithMeta "networks" [Network])+getNetworks = cloudQuery "GET" "/networks" noBody++-- | Get a single network.+getNetwork :: Token -> NetworkID -> IO Network+getNetwork token (NetworkID i) = withoutKey @"network" <$>+  cloudQuery "GET" ("/networks/" <> fromString (show i)) noBody token Nothing++-- | Create a new network.+createNetwork :: Token -> NewNetwork -> IO Network+createNetwork token new = withoutKey @"network" <$>+  cloudQuery "POST" "/networks" (Just new) token Nothing++-- | Delete a network.+deleteNetwork :: Token -> NetworkID -> IO ()+deleteNetwork token (NetworkID i) =+  cloudQuery "DELETE" ("/networks/" <> fromString (show i)) noBody token Nothing++-- | Update name and labels of a network.+updateNetwork+  :: Token+  -> NetworkID -- ^ Network to update.+  -> Text -- ^ New name for the network.+  -> [Label] -- ^ New labels for the network.+  -> IO Network+updateNetwork token (NetworkID i) name labels = withoutKey @"network" <$>+  let body = JSON.object+        [ "labels" .= toLabelMap labels+        , "name" .= name+          ]+  in  cloudQuery "PUT" ("/networks/" <> fromString (show i)) (Just body) token Nothing  ---------------------------------------------------------------------------------------------------- -- Pricing