Merge pull request #42 from vst/14-add-firewall-information-to-servers

feat: attach firewall information to servers

package.yaml

@@ -19,6 +19,7 @@ library:
     - '-Wunused-packages'
   dependencies:
     - aeson
+    - aeson-combinators
     - amazonka
     - amazonka-core
     - amazonka-ec2

src/Clompse/Programs/ListServers.hs

@@ -116,6 +116,7 @@ data ServerListItem = ServerListItem
   , _serverListItemIPv6Static :: ![Z.Net.IPv6]
   , _serverListItemIPv6Public :: ![Z.Net.IPv6]
   , _serverListItemIPv6Private :: ![Z.Net.IPv6]
+  , _serverListItemFirewalls :: ![Types.Firewall]
   }
   deriving (Eq, Generic, Show)
   deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec ServerListItem)
@@ -145,6 +146,7 @@ instance ADC.HasCodec ServerListItem where
             <*> 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
+            <*> ADC.requiredField "firewalls" "Firewall configurations." ADC..= _serverListItemFirewalls
 
 
 instance Cassava.ToNamedRecord ServerListItem where
@@ -218,6 +220,7 @@ toServerList ListServersResult {..} =
         , _serverListItemIPv6Static = _serverIpInfoStaticIpv6 _serverIpInfo
         , _serverListItemIPv6Public = _serverIpInfoPublicIpv6 _serverIpInfo
         , _serverListItemIPv6Private = _serverIpInfoPrivateIpv6 _serverIpInfo
+        , _serverListItemFirewalls = _serverFirewalls
         }
 
 

src/Clompse/Providers/Aws/ApiAws.hs

@@ -28,7 +28,7 @@ import qualified Data.Conduit as C
 import qualified Data.Conduit.List as CL
 import qualified Data.HashMap.Strict as HM
 import qualified Data.List as List
-import Data.Maybe (fromMaybe, mapMaybe, maybeToList)
+import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList)
 import qualified Data.Text as T
 import qualified Data.Time as Time
 import qualified Zamazingo.Net as Z.Net
@@ -43,7 +43,7 @@ listServersEc2
   => AwsConnection
   -> m [Types.Server]
 listServersEc2 cfg = do
-  instances <- awsEc2ListAllInstances cfg
+  instances <- awsEc2ListAllInstancesWithSecurityGroups cfg
   pure (fmap ec2InstanceToServer instances)
 
 
@@ -202,19 +202,20 @@ awsEc2ListAllSecurityGroupsForRegion cfg reg = do
 
 -- -- *** Instances with Security Groups
 
--- awsEc2ListAllInstancesWithSecurityGroups
---   :: MonadIO m
---   => MonadError AwsError m
---   => AwsConnection
---   -> m [(Aws.Region, Aws.Ec2.Instance, [Aws.Ec2.SecurityGroup])]
--- awsEc2ListAllInstancesWithSecurityGroups cfg = do
---   instancesWithRegions <- awsEc2ListAllInstances cfg
---   securityGroups <- awsEc2ListAllSecurityGroups cfg
---   pure (fmap (\(r, i) -> (r, i, findSecurityGroups securityGroups i)) instancesWithRegions)
---   where
---     findSecurityGroups sgs i =
---       let sids = catMaybes $ foldMap (fmap (L.^. Aws.Ec2.Lens.groupIdentifier_groupId)) (i L.^. Aws.Ec2.Lens.instance_securityGroups)
---        in concatMap (\gi -> filter (\sg -> sg L.^. Aws.Ec2.Lens.securityGroup_groupId == gi) sgs) sids
+awsEc2ListAllInstancesWithSecurityGroups
+  :: MonadIO m
+  => MonadError AwsError m
+  => AwsConnection
+  -> m [(Aws.Region, Aws.Ec2.Instance, Maybe Int, Maybe Integer, Maybe Integer, [Aws.Ec2.SecurityGroup])]
+awsEc2ListAllInstancesWithSecurityGroups cfg = do
+  instancesWithRegions <- awsEc2ListAllInstances cfg
+  securityGroups <- awsEc2ListAllSecurityGroups cfg
+  pure (fmap (\(r, i, m1, m2, m3) -> (r, i, m1, m2, m3, findSecurityGroups securityGroups i)) instancesWithRegions)
+  where
+    findSecurityGroups sgs i =
+      let sids = catMaybes $ foldMap (fmap (L.^. Aws.Ec2.Lens.groupIdentifier_groupId)) (i L.^. Aws.Ec2.Lens.instance_securityGroups)
+       in concatMap (\gi -> filter (\sg -> sg L.^. Aws.Ec2.Lens.securityGroup_groupId == gi) sgs) sids
+
 
 -- ** S3 Buckets
 
