Merge pull request #38 from vst/34-refactor-and-document-providerhetz…

…ner-module

refactor: refactor Hetzner provider module

src/Clompse/Programs/ListServers.hs

@@ -85,10 +85,10 @@ listServersForCloudConnection (CloudConnectionDo conn) = do
     Left e -> _log ("    ERROR (DO): " <> Z.Text.tshow e) >> pure []
     Right servers -> pure (fmap Providers.Do.toServer servers)
 listServersForCloudConnection (CloudConnectionHetzner conn) = do
-  eServers <- runExceptT (Providers.Hetzner.hetznerListServers conn)
+  eServers <- runExceptT (Providers.Hetzner.listServers conn)
   case eServers of
     Left e -> _log ("    ERROR (HETZNER): " <> Z.Text.tshow e) >> pure []
-    Right servers -> pure (fmap Providers.Hetzner.toServer servers)
+    Right servers -> pure servers
 
 
 _log :: MonadIO m => T.Text -> m ()

src/Clompse/Providers/Hetzner.hs

@@ -1,168 +1,12 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
+-- | This module provides top-level functions to query remote Hetzner
+-- API and provide responses as Clompse types.
+module Clompse.Providers.Hetzner (
+  HetznerError (..),
+  HetznerConnection (..),
+  listServers,
+) where
+
+import Clompse.Providers.Hetzner.Api (listServers)
+import Clompse.Providers.Hetzner.Connection (HetznerConnection (..))
+import Clompse.Providers.Hetzner.Error (HetznerError (..))
 
