From 8c065b516ee67fbab860b07d5e81919f7c774a05 Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Sat, 12 Apr 2014 01:25:15 -0400
Subject: reorganized cross_merge to use runKeyring

---
 KeyRing.hs | 82 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 75 insertions(+), 7 deletions(-)

(limited to 'KeyRing.hs')

diff --git a/KeyRing.hs b/KeyRing.hs
index 089b25a..7073e43 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -1,15 +1,18 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE EmptyDataDecls #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE ViewPatterns #-}
 module KeyRing where
 
 import System.Environment
 import Control.Monad
-import Control.Applicative
 import Data.Maybe
 import Data.Char
-import System.Directory ( getHomeDirectory, doesFileExist )
-import Control.Arrow    ( first, second )
+import Data.List
+import Control.Applicative ( (<$>) )
+import System.Directory    ( getHomeDirectory, doesFileExist )
+import Control.Arrow       ( first, second )
+
+import DotLock
 
 data HomeDir =
     HomeDir { homevar :: String
@@ -23,12 +26,77 @@ home = HomeDir
     , optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"]
     }
 
-data KeyRing
+data InputFile = HomeSec | HomePub | ArgFile FilePath
+
+data KeyRingRuntime = KeyRingRuntime
+                        { rtPubring :: FilePath
+                        , rtSecring :: FilePath
+                        , rtRings :: [FilePath]
+                        , rtWallets :: [FilePath]
+                        , rtGrip :: Maybe String
+                        }
+
+data KeyRingData a = KeyRingData
+    { filesToLock :: [InputFile]
+    , homeSpec :: Maybe String
+    , kaction :: KeyRingRuntime -> IO a
+    , keyringFiles :: [FilePath]
+    , walletFiles :: [FilePath]
+    }
 
 todo = error "unimplemented"
 
-loadKeys :: (Maybe FilePath) -> IO KeyRing
-loadKeys = todo
+data KikiResult = KikiSuccess | FailedToLock [FilePath]
+
+{-
+newtype KeyRing a = KeyRing
+    { krAction :: KeyRingData b -> IO a
+    }
+-}
+
+empty = KeyRingData { filesToLock = []
+                    , homeSpec = Nothing
+                    , kaction = \KeyRingRuntime {} -> return ()
+                    , keyringFiles = []
+                    , walletFiles = []
+                    }
+
+{-
+runKeyRing :: KeyRing () -> IO a
+runKeyRing keyring = krAction keyring empty
+-}
+
+
+runKeyRing :: KeyRingData a -> IO KikiResult
+runKeyRing keyring = do
+    (homedir,secring,pubring,grip0) <- getHomeDir (homeSpec keyring)
+    let tolocks = map resolve (filesToLock keyring)
+                  where resolve (ArgFile f) = f
+                        resolve HomePub     = pubring
+                        resolve HomeSec     = secring
+    lks <- forM tolocks $ \f -> do
+        lk <- dotlock_create f 0
+        v <- flip (maybe $ return Nothing) lk $ \lk -> do
+                e <- dotlock_take lk (-1)
+                if e==0 then return $ Just lk
+                        else dotlock_destroy lk >> return Nothing
+        return (v,f)
+    let (lked, map snd -> failed) = partition (isJust . fst) lks
+        ret = if null failed then KikiSuccess else FailedToLock failed
+
+    case ret of
+      KikiSuccess -> kaction keyring KeyRingRuntime
+                        { rtPubring = pubring
+                        , rtSecring = secring
+                        , rtRings = secring:pubring:keyringFiles keyring
+                        , rtWallets = walletFiles keyring
+                        , rtGrip = grip0
+                        }
+      _ -> return undefined
+
+    forM_ lked $ \(Just lk, fname) -> do dotlock_release lk
+                                         dotlock_destroy lk
+    return ret
 
 parseOptionFile fname = do
     xs <- fmap lines (readFile fname)
-- 
cgit v1.2.3