Merge pull request #23 from vst/17-add-ip-address-information-to-servers

Report Server IP Address Information

src/Clompse/Cli.hs

@@ -23,6 +23,7 @@ import qualified Data.Text.IO as TIO
 import qualified Options.Applicative as OA
 import System.Exit (ExitCode (..))
 import qualified Text.Layout.Table as Tab
+import qualified Zamazingo.Net as Z.Net
 import qualified Zamazingo.Text as Z.Text
 
 
@@ -196,6 +197,7 @@ doServerListConsole rs =
         , Tab.numCol
         , Tab.column Tab.expand Tab.left Tab.noAlign Tab.noCutMark
         , Tab.column Tab.expand Tab.left Tab.noAlign Tab.noCutMark
+        , Tab.column Tab.expand Tab.left Tab.noAlign Tab.noCutMark
         ]
       hs =
         Tab.titlesH
@@ -211,6 +213,7 @@ doServerListConsole rs =
           , "Disk"
           , "Type"
           , "Created"
+          , "IPv4"
           ]
       mkRows i Programs.ServerListItem {..} =
         Tab.rowG . fmap T.unpack $
@@ -226,6 +229,7 @@ doServerListConsole rs =
           , maybe "<unknown>" formatIntegral _serverListItemDisk
           , fromMaybe "<unknown>" _serverListItemType
           , maybe "<unknown>" Z.Text.tshow _serverListItemCreatedAt
+          , T.intercalate "," (fmap Z.Net.ipv4ToText (_serverListItemIPv4Static <> _serverListItemIPv4Public))
           ]
       rows = fmap (uncurry mkRows) (zip [1 :: Int ..] rs)
    in putStrLn $ Tab.tableString cs Tab.unicodeS hs rows

src/Clompse/Programs/ListServers.hs

@@ -11,7 +11,7 @@ import qualified Clompse.Providers.Aws as Providers
 import qualified Clompse.Providers.Aws as Providers.Aws
 import qualified Clompse.Providers.Do as Providers.Do
 import qualified Clompse.Providers.Hetzner as Providers.Hetzner
-import Clompse.Types (Server)
+import Clompse.Types (Server, ServerIpInfo (..))
 import qualified Clompse.Types as Types
 import qualified Control.Concurrent.Async.Pool as Async
 import Control.Monad.Except (runExceptT)
@@ -25,6 +25,7 @@ import qualified Data.Time as Time
 import qualified Data.Vector as V
 import GHC.Generics (Generic)
 import qualified System.IO
+import qualified Zamazingo.Net as Z.Net
 import qualified Zamazingo.Text as Z.Text
 
 
@@ -110,6 +111,12 @@ data ServerListItem = ServerListItem
   , _serverListItemDisk :: !(Maybe Int32)
   , _serverListItemType :: !(Maybe T.Text)
   , _serverListItemCreatedAt :: !(Maybe Time.UTCTime)
+  , _serverListItemIPv4Static :: ![Z.Net.IPv4]
+  , _serverListItemIPv4Public :: ![Z.Net.IPv4]
+  , _serverListItemIPv4Private :: ![Z.Net.IPv4]
+  , _serverListItemIPv6Static :: ![Z.Net.IPv6]
+  , _serverListItemIPv6Public :: ![Z.Net.IPv6]
+  , _serverListItemIPv6Private :: ![Z.Net.IPv6]
   }
   deriving (Eq, Generic, Show)
   deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec ServerListItem)
@@ -133,23 +140,37 @@ instance ADC.HasCodec ServerListItem where
             <*> ADC.optionalField "disk" "Disk of the server." ADC..= _serverListItemDisk
             <*> ADC.optionalField "type" "Type of the server." ADC..= _serverListItemType
             <*> ADC.optionalField "created_at" "Creation time of the server." ADC..= _serverListItemCreatedAt