-module Clompse.Providers.Hetzner where
-
-import qualified Autodocodec as ADC
-import qualified Clompse.Types as Types
-import Control.Monad.Except (MonadError)
-import Control.Monad.IO.Class (MonadIO)
-import qualified Data.Aeson as Aeson
-import Data.Int (Int16, Int32)
-import qualified Data.List as List
-import Data.Maybe (mapMaybe, maybeToList)
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
-import qualified Data.Time as Time
-import GHC.Generics (Generic)
-import qualified Hetzner.Cloud as Hetzner
-import qualified Zamazingo.Net as Z.Net
-import qualified Zamazingo.Text as Z.Text
-
-
--- * Connection
-
-
-newtype HetznerConnection = HetznerConnection
-  { _hetznerConnectionToken :: T.Text
-  }
-  deriving (Eq, Generic, Show)
-  deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec HetznerConnection)
-
-
-instance ADC.HasCodec HetznerConnection where
-  codec =
-    _codec ADC.<?> "Hetzner Connection"
-    where
-      _codec =
-        ADC.object "HetznerConnection" $
-          HetznerConnection
-            <$> ADC.requiredField "token" "Hetzner API token." ADC..= _hetznerConnectionToken
-
-
--- * Error
-
-
-newtype HetznerError
-  = HetznerErrorUnknown T.Text
-  deriving (Eq, Show)
-
-
--- * Operations
-
-
--- ** List Servers
-
-
--- TODO: Capture errors and lift to @MonadError HetznerError m@.
-hetznerListServers
-  :: MonadIO m
-  => MonadError HetznerError m
-  => HetznerConnection
-  -> m [Hetzner.Server]
-hetznerListServers conn =
-  Hetzner.streamToList (Hetzner.streamPages (Hetzner.getServers (_tokenFromConnection conn)))
-
-
--- ** List Firewalls
-
-
--- TODO: Capture errors and lift to @MonadError HetznerError m@.
-hetznerListFirewalls
-  :: MonadIO m
-  => MonadError HetznerError m
-  => HetznerConnection
-  -> m [Hetzner.Firewall]
-hetznerListFirewalls conn =
-  Hetzner.streamToList (Hetzner.streamPages (Hetzner.getFirewalls (_tokenFromConnection conn)))
-
-
--- ** List Servers with Firewalls
-
-
--- TODO: Capture errors and lift to @MonadError HetznerError m@.
-hetznerListServersWithFirewalls
-  :: MonadIO m
-  => MonadError HetznerError m
-  => HetznerConnection
-  -> m [(Hetzner.Server, [Hetzner.Firewall])]
-hetznerListServersWithFirewalls conn = do
-  servers <- hetznerListServers conn
-  firewalls <- hetznerListFirewalls conn
-  pure (fmap (\i -> (i, findFirewalls firewalls i)) servers)
-  where
-    findFirewalls fws i =
-      let pns = fmap Hetzner.firewallStatusID (filter Hetzner.firewallIsApplied (Hetzner.publicNetworkFirewalls (Hetzner.serverPublicNetwork i)))
-       in mapMaybe (\x -> List.find (\f -> Hetzner.firewallID f == x) fws) pns
-
-
--- * Helpers
-
-
-toServer :: Hetzner.Server -> Types.Server
-toServer srv@Hetzner.Server {..} =
-  Types.Server
-    { Types._serverId = toServerId serverID
-    , Types._serverName = Just serverName
-    , Types._serverCpu = Just (toServerCpu serverType)
-    , Types._serverRam = Just (toServerRam serverType)
-    , Types._serverDisk = Just (toServerDisk serverType)
-    , Types._serverState = toServerState serverStatus
-    , Types._serverCreatedAt = Just (Time.zonedTimeToUTC serverCreated)
-    , Types._serverProvider = Types.ProviderHetzner
-    , Types._serverRegion = Hetzner.locationName . Hetzner.datacenterLocation $ serverDatacenter
-    , Types._serverType = Just (Hetzner.serverTypeDescription serverType)
-    , Types._serverIpInfo = toServerIpInfo srv
-    }
-
-
-toServerIpInfo :: Hetzner.Server -> Types.ServerIpInfo
-toServerIpInfo Hetzner.Server {..} =
-  Types.ServerIpInfo
-    { _serverIpInfoStaticIpv4 = [] -- TODO: hetzner library does not provide this information.
-    , _serverIpInfoStaticIpv6 = [] -- TODO: hetzner library does not provide this information.
-    , _serverIpInfoPrivateIpv4 = [] -- TODO: hetzner library does not provide this information.
-    , _serverIpInfoPrivateIpv6 = [] -- TODO: hetzner library does not provide this information.
-    , _serverIpInfoPublicIpv4 = maybeToList (Z.Net.MkIPv4 . Hetzner.publicIP <$> Hetzner.publicIPv4 serverPublicNetwork)
-    , _serverIpInfoPublicIpv6 = foldMap (fmap (Z.Net.MkIPv6 . Hetzner.publicIP) . Hetzner.reverseDNS) (Hetzner.publicIPv6 serverPublicNetwork)
-    }
-
-
-toServerId :: Hetzner.ServerID -> T.Text
-toServerId (Hetzner.ServerID x) =
-  Z.Text.tshow x
-
-
-toServerCpu :: Hetzner.ServerType -> Int16
-toServerCpu Hetzner.ServerType {..} =
-  fromIntegral serverCores
-
-
-toServerRam :: Hetzner.ServerType -> Int32
-toServerRam Hetzner.ServerType {..} =
-  fromIntegral serverMemory * 1024
-
-
-toServerDisk :: Hetzner.ServerType -> Int32
-toServerDisk Hetzner.ServerType {..} =
-  fromIntegral serverDisk
-
-
-toServerState :: Hetzner.ServerStatus -> Types.State
-toServerState Hetzner.Initializing = Types.StateCreating
-toServerState Hetzner.Starting = Types.StateCreating
-toServerState Hetzner.Running = Types.StateRunning
-toServerState Hetzner.Stopping = Types.StateStopping
-toServerState Hetzner.Off = Types.StateStopped
-toServerState Hetzner.Deleting = Types.StateTerminating
-toServerState Hetzner.Rebuilding = Types.StateRebuilding
-toServerState Hetzner.Migrating = Types.StateMigrating
-toServerState Hetzner.StatusUnknown = Types.StateUnknown
-
-
-_tokenFromConnection :: HetznerConnection -> Hetzner.Token
-_tokenFromConnection =
-  Hetzner.Token . TE.encodeUtf8 . _hetznerConnectionToken

src/Clompse/Providers/Hetzner/Api.hs

