removed experimental code

2 files changed, 204 insertions, 197 deletions

diff --git a/ExperimentalCruft.hs b/ExperimentalCruft.hs
new file mode 100644
index 0000000..0c60731
--- /dev/null
+++ b/ExperimentalCruft.hs
@@ -0,0 +1,199 @@
+{-# LANGUAGE ExistentialQuantification #-}
+module ExperimentalCruft where
+
+import KeyRing
+
+data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a)
+
+data Kiki a =
+    SinglePass { passInfo :: KeyRingOperation
+               , rtAction :: KeyRingAction a }
+    | forall b.
+       MultiPass { passInfo :: KeyRingOperation
+                 , passAction :: KeyRingAction b
+                 , nextPass :: Kiki (b -> a)
+                 }
+
+
+
+evalAction :: KeyRingRuntime -> KeyRingAction a -> a
+evalAction rt (KeyRingAction v) = v
+evalAction rt (RunTimeAction g) = g rt
+
+instance Monad KeyRingAction where
+    return x = KeyRingAction x
+    m >>= g  = case m of
+        KeyRingAction v -> g v
+        RunTimeAction f -> RunTimeAction $ \rt -> evalAction rt (g $ f rt)
+
+instance Functor KeyRingAction where
+    fmap g (KeyRingAction v) = KeyRingAction $ g v
+    fmap g (RunTimeAction f) = RunTimeAction $ \rt -> g (f rt)
+
+{-
+argOut :: (KeyRingAction (a -> b)) -> a -> KeyRingAction b
+argOut = todo
+argIn :: (a -> KeyRingAction b) -> KeyRingAction (a->b)
+-}
+
+{-
+fmapWithRT :: (a -> KeyRingAction b) -> Kiki a -> Kiki b
+fmapWithRT g k@(SinglePass {}) = k { rtAction = action }
+ where
+    action = rtAction k >>= g
+fmapWithRT g (MultiPass p atn next) = MultiPass p atn next'
+ where
+    next' = fmapWithRT g' next {- next :: Kiki (x -> a) -}
+    -- g' :: ( (x->a) -> KeyRingAction b)
+    g' h = RunTimeAction $
+            \rt x -> case g (h x) of
+                        KeyRingAction v -> v
+                        RunTimeAction f -> f rt
+-}
+
+fmapWithRT :: KeyRingAction (a -> b) -> Kiki a -> Kiki b
+fmapWithRT g (SinglePass pass atn) = SinglePass pass atn'
+ where
+    atn' = g >>= flip fmap atn
+fmapWithRT g (MultiPass p atn next) = MultiPass p atn next'
+ where
+    next' = fmapWithRT g' next
+    g' = fmap (\gf h -> gf . h) g
+
+instance Functor Kiki where
+    fmap f k = fmapWithRT (return f) k
+
+{-
+instance Monad Kiki where
+    return x = SinglePass todo (return x)
+    k >>= f  = kjoin $ fmap f k
+
+kikiAction :: Kiki a -> KeyRingAction a
+kikiAction (SinglePass _ atn) = atn
+kikiAction (MultiPass _ atn next) = do
+        x <- atn
+        g <- kikiAction next
+        return $ g x
+
+kjoin :: Kiki (Kiki a) -> Kiki a
+kjoin k = fmapWithRT eval' k
+ where
+    eval' :: KeyRingAction (Kiki a -> a)
+    eval' = RunTimeAction (\rt -> evalAction rt . kikiAction )
+
+    {-
+    kjoin :: Kiki (Kiki a) -> Kiki a
+    kjoin k = kjoin' (fmap kikiAction k)
+     where
+        ev rt (KeyRingAction v) = v
+        ev rt (RunTimeAction g) = g rt
+
+        kjoin' :: Kiki (KeyRingAction a) -> Kiki a
+        kjoin' (SinglePass pass atn) = SinglePass pass $ join atn
+        kjoin' (MultiPass pass atn next) = MultiPass pass atn next'
+            where
+                next' = todo
+    -}
+
+
+{-
+instance Functor Kiki where
+    fmap f (SinglePass pass atn)
+        = SinglePass pass (fmap f atn)
+    fmap f (MultiPass pass atn next)
+        = MultiPass pass atn (next >>= g)
+     where
+        g = todo
+-}
+
+{-
+data Kiki a = SinglePass (KeyRingOperation a)
+              | forall b. MultiPass (KeyRingOperation b) (Kiki (b -> a))
+
+instance Functor Kiki where
+    fmap f (SinglePass d) = SinglePass $ case kAction d of
+                                  KeyRingAction v -> d { kAction = KeyRingAction (f v) }
+                                  RunTimeAction g -> d { kAction = RunTimeAction (f . g) }
+    fmap f (MultiPass p k)= MultiPass p (fmap (f .) k)
+
+eval :: KeyRingRuntime -> Kiki a -> a
+eval rt (SinglePass (KeyRingOperation { kAction = KeyRingAction v})) = v
+eval rt (SinglePass (KeyRingOperation { kAction = RunTimeAction f})) = f rt
+eval rt (MultiPass p kk) = eval rt kk $ eval rt (SinglePass p)
+
+fmapWithRT :: (KeyRingRuntime -> a -> b) -> Kiki a -> Kiki b
+fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = KeyRingAction v}))
+    = SinglePass $ d { kAction = RunTimeAction (\rt -> g rt v) }
+fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = RunTimeAction f}))
+    = SinglePass $ d { kAction = RunTimeAction f' }
+    where f' rt = g rt (f rt)
+fmapWithRT g (MultiPass p kk) = MultiPass p (fmapWithRT g' kk)
+    where g' rt h = g rt . h
+
+kjoin :: Kiki (Kiki a) -> Kiki a
+kjoin k = fmapWithRT eval k
+
+passCount :: Kiki a -> Int
+passCount (MultiPass _ k) = 1 + passCount k
+passCount (SinglePass {}) = 1
+
+instance Monad Kiki where
+    return x = SinglePass (kret x)
+    k >>= f  = kjoin (fmap f k)
+-}
+
+
+-- Kiki a -> a -> Kiki b
+
+atRuntime :: (KeyRingRuntime -> IO (a,KeyRingRuntime)) -> Kiki a
+atRuntime = todo
+
+goHome :: Maybe FilePath -> Kiki ()
+goHome p = todo -- SinglePass $ (kret ()) { homeSpec = p }
+
+syncRing :: InputFile -> Kiki ()
+syncRing = todo
+
+syncSubKey :: String -> FilePath -> String -> Kiki ()
+syncSubKey usage path cmd = todo
+
+syncWallet :: FilePath -> Kiki ()
+syncWallet = todo
+
+usePassphraseFD :: Int -> Kiki ()
+usePassphraseFD = todo
+
+{-
+importAll :: Kiki ()
+importAll = todo
+-}
+
+importAllAuthentic :: Kiki ()
+importAllAuthentic = todo
+
+signSelfAuthorized :: Kiki ()
+signSelfAuthorized = todo
+
+showIdentity :: Message -> String
+showIdentity = todo
+
+identities :: Kiki [Message]
+identities = todo
+
+currentIdentity :: Kiki Message
+currentIdentity = todo
+
+identityBySpec :: String -> Kiki Message
+identityBySpec = todo
+
+identityBySSHKey :: String -> Kiki Message
+identityBySSHKey = todo
+
+keyBySpec :: String -> Kiki Packet
+keyBySpec = todo
+
+walletInputFormat :: Packet -> String
+walletInputFormat = todo
+
+-}
+
diff --git a/KeyRing.hs b/KeyRing.hs
index 16e7751..c3a80d9 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DoAndIfThenElse #-}
@@ -16,6 +15,7 @@ module KeyRing
     , guardAuthentic
     , Hosts.Hosts
     , importPublic