+            <*> ADC.requiredField "ipv4_static" "Static IPv4 addresses." ADC..= _serverListItemIPv4Static
+            <*> ADC.requiredField "ipv4_public" "Public IPv4 addresses." ADC..= _serverListItemIPv4Public
+            <*> ADC.requiredField "ipv4_private" "Private IPv4 addresses." ADC..= _serverListItemIPv4Private
+            <*> ADC.requiredField "ipv6_static" "Ptatic IPv6 addresses." ADC..= _serverListItemIPv6Static
+            <*> ADC.requiredField "ipv6_public" "Public IPv6 addresses." ADC..= _serverListItemIPv6Public
+            <*> ADC.requiredField "ipv6_private" "Private IPv6 addresses." ADC..= _serverListItemIPv6Private
 
 
 instance Cassava.ToNamedRecord ServerListItem where
   toNamedRecord ServerListItem {..} =
-    Cassava.namedRecord
-      [ "profile" Cassava..= _serverListItemProfile
-      , "provider" Cassava..= Types.providerCode _serverListItemProvider
-      , "region" Cassava..= _serverListItemRegion
-      , "id" Cassava..= _serverListItemId
-      , "name" Cassava..= _serverListItemName
-      , "state" Cassava..= Types.stateCode _serverListItemState
-      , "cpu" Cassava..= _serverListItemCpu
-      , "ram" Cassava..= _serverListItemRam
-      , "disk" Cassava..= _serverListItemDisk
-      , "type" Cassava..= _serverListItemType
-      , "created_at" Cassava..= fmap Z.Text.tshow _serverListItemCreatedAt
-      ]
+    let reportIp4s = filterMaybe (not . T.null) . T.intercalate "," . fmap Z.Net.ipv4ToText
+        reportIp6s = filterMaybe (not . T.null) . T.intercalate "," . fmap Z.Net.ipv6ToText
+     in Cassava.namedRecord
+          [ "profile" Cassava..= _serverListItemProfile
+          , "provider" Cassava..= Types.providerCode _serverListItemProvider
+          , "region" Cassava..= _serverListItemRegion
+          , "id" Cassava..= _serverListItemId
+          , "name" Cassava..= _serverListItemName
+          , "state" Cassava..= Types.stateCode _serverListItemState
+          , "cpu" Cassava..= _serverListItemCpu
+          , "ram" Cassava..= _serverListItemRam
+          , "disk" Cassava..= _serverListItemDisk
+          , "type" Cassava..= _serverListItemType
+          , "created_at" Cassava..= fmap Z.Text.tshow _serverListItemCreatedAt
+          , "ipv4_static" Cassava..= reportIp4s _serverListItemIPv4Static
+          , "ipv4_public" Cassava..= reportIp4s _serverListItemIPv4Public
+          , "ipv4_private" Cassava..= reportIp4s _serverListItemIPv4Private
+          , "ipv6_static" Cassava..= reportIp6s _serverListItemIPv6Static
+          , "ipv6_public" Cassava..= reportIp6s _serverListItemIPv6Public
+          , "ipv6_private" Cassava..= reportIp6s _serverListItemIPv6Private
+          ]
 
 
 instance Cassava.DefaultOrdered ServerListItem where
@@ -166,6 +187,12 @@ instance Cassava.DefaultOrdered ServerListItem where
       , "disk"
       , "type"
       , "created_at"
+      , "ipv4_static"
+      , "ipv4_public"
+      , "ipv4_private"
+      , "ipv6_static"
+      , "ipv6_public"
+      , "ipv6_private"
       ]
 
 
@@ -186,4 +213,16 @@ toServerList ListServersResult {..} =
         , _serverListItemDisk = _serverDisk
         , _serverListItemType = _serverType
         , _serverListItemCreatedAt = _serverCreatedAt
+        , _serverListItemIPv4Static = _serverIpInfoStaticIpv4 _serverIpInfo
+        , _serverListItemIPv4Public = _serverIpInfoPublicIpv4 _serverIpInfo
+        , _serverListItemIPv4Private = _serverIpInfoPrivateIpv4 _serverIpInfo
+        , _serverListItemIPv6Static = _serverIpInfoStaticIpv6 _serverIpInfo
+        , _serverListItemIPv6Public = _serverIpInfoPublicIpv6 _serverIpInfo
+        , _serverListItemIPv6Private = _serverIpInfoPrivateIpv6 _serverIpInfo
         }