@@ -0,0 +1,158 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RecordWildCards #-}
+
+-- | This module provides functions to query remote Hetzner API and
+-- convert responses to Clompse types.
+module Clompse.Providers.Hetzner.Api where
+
+import Clompse.Providers.Hetzner.Connection (HetznerConnection (..), hetznerConnectionToken)
+import Clompse.Providers.Hetzner.Error (HetznerError)
+import qualified Clompse.Types as Types
+import Control.Monad.Except (MonadError)
+import Control.Monad.IO.Class (MonadIO)
+import Data.Int
+import qualified Data.List as List
+import Data.Maybe (mapMaybe, maybeToList)
+import qualified Data.Text as T
+import qualified Data.Time as Time
+import qualified Hetzner.Cloud as Hetzner
+import qualified Zamazingo.Net as Z.Net
+import qualified Zamazingo.Text as Z.Text
+
+
+-- * Operations
+
+
+-- | Lists all servers available in the Hetzner account associated
+-- with the given connection as Clompse servers.
+listServers
+  :: MonadIO m
+  => MonadError HetznerError m
+  => HetznerConnection
+  -> m [Types.Server]
+listServers =
+  fmap (fmap toServer) . apiListServers
+
+
+-- * Helpers
+
+
+-- ** Hetzner API Helpers
+
+
+-- | Lists all servers available in the Hetzner account associated
+-- with the given connection.
+--
+-- __TODO:__ Capture errors and lift to @MonadError HetznerError m@.
+apiListServers
+  :: MonadIO m
+  => MonadError HetznerError m
+  => HetznerConnection
+  -> m [Hetzner.Server]
+apiListServers =
+  Hetzner.streamToList . Hetzner.streamPages . Hetzner.getServers . hetznerConnectionToken
+
+
+-- | Lists all firewalls available in the Hetzner account associated
+-- with the given connection.
+--
+-- __TODO:__ Capture errors and lift to @MonadError HetznerError m@.
+apiListFirewalls
+  :: MonadIO m
+  => MonadError HetznerError m
+  => HetznerConnection
+  -> m [Hetzner.Firewall]
+apiListFirewalls =
+  Hetzner.streamToList . Hetzner.streamPages . Hetzner.getFirewalls . hetznerConnectionToken
+
+
+-- | Lists all servers available in the Hetzner account associated
+-- with the given connection along with their firewalls information,
+-- if any.
+--
+-- __TODO:__ Capture errors and lift to @MonadError HetznerError m@.
+apiListServersFirewalls
+  :: MonadIO m
+  => MonadError HetznerError m
+  => HetznerConnection
+  -> m [(Hetzner.Server, [Hetzner.Firewall])]
+apiListServersFirewalls conn = do
+  servers <- apiListServers conn
+  firewalls <- apiListFirewalls conn
+  pure (fmap (\i -> (i, findFirewalls firewalls i)) servers)
+  where
+    findFirewalls fws i =
+      let pns = fmap Hetzner.firewallStatusID (filter Hetzner.firewallIsApplied (Hetzner.publicNetworkFirewalls (Hetzner.serverPublicNetwork i)))
+       in mapMaybe (\x -> List.find (\f -> Hetzner.firewallID f == x) fws) pns
+
+
+-- ** Data Helpers
+
+
+-- | Converts a given Hetzner server to a Clompse server.
+toServer :: Hetzner.Server -> Types.Server
+toServer srv@Hetzner.Server {..} =
+  Types.Server
+    { Types._serverId = toServerId serverID
+    , Types._serverName = Just serverName
+    , Types._serverCpu = Just (toServerCpu serverType)
+    , Types._serverRam = Just (toServerRam serverType)
+    , Types._serverDisk = Just (toServerDisk serverType)
+    , Types._serverState = toServerState serverStatus
+    , Types._serverCreatedAt = Just (Time.zonedTimeToUTC serverCreated)
+    , Types._serverProvider = Types.ProviderHetzner
+    , Types._serverRegion = Hetzner.locationName . Hetzner.datacenterLocation $ serverDatacenter
+    , Types._serverType = Just (Hetzner.serverTypeDescription serverType)
+    , Types._serverIpInfo = toServerIpInfo srv
+    }
+
+
+-- | Extracts the IP information from a given Hetzner server.
+toServerIpInfo :: Hetzner.Server -> Types.ServerIpInfo
+toServerIpInfo Hetzner.Server {..} =
+  Types.ServerIpInfo
+    { _serverIpInfoStaticIpv4 = [] -- TODO: hetzner library does not provide this information.
+    , _serverIpInfoStaticIpv6 = [] -- TODO: hetzner library does not provide this information.
+    , _serverIpInfoPrivateIpv4 = [] -- TODO: hetzner library does not provide this information.
+    , _serverIpInfoPrivateIpv6 = [] -- TODO: hetzner library does not provide this information.
+    , _serverIpInfoPublicIpv4 = maybeToList (Z.Net.MkIPv4 . Hetzner.publicIP <$> Hetzner.publicIPv4 serverPublicNetwork)
+    , _serverIpInfoPublicIpv6 = foldMap (fmap (Z.Net.MkIPv6 . Hetzner.publicIP) . Hetzner.reverseDNS) (Hetzner.publicIPv6 serverPublicNetwork)
+    }
+
+
+-- | Extracts the server ID from a given Hetzner server ID as a
+-- textual value.
+toServerId :: Hetzner.ServerID -> T.Text
+toServerId (Hetzner.ServerID x) =
+  Z.Text.tshow x
+
+
+-- | Extracts the CPU count from a given Hetzner server type.
+toServerCpu :: Hetzner.ServerType -> Int16
+toServerCpu Hetzner.ServerType {..} =
+  fromIntegral serverCores
+
+
+-- | Extracts the RAM size from a given Hetzner server type.
+toServerRam :: Hetzner.ServerType -> Int32
+toServerRam Hetzner.ServerType {..} =
+  fromIntegral serverMemory * 1024
+
+
+-- | Extracts the disk size from a given Hetzner server type.
+toServerDisk :: Hetzner.ServerType -> Int32
+toServerDisk Hetzner.ServerType {..} =
+  fromIntegral serverDisk
+
+
+-- | Converts a given Hetzner server status to a Clompse server state.
+toServerState :: Hetzner.ServerStatus -> Types.State
+toServerState Hetzner.Initializing = Types.StateCreating
+toServerState Hetzner.Starting = Types.StateCreating
+toServerState Hetzner.Running = Types.StateRunning
+toServerState Hetzner.Stopping = Types.StateStopping
+toServerState Hetzner.Off = Types.StateStopped
+toServerState Hetzner.Deleting = Types.StateTerminating
+toServerState Hetzner.Rebuilding = Types.StateRebuilding
+toServerState Hetzner.Migrating = Types.StateMigrating
+toServerState Hetzner.StatusUnknown = Types.StateUnknown