+    , importSecret
     , PacketUpdate(..)
     , isCryptoCoinKey
     , isKey
@@ -36,7 +36,6 @@ module KeyRing
     , pkcs8
     , RSAPublicKey(..)
     , rsaKeyFromPacket
-    , RSAPublicKey
     , KeyRingRuntime(..)
     , runKeyRing
     , secretToPublic
@@ -112,7 +111,7 @@ import DotLock
 import ProcessUtils (systemEnv, ExitCode(ExitFailure, ExitSuccess) )
 
 -- DER-encoded elliptic curve ids
-nistp256_id  = 0x2a8648ce3d030107
+-- nistp256_id  = 0x2a8648ce3d030107
 secp256k1_id = 0x2b8104000a
 -- "\x2a\x86\x48\xce\x3d\x03\x01\x07"
 {-     OID                  Curve description              Curve name
@@ -199,8 +198,6 @@ data KeyRingRuntime = KeyRingRuntime
                         , rtKeyDB :: KeyDB
                         }
 
-data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a)
-
 -- | TODO: Packet Update should have deletiong action
 --         and any other kind of roster entry level
 --         action.
@@ -391,7 +388,7 @@ data KikiResult a = KikiResult
 
 keyPacket (KeyData k _ _ _) = packet k
 
-subkeyPacket (SubKey k _ ) = packet k
+-- subkeyPacket (SubKey k _ ) = packet k
 subkeyMappedPacket (SubKey k _ ) = k
 
 
