diff options
Diffstat (limited to 'lib/Types.hs')
-rw-r--r-- | lib/Types.hs | 298 |
1 files changed, 298 insertions, 0 deletions
diff --git a/lib/Types.hs b/lib/Types.hs new file mode 100644 index 0000000..86836e0 --- /dev/null +++ b/lib/Types.hs | |||
@@ -0,0 +1,298 @@ | |||
1 | {-# LANGUAGE DeriveFunctor #-} | ||
2 | module Types where | ||
3 | |||
4 | import Data.Map as Map (Map) | ||
5 | import qualified Data.Map as Map | ||
6 | import Data.OpenPGP | ||
7 | import Data.OpenPGP.Util | ||
8 | import FunctorToMaybe | ||
9 | import qualified Data.ByteString.Lazy as L | ||
10 | import qualified System.Posix.Types as Posix | ||
11 | |||
12 | -- | This type describes an idempotent transformation (merge or import) on a | ||
13 | -- set of GnuPG keyrings and other key files. | ||
14 | data KeyRingOperation = KeyRingOperation | ||
15 | { opFiles :: Map InputFile StreamInfo | ||
16 | -- ^ Indicates files to be read or updated. | ||
17 | , opPassphrases :: [PassphraseSpec] | ||
18 | -- ^ Indicates files or file descriptors where passphrases can be found. | ||
19 | , opTransforms :: [Transform] | ||
20 | -- ^ Transformations to be performed on the key pool after all files have | ||
21 | -- been read and before any have been written. | ||
22 | , opHome :: Maybe FilePath | ||
23 | -- ^ If provided, this is the directory where the 'HomeSec' and 'HomePub' | ||
24 | -- files reside. Otherwise, the evironment variable $GNUPGHOME is consulted | ||
25 | -- and if that is not set, it falls back to $HOME/.gnupg. | ||
26 | } | ||
27 | deriving (Eq,Show) | ||
28 | |||
29 | data InputFile = HomeSec | ||
30 | -- ^ A file named secring.gpg located in the home directory. | ||
31 | -- See 'opHome'. | ||
32 | | HomePub | ||
33 | -- ^ A file named pubring.gpg located in the home directory. | ||
34 | -- See 'opHome'. | ||
35 | | ArgFile FilePath | ||
36 | -- ^ Contents will be read or written from the specified path. | ||
37 | | FileDesc Posix.Fd | ||
38 | -- ^ Contents will be read or written from the specified file | ||
39 | -- descriptor. | ||
40 | | Pipe Posix.Fd Posix.Fd | ||
41 | -- ^ Contents will be read from the first descriptor and updated | ||
42 | -- content will be writen to the second. Note: Don't use Pipe | ||
43 | -- for 'Wallet' files. (TODO: Wallet support) | ||
44 | | Generate Int GenerateKeyParams | ||
45 | -- ^ New key packets will be generated if there is no | ||
46 | -- matching content already in the key pool. The integer is | ||
47 | -- a unique id number so that multiple generations can be | ||
48 | -- inserted into 'opFiles' | ||
49 | deriving (Eq,Ord,Show) | ||
50 | |||
51 | -- | This type describes how 'runKeyRing' will treat a file. | ||
52 | data StreamInfo = StreamInfo | ||
53 | { access :: Access | ||
54 | -- ^ Indicates whether the file is allowed to contain secret information. | ||
55 | , typ :: FileType | ||
56 | -- ^ Indicates the format and content type of the file. | ||
57 | , fill :: KeyFilter | ||
58 | -- ^ This filter controls what packets will be inserted into a file. | ||
59 | , spill :: KeyFilter | ||
60 | -- | ||
61 | -- ^ Use this to indicate whether or not a file's contents should be | ||
62 | -- available for updating other files. Note that although its type is | ||
63 | -- 'KeyFilter', it is usually interpretted as a boolean flag. Details | ||
64 | -- depend on 'typ' and are as follows: | ||
65 | -- | ||
66 | -- 'KeyRingFile': | ||
67 | -- | ||
68 | -- * 'KF_None' - The file's contents will not be shared. | ||
69 | -- | ||
70 | -- * otherwise - The file's contents will be shared. | ||
71 | -- | ||
72 | -- 'PEMFile': | ||
73 | -- | ||
74 | -- * 'KF_None' - The file's contents will not be shared. | ||
75 | -- | ||
76 | -- * 'KF_Match' - The file's key will be shared with the specified owner | ||
77 | -- key and usage tag. If 'fill' is also a 'KF_Match', then it must be | ||
78 | -- equal to this value; changing the usage or owner of a key is not | ||
79 | -- supported via the fill/spill mechanism. | ||
80 | -- | ||
81 | -- * otherwise - Unspecified. Do not use. | ||
82 | -- | ||
83 | -- 'WalletFile': | ||
84 | -- | ||
85 | -- * The 'spill' setting is ignored and the file's contents are shared. | ||
86 | -- (TODO) | ||
87 | -- | ||
88 | -- 'Hosts': | ||
89 | -- | ||
90 | -- * The 'spill' setting is ignored and the file's contents are shared. | ||
91 | -- (TODO) | ||
92 | -- | ||
93 | , initializer :: Initializer | ||
94 | -- ^ If 'typ' is 'PEMFile' and an 'External' 'initializer' string is set, | ||
95 | -- then it is interpretted as a shell command that may be used to create | ||
96 | -- the key if it does not exist. | ||
97 | , transforms :: [Transform] | ||
98 | -- ^ Per-file transformations that occur before the contents of a file are | ||
99 | -- spilled into the common pool. | ||
100 | } | ||
101 | deriving (Eq,Show) | ||
102 | |||
103 | |||
104 | -- | This type is used to indicate where to obtain passphrases. | ||
105 | data PassphraseSpec = PassphraseSpec | ||
106 | { passSpecRingFile :: Maybe FilePath | ||
107 | -- ^ If not Nothing, the passphrase is to be used for packets | ||
108 | -- from this file. | ||
109 | , passSpecKeySpec :: Maybe String | ||
110 | -- ^ Non-Nothing value reserved for future use. | ||
111 | -- (TODO: Use this to implement per-key passphrase associations). | ||
112 | , passSpecPassFile :: InputFile | ||
113 | -- ^ The passphrase will be read from this file or file descriptor. | ||
114 | } | ||
115 | -- | Use this to carry pasphrases from a previous run. | ||
116 | | PassphraseMemoizer PacketTranscoder | ||
117 | | PassphraseAgent | ||
118 | |||
119 | instance Show PassphraseSpec where | ||
120 | show (PassphraseSpec a b c) = "PassphraseSpec "++show (a,b,c) | ||
121 | show (PassphraseMemoizer _) = "PassphraseMemoizer" | ||
122 | instance Eq PassphraseSpec where | ||
123 | PassphraseSpec a b c == PassphraseSpec d e f | ||
124 | = and [a==d,b==e,c==f] | ||
125 | _ == _ | ||
126 | = False | ||
127 | |||
128 | |||
129 | |||
130 | data Transform = | ||
131 | Autosign | ||
132 | -- ^ This operation will make signatures for any tor-style UID | ||
133 | -- that matches a tor subkey and thus can be authenticated without | ||
134 | -- requring the judgement of a human user. | ||
135 | -- | ||
136 | -- A tor-style UID is one of the following form: | ||
137 | -- | ||
138 | -- > Anonymous <root@HOSTNAME.onion> | ||
139 | | DeleteSubkeyByFingerprint String | ||
140 | -- ^ Delete the subkey specified by the given fingerprint and any | ||
141 | -- associated signatures on that key. | ||
142 | | DeleteSubkeyByUsage String | ||
143 | -- ^ Delete the subkey specified by the given fingerprint and any | ||
144 | -- associated signatures on that key. | ||
145 | deriving (Eq,Ord,Show) | ||
146 | |||
147 | -- | Use this type to indicate whether a file of type 'KeyRingFile' is expected | ||
148 | -- to contain secret or public PGP key packets. Note that it is not supported | ||
149 | -- to mix both in the same file and that the secret key packets include all of | ||
150 | -- the information contained in their corresponding public key packets. | ||
151 | data Access = AutoAccess -- ^ secret or public as appropriate based on existing content. | ||
152 | -- (see 'rtRingAccess') | ||
153 | | Sec -- ^ secret information | ||
154 | | Pub -- ^ public information | ||
155 | deriving (Eq,Ord,Show) | ||
156 | |||
157 | data FileType = KeyRingFile | ||
158 | | PEMFile | ||
159 | | WalletFile | ||
160 | | DNSPresentation | ||
161 | | Hosts | ||
162 | | SshFile | ||
163 | deriving (Eq,Ord,Enum,Show) | ||
164 | |||
165 | -- type UsageTag = String | ||
166 | data Initializer = NoCreate | Internal GenerateKeyParams | External String | WarnMissing String | ||
167 | deriving (Eq,Ord,Show) | ||
168 | |||
169 | |||
170 | |||
171 | type PacketTranscoder = (SymmetricAlgorithm,S2K) -> MappedPacket -> IO (KikiCondition Packet) | ||
172 | type PacketDecrypter = MappedPacket -> IO (KikiCondition Packet) | ||
173 | |||
174 | -- | Note that the documentation here is intended for when this value is | ||
175 | -- assigned to 'fill'. For other usage, see 'spill'. | ||
176 | data KeyFilter = KF_None -- ^ No keys will be imported. | ||
177 | | KF_Match String -- ^ Only the key that matches the spec will be imported. | ||
178 | | KF_Subkeys -- ^ Subkeys will be imported if their owner key is | ||
179 | -- already in the ring. TODO: Even if their signatures | ||
180 | -- are bad? | ||
181 | | KF_Authentic -- ^ Keys are imported if they belong to an authenticated | ||
182 | -- identity (signed or self-authenticating). | ||
183 | | KF_All -- ^ All keys will be imported. | ||
184 | deriving (Eq,Ord,Show) | ||
185 | |||
186 | -- | The position and acces a packet had before the operation | ||
187 | data OriginFlags = OriginFlags | ||
188 | { originallyPublic :: Bool | ||
189 | -- ^ false if SecretKeyPacket | ||
190 | , originalNum :: Int | ||
191 | -- ^ packets are numbered, starting from 1.. | ||
192 | } deriving Show | ||
193 | |||
194 | type OriginMap = Map FilePath OriginFlags | ||
195 | |||
196 | type MappedPacket = OriginMapped Packet | ||
197 | data OriginMapped a = MappedPacket | ||
198 | { packet :: a | ||
199 | , locations :: OriginMap | ||
200 | } deriving Show | ||
201 | instance Functor OriginMapped where | ||
202 | fmap f (MappedPacket x ls) = MappedPacket (f x) ls | ||
203 | |||
204 | origin :: Packet -> Int -> OriginFlags | ||
205 | origin p n = OriginFlags ispub n | ||
206 | where | ||
207 | ispub = case p of | ||
208 | SecretKeyPacket {} -> False | ||
209 | _ -> True | ||
210 | |||
211 | mappedPacket :: FilePath -> Packet -> MappedPacket | ||
212 | mappedPacket filename p = MappedPacket | ||
213 | { packet = p | ||
214 | , locations = Map.singleton filename (origin p (-1)) | ||
215 | } | ||
216 | |||
217 | mappedPacketWithHint :: FilePath -> Packet -> Int -> MappedPacket | ||
218 | mappedPacketWithHint filename p hint = MappedPacket | ||
219 | { packet = p | ||
220 | , locations = Map.singleton filename (origin p hint) | ||
221 | } | ||
222 | |||
223 | |||
224 | -- | This type is used to indicate success or failure | ||
225 | -- and in the case of success, return the computed object. | ||
226 | -- The 'FunctorToMaybe' class is implemented to facilitate | ||
227 | -- branching on failture. | ||
228 | data KikiCondition a = KikiSuccess a | ||
229 | | FailedToLock [FilePath] | ||
230 | | BadPassphrase | ||
231 | | FailedToMakeSignature | ||
232 | | CantFindHome | ||
233 | | AmbiguousKeySpec FilePath | ||
234 | | CannotImportMasterKey | ||
235 | | NoWorkingKey | ||
236 | deriving ( Functor, Show ) | ||
237 | |||
238 | instance FunctorToMaybe KikiCondition where | ||
239 | functorToMaybe (KikiSuccess a) = Just a | ||
240 | functorToMaybe _ = Nothing | ||
241 | |||
242 | instance Applicative KikiCondition where | ||
243 | pure a = KikiSuccess a | ||
244 | f <*> a = | ||
245 | case functorToEither f of | ||
246 | Right f -> case functorToEither a of | ||
247 | Right a -> pure (f a) | ||
248 | Left err -> err | ||
249 | Left err -> err | ||
250 | |||
251 | data InputFileContext = InputFileContext | ||
252 | { homesecPath :: FilePath | ||
253 | , homepubPath :: FilePath | ||
254 | } | ||
255 | |||
256 | |||
257 | -- | The 'KeyKey'-type is used to store the information of a key | ||
258 | -- which is used for finger-printing and as a lookup key into | ||
259 | -- maps. This type may be changed to an actual fingerprint in | ||
260 | -- in the future. | ||
261 | type KeyKey = [L.ByteString] | ||
262 | |||
263 | keykey :: Packet -> KeyKey | ||
264 | keykey key = | ||
265 | -- Note: The key's timestamp is normally included in it's fingerprint. | ||
266 | -- This is undesirable for kiki because it causes the same | ||
267 | -- key to be imported multiple times and show as apparently | ||
268 | -- distinct keys with different fingerprints. | ||
269 | -- Thus, we will remove the timestamp. | ||
270 | fingerprint_material (key {timestamp=0}) -- TODO: smaller key? | ||
271 | |||
272 | isKey :: Packet -> Bool | ||
273 | isKey (PublicKeyPacket {}) = True | ||
274 | isKey (SecretKeyPacket {}) = True | ||
275 | isKey _ = False | ||
276 | |||
277 | isSecretKey :: Packet -> Bool | ||
278 | isSecretKey (SecretKeyPacket {}) = True | ||
279 | isSecretKey _ = False | ||
280 | |||
281 | |||
282 | isUserID :: Packet -> Bool | ||
283 | isUserID (UserIDPacket {}) = True | ||
284 | isUserID _ = False | ||
285 | |||
286 | isTrust :: Packet -> Bool | ||
287 | isTrust (TrustPacket {}) = True | ||
288 | isTrust _ = False | ||
289 | |||
290 | -- matchpr computes the fingerprint of the given key truncated to | ||
291 | -- be the same lenght as the given fingerprint for comparison. | ||
292 | -- | ||
293 | -- matchpr fp = Data.List.Extra.takeEnd (length fp) | ||
294 | -- | ||
295 | matchpr :: String -> Packet -> String | ||
296 | matchpr fp k = reverse $ zipWith const (reverse (fingerprint k)) fp | ||
297 | |||
298 | |||