hetzner 0.2.0.0 → 0.2.1.0

raw patch · 5 files changed

+145/−5 lines, 5 filesdep +hetznerdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: hetzner

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• changelog.md +5/−0
• hetzner.cabal +11/−2
• readme.md +1/−1
• src/Hetzner/Cloud.hs +102/−2
• test/Main.hs +26/−0

@@ -1,3 +1,8 @@+## 0.2.1.0+* Add support for primary IPs.+* Add function to set reverse DNS for a primary IP.+* Add test.+ ## 0.2.0.0 * Allow to attach servers to networks on creation. * Modify `streamPages` to cover more cases.

@@ -2,7 +2,7 @@ category: Cloud synopsis: Hetzner Cloud and DNS library. description: Hetzner Cloud and DNS library. Check the readme and documentation for more details.-version: 0.2.0.0+version: 0.2.1.0 cabal-version: >= 1.10 build-type: Simple author: Daniel Casanueva (daniel.casanueva `at` proton.me)@@ -19,6 +19,7 @@     Hetzner.Cloud     Hetzner.Cloud.Fingerprint     Hetzner.DNS+  ghc-options: -Wall -Wunused-packages   default-extensions:       ImportQualifiedPost     , OverloadedStrings@@ -27,9 +28,17 @@     , ScopedTypeVariables     , GeneralizedNewtypeDeriving     , TypeApplications-  ghc-options: -Wall -Wunused-packages   build-depends:       base >= 4.16 && < 4.18     , text, aeson, containers, conduit     , http-conduit, bytestring, yaml, time     , country, ip, megaparsec, scientific++test-suite hetzner-test+  default-language: Haskell2010+  hs-source-dirs: test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  ghc-options: -Wall -Wunused-packages+  default-extensions: ImportQualifiedPost, OverloadedStrings+  build-depends: base, hetzner

