Prefer the UuidObject type class over specific functions
[ganeti-github.git] / src / Ganeti / Query / Network.hs
1 {-| Implementation of the Ganeti Query2 node group queries.
2
3 -}
4
5 {-
6
7 Copyright (C) 2012, 2013 Google Inc.
8 All rights reserved.
9
10 Redistribution and use in source and binary forms, with or without
11 modification, are permitted provided that the following conditions are
12 met:
13
14 1. Redistributions of source code must retain the above copyright notice,
15 this list of conditions and the following disclaimer.
16
17 2. Redistributions in binary form must reproduce the above copyright
18 notice, this list of conditions and the following disclaimer in the
19 documentation and/or other materials provided with the distribution.
20
21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
22 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
23 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
24 PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
25 CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
26 EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
27 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32
33 -}
34
35 module Ganeti.Query.Network
36 ( getGroupConnection
37 , getNetworkUuid
38 , instIsConnected
39 , fieldsMap
40 ) where
41
42 -- FIXME: everything except fieldsMap
43 -- is only exported for testing.
44
45 import qualified Data.Map as Map
46 import Data.Maybe (fromMaybe, mapMaybe)
47 import Data.List (find, intercalate)
48
49 import Ganeti.JSON
50 import Ganeti.Network
51 import Ganeti.Objects
52 import qualified Ganeti.Objects.BitArray as BA
53 import Ganeti.Query.Language
54 import Ganeti.Query.Common
55 import Ganeti.Query.Types
56 import Ganeti.Types
57
58 networkFields :: FieldList Network NoDataRuntime
59 networkFields =
60 [ (FieldDefinition "name" "Network" QFTText "Name",
61 FieldSimple (rsNormal . networkName), QffNormal)
62 , (FieldDefinition "network" "Subnet" QFTText "IPv4 subnet",
63 FieldSimple (rsNormal . networkNetwork), QffNormal)
64 , (FieldDefinition "gateway" "Gateway" QFTOther "IPv4 gateway",
65 FieldSimple (rsMaybeUnavail . networkGateway), QffNormal)
66 , (FieldDefinition "network6" "IPv6Subnet" QFTOther "IPv6 subnet",
67 FieldSimple (rsMaybeUnavail . networkNetwork6), QffNormal)
68 , (FieldDefinition "gateway6" "IPv6Gateway" QFTOther "IPv6 gateway",
69 FieldSimple (rsMaybeUnavail . networkGateway6), QffNormal)
70 , (FieldDefinition "mac_prefix" "MacPrefix" QFTOther "MAC address prefix",
71 FieldSimple (rsMaybeUnavail . networkMacPrefix), QffNormal)
72 , (FieldDefinition "free_count" "FreeCount" QFTNumber "Number of available\
73 \ addresses",
74 FieldSimple (rsNormal . getFreeCount),
75 QffNormal)
76 , (FieldDefinition "map" "Map" QFTText "Actual mapping",
77 FieldSimple (rsNormal . getMap),
78 QffNormal)
79 , (FieldDefinition "reserved_count" "ReservedCount" QFTNumber
80 "Number of reserved addresses",
81 FieldSimple (rsNormal . getReservedCount),
82 QffNormal)
83 , (FieldDefinition "group_list" "GroupList" QFTOther
84 "List of nodegroups (group name, NIC mode, NIC link)",
85 FieldConfig (\cfg -> rsNormal . getGroupConnections cfg . uuidOf),
86 QffNormal)
87 , (FieldDefinition "group_cnt" "NodeGroups" QFTNumber "Number of nodegroups",
88 FieldConfig (\cfg -> rsNormal . length . getGroupConnections cfg
89 . uuidOf), QffNormal)
90 , (FieldDefinition "inst_list" "InstanceList" QFTOther "List of instances",
91 FieldConfig (\cfg -> rsNormal . getInstances cfg . uuidOf),
92 QffNormal)
93 , (FieldDefinition "inst_cnt" "Instances" QFTNumber "Number of instances",
94 FieldConfig (\cfg -> rsNormal . length . getInstances cfg
95 . uuidOf), QffNormal)
96 , (FieldDefinition "external_reservations" "ExternalReservations" QFTText
97 "External reservations",
98 FieldSimple getExtReservationsString, QffNormal)
99 ] ++
100 timeStampFields ++
101 uuidFields "Network" ++
102 serialFields "Network" ++
103 tagsFields
104
105 -- | The group fields map.
106 fieldsMap :: FieldMap Network NoDataRuntime
107 fieldsMap = fieldListToFieldMap networkFields
108
109 -- TODO: the following fields are not implemented yet: external_reservations
110
111 -- | Given a network's UUID, this function lists all connections from
112 -- the network to nodegroups including the respective mode and links.
113 getGroupConnections ::
114 ConfigData -> String -> [(String, String, String, String)]
115 getGroupConnections cfg network_uuid =
116 mapMaybe (getGroupConnection network_uuid)
117 ((Map.elems . fromContainer . configNodegroups) cfg)
118
119 -- | Given a network's UUID and a node group, this function assembles
120 -- a tuple of the group's name, the mode and the link by which the
121 -- network is connected to the group. Returns 'Nothing' if the network
122 -- is not connected to the group.
123 getGroupConnection ::
124 String -> NodeGroup -> Maybe (String, String, String, String)
125 getGroupConnection network_uuid group =
126 let networks = fromContainer . groupNetworks $ group
127 in case Map.lookup network_uuid networks of
128 Nothing -> Nothing
129 Just net ->
130 Just (groupName group, getNicMode net, getNicLink net, getNicVlan net)
131
132 -- | Retrieves the network's mode and formats it human-readable,
133 -- also in case it is not available.
134 getNicMode :: PartialNicParams -> String
135 getNicMode nic_params =
136 maybe "-" nICModeToRaw $ nicpModeP nic_params
137
138 -- | Retrieves the network's vlan and formats it human-readable, also in
139 -- case it it not available.
140 getNicLink :: PartialNicParams -> String
141 getNicLink nic_params = fromMaybe "-" (nicpLinkP nic_params)
142
143 -- | Retrieves the network's link and formats it human-readable, also in
144 -- case it it not available.
145 getNicVlan :: PartialNicParams -> String
146 getNicVlan nic_params = fromMaybe "-" (nicpVlanP nic_params)
147
148 -- | Retrieves the network's instances' names.
149 getInstances :: ConfigData -> String -> [String]
150 getInstances cfg network_uuid =
151 mapMaybe instName (filter (instIsConnected network_uuid)
152 ((Map.elems . fromContainer . configInstances) cfg))
153
154 -- | Helper function that checks if an instance is linked to the given network.
155 instIsConnected :: String -> Instance -> Bool
156 instIsConnected network_uuid inst =
157 network_uuid `elem` mapMaybe nicNetwork (instNics inst)
158
159 -- | Helper function to look up a network's UUID by its name
160 getNetworkUuid :: ConfigData -> String -> Maybe String
161 getNetworkUuid cfg name =
162 let net = find (\n -> name == fromNonEmpty (networkName n))
163 ((Map.elems . fromContainer . configNetworks) cfg)
164 in fmap uuidOf net
165
166 -- | Computes the reservations list for a network.
167 --
168 -- This doesn't use the netmask for validation of the length, instead
169 -- simply iterating over the reservations.
170 getReservations :: Ip4Network -> Maybe AddressPool -> [Ip4Address]
171 getReservations _ Nothing = []
172 getReservations net (Just pool) =
173 map snd . filter fst
174 $ zip (BA.toList . apReservations $ pool)
175 (iterate nextIp4Address $ ip4BaseAddr net)
176
177 -- | Computes the external reservations as string for a network.
178 getExtReservationsString :: Network -> ResultEntry
179 getExtReservationsString net =
180 let addrs = getReservations (networkNetwork net)
181 (networkExtReservations net)
182 in rsNormal . intercalate ", " $ map show addrs