summaryrefslogtreecommitdiff
path: root/lib/KeyRing/Types.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/KeyRing/Types.hs')
-rw-r--r--lib/KeyRing/Types.hs394
1 files changed, 394 insertions, 0 deletions
diff --git a/lib/KeyRing/Types.hs b/lib/KeyRing/Types.hs
new file mode 100644
index 0000000..2383140
--- /dev/null
+++ b/lib/KeyRing/Types.hs
@@ -0,0 +1,394 @@
1{-# LANGUAGE DeriveFunctor #-}
2module KeyRing.Types where
3
4import Data.Char (isLower,toLower)
5import Data.List (groupBy)
6import Data.Map as Map (Map)
7import qualified Data.Map as Map
8import Data.OpenPGP
9import Data.OpenPGP.Util
10import Data.Time.Clock
11import FunctorToMaybe
12import qualified Data.ByteString.Lazy as L
13import qualified System.Posix.Types as Posix
14
15-- | This type describes an idempotent transformation (merge or import) on a
16-- set of GnuPG keyrings and other key files.
17data KeyRingOperation = KeyRingOperation
18 { opFiles :: Map InputFile StreamInfo
19 -- ^ Indicates files to be read or updated.
20 , opPassphrases :: [PassphraseSpec]
21 -- ^ Indicates files or file descriptors where passphrases can be found.
22 , opTransforms :: [Transform]
23 -- ^ Transformations to be performed on the key pool after all files have
24 -- been read and before any have been written.
25 , opHome :: Maybe FilePath
26 -- ^ If provided, this is the directory where the 'HomeSec' and 'HomePub'
27 -- files reside. Otherwise, the evironment variable $GNUPGHOME is consulted
28 -- and if that is not set, it falls back to $HOME/.gnupg.
29 }
30 deriving (Eq,Show)
31
32data InputFile = HomeSec
33 -- ^ A file named secring.gpg located in the home directory.
34 -- See 'opHome'.
35 | HomePub
36 -- ^ A file named pubring.gpg located in the home directory.
37 -- See 'opHome'.
38 | ArgFile FilePath
39 -- ^ Contents will be read or written from the specified path.
40 | FileDesc Posix.Fd
41 -- ^ Contents will be read or written from the specified file
42 -- descriptor.
43 | Pipe Posix.Fd Posix.Fd
44 -- ^ Contents will be read from the first descriptor and updated
45 -- content will be writen to the second. Note: Don't use Pipe
46 -- for 'Wallet' files. (TODO: Wallet support)
47 | Generate Int GenerateKeyParams
48 -- ^ New key packets will be generated if there is no
49 -- matching content already in the key pool. The integer is
50 -- a unique id number so that multiple generations can be
51 -- inserted into 'opFiles'
52 deriving (Eq,Ord,Show)
53
54-- | This type describes how 'runKeyRing' will treat a file.
55data StreamInfo = StreamInfo
56 { access :: Access
57 -- ^ Indicates whether the file is allowed to contain secret information.
58 , typ :: FileType
59 -- ^ Indicates the format and content type of the file.
60 , fill :: KeyFilter
61 -- ^ This filter controls what packets will be inserted into a file.
62 , spill :: KeyFilter
63 --
64 -- ^ Use this to indicate whether or not a file's contents should be
65 -- available for updating other files. Note that although its type is
66 -- 'KeyFilter', it is usually interpretted as a boolean flag. Details
67 -- depend on 'typ' and are as follows:
68 --
69 -- 'KeyRingFile':
70 --
71 -- * 'KF_None' - The file's contents will not be shared.
72 --
73 -- * otherwise - The file's contents will be shared.
74 --
75 -- 'PEMFile':
76 --
77 -- * 'KF_None' - The file's contents will not be shared.
78 --
79 -- * 'KF_Match' - The file's key will be shared with the specified owner
80 -- key and usage tag. If 'fill' is also a 'KF_Match', then it must be
81 -- equal to this value; changing the usage or owner of a key is not
82 -- supported via the fill/spill mechanism.
83 --
84 -- * otherwise - Unspecified. Do not use.
85 --
86 -- 'WalletFile':
87 --
88 -- * The 'spill' setting is ignored and the file's contents are shared.
89 -- (TODO)
90 --
91 -- 'Hosts':
92 --
93 -- * The 'spill' setting is ignored and the file's contents are shared.
94 -- (TODO)
95 --
96 , initializer :: Initializer
97 -- ^ If 'typ' is 'PEMFile' and an 'External' 'initializer' string is set,
98 -- then it is interpretted as a shell command that may be used to create
99 -- the key if it does not exist.
100 , transforms :: [Transform]
101 -- ^ Per-file transformations that occur before the contents of a file are
102 -- spilled into the common pool.
103 }
104 deriving (Eq,Show)
105
106
107-- | This type is used to indicate where to obtain passphrases.
108data PassphraseSpec = PassphraseSpec
109 { passSpecRingFile :: Maybe FilePath
110 -- ^ If not Nothing, the passphrase is to be used for packets
111 -- from this file.
112 , passSpecKeySpec :: Maybe String
113 -- ^ Non-Nothing value reserved for future use.
114 -- (TODO: Use this to implement per-key passphrase associations).
115 , passSpecPassFile :: InputFile
116 -- ^ The passphrase will be read from this file or file descriptor.
117 }
118 -- | Use this to carry pasphrases from a previous run.
119 | PassphraseMemoizer { passSpecTranscoder :: PacketTranscoder }
120 | PassphraseAgent
121
122instance Show PassphraseSpec where
123 show (PassphraseSpec a b c) = "PassphraseSpec "++show (a,b,c)
124 show (PassphraseMemoizer _) = "PassphraseMemoizer"
125instance Eq PassphraseSpec where
126 PassphraseSpec a b c == PassphraseSpec d e f
127 = and [a==d,b==e,c==f]
128 _ == _
129 = False
130
131-- Ord instance for PassphraseSpec generally orders by generality with the most
132-- general being greatest and the least general being least. The one exception
133-- is the 'PassphraseMemoizer' which is considered least of all even though it
134-- is very general. This is so an existing memoizer will be tried first, and
135-- if there is none, one will be created that tries the others in order of
136-- increasing generality. Key-specialization is considered less general than
137-- file-specialization.
138instance Ord PassphraseSpec where
139 compare (PassphraseMemoizer _) (PassphraseMemoizer _) = EQ
140 compare PassphraseAgent PassphraseAgent = EQ
141 compare (PassphraseMemoizer _) _ = LT
142 compare (PassphraseSpec a b c) (PassphraseSpec d e f)
143 | fmap (const ()) a == fmap (const ()) d
144 && fmap (const ()) b == fmap (const ()) e = compare (a,b,c) (d,e,f)
145 compare (PassphraseSpec (Just _) (Just _) _) _ = LT
146 compare (PassphraseSpec Nothing (Just _) _) _ = LT
147 compare (PassphraseSpec (Just _) _ _) _ = LT
148 compare PassphraseAgent _ = GT
149
150data Transform =
151 Autosign
152 -- ^ This operation will make signatures for any tor-style UID
153 -- that matches a tor subkey and thus can be authenticated without
154 -- requring the judgement of a human user.
155 --
156 -- A tor-style UID is one of the following form:
157 --
158 -- > Anonymous <root@HOSTNAME.onion>
159 | DeleteSubkeyByFingerprint String
160 -- ^ Delete the subkey specified by the given fingerprint and any
161 -- associated signatures on that key.
162 | DeleteSubkeyByUsage String
163 -- ^ Delete the subkey specified by the given usage tag and any
164 -- associated signatures on that key.
165 | RenameSubkeys String String
166 -- ^ Replace all subkey signatures matching the first usage tag with
167 -- fresh signatures that match the second usage tag.
168 deriving (Eq,Ord,Show)
169
170-- | Use this type to indicate whether a file of type 'KeyRingFile' is expected
171-- to contain secret or public PGP key packets. Note that it is not supported
172-- to mix both in the same file and that the secret key packets include all of
173-- the information contained in their corresponding public key packets.
174data Access = AutoAccess -- ^ secret or public as appropriate based on existing content.
175 -- (see 'rtRingAccess')
176 | Sec -- ^ secret information
177 | Pub -- ^ public information
178 deriving (Eq,Ord,Show)
179
180data FileType = KeyRingFile
181 | PEMFile
182 | WalletFile
183 | DNSPresentation
184 | Hosts
185 | SshFile
186 deriving (Eq,Ord,Enum,Show)
187
188-- type UsageTag = String
189data Initializer = NoCreate | Internal GenerateKeyParams | External String | WarnMissing String
190 deriving (Eq,Ord,Show)
191
192
193
194type PacketTranscoder = (SymmetricAlgorithm,S2K) -> MappedPacket -> IO (KikiCondition Packet)
195type PacketDecrypter = MappedPacket -> IO (KikiCondition Packet)
196
197-- | Note that the documentation here is intended for when this value is
198-- assigned to 'fill'. For other usage, see 'spill'.
199data KeyFilter = KF_None -- ^ No keys will be imported.
200 | KF_Match String -- ^ Only the key that matches the spec will be imported.
201 | KF_Subkeys -- ^ Subkeys will be imported if their owner key is
202 -- already in the ring. TODO: Even if their signatures
203 -- are bad?
204 | KF_Authentic -- ^ Keys are imported if they belong to an authenticated
205 -- identity (signed or self-authenticating).
206 | KF_All -- ^ All keys will be imported.
207 deriving (Eq,Ord,Show)
208
209-- | The position and acces a packet had before the operation
210data OriginFlags = OriginFlags
211 { originallyPublic :: Bool
212 -- ^ false if SecretKeyPacket
213 , originalNum :: Int
214 -- ^ packets are numbered, starting from 1..
215 } deriving Show
216
217type OriginMap = Map FilePath OriginFlags
218
219type MappedPacket = OriginMapped Packet
220data OriginMapped a = MappedPacket
221 { packet :: a
222 , locations :: OriginMap
223 } deriving Show
224instance Functor OriginMapped where
225 fmap f (MappedPacket x ls) = MappedPacket (f x) ls
226
227origin :: Packet -> Int -> OriginFlags
228origin p n = OriginFlags ispub n
229 where
230 ispub = case p of
231 SecretKeyPacket {} -> False
232 _ -> True
233
234mappedPacket :: FilePath -> Packet -> MappedPacket
235mappedPacket filename p = MappedPacket
236 { packet = p
237 , locations = Map.singleton filename (origin p (-1))
238 }
239
240mappedPacketWithHint :: FilePath -> Packet -> Int -> MappedPacket
241mappedPacketWithHint filename p hint = MappedPacket
242 { packet = p
243 , locations = Map.singleton filename (origin p hint)
244 }
245
246
247-- | This type is used to indicate success or failure
248-- and in the case of success, return the computed object.
249-- The 'FunctorToMaybe' class is implemented to facilitate
250-- branching on failture.
251data KikiCondition a = KikiSuccess a
252 | FailedToLock [FilePath]
253 | BadPassphrase
254 | FailedToMakeSignature
255 | CantFindHome
256 | AmbiguousKeySpec FilePath
257 | CannotImportMasterKey
258 | NoWorkingKey
259 | AgentConnectionFailure
260 | OperationCanceled
261 deriving ( Functor, Show )
262
263instance FunctorToMaybe KikiCondition where
264 functorToMaybe (KikiSuccess a) = Just a
265 functorToMaybe _ = Nothing
266
267instance Applicative KikiCondition where
268 pure a = KikiSuccess a
269 f <*> a =
270 case functorToEither f of
271 Right f -> case functorToEither a of
272 Right a -> pure (f a)
273 Left err -> err
274 Left err -> err
275
276uncamel :: String -> String
277uncamel str = unwords $ firstWord ++ (toLower .: otherWords) ++ args
278 where
279 (.:) = fmap . fmap
280 ( firstWord ,
281 otherWords ) = splitAt 1 ws
282 ws = camel >>= groupBy (\_ c -> isLower c)
283 ( camel, args) = splitAt 1 $ words str
284
285errorString :: KikiCondition a -> String
286errorString (KikiSuccess {}) = "success"
287errorString e = uncamel . show $ fmap (const ()) e
288
289
290
291data InputFileContext = InputFileContext
292 { homesecPath :: FilePath
293 , homepubPath :: FilePath
294 }
295
296
297-- | The 'KeyKey'-type is used to store the information of a key
298-- which is used for finger-printing and as a lookup key into
299-- maps. This type may be changed to an actual fingerprint in
300-- in the future.
301type KeyKey = [L.ByteString]
302
303keykey :: Packet -> KeyKey
304keykey key =
305 -- Note: The key's timestamp is normally included in it's fingerprint.
306 -- This is undesirable for kiki because it causes the same
307 -- key to be imported multiple times and show as apparently
308 -- distinct keys with different fingerprints.
309 -- Thus, we will remove the timestamp.
310 fingerprint_material (key {timestamp=0}) -- TODO: smaller key?
311
312isKey :: Packet -> Bool
313isKey (PublicKeyPacket {}) = True
314isKey (SecretKeyPacket {}) = True
315isKey _ = False
316
317isSecretKey :: Packet -> Bool
318isSecretKey (SecretKeyPacket {}) = True
319isSecretKey _ = False
320
321
322isUserID :: Packet -> Bool
323isUserID (UserIDPacket {}) = True
324isUserID _ = False
325
326isTrust :: Packet -> Bool
327isTrust (TrustPacket {}) = True
328isTrust _ = False
329
330-- matchpr computes the fingerprint of the given key truncated to
331-- be the same lenght as the given fingerprint for comparison.
332--
333-- matchpr fp = Data.List.Extra.takeEnd (length fp)
334--
335matchpr :: String -> Packet -> String
336matchpr fp k = reverse $ zipWith const (reverse (fingerprint k)) fp
337
338
339
340
341data KeySpec =
342 KeyGrip String -- fp:
343 | KeyTag Packet String -- fp:????/t:
344 | KeyUidMatch String -- u:
345 deriving Show
346
347{-
348RSAPrivateKey ::= SEQUENCE {
349 version Version,
350 modulus INTEGER, -- n
351 publicExponent INTEGER, -- e
352 privateExponent INTEGER, -- d
353 prime1 INTEGER, -- p
354 prime2 INTEGER, -- q
355 exponent1 INTEGER, -- d mod (p1) -- ?? d mod (p-1)
356 exponent2 INTEGER, -- d mod (q-1)
357 coefficient INTEGER, -- (inverse of q) mod p
358 otherPrimeInfos OtherPrimeInfos OPTIONAL
359 }
360-}
361data RSAPrivateKey = RSAPrivateKey
362 { rsaN :: MPI
363 , rsaE :: MPI
364 , rsaD :: MPI
365 , rsaP :: MPI
366 , rsaQ :: MPI
367 , rsaDmodP1 :: MPI
368 , rsaDmodQminus1 :: MPI
369 , rsaCoefficient :: MPI
370 }
371 deriving Show
372
373data ParsedCert = ParsedCert
374 { pcertKey :: Packet
375 , pcertTimestamp :: UTCTime
376 , pcertBlob :: L.ByteString
377 }
378 deriving (Show,Eq)
379
380data SubkeyStatus = Unsigned | OwnerSigned | CrossSigned
381 deriving (Eq,Ord,Enum,Show,Read)
382
383data SecretPEMData = PEMPacket Packet | PEMCertificate ParsedCert
384 deriving (Show,Eq)
385
386data MatchingField = KeyTypeField | UserIDField | GroupIDField deriving (Show,Eq,Ord,Enum)
387
388data SingleKeySpec = FingerprintMatch String
389 | SubstringMatch (Maybe MatchingField) String
390 | EmptyMatch
391 | AnyMatch
392 | WorkingKeyMatch
393 deriving (Show,Eq,Ord)
394