Statistics
| Branch: | Tag: | Revision:

root / test / hs / Test / Ganeti / OpCodes.hs @ 93f1e606

History | View | Annotate | Download (30.2 kB)

1 aed2325f Iustin Pop
{-# LANGUAGE TemplateHaskell #-}
2 aed2325f Iustin Pop
{-# OPTIONS_GHC -fno-warn-orphans #-}
3 aed2325f Iustin Pop
4 aed2325f Iustin Pop
{-| Unittests for ganeti-htools.
5 aed2325f Iustin Pop
6 aed2325f Iustin Pop
-}
7 aed2325f Iustin Pop
8 aed2325f Iustin Pop
{-
9 aed2325f Iustin Pop
10 72747d91 Iustin Pop
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
11 aed2325f Iustin Pop
12 aed2325f Iustin Pop
This program is free software; you can redistribute it and/or modify
13 aed2325f Iustin Pop
it under the terms of the GNU General Public License as published by
14 aed2325f Iustin Pop
the Free Software Foundation; either version 2 of the License, or
15 aed2325f Iustin Pop
(at your option) any later version.
16 aed2325f Iustin Pop
17 aed2325f Iustin Pop
This program is distributed in the hope that it will be useful, but
18 aed2325f Iustin Pop
WITHOUT ANY WARRANTY; without even the implied warranty of
19 aed2325f Iustin Pop
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
20 aed2325f Iustin Pop
General Public License for more details.
21 aed2325f Iustin Pop
22 aed2325f Iustin Pop
You should have received a copy of the GNU General Public License
23 aed2325f Iustin Pop
along with this program; if not, write to the Free Software
24 aed2325f Iustin Pop
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
25 aed2325f Iustin Pop
02110-1301, USA.
26 aed2325f Iustin Pop
27 aed2325f Iustin Pop
-}
28 aed2325f Iustin Pop
29 aed2325f Iustin Pop
module Test.Ganeti.OpCodes
30 aed2325f Iustin Pop
  ( testOpCodes
31 aed2325f Iustin Pop
  , OpCodes.OpCode(..)
32 aed2325f Iustin Pop
  ) where
33 aed2325f Iustin Pop
34 f56013fd Iustin Pop
import Test.HUnit as HUnit
35 f56013fd Iustin Pop
import Test.QuickCheck as QuickCheck
36 aed2325f Iustin Pop
37 aed2325f Iustin Pop
import Control.Applicative
38 dc4b5c42 Iustin Pop
import Control.Monad
39 dc4b5c42 Iustin Pop
import Data.Char
40 aed2325f Iustin Pop
import Data.List
41 c66f09f5 Iustin Pop
import qualified Data.Map as Map
42 aed2325f Iustin Pop
import qualified Text.JSON as J
43 8d239fa4 Iustin Pop
import Text.Printf (printf)
44 aed2325f Iustin Pop
45 aed2325f Iustin Pop
import Test.Ganeti.TestHelper
46 aed2325f Iustin Pop
import Test.Ganeti.TestCommon
47 c7d249d0 Iustin Pop
import Test.Ganeti.Types ()
48 6e94b75c Jose A. Lopes
import Test.Ganeti.Query.Language ()
49 aed2325f Iustin Pop
50 f56013fd Iustin Pop
import Ganeti.BasicTypes
51 aed2325f Iustin Pop
import qualified Ganeti.Constants as C
52 aed2325f Iustin Pop
import qualified Ganeti.OpCodes as OpCodes
53 c7d249d0 Iustin Pop
import Ganeti.Types
54 c7d249d0 Iustin Pop
import Ganeti.OpParams
55 c66f09f5 Iustin Pop
import Ganeti.JSON
56 aed2325f Iustin Pop
57 5b11f8db Iustin Pop
{-# ANN module "HLint: ignore Use camelCase" #-}
58 5b11f8db Iustin Pop
59 aed2325f Iustin Pop
-- * Arbitrary instances
60 aed2325f Iustin Pop
61 de36f091 Jose A. Lopes
instance (Ord k, Arbitrary k, Arbitrary a) => Arbitrary (Map.Map k a) where
62 de36f091 Jose A. Lopes
  arbitrary = Map.fromList <$> arbitrary
63 367c4241 Dato Simó
64 6e94b75c Jose A. Lopes
arbitraryOpTagsGet :: Gen OpCodes.OpCode
65 6e94b75c Jose A. Lopes
arbitraryOpTagsGet = do
66 6e94b75c Jose A. Lopes
  kind <- arbitrary
67 6e94b75c Jose A. Lopes
  OpCodes.OpTagsSet kind <$> arbitrary <*> genOpCodesTagName kind
68 6e94b75c Jose A. Lopes
69 6e94b75c Jose A. Lopes
arbitraryOpTagsSet :: Gen OpCodes.OpCode
70 6e94b75c Jose A. Lopes
arbitraryOpTagsSet = do
71 6e94b75c Jose A. Lopes
  kind <- arbitrary
72 6e94b75c Jose A. Lopes
  OpCodes.OpTagsSet kind <$> genTags <*> genOpCodesTagName kind
73 6e94b75c Jose A. Lopes
74 6e94b75c Jose A. Lopes
arbitraryOpTagsDel :: Gen OpCodes.OpCode
75 6e94b75c Jose A. Lopes
arbitraryOpTagsDel = do
76 6e94b75c Jose A. Lopes
  kind <- arbitrary
77 6e94b75c Jose A. Lopes
  OpCodes.OpTagsDel kind <$> genTags <*> genOpCodesTagName kind
78 6e94b75c Jose A. Lopes
79 7022db83 Iustin Pop
$(genArbitrary ''OpCodes.ReplaceDisksMode)
80 aed2325f Iustin Pop
81 6d558717 Iustin Pop
$(genArbitrary ''DiskAccess)
82 6d558717 Iustin Pop
83 f198cf91 Thomas Thrainer
$(genArbitrary ''ImportExportCompression)
84 f198cf91 Thomas Thrainer
85 aed2325f Iustin Pop
instance Arbitrary OpCodes.DiskIndex where
86 aed2325f Iustin Pop
  arbitrary = choose (0, C.maxDisks - 1) >>= OpCodes.mkDiskIndex
87 aed2325f Iustin Pop
88 5ef4fbb1 Iustin Pop
instance Arbitrary INicParams where
89 5006418e Iustin Pop
  arbitrary = INicParams <$> genMaybe genNameNE <*> genMaybe genName <*>
90 6e94b75c Jose A. Lopes
              genMaybe genNameNE <*> genMaybe genNameNE <*>
91 7295a6dc Hrvoje Ribicic
              genMaybe genNameNE <*> genMaybe genName <*>
92 6e94b75c Jose A. Lopes
              genMaybe genNameNE
93 c66f09f5 Iustin Pop
94 6d558717 Iustin Pop
instance Arbitrary IDiskParams where
95 6d558717 Iustin Pop
  arbitrary = IDiskParams <$> arbitrary <*> arbitrary <*>
96 5006418e Iustin Pop
              genMaybe genNameNE <*> genMaybe genNameNE <*>
97 2ca1b52d Klaus Aehlig
              genMaybe genNameNE <*> genMaybe genNameNE <*>
98 2e09344f Klaus Aehlig
              genMaybe genNameNE <*> arbitrary <*> genAndRestArguments
99 6d558717 Iustin Pop
100 c2d3219b Iustin Pop
instance Arbitrary RecreateDisksInfo where
101 c2d3219b Iustin Pop
  arbitrary = oneof [ pure RecreateDisksAll
102 c2d3219b Iustin Pop
                    , RecreateDisksIndices <$> arbitrary
103 c2d3219b Iustin Pop
                    , RecreateDisksParams <$> arbitrary
104 c2d3219b Iustin Pop
                    ]
105 c2d3219b Iustin Pop
106 c2d3219b Iustin Pop
instance Arbitrary DdmOldChanges where
107 c2d3219b Iustin Pop
  arbitrary = oneof [ DdmOldIndex <$> arbitrary
108 c2d3219b Iustin Pop
                    , DdmOldMod   <$> arbitrary
109 c2d3219b Iustin Pop
                    ]
110 c2d3219b Iustin Pop
111 c2d3219b Iustin Pop
instance (Arbitrary a) => Arbitrary (SetParamsMods a) where
112 c2d3219b Iustin Pop
  arbitrary = oneof [ pure SetParamsEmpty
113 c2d3219b Iustin Pop
                    , SetParamsDeprecated <$> arbitrary
114 c2d3219b Iustin Pop
                    , SetParamsNew        <$> arbitrary
115 c2d3219b Iustin Pop
                    ]
116 c2d3219b Iustin Pop
117 398e9066 Iustin Pop
instance Arbitrary ExportTarget where
118 398e9066 Iustin Pop
  arbitrary = oneof [ ExportTargetLocal <$> genNodeNameNE
119 398e9066 Iustin Pop
                    , ExportTargetRemote <$> pure []
120 398e9066 Iustin Pop
                    ]
121 398e9066 Iustin Pop
122 aed2325f Iustin Pop
instance Arbitrary OpCodes.OpCode where
123 aed2325f Iustin Pop
  arbitrary = do
124 aed2325f Iustin Pop
    op_id <- elements OpCodes.allOpIDs
125 aed2325f Iustin Pop
    case op_id of
126 aed2325f Iustin Pop
      "OP_TEST_DELAY" ->
127 7d421386 Iustin Pop
        OpCodes.OpTestDelay <$> arbitrary <*> arbitrary <*>
128 1c3231aa Thomas Thrainer
          genNodeNamesNE <*> return Nothing <*> arbitrary
129 aed2325f Iustin Pop
      "OP_INSTANCE_REPLACE_DISKS" ->
130 da4a52a3 Thomas Thrainer
        OpCodes.OpInstanceReplaceDisks <$> genFQDN <*> return Nothing <*>
131 da4a52a3 Thomas Thrainer
          arbitrary <*> arbitrary <*> arbitrary <*> genDiskIndices <*>
132 1c3231aa Thomas Thrainer
          genMaybe genNodeNameNE <*> return Nothing <*> genMaybe genNameNE
133 aed2325f Iustin Pop
      "OP_INSTANCE_FAILOVER" ->
134 da4a52a3 Thomas Thrainer
        OpCodes.OpInstanceFailover <$> genFQDN <*> return Nothing <*>
135 da4a52a3 Thomas Thrainer
        arbitrary <*> arbitrary <*> genMaybe genNodeNameNE <*>
136 1ca326c8 Thomas Thrainer
        return Nothing <*> arbitrary <*> arbitrary <*> genMaybe genNameNE
137 aed2325f Iustin Pop
      "OP_INSTANCE_MIGRATE" ->
138 da4a52a3 Thomas Thrainer
        OpCodes.OpInstanceMigrate <$> genFQDN <*> return Nothing <*>
139 da4a52a3 Thomas Thrainer
          arbitrary <*> arbitrary <*> genMaybe genNodeNameNE <*>
140 da4a52a3 Thomas Thrainer
          return Nothing <*> arbitrary <*> arbitrary <*> arbitrary <*>
141 da4a52a3 Thomas Thrainer
          genMaybe genNameNE <*> arbitrary
142 a451dae2 Iustin Pop
      "OP_TAGS_GET" ->
143 6e94b75c Jose A. Lopes
        arbitraryOpTagsGet
144 a451dae2 Iustin Pop
      "OP_TAGS_SEARCH" ->
145 a451dae2 Iustin Pop
        OpCodes.OpTagsSearch <$> genNameNE
146 3bebda52 Dato Simó
      "OP_TAGS_SET" ->
147 6e94b75c Jose A. Lopes
        arbitraryOpTagsSet
148 3bebda52 Dato Simó
      "OP_TAGS_DEL" ->
149 6e94b75c Jose A. Lopes
        arbitraryOpTagsDel
150 c66f09f5 Iustin Pop
      "OP_CLUSTER_POST_INIT" -> pure OpCodes.OpClusterPostInit
151 b3cc1646 Helga Velroyen
      "OP_CLUSTER_RENEW_CRYPTO" -> pure OpCodes.OpClusterRenewCrypto
152 c66f09f5 Iustin Pop
      "OP_CLUSTER_DESTROY" -> pure OpCodes.OpClusterDestroy
153 c66f09f5 Iustin Pop
      "OP_CLUSTER_QUERY" -> pure OpCodes.OpClusterQuery
154 c66f09f5 Iustin Pop
      "OP_CLUSTER_VERIFY" ->
155 c66f09f5 Iustin Pop
        OpCodes.OpClusterVerify <$> arbitrary <*> arbitrary <*>
156 4651c69f Jose A. Lopes
          genListSet Nothing <*> genListSet Nothing <*> arbitrary <*>
157 5006418e Iustin Pop
          genMaybe genNameNE
158 c66f09f5 Iustin Pop
      "OP_CLUSTER_VERIFY_CONFIG" ->
159 c66f09f5 Iustin Pop
        OpCodes.OpClusterVerifyConfig <$> arbitrary <*> arbitrary <*>
160 4651c69f Jose A. Lopes
          genListSet Nothing <*> arbitrary
161 c66f09f5 Iustin Pop
      "OP_CLUSTER_VERIFY_GROUP" ->
162 5ef4fbb1 Iustin Pop
        OpCodes.OpClusterVerifyGroup <$> genNameNE <*> arbitrary <*>
163 4651c69f Jose A. Lopes
          arbitrary <*> genListSet Nothing <*> genListSet Nothing <*> arbitrary
164 c66f09f5 Iustin Pop
      "OP_CLUSTER_VERIFY_DISKS" -> pure OpCodes.OpClusterVerifyDisks
165 c66f09f5 Iustin Pop
      "OP_GROUP_VERIFY_DISKS" ->
166 5ef4fbb1 Iustin Pop
        OpCodes.OpGroupVerifyDisks <$> genNameNE
167 c66f09f5 Iustin Pop
      "OP_CLUSTER_REPAIR_DISK_SIZES" ->
168 5006418e Iustin Pop
        OpCodes.OpClusterRepairDiskSizes <$> genNodeNamesNE
169 c66f09f5 Iustin Pop
      "OP_CLUSTER_CONFIG_QUERY" ->
170 5ef4fbb1 Iustin Pop
        OpCodes.OpClusterConfigQuery <$> genFieldsNE
171 c66f09f5 Iustin Pop
      "OP_CLUSTER_RENAME" ->
172 5006418e Iustin Pop
        OpCodes.OpClusterRename <$> genNameNE
173 c66f09f5 Iustin Pop
      "OP_CLUSTER_SET_PARAMS" ->
174 07e3c124 Santi Raffa
        OpCodes.OpClusterSetParams
175 07e3c124 Santi Raffa
          <$> arbitrary                    -- force
176 07e3c124 Santi Raffa
          <*> emptyMUD                     -- hv_state
177 07e3c124 Santi Raffa
          <*> emptyMUD                     -- disk_state
178 07e3c124 Santi Raffa
          <*> arbitrary                    -- vg_name
179 07e3c124 Santi Raffa
          <*> genMaybe arbitrary           -- enabled_hypervisors
180 07e3c124 Santi Raffa
          <*> genMaybe genEmptyContainer   -- hvparams
181 07e3c124 Santi Raffa
          <*> emptyMUD                     -- beparams
182 07e3c124 Santi Raffa
          <*> genMaybe genEmptyContainer   -- os_hvp
183 07e3c124 Santi Raffa
          <*> genMaybe genEmptyContainer   -- osparams
184 07e3c124 Santi Raffa
          <*> genMaybe genEmptyContainer   -- osparams_private_cluster
185 07e3c124 Santi Raffa
          <*> genMaybe genEmptyContainer   -- diskparams
186 07e3c124 Santi Raffa
          <*> genMaybe arbitrary           -- candidate_pool_size
187 07e3c124 Santi Raffa
          <*> genMaybe arbitrary           -- max_running_jobs
188 07e3c124 Santi Raffa
          <*> arbitrary                    -- uid_pool
189 07e3c124 Santi Raffa
          <*> arbitrary                    -- add_uids
190 07e3c124 Santi Raffa
          <*> arbitrary                    -- remove_uids
191 07e3c124 Santi Raffa
          <*> arbitrary                    -- maintain_node_health
192 07e3c124 Santi Raffa
          <*> arbitrary                    -- prealloc_wipe_disks
193 07e3c124 Santi Raffa
          <*> arbitrary                    -- nicparams
194 07e3c124 Santi Raffa
          <*> emptyMUD                     -- ndparams
195 07e3c124 Santi Raffa
          <*> emptyMUD                     -- ipolicy
196 07e3c124 Santi Raffa
          <*> arbitrary                    -- drbd_helper
197 07e3c124 Santi Raffa
          <*> arbitrary                    -- default_iallocator
198 07e3c124 Santi Raffa
          <*> emptyMUD                     -- default_iallocator_params
199 07e3c124 Santi Raffa
          <*> arbitrary                    -- master_netdev
200 07e3c124 Santi Raffa
          <*> arbitrary                    -- master_netmask
201 07e3c124 Santi Raffa
          <*> arbitrary                    -- reserved_lvs
202 07e3c124 Santi Raffa
          <*> arbitrary                    -- hidden_os
203 07e3c124 Santi Raffa
          <*> arbitrary                    -- blacklisted_os
204 07e3c124 Santi Raffa
          <*> arbitrary                    -- use_external_mip_script
205 07e3c124 Santi Raffa
          <*> arbitrary                    -- enabled_disk_templates
206 07e3c124 Santi Raffa
          <*> arbitrary                    -- modify_etc_hosts
207 07e3c124 Santi Raffa
          <*> genMaybe genName             -- file_storage_dir
208 07e3c124 Santi Raffa
          <*> genMaybe genName             -- shared_file_storage_dir
209 07e3c124 Santi Raffa
          <*> genMaybe genName             -- gluster_file_storage_dir
210 42fda604 Jose A. Lopes
          <*> arbitrary                    -- instance_communication_network
211 c66f09f5 Iustin Pop
      "OP_CLUSTER_REDIST_CONF" -> pure OpCodes.OpClusterRedistConf
212 c66f09f5 Iustin Pop
      "OP_CLUSTER_ACTIVATE_MASTER_IP" ->
213 c66f09f5 Iustin Pop
        pure OpCodes.OpClusterActivateMasterIp
214 c66f09f5 Iustin Pop
      "OP_CLUSTER_DEACTIVATE_MASTER_IP" ->
215 c66f09f5 Iustin Pop
        pure OpCodes.OpClusterDeactivateMasterIp
216 c66f09f5 Iustin Pop
      "OP_QUERY" ->
217 6e94b75c Jose A. Lopes
        OpCodes.OpQuery <$> arbitrary <*> arbitrary <*> arbitrary <*>
218 6e94b75c Jose A. Lopes
        pure Nothing
219 c66f09f5 Iustin Pop
      "OP_QUERY_FIELDS" ->
220 c66f09f5 Iustin Pop
        OpCodes.OpQueryFields <$> arbitrary <*> arbitrary
221 c66f09f5 Iustin Pop
      "OP_OOB_COMMAND" ->
222 1c3231aa Thomas Thrainer
        OpCodes.OpOobCommand <$> genNodeNamesNE <*> return Nothing <*>
223 1c3231aa Thomas Thrainer
          arbitrary <*> arbitrary <*> arbitrary <*>
224 1c3231aa Thomas Thrainer
          (arbitrary `suchThat` (>0))
225 1c3231aa Thomas Thrainer
      "OP_NODE_REMOVE" ->
226 1c3231aa Thomas Thrainer
        OpCodes.OpNodeRemove <$> genNodeNameNE <*> return Nothing
227 c66f09f5 Iustin Pop
      "OP_NODE_ADD" ->
228 5ef4fbb1 Iustin Pop
        OpCodes.OpNodeAdd <$> genNodeNameNE <*> emptyMUD <*> emptyMUD <*>
229 5cbf7832 Jose A. Lopes
          genMaybe genNameNE <*> genMaybe genNameNE <*> arbitrary <*>
230 5006418e Iustin Pop
          genMaybe genNameNE <*> arbitrary <*> arbitrary <*> emptyMUD
231 c66f09f5 Iustin Pop
      "OP_NODE_QUERYVOLS" ->
232 c66f09f5 Iustin Pop
        OpCodes.OpNodeQueryvols <$> arbitrary <*> genNodeNamesNE
233 c66f09f5 Iustin Pop
      "OP_NODE_QUERY_STORAGE" ->
234 c66f09f5 Iustin Pop
        OpCodes.OpNodeQueryStorage <$> arbitrary <*> arbitrary <*>
235 6e94b75c Jose A. Lopes
          genNodeNamesNE <*> genMaybe genNameNE
236 c66f09f5 Iustin Pop
      "OP_NODE_MODIFY_STORAGE" ->
237 1c3231aa Thomas Thrainer
        OpCodes.OpNodeModifyStorage <$> genNodeNameNE <*> return Nothing <*>
238 6e94b75c Jose A. Lopes
          arbitrary <*> genMaybe genNameNE <*> pure emptyJSObject
239 c66f09f5 Iustin Pop
      "OP_REPAIR_NODE_STORAGE" ->
240 1c3231aa Thomas Thrainer
        OpCodes.OpRepairNodeStorage <$> genNodeNameNE <*> return Nothing <*>
241 6e94b75c Jose A. Lopes
          arbitrary <*> genMaybe genNameNE <*> arbitrary
242 c66f09f5 Iustin Pop
      "OP_NODE_SET_PARAMS" ->
243 1c3231aa Thomas Thrainer
        OpCodes.OpNodeSetParams <$> genNodeNameNE <*> return Nothing <*>
244 1c3231aa Thomas Thrainer
          arbitrary <*> emptyMUD <*> emptyMUD <*> arbitrary <*> arbitrary <*>
245 1c3231aa Thomas Thrainer
          arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
246 1c3231aa Thomas Thrainer
          genMaybe genNameNE <*> emptyMUD <*> arbitrary
247 c66f09f5 Iustin Pop
      "OP_NODE_POWERCYCLE" ->
248 1c3231aa Thomas Thrainer
        OpCodes.OpNodePowercycle <$> genNodeNameNE <*> return Nothing <*>
249 1c3231aa Thomas Thrainer
          arbitrary
250 c66f09f5 Iustin Pop
      "OP_NODE_MIGRATE" ->
251 1c3231aa Thomas Thrainer
        OpCodes.OpNodeMigrate <$> genNodeNameNE <*> return Nothing <*>
252 1c3231aa Thomas Thrainer
          arbitrary <*> arbitrary <*> genMaybe genNodeNameNE <*>
253 1c3231aa Thomas Thrainer
          return Nothing <*> arbitrary <*> arbitrary <*> genMaybe genNameNE
254 c66f09f5 Iustin Pop
      "OP_NODE_EVACUATE" ->
255 c66f09f5 Iustin Pop
        OpCodes.OpNodeEvacuate <$> arbitrary <*> genNodeNameNE <*>
256 1c3231aa Thomas Thrainer
          return Nothing <*> genMaybe genNodeNameNE <*> return Nothing <*>
257 1c3231aa Thomas Thrainer
          genMaybe genNameNE <*> arbitrary
258 6d558717 Iustin Pop
      "OP_INSTANCE_CREATE" ->
259 6bce7ba2 Santi Raffa
        OpCodes.OpInstanceCreate
260 6bce7ba2 Santi Raffa
          <$> genFQDN                         -- instance_name
261 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- force_variant
262 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- wait_for_sync
263 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- name_check
264 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- ignore_ipolicy
265 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- opportunistic_locking
266 6bce7ba2 Santi Raffa
          <*> pure emptyJSObject              -- beparams
267 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- disks
268 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- disk_template
269 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- file_driver
270 6bce7ba2 Santi Raffa
          <*> genMaybe genNameNE              -- file_storage_dir
271 6bce7ba2 Santi Raffa
          <*> pure emptyJSObject              -- hvparams
272 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- hypervisor
273 6bce7ba2 Santi Raffa
          <*> genMaybe genNameNE              -- iallocator
274 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- identify_defaults
275 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- ip_check
276 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- conflicts_check
277 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- mode
278 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- nics
279 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- no_install
280 6bce7ba2 Santi Raffa
          <*> pure emptyJSObject              -- osparams
281 6bce7ba2 Santi Raffa
          <*> genMaybe arbitraryPrivateJSObj  -- osparams_private
282 6bce7ba2 Santi Raffa
          <*> genMaybe arbitraryPrivateJSObj  -- osparams_secret
283 6bce7ba2 Santi Raffa
          <*> genMaybe genNameNE              -- os_type
284 6bce7ba2 Santi Raffa
          <*> genMaybe genNodeNameNE          -- pnode
285 6bce7ba2 Santi Raffa
          <*> return Nothing                  -- pnode_uuid
286 6bce7ba2 Santi Raffa
          <*> genMaybe genNodeNameNE          -- snode
287 6bce7ba2 Santi Raffa
          <*> return Nothing                  -- snode_uuid
288 6bce7ba2 Santi Raffa
          <*> genMaybe (pure [])              -- source_handshake
289 6bce7ba2 Santi Raffa
          <*> genMaybe genNodeNameNE          -- source_instance_name
290 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- source_shutdown_timeout
291 6bce7ba2 Santi Raffa
          <*> genMaybe genNodeNameNE          -- source_x509_ca
292 6bce7ba2 Santi Raffa
          <*> return Nothing                  -- src_node
293 6bce7ba2 Santi Raffa
          <*> genMaybe genNodeNameNE          -- src_node_uuid
294 6bce7ba2 Santi Raffa
          <*> genMaybe genNameNE              -- src_path
295 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- compress
296 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- start
297 6bce7ba2 Santi Raffa
          <*> (genTags >>= mapM mkNonEmpty)   -- tags
298 6bce7ba2 Santi Raffa
          <*> arbitrary                       -- instance_communication
299 c2d3219b Iustin Pop
      "OP_INSTANCE_MULTI_ALLOC" ->
300 6e94b75c Jose A. Lopes
        OpCodes.OpInstanceMultiAlloc <$> arbitrary <*> genMaybe genNameNE <*>
301 6e94b75c Jose A. Lopes
        pure []
302 c2d3219b Iustin Pop
      "OP_INSTANCE_REINSTALL" ->
303 da4a52a3 Thomas Thrainer
        OpCodes.OpInstanceReinstall <$> genFQDN <*> return Nothing <*>
304 da4a52a3 Thomas Thrainer
          arbitrary <*> genMaybe genNameNE <*> genMaybe (pure emptyJSObject)
305 da0aa302 Santi Raffa
          <*> genMaybe arbitraryPrivateJSObj <*> genMaybe arbitraryPrivateJSObj
306 c2d3219b Iustin Pop
      "OP_INSTANCE_REMOVE" ->
307 da4a52a3 Thomas Thrainer
        OpCodes.OpInstanceRemove <$> genFQDN <*> return Nothing <*>
308 c2d3219b Iustin Pop
          arbitrary <*> arbitrary
309 da4a52a3 Thomas Thrainer
      "OP_INSTANCE_RENAME" ->
310 da4a52a3 Thomas Thrainer
        OpCodes.OpInstanceRename <$> genFQDN <*> return Nothing <*>
311 da4a52a3 Thomas Thrainer
          genNodeNameNE <*> arbitrary <*> arbitrary
312 c2d3219b Iustin Pop
      "OP_INSTANCE_STARTUP" ->
313 da4a52a3 Thomas Thrainer
        OpCodes.OpInstanceStartup <$> genFQDN <*> return Nothing <*>
314 da4a52a3 Thomas Thrainer
          arbitrary <*> arbitrary <*> pure emptyJSObject <*>
315 da4a52a3 Thomas Thrainer
          pure emptyJSObject <*> arbitrary <*> arbitrary
316 c2d3219b Iustin Pop
      "OP_INSTANCE_SHUTDOWN" ->
317 da4a52a3 Thomas Thrainer
        OpCodes.OpInstanceShutdown <$> genFQDN <*> return Nothing <*>
318 da4a52a3 Thomas Thrainer
          arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
319 c2d3219b Iustin Pop
      "OP_INSTANCE_REBOOT" ->
320 da4a52a3 Thomas Thrainer
        OpCodes.OpInstanceReboot <$> genFQDN <*> return Nothing <*>
321 da4a52a3 Thomas Thrainer
          arbitrary <*> arbitrary <*> arbitrary
322 c2d3219b Iustin Pop
      "OP_INSTANCE_MOVE" ->
323 da4a52a3 Thomas Thrainer
        OpCodes.OpInstanceMove <$> genFQDN <*> return Nothing <*>
324 da4a52a3 Thomas Thrainer
          arbitrary <*> arbitrary <*> genNodeNameNE <*> return Nothing <*>
325 f198cf91 Thomas Thrainer
          arbitrary <*> arbitrary
326 da4a52a3 Thomas Thrainer
      "OP_INSTANCE_CONSOLE" -> OpCodes.OpInstanceConsole <$> genFQDN <*>
327 da4a52a3 Thomas Thrainer
          return Nothing
328 c2d3219b Iustin Pop
      "OP_INSTANCE_ACTIVATE_DISKS" ->
329 da4a52a3 Thomas Thrainer
        OpCodes.OpInstanceActivateDisks <$> genFQDN <*> return Nothing <*>
330 c2d3219b Iustin Pop
          arbitrary <*> arbitrary
331 c2d3219b Iustin Pop
      "OP_INSTANCE_DEACTIVATE_DISKS" ->
332 da4a52a3 Thomas Thrainer
        OpCodes.OpInstanceDeactivateDisks <$> genFQDN <*> return Nothing <*>
333 da4a52a3 Thomas Thrainer
          arbitrary
334 c2d3219b Iustin Pop
      "OP_INSTANCE_RECREATE_DISKS" ->
335 da4a52a3 Thomas Thrainer
        OpCodes.OpInstanceRecreateDisks <$> genFQDN <*> return Nothing <*>
336 da4a52a3 Thomas Thrainer
          arbitrary <*> genNodeNamesNE <*> return Nothing <*>
337 da4a52a3 Thomas Thrainer
          genMaybe genNameNE
338 c2d3219b Iustin Pop
      "OP_INSTANCE_QUERY_DATA" ->
339 c2d3219b Iustin Pop
        OpCodes.OpInstanceQueryData <$> arbitrary <*>
340 c2d3219b Iustin Pop
          genNodeNamesNE <*> arbitrary
341 c2d3219b Iustin Pop
      "OP_INSTANCE_SET_PARAMS" ->
342 1a182390 Santi Raffa
        OpCodes.OpInstanceSetParams
343 1a182390 Santi Raffa
          <$> genFQDN                         -- instance_name
344 1a182390 Santi Raffa
          <*> return Nothing                  -- instance_uuid
345 1a182390 Santi Raffa
          <*> arbitrary                       -- force
346 1a182390 Santi Raffa
          <*> arbitrary                       -- force_variant
347 1a182390 Santi Raffa
          <*> arbitrary                       -- ignore_ipolicy
348 1a182390 Santi Raffa
          <*> arbitrary                       -- nics
349 1a182390 Santi Raffa
          <*> arbitrary                       -- disks
350 1a182390 Santi Raffa
          <*> pure emptyJSObject              -- beparams
351 1a182390 Santi Raffa
          <*> arbitrary                       -- runtime_mem
352 1a182390 Santi Raffa
          <*> pure emptyJSObject              -- hvparams
353 1a182390 Santi Raffa
          <*> arbitrary                       -- disk_template
354 1a182390 Santi Raffa
          <*> genMaybe genNodeNameNE          -- pnode
355 1a182390 Santi Raffa
          <*> return Nothing                  -- pnode_uuid
356 1a182390 Santi Raffa
          <*> genMaybe genNodeNameNE          -- remote_node
357 1a182390 Santi Raffa
          <*> return Nothing                  -- remote_node_uuid
358 1a182390 Santi Raffa
          <*> genMaybe genNameNE              -- os_name
359 1a182390 Santi Raffa
          <*> pure emptyJSObject              -- osparams
360 1a182390 Santi Raffa
          <*> genMaybe arbitraryPrivateJSObj  -- osparams_private
361 1a182390 Santi Raffa
          <*> arbitrary                       -- wait_for_sync
362 1a182390 Santi Raffa
          <*> arbitrary                       -- offline
363 1a182390 Santi Raffa
          <*> arbitrary                       -- conflicts_check
364 1a182390 Santi Raffa
          <*> arbitrary                       -- hotplug
365 1a182390 Santi Raffa
          <*> arbitrary                       -- hotplug_if_possible
366 93f1e606 Jose A. Lopes
          <*> arbitrary                       -- instance_communication
367 c2d3219b Iustin Pop
      "OP_INSTANCE_GROW_DISK" ->
368 da4a52a3 Thomas Thrainer
        OpCodes.OpInstanceGrowDisk <$> genFQDN <*> return Nothing <*>
369 da4a52a3 Thomas Thrainer
          arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
370 c2d3219b Iustin Pop
      "OP_INSTANCE_CHANGE_GROUP" ->
371 da4a52a3 Thomas Thrainer
        OpCodes.OpInstanceChangeGroup <$> genFQDN <*> return Nothing <*>
372 da4a52a3 Thomas Thrainer
          arbitrary <*> genMaybe genNameNE <*>
373 da4a52a3 Thomas Thrainer
          genMaybe (resize maxNodes (listOf genNameNE))
374 398e9066 Iustin Pop
      "OP_GROUP_ADD" ->
375 398e9066 Iustin Pop
        OpCodes.OpGroupAdd <$> genNameNE <*> arbitrary <*>
376 5006418e Iustin Pop
          emptyMUD <*> genMaybe genEmptyContainer <*>
377 398e9066 Iustin Pop
          emptyMUD <*> emptyMUD <*> emptyMUD
378 398e9066 Iustin Pop
      "OP_GROUP_ASSIGN_NODES" ->
379 398e9066 Iustin Pop
        OpCodes.OpGroupAssignNodes <$> genNameNE <*> arbitrary <*>
380 1c3231aa Thomas Thrainer
          genNodeNamesNE <*> return Nothing
381 398e9066 Iustin Pop
      "OP_GROUP_SET_PARAMS" ->
382 398e9066 Iustin Pop
        OpCodes.OpGroupSetParams <$> genNameNE <*> arbitrary <*>
383 5006418e Iustin Pop
          emptyMUD <*> genMaybe genEmptyContainer <*>
384 398e9066 Iustin Pop
          emptyMUD <*> emptyMUD <*> emptyMUD
385 398e9066 Iustin Pop
      "OP_GROUP_REMOVE" ->
386 398e9066 Iustin Pop
        OpCodes.OpGroupRemove <$> genNameNE
387 398e9066 Iustin Pop
      "OP_GROUP_RENAME" ->
388 398e9066 Iustin Pop
        OpCodes.OpGroupRename <$> genNameNE <*> genNameNE
389 398e9066 Iustin Pop
      "OP_GROUP_EVACUATE" ->
390 398e9066 Iustin Pop
        OpCodes.OpGroupEvacuate <$> genNameNE <*> arbitrary <*>
391 5006418e Iustin Pop
          genMaybe genNameNE <*> genMaybe genNamesNE
392 398e9066 Iustin Pop
      "OP_OS_DIAGNOSE" ->
393 398e9066 Iustin Pop
        OpCodes.OpOsDiagnose <$> genFieldsNE <*> genNamesNE
394 b954f097 Constantinos Venetsanopoulos
      "OP_EXT_STORAGE_DIAGNOSE" ->
395 b954f097 Constantinos Venetsanopoulos
        OpCodes.OpOsDiagnose <$> genFieldsNE <*> genNamesNE
396 398e9066 Iustin Pop
      "OP_BACKUP_PREPARE" ->
397 da4a52a3 Thomas Thrainer
        OpCodes.OpBackupPrepare <$> genFQDN <*> return Nothing <*> arbitrary
398 398e9066 Iustin Pop
      "OP_BACKUP_EXPORT" ->
399 da4a52a3 Thomas Thrainer
        OpCodes.OpBackupExport <$> genFQDN <*> return Nothing <*>
400 896cc964 Thomas Thrainer
          arbitrary <*> arbitrary <*> arbitrary <*> return Nothing <*>
401 896cc964 Thomas Thrainer
          arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
402 896cc964 Thomas Thrainer
          genMaybe (pure []) <*> genMaybe genNameNE
403 398e9066 Iustin Pop
      "OP_BACKUP_REMOVE" ->
404 da4a52a3 Thomas Thrainer
        OpCodes.OpBackupRemove <$> genFQDN <*> return Nothing
405 a3f02317 Iustin Pop
      "OP_TEST_ALLOCATOR" ->
406 a3f02317 Iustin Pop
        OpCodes.OpTestAllocator <$> arbitrary <*> arbitrary <*>
407 6e94b75c Jose A. Lopes
          genNameNE <*> genMaybe (pure []) <*> genMaybe (pure []) <*>
408 5006418e Iustin Pop
          arbitrary <*> genMaybe genNameNE <*>
409 a3f02317 Iustin Pop
          (genTags >>= mapM mkNonEmpty) <*>
410 5006418e Iustin Pop
          arbitrary <*> arbitrary <*> genMaybe genNameNE <*>
411 5006418e Iustin Pop
          arbitrary <*> genMaybe genNodeNamesNE <*> arbitrary <*>
412 5006418e Iustin Pop
          genMaybe genNamesNE <*> arbitrary <*> arbitrary
413 a3f02317 Iustin Pop
      "OP_TEST_JQUEUE" ->
414 a3f02317 Iustin Pop
        OpCodes.OpTestJqueue <$> arbitrary <*> arbitrary <*>
415 5006418e Iustin Pop
          resize 20 (listOf genFQDN) <*> arbitrary
416 a3f02317 Iustin Pop
      "OP_TEST_DUMMY" ->
417 a3f02317 Iustin Pop
        OpCodes.OpTestDummy <$> pure J.JSNull <*> pure J.JSNull <*>
418 a3f02317 Iustin Pop
          pure J.JSNull <*> pure J.JSNull
419 8d239fa4 Iustin Pop
      "OP_NETWORK_ADD" ->
420 6e94b75c Jose A. Lopes
        OpCodes.OpNetworkAdd <$> genNameNE <*> genIPv4Network <*>
421 6e94b75c Jose A. Lopes
          genMaybe genIPv4Address <*> pure Nothing <*> pure Nothing <*>
422 6e94b75c Jose A. Lopes
          genMaybe genMacPrefix <*> genMaybe (listOf genIPv4Address) <*>
423 1dbceab9 Iustin Pop
          arbitrary <*> (genTags >>= mapM mkNonEmpty)
424 8d239fa4 Iustin Pop
      "OP_NETWORK_REMOVE" ->
425 8d239fa4 Iustin Pop
        OpCodes.OpNetworkRemove <$> genNameNE <*> arbitrary
426 8d239fa4 Iustin Pop
      "OP_NETWORK_SET_PARAMS" ->
427 5cfa6c37 Dimitris Aragiorgis
        OpCodes.OpNetworkSetParams <$> genNameNE <*>
428 6e94b75c Jose A. Lopes
          genMaybe genIPv4Address <*> pure Nothing <*> pure Nothing <*>
429 6e94b75c Jose A. Lopes
          genMaybe genMacPrefix <*> genMaybe (listOf genIPv4Address) <*>
430 6e94b75c Jose A. Lopes
          genMaybe (listOf genIPv4Address)
431 8d239fa4 Iustin Pop
      "OP_NETWORK_CONNECT" ->
432 8d239fa4 Iustin Pop
        OpCodes.OpNetworkConnect <$> genNameNE <*> genNameNE <*>
433 8d239fa4 Iustin Pop
          arbitrary <*> genNameNE <*> arbitrary
434 8d239fa4 Iustin Pop
      "OP_NETWORK_DISCONNECT" ->
435 0ae4b355 Helga Velroyen
        OpCodes.OpNetworkDisconnect <$> genNameNE <*> genNameNE
436 1cd563e2 Iustin Pop
      "OP_RESTRICTED_COMMAND" ->
437 1cd563e2 Iustin Pop
        OpCodes.OpRestrictedCommand <$> arbitrary <*> genNodeNamesNE <*>
438 1c3231aa Thomas Thrainer
          return Nothing <*> genNameNE
439 c66f09f5 Iustin Pop
      _ -> fail $ "Undefined arbitrary for opcode " ++ op_id
440 aed2325f Iustin Pop
441 516a0e94 Michele Tartara
-- | Generates one element of a reason trail
442 516a0e94 Michele Tartara
genReasonElem :: Gen ReasonElem
443 516a0e94 Michele Tartara
genReasonElem = (,,) <$> genFQDN <*> genFQDN <*> arbitrary
444 516a0e94 Michele Tartara
445 516a0e94 Michele Tartara
-- | Generates a reason trail
446 516a0e94 Michele Tartara
genReasonTrail :: Gen ReasonTrail
447 516a0e94 Michele Tartara
genReasonTrail = do
448 516a0e94 Michele Tartara
  size <- choose (0, 10)
449 516a0e94 Michele Tartara
  vectorOf size genReasonElem
450 516a0e94 Michele Tartara
451 4a826364 Iustin Pop
instance Arbitrary OpCodes.CommonOpParams where
452 4a826364 Iustin Pop
  arbitrary = OpCodes.CommonOpParams <$> arbitrary <*> arbitrary <*>
453 516a0e94 Michele Tartara
                arbitrary <*> resize 5 arbitrary <*> genMaybe genName <*>
454 516a0e94 Michele Tartara
                genReasonTrail
455 4a826364 Iustin Pop
456 c7d249d0 Iustin Pop
-- * Helper functions
457 c7d249d0 Iustin Pop
458 c66f09f5 Iustin Pop
-- | Empty JSObject.
459 c66f09f5 Iustin Pop
emptyJSObject :: J.JSObject J.JSValue
460 c66f09f5 Iustin Pop
emptyJSObject = J.toJSObject []
461 c66f09f5 Iustin Pop
462 c66f09f5 Iustin Pop
-- | Empty maybe unchecked dictionary.
463 c66f09f5 Iustin Pop
emptyMUD :: Gen (Maybe (J.JSObject J.JSValue))
464 5006418e Iustin Pop
emptyMUD = genMaybe $ pure emptyJSObject
465 c66f09f5 Iustin Pop
466 c66f09f5 Iustin Pop
-- | Generates an empty container.
467 c66f09f5 Iustin Pop
genEmptyContainer :: (Ord a) => Gen (GenericContainer a b)
468 c66f09f5 Iustin Pop
genEmptyContainer = pure . GenericContainer $ Map.fromList []
469 c66f09f5 Iustin Pop
470 c7d249d0 Iustin Pop
-- | Generates list of disk indices.
471 c7d249d0 Iustin Pop
genDiskIndices :: Gen [DiskIndex]
472 c7d249d0 Iustin Pop
genDiskIndices = do
473 c7d249d0 Iustin Pop
  cnt <- choose (0, C.maxDisks)
474 df8578fb Iustin Pop
  genUniquesList cnt arbitrary
475 c7d249d0 Iustin Pop
476 c7d249d0 Iustin Pop
-- | Generates a list of node names.
477 c7d249d0 Iustin Pop
genNodeNames :: Gen [String]
478 5006418e Iustin Pop
genNodeNames = resize maxNodes (listOf genFQDN)
479 c7d249d0 Iustin Pop
480 c66f09f5 Iustin Pop
-- | Generates a list of node names in non-empty string type.
481 c66f09f5 Iustin Pop
genNodeNamesNE :: Gen [NonEmptyString]
482 417ab39c Iustin Pop
genNodeNamesNE = genNodeNames >>= mapM mkNonEmpty
483 c66f09f5 Iustin Pop
484 c7d249d0 Iustin Pop
-- | Gets a node name in non-empty type.
485 c7d249d0 Iustin Pop
genNodeNameNE :: Gen NonEmptyString
486 5006418e Iustin Pop
genNodeNameNE = genFQDN >>= mkNonEmpty
487 c7d249d0 Iustin Pop
488 5ef4fbb1 Iustin Pop
-- | Gets a name (non-fqdn) in non-empty type.
489 5ef4fbb1 Iustin Pop
genNameNE :: Gen NonEmptyString
490 5006418e Iustin Pop
genNameNE = genName >>= mkNonEmpty
491 5ef4fbb1 Iustin Pop
492 398e9066 Iustin Pop
-- | Gets a list of names (non-fqdn) in non-empty type.
493 398e9066 Iustin Pop
genNamesNE :: Gen [NonEmptyString]
494 398e9066 Iustin Pop
genNamesNE = resize maxNodes (listOf genNameNE)
495 398e9066 Iustin Pop
496 5ef4fbb1 Iustin Pop
-- | Returns a list of non-empty fields.
497 5ef4fbb1 Iustin Pop
genFieldsNE :: Gen [NonEmptyString]
498 5006418e Iustin Pop
genFieldsNE = genFields >>= mapM mkNonEmpty
499 5ef4fbb1 Iustin Pop
500 8d239fa4 Iustin Pop
-- | Generate a 3-byte MAC prefix.
501 8d239fa4 Iustin Pop
genMacPrefix :: Gen NonEmptyString
502 8d239fa4 Iustin Pop
genMacPrefix = do
503 8d239fa4 Iustin Pop
  octets <- vectorOf 3 $ choose (0::Int, 255)
504 8d239fa4 Iustin Pop
  mkNonEmpty . intercalate ":" $ map (printf "%02x") octets
505 8d239fa4 Iustin Pop
506 4884f187 Santi Raffa
-- | JSObject of arbitrary data.
507 4884f187 Santi Raffa
--
508 4884f187 Santi Raffa
-- Since JSValue does not implement Arbitrary, I'll simply generate
509 4884f187 Santi Raffa
-- (String, String) objects.
510 4884f187 Santi Raffa
arbitraryPrivateJSObj :: Gen (J.JSObject (Private J.JSValue))
511 4884f187 Santi Raffa
arbitraryPrivateJSObj =
512 4884f187 Santi Raffa
  constructor <$> (fromNonEmpty <$> genNameNE)
513 4884f187 Santi Raffa
              <*> (fromNonEmpty <$> genNameNE)
514 4884f187 Santi Raffa
    where constructor k v = showPrivateJSObject [(k, v)]
515 4884f187 Santi Raffa
516 4a826364 Iustin Pop
-- | Arbitrary instance for MetaOpCode, defined here due to TH ordering.
517 4a826364 Iustin Pop
$(genArbitrary ''OpCodes.MetaOpCode)
518 4a826364 Iustin Pop
519 f56013fd Iustin Pop
-- | Small helper to check for a failed JSON deserialisation
520 f56013fd Iustin Pop
isJsonError :: J.Result a -> Bool
521 f56013fd Iustin Pop
isJsonError (J.Error _) = True
522 f56013fd Iustin Pop
isJsonError _           = False
523 f56013fd Iustin Pop
524 aed2325f Iustin Pop
-- * Test cases
525 aed2325f Iustin Pop
526 aed2325f Iustin Pop
-- | Check that opcode serialization is idempotent.
527 20bc5360 Iustin Pop
prop_serialization :: OpCodes.OpCode -> Property
528 63b068c1 Iustin Pop
prop_serialization = testSerialisation
529 aed2325f Iustin Pop
530 aed2325f Iustin Pop
-- | Check that Python and Haskell defined the same opcode list.
531 20bc5360 Iustin Pop
case_AllDefined :: HUnit.Assertion
532 20bc5360 Iustin Pop
case_AllDefined = do
533 d31193c3 Jose A. Lopes
  py_stdout <-
534 d31193c3 Jose A. Lopes
     runPython "from ganeti import opcodes\n\
535 d31193c3 Jose A. Lopes
               \from ganeti import serializer\n\
536 d31193c3 Jose A. Lopes
               \import sys\n\
537 6e94b75c Jose A. Lopes
               \print serializer.Dump([opid for opid in opcodes.OP_MAPPING])\n"
538 6e94b75c Jose A. Lopes
               ""
539 d31193c3 Jose A. Lopes
     >>= checkPythonResult
540 d31193c3 Jose A. Lopes
  py_ops <- case J.decode py_stdout::J.Result [String] of
541 d31193c3 Jose A. Lopes
               J.Ok ops -> return ops
542 d31193c3 Jose A. Lopes
               J.Error msg ->
543 d31193c3 Jose A. Lopes
                 HUnit.assertFailure ("Unable to decode opcode names: " ++ msg)
544 d31193c3 Jose A. Lopes
                 -- this already raised an expection, but we need it
545 d31193c3 Jose A. Lopes
                 -- for proper types
546 d31193c3 Jose A. Lopes
                 >> fail "Unable to decode opcode names"
547 d31193c3 Jose A. Lopes
  let hs_ops = sort OpCodes.allOpIDs
548 9b773665 Iustin Pop
      extra_py = py_ops \\ hs_ops
549 aed2325f Iustin Pop
      extra_hs = hs_ops \\ py_ops
550 9b773665 Iustin Pop
  HUnit.assertBool ("Missing OpCodes from the Haskell code:\n" ++
551 9b773665 Iustin Pop
                    unlines extra_py) (null extra_py)
552 aed2325f Iustin Pop
  HUnit.assertBool ("Extra OpCodes in the Haskell code code:\n" ++
553 aed2325f Iustin Pop
                    unlines extra_hs) (null extra_hs)
554 aed2325f Iustin Pop
555 aed2325f Iustin Pop
-- | Custom HUnit test case that forks a Python process and checks
556 aed2325f Iustin Pop
-- correspondence between Haskell-generated OpCodes and their Python
557 aed2325f Iustin Pop
-- decoded, validated and re-encoded version.
558 aed2325f Iustin Pop
--
559 aed2325f Iustin Pop
-- Note that we have a strange beast here: since launching Python is
560 aed2325f Iustin Pop
-- expensive, we don't do this via a usual QuickProperty, since that's
561 aed2325f Iustin Pop
-- slow (I've tested it, and it's indeed quite slow). Rather, we use a
562 aed2325f Iustin Pop
-- single HUnit assertion, and in it we manually use QuickCheck to
563 aed2325f Iustin Pop
-- generate 500 opcodes times the number of defined opcodes, which
564 aed2325f Iustin Pop
-- then we pass in bulk to Python. The drawbacks to this method are
565 aed2325f Iustin Pop
-- two fold: we cannot control the number of generated opcodes, since
566 aed2325f Iustin Pop
-- HUnit assertions don't get access to the test options, and for the
567 aed2325f Iustin Pop
-- same reason we can't run a repeatable seed. We should probably find
568 aed2325f Iustin Pop
-- a better way to do this, for example by having a
569 aed2325f Iustin Pop
-- separately-launched Python process (if not running the tests would
570 aed2325f Iustin Pop
-- be skipped).
571 d1ac695f Iustin Pop
case_py_compat_types :: HUnit.Assertion
572 d1ac695f Iustin Pop
case_py_compat_types = do
573 086ad4cf Iustin Pop
  let num_opcodes = length OpCodes.allOpIDs * 100
574 72747d91 Iustin Pop
  opcodes <- genSample (vectorOf num_opcodes
575 72747d91 Iustin Pop
                                   (arbitrary::Gen OpCodes.MetaOpCode))
576 72747d91 Iustin Pop
  let with_sum = map (\o -> (OpCodes.opSummary $
577 ad1c1e41 Iustin Pop
                             OpCodes.metaOpCode o, o)) opcodes
578 aed2325f Iustin Pop
      serialized = J.encode opcodes
579 dc4b5c42 Iustin Pop
  -- check for non-ASCII fields, usually due to 'arbitrary :: String'
580 dc4b5c42 Iustin Pop
  mapM_ (\op -> when (any (not . isAscii) (J.encode op)) .
581 dc4b5c42 Iustin Pop
                HUnit.assertFailure $
582 dc4b5c42 Iustin Pop
                  "OpCode has non-ASCII fields: " ++ show op
583 dc4b5c42 Iustin Pop
        ) opcodes
584 aed2325f Iustin Pop
  py_stdout <-
585 aed2325f Iustin Pop
     runPython "from ganeti import opcodes\n\
586 aed2325f Iustin Pop
               \from ganeti import serializer\n\
587 6e94b75c Jose A. Lopes
               \import sys\n\
588 aed2325f Iustin Pop
               \op_data = serializer.Load(sys.stdin.read())\n\
589 aed2325f Iustin Pop
               \decoded = [opcodes.OpCode.LoadOpCode(o) for o in op_data]\n\
590 aed2325f Iustin Pop
               \for op in decoded:\n\
591 aed2325f Iustin Pop
               \  op.Validate(True)\n\
592 ad1c1e41 Iustin Pop
               \encoded = [(op.Summary(), op.__getstate__())\n\
593 ad1c1e41 Iustin Pop
               \           for op in decoded]\n\
594 560ef132 Santi Raffa
               \print serializer.Dump(\
595 560ef132 Santi Raffa
               \  encoded,\
596 560ef132 Santi Raffa
               \  private_encoder=serializer.EncodeWithPrivateFields)"
597 560ef132 Santi Raffa
               serialized
598 aed2325f Iustin Pop
     >>= checkPythonResult
599 ad1c1e41 Iustin Pop
  let deserialised =
600 ad1c1e41 Iustin Pop
        J.decode py_stdout::J.Result [(String, OpCodes.MetaOpCode)]
601 aed2325f Iustin Pop
  decoded <- case deserialised of
602 aed2325f Iustin Pop
               J.Ok ops -> return ops
603 aed2325f Iustin Pop
               J.Error msg ->
604 aed2325f Iustin Pop
                 HUnit.assertFailure ("Unable to decode opcodes: " ++ msg)
605 aed2325f Iustin Pop
                 -- this already raised an expection, but we need it
606 aed2325f Iustin Pop
                 -- for proper types
607 aed2325f Iustin Pop
                 >> fail "Unable to decode opcodes"
608 aed2325f Iustin Pop
  HUnit.assertEqual "Mismatch in number of returned opcodes"
609 ad1c1e41 Iustin Pop
    (length decoded) (length with_sum)
610 aed2325f Iustin Pop
  mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
611 9d929656 Santi Raffa
        ) $ zip with_sum decoded
612 aed2325f Iustin Pop
613 d1ac695f Iustin Pop
-- | Custom HUnit test case that forks a Python process and checks
614 d1ac695f Iustin Pop
-- correspondence between Haskell OpCodes fields and their Python
615 d1ac695f Iustin Pop
-- equivalent.
616 d1ac695f Iustin Pop
case_py_compat_fields :: HUnit.Assertion
617 d1ac695f Iustin Pop
case_py_compat_fields = do
618 d1ac695f Iustin Pop
  let hs_fields = sort $ map (\op_id -> (op_id, OpCodes.allOpFields op_id))
619 d1ac695f Iustin Pop
                         OpCodes.allOpIDs
620 d1ac695f Iustin Pop
  py_stdout <-
621 d1ac695f Iustin Pop
     runPython "from ganeti import opcodes\n\
622 d1ac695f Iustin Pop
               \import sys\n\
623 d1ac695f Iustin Pop
               \from ganeti import serializer\n\
624 d1ac695f Iustin Pop
               \fields = [(k, sorted([p[0] for p in v.OP_PARAMS]))\n\
625 d1ac695f Iustin Pop
               \           for k, v in opcodes.OP_MAPPING.items()]\n\
626 d1ac695f Iustin Pop
               \print serializer.Dump(fields)" ""
627 d1ac695f Iustin Pop
     >>= checkPythonResult
628 d1ac695f Iustin Pop
  let deserialised = J.decode py_stdout::J.Result [(String, [String])]
629 d1ac695f Iustin Pop
  py_fields <- case deserialised of
630 d1ac695f Iustin Pop
                 J.Ok v -> return $ sort v
631 d1ac695f Iustin Pop
                 J.Error msg ->
632 d1ac695f Iustin Pop
                   HUnit.assertFailure ("Unable to decode op fields: " ++ msg)
633 d1ac695f Iustin Pop
                   -- this already raised an expection, but we need it
634 d1ac695f Iustin Pop
                   -- for proper types
635 d1ac695f Iustin Pop
                   >> fail "Unable to decode op fields"
636 d1ac695f Iustin Pop
  HUnit.assertEqual "Mismatch in number of returned opcodes"
637 d1ac695f Iustin Pop
    (length hs_fields) (length py_fields)
638 d1ac695f Iustin Pop
  HUnit.assertEqual "Mismatch in defined OP_IDs"
639 d1ac695f Iustin Pop
    (map fst hs_fields) (map fst py_fields)
640 d1ac695f Iustin Pop
  mapM_ (\((py_id, py_flds), (hs_id, hs_flds)) -> do
641 d1ac695f Iustin Pop
           HUnit.assertEqual "Mismatch in OP_ID" py_id hs_id
642 d1ac695f Iustin Pop
           HUnit.assertEqual ("Mismatch in fields for " ++ hs_id)
643 d1ac695f Iustin Pop
             py_flds hs_flds
644 9d929656 Santi Raffa
        ) $ zip hs_fields py_fields
645 d1ac695f Iustin Pop
646 4a826364 Iustin Pop
-- | Checks that setOpComment works correctly.
647 4a826364 Iustin Pop
prop_setOpComment :: OpCodes.MetaOpCode -> String -> Property
648 4a826364 Iustin Pop
prop_setOpComment op comment =
649 4a826364 Iustin Pop
  let (OpCodes.MetaOpCode common _) = OpCodes.setOpComment comment op
650 4a826364 Iustin Pop
  in OpCodes.opComment common ==? Just comment
651 4a826364 Iustin Pop
652 f56013fd Iustin Pop
-- | Tests wrong (negative) disk index.
653 f56013fd Iustin Pop
prop_mkDiskIndex_fail :: QuickCheck.Positive Int -> Property
654 f56013fd Iustin Pop
prop_mkDiskIndex_fail (Positive i) =
655 f56013fd Iustin Pop
  case mkDiskIndex (negate i) of
656 f56013fd Iustin Pop
    Bad msg -> printTestCase "error message " $
657 f56013fd Iustin Pop
               "Invalid value" `isPrefixOf` msg
658 f56013fd Iustin Pop
    Ok v -> failTest $ "Succeeded to build disk index '" ++ show v ++
659 f56013fd Iustin Pop
                       "' from negative value " ++ show (negate i)
660 f56013fd Iustin Pop
661 f56013fd Iustin Pop
-- | Tests a few invalid 'readRecreateDisks' cases.
662 f56013fd Iustin Pop
case_readRecreateDisks_fail :: Assertion
663 f56013fd Iustin Pop
case_readRecreateDisks_fail = do
664 f56013fd Iustin Pop
  assertBool "null" $
665 f56013fd Iustin Pop
    isJsonError (J.readJSON J.JSNull::J.Result RecreateDisksInfo)
666 f56013fd Iustin Pop
  assertBool "string" $
667 f56013fd Iustin Pop
    isJsonError (J.readJSON (J.showJSON "abc")::J.Result RecreateDisksInfo)
668 f56013fd Iustin Pop
669 f56013fd Iustin Pop
-- | Tests a few invalid 'readDdmOldChanges' cases.
670 f56013fd Iustin Pop
case_readDdmOldChanges_fail :: Assertion
671 f56013fd Iustin Pop
case_readDdmOldChanges_fail = do
672 f56013fd Iustin Pop
  assertBool "null" $
673 f56013fd Iustin Pop
    isJsonError (J.readJSON J.JSNull::J.Result DdmOldChanges)
674 f56013fd Iustin Pop
  assertBool "string" $
675 f56013fd Iustin Pop
    isJsonError (J.readJSON (J.showJSON "abc")::J.Result DdmOldChanges)
676 f56013fd Iustin Pop
677 f56013fd Iustin Pop
-- | Tests a few invalid 'readExportTarget' cases.
678 f56013fd Iustin Pop
case_readExportTarget_fail :: Assertion
679 f56013fd Iustin Pop
case_readExportTarget_fail = do
680 f56013fd Iustin Pop
  assertBool "null" $
681 f56013fd Iustin Pop
    isJsonError (J.readJSON J.JSNull::J.Result ExportTarget)
682 f56013fd Iustin Pop
  assertBool "int" $
683 f56013fd Iustin Pop
    isJsonError (J.readJSON (J.showJSON (5::Int))::J.Result ExportTarget)
684 f56013fd Iustin Pop
685 aed2325f Iustin Pop
testSuite "OpCodes"
686 20bc5360 Iustin Pop
            [ 'prop_serialization
687 20bc5360 Iustin Pop
            , 'case_AllDefined
688 d1ac695f Iustin Pop
            , 'case_py_compat_types
689 d1ac695f Iustin Pop
            , 'case_py_compat_fields
690 4a826364 Iustin Pop
            , 'prop_setOpComment
691 f56013fd Iustin Pop
            , 'prop_mkDiskIndex_fail
692 f56013fd Iustin Pop
            , 'case_readRecreateDisks_fail
693 f56013fd Iustin Pop
            , 'case_readDdmOldChanges_fail
694 f56013fd Iustin Pop
            , 'case_readExportTarget_fail
695 aed2325f Iustin Pop
            ]