@@ -239,8 +240,8 @@ awsListAllS3Buckets cfg = do
 -- ** Converters
 
 
-ec2InstanceToServer :: (Aws.Region, Aws.Ec2.Instance, Maybe Int, Maybe Integer, Maybe Integer) -> Types.Server
-ec2InstanceToServer (region, i@Aws.Ec2.Instance' {..}, mCpu, mRam, mDisks) =
+ec2InstanceToServer :: (Aws.Region, Aws.Ec2.Instance, Maybe Int, Maybe Integer, Maybe Integer, [Aws.Ec2.SecurityGroup]) -> Types.Server
+ec2InstanceToServer (region, i@Aws.Ec2.Instance' {..}, mCpu, mRam, mDisks, _sgs) =
   Types.Server
     { Types._serverId = instanceId
     , Types._serverName = awsEc2InstanceName i
@@ -253,9 +254,38 @@ ec2InstanceToServer (region, [email protected]' {..}, mCpu, mRam, mDisks) =
     , Types._serverRegion = Aws.fromRegion region
     , Types._serverType = Just (Aws.Ec2.fromInstanceType instanceType)
     , Types._serverIpInfo = ec2InstanceToServerIpInfo i
+    , Types._serverFirewalls = fmap toFirewall _sgs
     }
 
 
+toFirewall :: Aws.Ec2.SecurityGroup -> Types.Firewall
+toFirewall sgs =
+  let fid = sgs L.^. Aws.Ec2.Lens.securityGroup_groupId
+      name = sgs L.^. Aws.Ec2.Lens.securityGroup_groupName
+      inbound = fromMaybe [] $ sgs L.^. Aws.Ec2.Lens.securityGroup_ipPermissions
+      outbound = fromMaybe [] $ sgs L.^. Aws.Ec2.Lens.securityGroup_ipPermissionsEgress
+   in Types.Firewall
+        { _firewallId = fid
+        , _firewallName = Just name
+        , _firewallRulesInbound = fmap toFirewallRule inbound
+        , _firewallRulesOutbound = fmap toFirewallRule outbound
+        , _firewallCreatedAt = Nothing
+        }
+
+
+toFirewallRule :: Aws.Ec2.IpPermission -> Types.FirewallRule
+toFirewallRule ip =
+  let proto = ip L.^. Aws.Ec2.Lens.ipPermission_ipProtocol
+      fromPort = fromIntegral . fromMaybe 0 $ ip L.^. Aws.Ec2.Lens.ipPermission_fromPort
+      toPort = fromIntegral . fromMaybe 0 $ ip L.^. Aws.Ec2.Lens.ipPermission_toPort
+      ips = fromMaybe [] $ ip L.^. Aws.Ec2.Lens.ipPermission_ipRanges
+   in Types.FirewallRule
+        { _firewallRuleProtocol = proto
+        , _firewallRulePorts = [Types.FirewallRulePorts {_firewallRulePortsFrom = fromPort, _firewallRulePortsTo = toPort}]
+        , _firewallRuleEntities = fmap (L.^. Aws.Ec2.Lens.ipRange_cidrIp) ips
+        }
+
+
 ec2InstanceToServerState :: Aws.Ec2.Types.InstanceState -> Types.State
 ec2InstanceToServerState Aws.Ec2.Types.InstanceState' {..} =
   case name of

src/Clompse/Providers/Aws/ApiLightsail.hs

@@ -184,12 +184,38 @@ lightsailInstanceToServer region i =
       _serverRegion = Aws.fromRegion region
       _serverType = i L.^. Aws.Lightsail.Lens.instance_bundleId
       _serverIpInfo = lightsailInstanceToServerIpInfo i
+      _serverFirewalls = foldMap (fmap toFirewall) $ i L.^? Aws.Lightsail.Lens.instance_networking . L._Just . Aws.Lightsail.Lens.instanceNetworking_ports . L._Just
    in Types.Server {..}
   where
     _toInt16 :: Int -> Int16
     _toInt16 = fromIntegral
 
 
+toFirewall :: Aws.Lightsail.InstancePortInfo -> Types.Firewall
+toFirewall i =
+  let _firewallId = "#N/A"
+      _firewallName = Nothing
+      _firewallCreatedAt = Nothing
+      _isIn = case i L.^. Aws.Lightsail.Lens.instancePortInfo_accessDirection of
+        Just Aws.Lightsail.AccessDirection_Inbound -> True
+        Just Aws.Lightsail.AccessDirection_Outbound -> False
+        _ -> True
+      rule =
+        Types.FirewallRule
+          { _firewallRuleProtocol = maybe "#N/A" Aws.Data.toText (i L.^. Aws.Lightsail.Lens.instancePortInfo_protocol)
+          , _firewallRulePorts =
+              [ Types.FirewallRulePorts
+                  { _firewallRulePortsFrom = maybe 0 fromIntegral (i L.^. Aws.Lightsail.Lens.instancePortInfo_fromPort)
+                  , _firewallRulePortsTo = maybe 0 fromIntegral (i L.^. Aws.Lightsail.Lens.instancePortInfo_toPort)
+                  }
+              ]
+          , _firewallRuleEntities = fromMaybe [] (i L.^. Aws.Lightsail.Lens.instancePortInfo_cidrs) <> fromMaybe [] (i L.^. Aws.Lightsail.Lens.instancePortInfo_ipv6Cidrs)
+          }
+      _firewallRulesInbound = ([rule | _isIn])
+      _firewallRulesOutbound = ([rule | not _isIn])
+   in Types.Firewall {..}
+
+
 lightsailInstanceToServerState :: Aws.Lightsail.InstanceState -> Types.State
 lightsailInstanceToServerState i =
   case i L.^. Aws.Lightsail.Lens.instanceState_name of

src/Clompse/Providers/Do/Api.hs

@@ -15,11 +15,13 @@ import qualified Amazonka.S3.Lens as Aws.S3.Lens
 import qualified Autodocodec as ADC
 import Clompse.Providers.Do.Connection (DoConnection (..))
 import Clompse.Providers.Do.Error (DoError (..))
+import Clompse.Types (Firewall (_firewallRulesInbound))
 import qualified Clompse.Types as Types
 import qualified Control.Lens as L
 import Control.Monad.Except (MonadError (..))
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Combinators.Decode as ACD
 import Data.Int (Int16, Int32, Int64)
 import qualified Data.List as List
 import Data.Maybe (fromMaybe)
@@ -46,8 +48,14 @@ listServers
   => MonadError DoError m
   => DoConnection
   -> m [Types.Server]
-listServers conn =
-  fmap (fmap toServer) (apiListDroplets conn)
+listServers conn = do
+  droplets <- apiListDroplets conn
+  firewalls <- apiListFirewalls conn
+  let dropletsWithFirewalls = fmap (addFirewalls firewalls) droplets
+  pure $ fmap toServer dropletsWithFirewalls
+  where
+    addFirewalls firewalls droplet@DoDroplet {..} =
+      (droplet, filter (List.elem _doDropletId . _doFirewallDropletIds) firewalls)
 
 
 -- | Lists all DigitalOcean Spaces buckets available in the account
@@ -542,8 +550,8 @@ doctl DoConnection {..} args = do
 
 
 -- | Converts DigitalOcean Droplet to Clompse Server.
-toServer :: DoDroplet -> Types.Server
-toServer droplet@DoDroplet {..} =
+toServer :: (DoDroplet, [DoFirewall]) -> Types.Server
+toServer (droplet@DoDroplet {..}, fws) =
   Types.Server
     { _serverId = Z.Text.tshow _doDropletId
     , _serverName = Just _doDropletName
@@ -556,6 +564,7 @@ toServer droplet@DoDroplet {..} =
     , _serverRegion = _doRegionSlug _doDropletRegion
     , _serverType = Just _doDropletSizeSlug
     , _serverIpInfo = toServerIpInfo droplet
+    , _serverFirewalls = fmap toFirewall fws
     }
 
 
@@ -583,3 +592,42 @@ toServerState "active" = Types.StateRunning
 toServerState "off" = Types.StateStopped
 toServerState "archive" = Types.StateArchived
 toServerState _ = Types.StateUnknown
+
+
+-- | Converts a 'DoFirewall' to a 'Types.Firewall'.
+toFirewall :: DoFirewall -> Types.Firewall
+toFirewall DoFirewall {..} =
+  Types.Firewall
+    { _firewallId = _doFirewallId
+    , _firewallName = Just _doFirewallName
+    , _firewallRulesInbound = fmap toInboundRule _doFirewallInboundRules
+    , _firewallRulesOutbound = fmap toOutboundRule _doFirewallOutboundRules
+    , _firewallCreatedAt = Just _doFirewallCreatedAt
+    }
+
+
+-- | Converts a 'DoFirewallInboundRule' to a 'Types.FirewallRule'.
+toInboundRule :: DoFirewallInboundRule -> Types.FirewallRule
+toInboundRule DoFirewallInboundRule {..} =
+  Types.FirewallRule
+    { _firewallRuleProtocol = _doFirewallInboundRuleProtocol
+    , _firewallRulePorts = [mkFirewallPorts $ fmap (read . T.unpack) (T.split (== '-') _doFirewallInboundRulePorts)]
+    , _firewallRuleEntities = fromMaybe [] $ ACD.parseMaybe (ACD.key "addresses" (ACD.list ACD.text)) _doFirewallInboundRuleSources
+    }
+
+
+-- | Converts a 'DoFirewallOutboundRule' to a 'Types.FirewallRule'.
+toOutboundRule :: DoFirewallOutboundRule -> Types.FirewallRule
+toOutboundRule DoFirewallOutboundRule {..} =
+  Types.FirewallRule
+    { _firewallRuleProtocol = _doFirewallOutboundRuleProtocol
+    , _firewallRulePorts = [mkFirewallPorts $ fmap (read . T.unpack) (T.split (== '-') _doFirewallOutboundRulePorts)]
+    , _firewallRuleEntities = fromMaybe [] $ ACD.parseMaybe (ACD.key "addresses" (ACD.list ACD.text)) _doFirewallOutboundRuleDestinations
+    }
+
+
+-- | Converts a list of integers to a 'Types.FirewallRulePorts'.
+mkFirewallPorts :: [Int] -> Types.FirewallRulePorts
+mkFirewallPorts [p] = Types.FirewallRulePorts (fromIntegral p) (fromIntegral p)
+mkFirewallPorts [p1, p2] = Types.FirewallRulePorts (fromIntegral p1) (fromIntegral p2)
+mkFirewallPorts _ = Types.FirewallRulePorts 0 0

src/Clompse/Providers/Hetzner/Api.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
 -- | This module provides functions to query remote Hetzner API and
@@ -12,10 +13,13 @@ import Control.Monad.Except (MonadError)
 import Control.Monad.IO.Class (MonadIO)
 import Data.Int
 import qualified Data.List as List
+import qualified Data.List.NonEmpty as NE
 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 Net.IPv4
+import qualified Net.IPv6
 import qualified Zamazingo.Net as Z.Net
 import qualified Zamazingo.Text as Z.Text
 
@@ -30,8 +34,8 @@ listServers
   => MonadError HetznerError m
   => HetznerConnection
   -> m [Types.Server]
-listServers =
-  fmap (fmap toServer) . apiListServers
+listServers = do
+  fmap (fmap toServer) . apiListServersFirewalls
 
 
 -- * Helpers
@@ -90,21 +94,23 @@ apiListServersFirewalls conn = do
 
 
 -- | 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
-    }
+toServer :: (Hetzner.Server, [Hetzner.Firewall]) -> Types.Server
+toServer (srv@Hetzner.Server {..}, fws) =
+  let
+   in 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
+        , Types._serverFirewalls = fmap toFirewall fws
+        }
 
 
 -- | Extracts the IP information from a given Hetzner server.
@@ -156,3 +162,42 @@ toServerState Hetzner.Deleting = Types.StateTerminating
 toServerState Hetzner.Rebuilding = Types.StateRebuilding
 toServerState Hetzner.Migrating = Types.StateMigrating
 toServerState Hetzner.StatusUnknown = Types.StateUnknown
+
+
+-- | Converts a given Hetzner firewall to a Clompse firewall.
+toFirewall :: Hetzner.Firewall -> Types.Firewall
+toFirewall Hetzner.Firewall {..} =
+  Types.Firewall
+    { _firewallId = Z.Text.tshow (fwId firewallID)
+    , _firewallName = Just firewallName
+    , _firewallRulesInbound = fmap toFirewallRule (filter ((==) Hetzner.TrafficIn . Hetzner.firewallRuleDirection) firewallRules)
+    , _firewallRulesOutbound = fmap toFirewallRule (filter ((==) Hetzner.TrafficOut . Hetzner.firewallRuleDirection) firewallRules)
+    , _firewallCreatedAt = Just (Time.zonedTimeToUTC firewallCreated)
+    }
+  where
+    fwId (Hetzner.FirewallID x) = x
+
+
+-- | Converts a given Hetzner firewall rule to a Clompse firewall
+-- rule.
+toFirewallRule :: Hetzner.FirewallRule -> Types.FirewallRule
+toFirewallRule Hetzner.FirewallRule {..} =
+  Types.FirewallRule
+    { _firewallRuleProtocol = protocol
+    , _firewallRulePorts = ports
+    , _firewallRuleEntities = entities
+    }
+  where
+    protocol = case firewallRuleProtocol of
+      Hetzner.FirewallRuleTCP _ -> "tcp"
+      Hetzner.FirewallRuleUDP _ -> "udp"
+      Hetzner.FirewallRuleICMP -> "icmp"
+      Hetzner.FirewallRuleESP -> "esp"
+      Hetzner.FirewallRuleGRE -> "gre"
+    entities = NE.toList $ fmap (either Net.IPv4.encodeRange Net.IPv6.encodeRange) firewallRuleIPs
+    ports = case firewallRuleProtocol of
+      Hetzner.FirewallRuleTCP (Hetzner.PortRange f t) ->
+        [Types.FirewallRulePorts {_firewallRulePortsFrom = fromIntegral f, _firewallRulePortsTo = fromIntegral t}]
+      Hetzner.FirewallRuleUDP (Hetzner.PortRange f t) ->
+        [Types.FirewallRulePorts {_firewallRulePortsFrom = fromIntegral f, _firewallRulePortsTo = fromIntegral t}]
+      _ -> []