+
+
+filterMaybe :: (a -> Bool) -> a -> Maybe a
+filterMaybe p a
+  | p a = Just a
+  | otherwise = Nothing

src/Clompse/Providers/Aws.hs

@@ -32,11 +32,12 @@ import qualified Data.Conduit as C
 import qualified Data.Conduit.List as CL
 import Data.Int (Int16, Int32)
 import qualified Data.List as L
-import Data.Maybe (catMaybes, fromMaybe)
+import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import GHC.Float (double2Int)
 import GHC.Generics (Generic)
+import qualified Zamazingo.Net as Z.Net
 import qualified Zamazingo.Text as Z.Text
 
 
@@ -283,6 +284,7 @@ ec2InstanceToServer region [email protected]' {..} =
     , Types._serverProvider = Types.ProviderAws
     , Types._serverRegion = Aws.fromRegion region
     , Types._serverType = Just (Aws.Ec2.fromInstanceType instanceType)
+    , Types._serverIpInfo = ec2InstanceToServerIpInfo i
     }
 
 
@@ -298,6 +300,18 @@ ec2InstanceToServerState Aws.Ec2.Types.InstanceState' {..} =
     _ -> Types.StateUnknown
 
 
+ec2InstanceToServerIpInfo :: Aws.Ec2.Instance -> Types.ServerIpInfo
+ec2InstanceToServerIpInfo Aws.Ec2.Instance' {..} =
+  Types.ServerIpInfo
+    { _serverIpInfoStaticIpv4 = [] -- TODO: This is now reported below in public v4 field.
+    , _serverIpInfoStaticIpv6 = [] -- TODO: Is there such thing for AWS EC2?
+    , _serverIpInfoPublicIpv4 = maybeToList (Z.Net.ipv4FromText =<< publicIpAddress)
+    , _serverIpInfoPublicIpv6 = maybeToList (Z.Net.ipv6FromText =<< ipv6Address)
+    , _serverIpInfoPrivateIpv4 = maybeToList (Z.Net.ipv4FromText =<< privateIpAddress)
+    , _serverIpInfoPrivateIpv6 = [] -- There is no such thing for AWS EC2.
+    }
+
+
 awsEc2InstanceName
   :: Aws.Ec2.Instance
   -> Maybe T.Text
@@ -310,7 +324,7 @@ awsEc2InstanceName i =
 
 
 lightsailInstanceToServer :: Aws.Region -> Aws.Lightsail.Instance -> Types.Server
-lightsailInstanceToServer region Aws.Lightsail.Types.Instance' {..} =
+lightsailInstanceToServer region i@Aws.Lightsail.Types.Instance' {..} =
   Types.Server
     { Types._serverId = fromMaybe "<unknown>" arn
     , Types._serverName = name
@@ -322,6 +336,7 @@ lightsailInstanceToServer region Aws.Lightsail.Types.Instance' {..} =
     , Types._serverProvider = Types.ProviderAws
     , Types._serverRegion = Aws.fromRegion region
     , Types._serverType = bundleId
+    , Types._serverIpInfo = lightsailInstanceToServerIpInfo i
     }
 
 
@@ -352,6 +367,21 @@ lightsailInstanceToServerState Aws.Lightsail.Types.InstanceState' {..} =
     _ -> Types.StateUnknown
 
 