@@ -675,6 +672,7 @@ selectKey0 wantPublic (spec,mtag) db = do
         zs = snd $ seek_key subspec ys1
     listToMaybe zs
 
+{-
 selectAll :: Bool -> (KeySpec,Maybe String) -> KeyDB -> [(Packet,Maybe Packet)]
 selectAll wantPublic (spec,mtag) db = do
     let Message ps = flattenKeys wantPublic db
@@ -688,6 +686,7 @@ selectAll wantPublic (spec,mtag) db = do
                     z <- take 1 zs
                     (y,Just z):search (drop 1 zs)
             in search (drop 1 ys)
+-}
 
 seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet])
 seek_key (KeyGrip grip) sec = (pre, subs)
@@ -2381,194 +2380,3 @@ fmapWithRT g (MultiPass p kk) = MultiPass p (fmapWithRT g' kk)
 -}
 
 
-data Kiki a =
-    SinglePass { passInfo :: KeyRingOperation
-               , rtAction :: KeyRingAction a }
-    | forall b.
-       MultiPass { passInfo :: KeyRingOperation
-                 , passAction :: KeyRingAction b
-                 , nextPass :: Kiki (b -> a)
-                 }
-
-
-
-evalAction :: KeyRingRuntime -> KeyRingAction a -> a
-evalAction rt (KeyRingAction v) = v
-evalAction rt (RunTimeAction g) = g rt
-
-instance Monad KeyRingAction where
-    return x = KeyRingAction x
-    m >>= g  = case m of
-        KeyRingAction v -> g v
-        RunTimeAction f -> RunTimeAction $ \rt -> evalAction rt (g $ f rt)
-
-instance Functor KeyRingAction where
-    fmap g (KeyRingAction v) = KeyRingAction $ g v
-    fmap g (RunTimeAction f) = RunTimeAction $ \rt -> g (f rt)
-
-{-
-argOut :: (KeyRingAction (a -> b)) -> a -> KeyRingAction b
-argOut = todo
-argIn :: (a -> KeyRingAction b) -> KeyRingAction (a->b)
--}
-
-{-
-fmapWithRT :: (a -> KeyRingAction b) -> Kiki a -> Kiki b
-fmapWithRT g k@(SinglePass {}) = k { rtAction = action }
- where
-    action = rtAction k >>= g
-fmapWithRT g (MultiPass p atn next) = MultiPass p atn next'
- where
-    next' = fmapWithRT g' next {- next :: Kiki (x -> a) -}
-    -- g' :: ( (x->a) -> KeyRingAction b)
-    g' h = RunTimeAction $
-            \rt x -> case g (h x) of
-                        KeyRingAction v -> v
-                        RunTimeAction f -> f rt
--}
-
-fmapWithRT :: KeyRingAction (a -> b) -> Kiki a -> Kiki b
-fmapWithRT g (SinglePass pass atn) = SinglePass pass atn'
- where
-    atn' = g >>= flip fmap atn
-fmapWithRT g (MultiPass p atn next) = MultiPass p atn next'
- where
-    next' = fmapWithRT g' next
-    g' = fmap (\gf h -> gf . h) g
-
-instance Functor Kiki where
-    fmap f k = fmapWithRT (return f) k
-
-{-
-instance Monad Kiki where
-    return x = SinglePass todo (return x)
-    k >>= f  = kjoin $ fmap f k
-
-kikiAction :: Kiki a -> KeyRingAction a
-kikiAction (SinglePass _ atn) = atn
-kikiAction (MultiPass _ atn next) = do
-        x <- atn
-        g <- kikiAction next
-        return $ g x
-
-kjoin :: Kiki (Kiki a) -> Kiki a
-kjoin k = fmapWithRT eval' k
- where
-    eval' :: KeyRingAction (Kiki a -> a)
-    eval' = RunTimeAction (\rt -> evalAction rt . kikiAction )
-
-    {-
-    kjoin :: Kiki (Kiki a) -> Kiki a
-    kjoin k = kjoin' (fmap kikiAction k)
-     where
-        ev rt (KeyRingAction v) = v
-        ev rt (RunTimeAction g) = g rt
-
-        kjoin' :: Kiki (KeyRingAction a) -> Kiki a
-        kjoin' (SinglePass pass atn) = SinglePass pass $ join atn
-        kjoin' (MultiPass pass atn next) = MultiPass pass atn next'
-            where
-                next' = todo
-    -}
-
-
-{-
-instance Functor Kiki where
-    fmap f (SinglePass pass atn)
-        = SinglePass pass (fmap f atn)
-    fmap f (MultiPass pass atn next)
-        = MultiPass pass atn (next >>= g)
-     where
-        g = todo
--}
-
-{-
-data Kiki a = SinglePass (KeyRingOperation a)
-              | forall b. MultiPass (KeyRingOperation b) (Kiki (b -> a))
-
-instance Functor Kiki where
-    fmap f (SinglePass d) = SinglePass $ case kAction d of
-                                  KeyRingAction v -> d { kAction = KeyRingAction (f v) }
-                                  RunTimeAction g -> d { kAction = RunTimeAction (f . g) }
-    fmap f (MultiPass p k)= MultiPass p (fmap (f .) k)
-
-eval :: KeyRingRuntime -> Kiki a -> a
-eval rt (SinglePass (KeyRingOperation { kAction = KeyRingAction v})) = v
-eval rt (SinglePass (KeyRingOperation { kAction = RunTimeAction f})) = f rt
-eval rt (MultiPass p kk) = eval rt kk $ eval rt (SinglePass p)
-
-fmapWithRT :: (KeyRingRuntime -> a -> b) -> Kiki a -> Kiki b
-fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = KeyRingAction v}))
-    = SinglePass $ d { kAction = RunTimeAction (\rt -> g rt v) }
-fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = RunTimeAction f}))
-    = SinglePass $ d { kAction = RunTimeAction f' }
-    where f' rt = g rt (f rt)
-fmapWithRT g (MultiPass p kk) = MultiPass p (fmapWithRT g' kk)
-    where g' rt h = g rt . h
-
-kjoin :: Kiki (Kiki a) -> Kiki a
-kjoin k = fmapWithRT eval k
-
-passCount :: Kiki a -> Int
-passCount (MultiPass _ k) = 1 + passCount k
-passCount (SinglePass {}) = 1
-
-instance Monad Kiki where
-    return x = SinglePass (kret x)
-    k >>= f  = kjoin (fmap f k)
--}
-
-
--- Kiki a -> a -> Kiki b
-
-atRuntime :: (KeyRingRuntime -> IO (a,KeyRingRuntime)) -> Kiki a
-atRuntime = todo
-
-goHome :: Maybe FilePath -> Kiki ()
-goHome p = todo -- SinglePass $ (kret ()) { homeSpec = p }
-
-syncRing :: InputFile -> Kiki ()
-syncRing = todo
-
-syncSubKey :: String -> FilePath -> String -> Kiki ()
-syncSubKey usage path cmd = todo
-
-syncWallet :: FilePath -> Kiki ()
-syncWallet = todo
-
-usePassphraseFD :: Int -> Kiki ()
-usePassphraseFD = todo
-
-{-
-importAll :: Kiki ()
-importAll = todo
--}
-
-importAllAuthentic :: Kiki ()
-importAllAuthentic = todo
-
-signSelfAuthorized :: Kiki ()
-signSelfAuthorized = todo
-
-showIdentity :: Message -> String
-showIdentity = todo
-
-identities :: Kiki [Message]
-identities = todo
-
-currentIdentity :: Kiki Message
-currentIdentity = todo
-
-identityBySpec :: String -> Kiki Message
-identityBySpec = todo
-
-identityBySSHKey :: String -> Kiki Message
-identityBySSHKey = todo
-
-keyBySpec :: String -> Kiki Packet
-keyBySpec = todo
-
-walletInputFormat :: Packet -> String
-walletInputFormat = todo
-
--}