src/Clompse/Providers/Hetzner/Connection.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | This module provides definitions for Hetzner API connection
+-- configuration.
+module Clompse.Providers.Hetzner.Connection where
+
+import qualified Autodocodec as ADC
+import qualified Data.Aeson as Aeson
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import GHC.Generics (Generic)
+import qualified Hetzner.Cloud as Hetzner
+
+
+-- | Data definition for Hetzner API connection configuration.
+--
+-- >>> Aeson.encode $ HetznerConnection "my-token"
+-- "{\"token\":\"my-token\"}"
+-- >>> Aeson.decode "{\"token\":\"my-token\"}" :: Maybe HetznerConnection
+-- Just (HetznerConnection {_hetznerConnectionToken = "my-token"})
+newtype HetznerConnection = HetznerConnection
+  { _hetznerConnectionToken :: T.Text
+  }
+  deriving (Eq, Generic, Show)
+  deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec HetznerConnection)
+
+
+instance ADC.HasCodec HetznerConnection where
+  codec =
+    _codec ADC.<?> "Hetzner Connection"
+    where
+      _codec =
+        ADC.object "HetznerConnection" $
+          HetznerConnection
+            <$> ADC.requiredField "token" "Hetzner API token." ADC..= _hetznerConnectionToken
+
+
+-- | Extracts the Hetzner API token from a connection configuration
+-- and builds a 'Hetzner.Token' value.
+--
+-- >>> hetznerConnectionToken (HetznerConnection "my-token")
+-- Token "my-token"
+hetznerConnectionToken :: HetznerConnection -> Hetzner.Token
+hetznerConnectionToken =
+  Hetzner.Token . TE.encodeUtf8 . _hetznerConnectionToken