changed kFiles to use StreamInfo as element type.

1 files changed, 39 insertions, 52 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index ac92b14..4e6c512 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -6,6 +6,8 @@
 {-# LANGUAGE DoAndIfThenElse #-}
 module KeyRing
     ( runKeyRing
+    , StreamInfo(..)
+    , KeyFilter(..)
     , KeyRingOperation(..)
     , KikiResult(..)
     , KikiCondition(..)
@@ -15,7 +17,6 @@ module KeyRing
     , KeyRingRuntime(..)
     , InputFile(..)
     , FileType(..)
-    , RefType(..)
     , importPublic
     , importSecret
     , subkeysOnly
@@ -172,10 +173,10 @@ data Access = AutoAccess -- ^ secret or public as appropriate based on existing
             | Sec        -- ^ secret information
             | Pub        -- ^ public information
 
+-- | TODO: Implement keyfilters other than KF_None and KF_All
+-- This should make kImports obsolete.
 data KeyFilter = KF_None | KF_Match String | KF_Subkeys | KF_Authentic | KF_All
 
--- | TODO: This should replace the element type of kFiles
--- and kImports will be obsolete.
 data StreamInfo = StreamInfo
     { access :: Access
     , typ :: FileType
@@ -183,22 +184,10 @@ data StreamInfo = StreamInfo
     , spill :: KeyFilter
     , initializer :: Maybe String }
 
--- | RefType is perhaps not a good name for this...
---   It is sort of like a read/write flag, although
---   semantically, it is indicating the intention of
---   an action and not just the access level of an
---   object.
-data RefType = ConstRef
-             -- ^ merge into database but do not update
-             | MutableRef (Maybe Initializer)
-             -- ^ sync into database
-             --         update dabase and also update file
-             --   Initializer is a shell command that creates
-             --   the file; eg, ssh-keygen
-
-isMutable :: RefType -> Bool
-isMutable (MutableRef {}) = True
-isMutable _               = False
+
+isMutable :: StreamInfo -> Bool
+isMutable stream | KF_None <- fill stream = False
+isMutable _                               = True
 
 isring :: FileType -> Bool
 isring (KeyRingFile {}) = True
@@ -212,10 +201,6 @@ iswallet :: FileType -> Bool
 iswallet (WalletFile {}) = True
 iswallet _               = False
 
-rtyp_initializer :: RefType -> Maybe Initializer
-rtyp_initializer (MutableRef x) = x
-rtyp_initializer _              = Nothing
-
 getUsage ::
   MonadPlus m => FileType -> m UsageTag
 getUsage (PEMFile usage) = return usage
@@ -239,7 +224,7 @@ noManip :: KeyRingRuntime -> KeyData -> [PacketUpdate]
 noManip _ _ = []
 
 data KeyRingOperation = KeyRingOperation
-    { kFiles :: Map.Map InputFile (RefType,FileType)
+    { kFiles :: Map.Map InputFile StreamInfo
     , kImports :: Map.Map InputFile (KeyRingRuntime -> KeyData -> Maybe Bool)
     -- ^
     -- Indicates what pgp master keys get written to which keyring files.
@@ -265,10 +250,10 @@ resolveInputFile secring pubring = resolve
 filesToLock ::
   KeyRingOperation -> FilePath -> FilePath -> [FilePath]
 filesToLock k secring pubring = do
-    (f,(rtyp,ftyp)) <- Map.toList (kFiles k)
-    case rtyp of
-        ConstRef -> []
-        MutableRef {} -> resolveInputFile secring pubring f
+    (f,stream) <- Map.toList (kFiles k)
+    case fill stream of
+        KF_None -> []
+        _       -> resolveInputFile secring pubring f
 
 
 -- kret :: a -> KeyRingOperation a
@@ -860,8 +845,8 @@ mergeHostFiles krd db secring pubring = do
         ishosts Hosts = True
         ishosts _     = False
         files istyp = do
-            (f,(rtyp,ftyp)) <- Map.toList (kFiles krd)
-            guard (istyp ftyp)
+            (f,stream) <- Map.toList (kFiles krd)
+            guard (istyp $ typ stream)
             resolveInputFile secring pubring f
 
     hostdbs0 <- mapM (fmap Hosts.decode . L.readFile) hns
@@ -915,11 +900,12 @@ writeHostsFiles
      -> IO [(FilePath, KikiReportAction)]
 writeHostsFiles krd secring pubring (hostdbs0,hostdbs,u1,gpgnames,outgoing_names) = do
     let hns = files isMutableHosts
-        isMutableHosts (MutableRef _,Hosts) = True
-        isMutableHosts _ = False
+        isMutableHosts stream | KF_None <- fill stream = False
+        isMutableHosts stream | Hosts <- typ stream    = True
+        isMutableHosts _                               = False
         files istyp = do
-            (f,typ) <- Map.toList (kFiles krd)
-            guard (istyp typ)
+            (f,stream) <- Map.toList (kFiles krd)
+            guard (istyp stream)
             resolveInputFile secring pubring f
 
     -- 3. add hostnames from gpg for addresses not in U
@@ -955,8 +941,8 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do
     let
 
         files isring = do
-            (f,(rtyp,ftyp)) <- Map.toList (kFiles keyring)
-            guard (isring ftyp)
+            (f,stream) <- Map.toList (kFiles keyring)
+            guard (isring $ typ stream)
             resolveInputFile secring pubring f
 
         readp n = fmap (n,) (readPacketsFromFile n)
@@ -1007,12 +993,12 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do
 
     -- PEM files
     let pems = do
-            (n,(rtyp,ftyp)) <- Map.toList $ kFiles keyring
+            (n,stream) <- Map.toList $ kFiles keyring
             grip <- maybeToList grip
-            (topspec,subspec) <- fmap (parseSpec grip) $ getUsage ftyp
+            (topspec,subspec) <- fmap (parseSpec grip) $ getUsage (typ stream)
             n <- resolveInputFile secring pubring n
             let ms = map fst $ filterMatches topspec (Map.toList db)
-                cmd = rtyp_initializer rtyp
+                cmd = initializer stream
             return (n,subspec,ms,cmd)
     imports <- filterM (\(n,_,_,_) -> doesFileExist n) pems
     db <- foldM (importPEMKey doDecrypt) (KikiSuccess (db,[])) imports
@@ -1238,11 +1224,12 @@ writeWalletKeys :: KeyRingOperation -> KeyDB -> Maybe Packet -> IO (KikiConditio
 writeWalletKeys krd db wk = do
     let cs = db `coinKeysOwnedBy` wk
     -- export wallet keys
-        isMutableWallet (MutableRef {}) (WalletFile {}) = True
-        isMutableWallet _ _ = False
+        isMutableWallet stream | KF_None <- fill stream      = False
+        isMutableWallet stream | WalletFile {} <- typ stream = True
+        isMutableWallet _                                    = False
         files pred = do
-            (f,(rtyp,ftyp)) <- Map.toList (kFiles krd)
-            guard (pred rtyp ftyp)
+            (f,stream) <- Map.toList (kFiles krd)
+            guard (pred stream)
             resolveInputFile "" "" f
     let writeWallet report n = do
         let cs' = do
@@ -1319,10 +1306,10 @@ writeRingKeys krd rt {- db wk secring pubring -} = do
         pubring = rtPubring rt
     let s = do
         (f,f0,mutable) <- do
-            (f0,(rtyp,ftyp)) <- Map.toList (kFiles krd)
-            guard (isring ftyp)
+            (f0,stream) <- Map.toList (kFiles krd)
+            guard (isring $ typ stream)
             f <- resolveInputFile secring pubring f0
-            return (f,f0,isMutable rtyp)
+            return (f,f0,isMutable stream)
         let x = do
                 let wanted kd@(KeyData p _ _ _)
                         = mplus (fmap originallyPublic $ Map.lookup f $ locations p)
@@ -1468,9 +1455,9 @@ makeMemoizingDecrypter operation secring pubring = do
         -- TODO: head will throw an exception if a File Descriptor operation
         -- file is present.  We probably should change OriginMap to use InputFile
         -- instead of FilePath.
-        Traversable.mapM (cachedContents secring pubring . fromJust . pwfile . snd)
+        Traversable.mapM (cachedContents secring pubring . fromJust . pwfile . typ)
                          (Map.mapKeys (head . resolveInputFile secring pubring)
-                            $ Map.filter (isJust . pwfile . snd) $ kFiles operation)
+                            $ Map.filter (isJust . pwfile . typ) $ kFiles operation)
     unkeysRef <- newIORef Map.empty
     return $ doDecrypt unkeysRef pws
  where
@@ -1574,10 +1561,10 @@ initializeMissingPEMFiles operation secring pubring grip decrypt db = do
                     return (f,t)
 
         let (missing,notmissing) = partition (\(_,_,ns,_)->null (ns >>= snd)) $ do
-                (fname,(rtyp,ftyp)) <- nonexistents
-                guard $ isMutable rtyp
+                (fname,stream) <- nonexistents
+                guard $ isMutable stream
                 (topspec,subspec) <- fmap (parseSpec $ fromMaybe "" grip)
-                                       $ getUsage ftyp
+                                       $ getUsage $ typ stream
                 -- ms will contain duplicates if a top key has multiple matching
                 -- subkeys.  This is intentional.
                 let -- ms =  map (keykey . fst) $ selectAll True (topspec,subspec) db
@@ -1585,7 +1572,7 @@ initializeMissingPEMFiles operation secring pubring grip decrypt db = do
                     ns = do
                        (kk,kd) <- filterMatches topspec $ Map.toList db
                        return (kk , subkeysForExport subspec kd)
-                return (fname,subspec,ns,rtyp_initializer rtyp)
+                return (fname,subspec,ns,initializer stream)
             (exports0,ambiguous) = partition (\(_,_,ns,_)->null $ drop 1 $ (ns>>=snd))
                                              notmissing
             exports = map (\(f,subspec,ns,cmd) -> (f,subspec,ns >>= snd,cmd)) exports0