diff --git a/src/Clompse/Programs/ListServers.hs b/src/Clompse/Programs/ListServers.hs index 696971d..866d686 100644 --- a/src/Clompse/Programs/ListServers.hs +++ b/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 () diff --git a/src/Clompse/Providers/Hetzner.hs b/src/Clompse/Providers/Hetzner.hs index fd7e53b..cbe2e26 100644 --- a/src/Clompse/Providers/Hetzner.hs +++ b/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 diff --git a/src/Clompse/Providers/Hetzner/Api.hs b/src/Clompse/Providers/Hetzner/Api.hs new file mode 100644 index 0000000..46f41bf --- /dev/null +++ b/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 diff --git a/src/Clompse/Providers/Hetzner/Connection.hs b/src/Clompse/Providers/Hetzner/Connection.hs new file mode 100644 index 0000000..9723acd --- /dev/null +++ b/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 diff --git a/src/Clompse/Providers/Hetzner/Error.hs b/src/Clompse/Providers/Hetzner/Error.hs new file mode 100644 index 0000000..b4c8d45 --- /dev/null +++ b/src/Clompse/Providers/Hetzner/Error.hs @@ -0,0 +1,13 @@ +-- | This module provides Hetzner error types and primitives. +module Clompse.Providers.Hetzner.Error where + +import qualified Data.Text as T + + +-- | This type represents errors that can occur when interacting with +-- or interpreting responses received from Hetzner API. +newtype HetznerError + = -- | Indicates an unknown/unexpected + -- error. + HetznerErrorUnknown T.Text + deriving (Eq, Show)