Encode UUIDs as ByteStrings
[ganeti-github.git] / src / Ganeti / Objects / Lens.hs
1 {-# LANGUAGE TemplateHaskell #-}
2
3 {-| Lenses for Ganeti config objects
4
5 -}
6
7 {-
8
9 Copyright (C) 2014 Google Inc.
10 All rights reserved.
11
12 Redistribution and use in source and binary forms, with or without
13 modification, are permitted provided that the following conditions are
14 met:
15
16 1. Redistributions of source code must retain the above copyright notice,
17 this list of conditions and the following disclaimer.
18
19 2. Redistributions in binary form must reproduce the above copyright
20 notice, this list of conditions and the following disclaimer in the
21 documentation and/or other materials provided with the distribution.
22
23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
24 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
25 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
26 PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
27 CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
28 EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
29 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
30 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
31 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
32 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
33 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34
35 -}
36
37 module Ganeti.Objects.Lens where
38
39 import qualified Data.ByteString as BS
40 import qualified Data.ByteString.UTF8 as UTF8
41 import Control.Lens (Simple)
42 import Control.Lens.Iso (Iso, iso)
43 import qualified Data.Set as Set
44 import System.Time (ClockTime(..))
45
46 import Ganeti.Lens (makeCustomLenses, Lens')
47 import Ganeti.Objects
48
49 -- | Isomorphism between Strings and bytestrings
50 stringL :: Simple Iso BS.ByteString String
51 stringL = iso UTF8.toString UTF8.fromString
52
53 -- | Class of objects that have timestamps.
54 class TimeStampObject a => TimeStampObjectL a where
55 mTimeL :: Lens' a ClockTime
56
57 -- | Class of objects that have an UUID.
58 class UuidObject a => UuidObjectL a where
59 uuidL :: Lens' a String
60
61 -- | Class of object that have a serial number.
62 class SerialNoObject a => SerialNoObjectL a where
63 serialL :: Lens' a Int
64
65 -- | Class of objects that have tags.
66 class TagsObject a => TagsObjectL a where
67 tagsL :: Lens' a (Set.Set String)
68
69 $(makeCustomLenses ''AddressPool)
70
71 $(makeCustomLenses ''Network)
72
73 instance SerialNoObjectL Network where
74 serialL = networkSerialL
75
76 instance TagsObjectL Network where
77 tagsL = networkTagsL
78
79 instance UuidObjectL Network where
80 uuidL = networkUuidL . stringL
81
82 instance TimeStampObjectL Network where
83 mTimeL = networkMtimeL
84
85 $(makeCustomLenses ''PartialNic)
86
87 $(makeCustomLenses ''Disk)
88
89 $(makeCustomLenses ''Instance)
90
91 instance TimeStampObjectL Instance where
92 mTimeL = instMtimeL
93
94 instance UuidObjectL Instance where
95 uuidL = instUuidL . stringL
96
97 instance SerialNoObjectL Instance where
98 serialL = instSerialL
99
100 instance TagsObjectL Instance where
101 tagsL = instTagsL
102
103 $(makeCustomLenses ''MinMaxISpecs)
104
105 $(makeCustomLenses ''PartialIPolicy)
106
107 $(makeCustomLenses ''FilledIPolicy)
108
109 $(makeCustomLenses ''Node)
110
111 instance TimeStampObjectL Node where
112 mTimeL = nodeMtimeL
113
114 instance UuidObjectL Node where
115 uuidL = nodeUuidL . stringL
116
117 instance SerialNoObjectL Node where
118 serialL = nodeSerialL
119
120 instance TagsObjectL Node where
121 tagsL = nodeTagsL
122
123 $(makeCustomLenses ''NodeGroup)
124
125 instance TimeStampObjectL NodeGroup where
126 mTimeL = groupMtimeL
127
128 instance UuidObjectL NodeGroup where
129 uuidL = groupUuidL . stringL
130
131 instance SerialNoObjectL NodeGroup where
132 serialL = groupSerialL
133
134 instance TagsObjectL NodeGroup where
135 tagsL = groupTagsL
136
137 $(makeCustomLenses ''Cluster)
138
139 instance TimeStampObjectL Cluster where
140 mTimeL = clusterMtimeL
141
142 instance UuidObjectL Cluster where
143 uuidL = clusterUuidL . stringL
144
145 instance SerialNoObjectL Cluster where
146 serialL = clusterSerialL
147
148 instance TagsObjectL Cluster where
149 tagsL = clusterTagsL
150
151 $(makeCustomLenses ''ConfigData)
152
153 instance SerialNoObjectL ConfigData where
154 serialL = configSerialL
155
156 instance TimeStampObjectL ConfigData where
157 mTimeL = configMtimeL