+lightsailInstanceToServerIpInfo :: Aws.Lightsail.Instance -> Types.ServerIpInfo
+lightsailInstanceToServerIpInfo Aws.Lightsail.Instance' {..} =
+  let hasStatic = fromMaybe False isStaticIp
+      static4 = if hasStatic then publicIpAddress else Nothing
+      public4 = if hasStatic then Nothing else publicIpAddress
+   in Types.ServerIpInfo
+        { _serverIpInfoStaticIpv4 = maybeToList (Z.Net.ipv4FromText =<< static4)
+        , _serverIpInfoStaticIpv6 = [] -- TODO: Is there such thing for AWS Lightsail?
+        , _serverIpInfoPublicIpv4 = maybeToList (Z.Net.ipv4FromText =<< public4)
+        , _serverIpInfoPublicIpv6 = mapMaybe Z.Net.ipv6FromText (fromMaybe [] ipv6Addresses)
+        , _serverIpInfoPrivateIpv4 = maybeToList (Z.Net.ipv4FromText =<< privateIpAddress)
+        , _serverIpInfoPrivateIpv6 = [] -- TODO: Is there such thing for AWS Lightsail?
+        }
+
+
 -- ** Others
 
 

src/Clompse/Providers/Do.hs

@@ -13,6 +13,8 @@ import Control.Monad.IO.Class (MonadIO)
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString.Lazy as BL
 import Data.Int (Int16, Int32, Int64)
+import qualified Data.List as List
+import Data.Maybe (fromMaybe)
 import Data.Scientific (Scientific)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
@@ -405,7 +407,7 @@ doListFirewalls conn =
 
 
 toServer :: DoDroplet -> Types.Server
-toServer DoDroplet {..} =
+toServer droplet@DoDroplet {..} =
   Types.Server
     { _serverId = Z.Text.tshow _doDropletId
     , _serverName = Just _doDropletName
@@ -417,9 +419,26 @@ toServer DoDroplet {..} =
     , _serverProvider = Types.ProviderDo
     , _serverRegion = _doRegionSlug _doDropletRegion
     , _serverType = Just _doDropletSizeSlug
+    , _serverIpInfo = toServerIpInfo droplet
     }
 
 
+toServerIpInfo :: DoDroplet -> Types.ServerIpInfo
+toServerIpInfo DoDroplet {..} =
+  let nets4 = fromMaybe [] (_doNetworksV4 _doDropletNetworks)
+      nets6 = fromMaybe [] (_doNetworksV6 _doDropletNetworks)
+      ipv4s = fmap ((,) <$> _doNetworkV4IpAddress <*> _doNetworkV4Type) nets4
+      ipv6s = fmap ((,) <$> _doNetworkV6IpAddress <*> _doNetworkV6Type) nets6
+   in Types.ServerIpInfo
+        { _serverIpInfoStaticIpv4 = [] -- TODO: For now, reserved IP is seen in public IP section below.
+        , _serverIpInfoStaticIpv6 = [] -- No such thing for DO.
+        , _serverIpInfoPublicIpv4 = List.nub [ip | (ip, "public") <- ipv4s]
+        , _serverIpInfoPublicIpv6 = List.nub [ip | (ip, "public") <- ipv6s]
+        , _serverIpInfoPrivateIpv4 = List.nub [ip | (ip, "private") <- ipv4s]
+        , _serverIpInfoPrivateIpv6 = List.nub [ip | (ip, "private") <- ipv6s]
+        }
+
+
 toServerState :: T.Text -> Types.State
 toServerState "new" = Types.StateCreating
 toServerState "active" = Types.StateRunning

src/Clompse/Providers/Hetzner.hs

@@ -13,12 +13,13 @@ 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)
+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
 
 
@@ -102,7 +103,7 @@ hetznerListServersWithFirewalls conn = do
 
 
 toServer :: Hetzner.Server -> Types.Server
-toServer Hetzner.Server {..} =
+toServer srv@Hetzner.Server {..} =
   Types.Server
     { Types._serverId = toServerId serverID
     , Types._serverName = Just serverName
@@ -114,6 +115,19 @@ toServer Hetzner.Server {..} =
     , 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)
     }
 
 

src/Clompse/Types.hs

@@ -13,6 +13,7 @@ import qualified Data.List.NonEmpty as NE
 import qualified Data.Text as T
 import qualified Data.Time as Time
 import GHC.Generics (Generic)
+import qualified Zamazingo.Net as Z.Net
 
 
 -- $setup