@@ -2,7 +2,7 @@  [![Build Status](https://img.shields.io/github/actions/workflow/status/Daniel-Diaz/hetzner/build.yml?branch=main&style=for-the-badge)](https://github.com/Daniel-Diaz/hetzner/actions/workflows/build.yml) -## Distributions+## Distribution  [![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)

@@ -80,6 +80,12 @@   , Location (..)   , getLocations   , getLocation+    -- ** Primary IPs+  , PrimaryIPID (..)+  , PrimaryIP (..)+  , getPrimaryIPs+  , getPrimaryIP+  , setReverseDNS     -- ** Networks   , NetworkID (..)   , Route (..)@@ -169,14 +175,13 @@   , Pagination (..)     ) where -import Hetzner.Cloud.Fingerprint ()+import Hetzner.Cloud.Fingerprint (Fingerprint) -- base import Control.Exception (Exception, throwIO) import Control.Concurrent (threadDelay) import GHC.TypeLits (Symbol, KnownSymbol, symbolVal) import Data.Proxy import Data.String (IsString, fromString)-import GHC.Fingerprint (Fingerprint (..)) import Data.Void import Control.Applicative (liftA2) import Control.Monad.IO.Class (MonadIO, liftIO)@@ -421,6 +426,8 @@   in  HTTP.httpBS req >>= Yaml.decodeThrow . HTTP.getResponseBody  -- | Obtain metadata from running server.+--   It doesn't need a 'Token' but must be+--   run from a server in Hetzner Cloud. getMetadata :: IO Metadata getMetadata = metadataQuery mempty @@ -459,6 +466,18 @@     <$> o .: "dns_ptr"     <*> o .: "ip" +instance (ToJSON dnsptr, ToJSON ip) => ToJSON (PublicIPInfo dnsptr ip) where+  toJSON (PublicIPInfo dns ip) = JSON.object [ "dns_ptr" .= dns, "ip" .= ip ]++instance Functor (PublicIPInfo dnsptr) where+  fmap f (PublicIPInfo dns ip) = PublicIPInfo dns (f ip)++instance Foldable (PublicIPInfo dnsptr) where+  foldMap f (PublicIPInfo _ ip) = f ip++instance Traversable (PublicIPInfo dnsptr) where+  traverse f (PublicIPInfo dns ip) = PublicIPInfo dns <$> f ip+ -- | Public network information associated with a 'Server'. data PublicNetwork = PublicNetwork   { publicNetworkFirewalls :: [FirewallStatus]@@ -623,6 +642,7 @@   | ApplyFirewall   | CreateVolume   | AttachVolume+  | ChangeDNSPtr     deriving Show  instance FromJSON ActionCommand where@@ -635,6 +655,7 @@     "apply_firewall" -> pure ApplyFirewall     "create_volume" -> pure CreateVolume     "attach_volume" -> pure AttachVolume+    "change_dns_ptr" -> pure ChangeDNSPtr     _ -> fail $ "Unknown action command " ++ Text.unpack t  -- | Action identifier.@@ -646,6 +667,8 @@     ResourceServerID ServerID     -- | Volume ID.   | ResourceVolumeID VolumeID+    -- | Primary IP ID.+  | ResourcePrimaryIPID PrimaryIPID     deriving Show  instance FromJSON ResourceID where@@ -654,6 +677,7 @@     case t :: Text of       "server" -> ResourceServerID <$> o .: "id"       "volume" -> ResourceVolumeID <$> o .: "id"+      "primary_ip" -> ResourcePrimaryIPID <$> o .: "id"       _ -> fail $ "Unknown resource type: " ++ Text.unpack t  -- | Action.@@ -921,6 +945,82 @@ getLocation :: Token -> LocationID -> IO Location getLocation token (LocationID i) = withoutKey @"location" <$>   cloudQuery "GET" ("/locations/" <> fromString (show i)) noBody token Nothing++----------------------------------------------------------------------------------------------------+-- Primary IPs+----------------------------------------------------------------------------------------------------++-- | Primary IP identifier.+newtype PrimaryIPID = PrimaryIPID Int deriving (Eq, Ord, Show, FromJSON, ToJSON)++-- | Primary IP.+data PrimaryIP = PrimaryIP+  { -- | Resource the primary IP is assigned to.+    primaryIPAssignee :: ResourceID+    -- | This primary IP is deleted when the resource it is assigned to is deleted.+  , primaryIPAutoDelete :: Bool+  , primaryIPIsBlocked :: Bool+    -- | Point in time where the primary IP was created.+  , primaryIPCreated :: ZonedTime+  , primaryIPDatacenter :: Datacenter+  , primaryIPID :: PrimaryIPID+    -- | Primary IP together with reverse DNS information.+  , primaryIP :: Either (PublicIPInfo Text IPv4) (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)+  , primaryIPLabels :: LabelMap+  , primaryIPName :: Text+    } deriving Show++instance FromJSON PrimaryIP where+  parseJSON = JSON.withObject "PrimaryIP" $ \o -> do+    aid <- o .: "assignee_id" :: JSON.Parser Int+    atype <- o .: "assignee_type" :: JSON.Parser Text+    iptype <- o .: "type"+    PrimaryIP+      <$> JSON.parseJSON (JSON.object [ "id" .= aid, "type" .= atype ])+      <*> o .: "auto_delete"+      <*> o .: "blocked"+      <*> o .: "created"+      <*> o .: "datacenter"+      <*> o .: "id"+      <*> (case iptype :: Text of+             "ipv4" -> Left <$> (o .: "dns_ptr" >>= JSON.parseJSON . head)+             "ipv6" -> Right <$> JSON.parseJSON (JSON.Object o)+             _ -> fail $ "Invalid ip type: " ++ Text.unpack iptype+             )+      <*> o .: "labels"+      <*> o .: "name"++-- | Get primary IPs.+getPrimaryIPs+  :: Token+  -> Maybe Int -- ^ Page.+  -> IO (WithMeta "primary_ips" [PrimaryIP])+getPrimaryIPs = cloudQuery "GET" "/primary_ips" noBody++-- | Get a single primary IP.+getPrimaryIP :: Token -> PrimaryIPID -> IO PrimaryIP+getPrimaryIP token (PrimaryIPID i) = withoutKey @"primary_ip" <$>+  cloudQuery "GET" ("/primary_ips" <> fromString (show i)) noBody token Nothing++-- | Set reverse DNS for a primary IP.+--+--   * If the primary IP corresponds to an IPv4, the reverse DNS setting's+--     IP /must/ coincide with the primary IP's IPv4.+--+--   * If the primary IP corresponds to an IPv6, the reverse DNS setting's+--     IP /must/ be within the primary IP's IPv6 range.+--+setReverseDNS+  :: Token+     -- | Primary IP to set reverse DNS for.+  -> PrimaryIPID+     -- | Reverse DNS settings.+  -> PublicIPInfo Text (Either IPv4 IPv6)+  -> IO Action+setReverseDNS token (PrimaryIPID i) (PublicIPInfo dns ip) = withoutKey @"action" <$>+  cloudQuery "POST" ("/primary_ips/" <> fromString (show i) <> "/actions/change_dns_ptr")+    (Just $ either (JSON.toJSON . PublicIPInfo dns) (JSON.toJSON . PublicIPInfo dns) ip)+    token Nothing  ---------------------------------------------------------------------------------------------------- -- Networks

@@ -0,0 +1,26 @@++-- | If the environment variable @HETZNER_API_TOKEN@ isn't set, this test succeeds without+--   doing anything. If it is set to a valid Hetzner token, this test will create and destroy+--   resources in Hetzner Cloud, which carries some cost, albeit small.+module Main (main) where++import Hetzner.Cloud qualified as Hetzner+import Control.Monad (void)++main :: IO ()+main = do+  mtoken <- Hetzner.getTokenFromEnv+  case mtoken of+    Nothing -> putStrLn "Environment variable HETZNER_API_TOKEN not provided. Skipping test."+    Just token -> do+      putStrLn "Creating test server..."+      cserver <- Hetzner.createServer token $ Hetzner.defaultNewServer "test"+      mapM_ (Hetzner.waitForAction token) $+        fmap Hetzner.actionID $+          Hetzner.createdServerAction cserver : Hetzner.createdServerNextActions cserver+      let server = Hetzner.createdServer cserver+      putStrLn "Server created:"+      print server+      putStrLn "Deleting test server..."+      void $ Hetzner.deleteServer token (Hetzner.serverID server)+        >>= Hetzner.waitForAction token . Hetzner.actionID