@@ -123,6 +124,7 @@ data Server = Server
   , _serverProvider :: !Provider
   , _serverRegion :: !T.Text
   , _serverType :: !(Maybe T.Text)
+  , _serverIpInfo :: !ServerIpInfo
   }
   deriving (Eq, Generic, Show)
   deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec Server)
@@ -145,3 +147,32 @@ instance ADC.HasCodec Server where
             <*> ADC.requiredField "provider" "Cloud provider." ADC..= _serverProvider
             <*> ADC.requiredField "region" "Region." ADC..= _serverRegion
             <*> ADC.optionalField "type" "Server type." ADC..= _serverType
+            <*> ADC.requiredField "ip_info" "Server IP addresses information." ADC..= _serverIpInfo
+
+
+-- | Server IP addresses information.
+data ServerIpInfo = ServerIpInfo
+  { _serverIpInfoStaticIpv4 :: ![Z.Net.IPv4]
+  , _serverIpInfoStaticIpv6 :: ![Z.Net.IPv6]
+  , _serverIpInfoPublicIpv4 :: ![Z.Net.IPv4]
+  , _serverIpInfoPublicIpv6 :: ![Z.Net.IPv6]
+  , _serverIpInfoPrivateIpv4 :: ![Z.Net.IPv4]
+  , _serverIpInfoPrivateIpv6 :: ![Z.Net.IPv6]
+  }
+  deriving (Eq, Generic, Show)
+  deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec ServerIpInfo)
+
+
+instance ADC.HasCodec ServerIpInfo where
+  codec =
+    _codec ADC.<?> "Server IP Addresses Information"
+    where
+      _codec =
+        ADC.object "ServerIpInfo" $
+          ServerIpInfo
+            <$> ADC.requiredField "static_ipv4" "Static IPv4 addresses." ADC..= _serverIpInfoStaticIpv4
+            <*> ADC.requiredField "static_ipv6" "Static IPv6 addresses." ADC..= _serverIpInfoStaticIpv6
+            <*> ADC.requiredField "public_ipv4" "Public IPv4 addresses." ADC..= _serverIpInfoPublicIpv4
+            <*> ADC.requiredField "public_ipv6" "Public IPv6 addresses." ADC..= _serverIpInfoPublicIpv6
+            <*> ADC.requiredField "private_ipv4" "Private IPv4 addresses." ADC..= _serverIpInfoPrivateIpv4
+            <*> ADC.requiredField "private_ipv6" "Private IPv6 addresses." ADC..= _serverIpInfoPrivateIpv6

src/Zamazingo/Net.hs

@@ -5,6 +5,7 @@ module Zamazingo.Net where
 
 import qualified Autodocodec as ADC
 import qualified Data.Aeson as Aeson
+import qualified Data.Text as T
 import qualified Net.IPv4
 import qualified Net.IPv6
 
@@ -24,6 +25,16 @@ instance ADC.HasCodec IPv4 where
       _codec = ADC.dimapCodec MkIPv4 _unIPv4 (ADC.codecViaAeson "_IPv4")
 
 
+ipv4FromText :: T.Text -> Maybe IPv4
+ipv4FromText =
+  fmap MkIPv4 . Net.IPv4.decodeString . T.unpack
+
+
+ipv4ToText :: IPv4 -> T.Text
+ipv4ToText =
+  T.pack . Net.IPv4.encodeString . _unIPv4
+
+
 newtype IPv6 = MkIPv6
   { _unIPv6 :: Net.IPv6.IPv6
   }
@@ -37,3 +48,13 @@ instance ADC.HasCodec IPv6 where
       _type = "IPv6"
       _docs = "An IPv6 address"
       _codec = ADC.dimapCodec MkIPv6 _unIPv6 (ADC.codecViaAeson "_IPv6")
+
+
+ipv6FromText :: T.Text -> Maybe IPv6
+ipv6FromText =
+  fmap MkIPv6 . Net.IPv6.decode
+
+
+ipv6ToText :: IPv6 -> T.Text
+ipv6ToText =
+  Net.IPv6.encode . _unIPv6