removed unused imports and binds from kiki.hs

1 files changed, 10 insertions, 182 deletions

diff --git a/kiki.hs b/kiki.hs
index d1d8bb3..532c2ab 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -8,75 +8,51 @@
 {-# LANGUAGE CPP #-}
 module Main where
 
-import Debug.Trace
-import GHC.Exts (Down(..))
-import GHC.IO.Exception ( ioException, IOErrorType(..) )
 import Data.IORef
-import Data.Tuple
 import Data.Binary
 import Data.OpenPGP as OpenPGP
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.Char8 as Char8
 import qualified Data.ByteString      as S
-import qualified Data.ByteString.Char8 as S8
 import Control.Monad
-import qualified Text.Show.Pretty as PP
-import Text.PrettyPrint as PP hiding ((<>))
+-- import qualified Text.Show.Pretty as PP
+-- import Text.PrettyPrint as PP hiding ((<>))
 import Data.List
-import Data.OpenPGP.Util (verify,fingerprint,decryptSecretKey,pgpSign)
+import Data.OpenPGP.Util (verify,fingerprint)
 import Data.Ord
 import Data.Maybe
 import Data.Bits
 import qualified Data.Text as T
 import Data.Text.Encoding
-import qualified Codec.Binary.Base32 as Base32
 import qualified Codec.Binary.Base64 as Base64
-import qualified Crypto.Hash.SHA1 as SHA1
 import qualified Crypto.Hash.SHA256 as SHA256
 import qualified Crypto.Hash.RIPEMD160 as RIPEMD160
-import qualified Crypto.Types.PubKey.ECC as ECC
 -- import qualified Crypto.Types.PubKey.ECDSA as ECDSA
 -- import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
 
-import Data.Char (toLower)
-import qualified Crypto.PubKey.RSA as RSA
 -- import Crypto.Random (newGenIO,SystemRandom)
 import Data.ASN1.Types
 import Data.ASN1.Encoding
 import Data.ASN1.BinaryEncoding
-import Data.ASN1.BitArray
-import qualified Data.Foldable as Foldable
-import qualified Data.Sequence as Sequence
 import Control.Applicative
 import System.Environment
-import System.Directory
-import System.FilePath
 import System.Exit
-import System.Process
-import System.Posix.IO (fdToHandle,fdRead)
-import System.Posix.Files
-import System.Posix.Signals
-import System.Posix.Types (EpochTime)
-import System.Process.Internals (runGenProcess_,defaultSignal)
-import System.IO (hPutStrLn,stderr,withFile,IOMode(..))
-import System.IO.Error
-import ControlMaybe
+import System.IO (hPutStrLn,stderr)
+#if ! MIN_VERSION_base(4,6,0)
+import ControlMaybe ( handleIO_ )
+#endif
 import Data.Char
 import Control.Arrow (first,second)
-import Data.Traversable hiding (mapM,forM,sequence)
-import qualified Data.Traversable as Traversable (mapM,forM,sequence)
+-- import Data.Traversable hiding (mapM,forM,sequence)
+-- import qualified Data.Traversable as Traversable (mapM,forM,sequence)
 -- import System.Console.CmdArgs
 -- import System.Posix.Time
-import Data.Time.Clock.POSIX
-import Data.Monoid ((<>))
 -- import Data.X509
 import qualified Data.Map as Map
 import DotLock
 -- import Codec.Crypto.ECC.Base -- hecc package
 import Text.Printf
 import qualified CryptoCoins as CryptoCoins
-import qualified Hosts
-import Network.Socket -- (SockAddr)
 import LengthPrefixedBE
 import Data.Binary.Put (putWord32be,runPut,putByteString)
 import Data.Binary.Get (runGet)
@@ -360,8 +336,7 @@ modifyUID other              = other
 
 todo = error "unimplemented"
 
-#if MIN_VERSION_base(4,6,0)
-#else
+#if ! MIN_VERSION_base(4,6,0)
 lookupEnv var =
     handleIO_ (return Nothing) $ fmap Just (getEnv var)
 #endif
@@ -1047,17 +1022,6 @@ main = do
                 guard $ take 1 bdmcb == "}"
                 let cmd = (drop 1 . reverse . drop 1) bdmcb
                 Just (spec,file,cmd)
-        btcpairs0 =
-            flip map (maybe [] id $ Map.lookup "--bitcoin-keypairs" margs) $ \specfile -> do
-                let (spec,efilecmd) = break (=='=') specfile
-                (spec,protocnt) <- do
-                    return $ if take 1 efilecmd=="=" then (spec,drop 1 efilecmd)
-                                                     else ("",spec)
-                let (proto,content) = break (==':') protocnt
-                spec <- return $ if null spec then "bitcoin" else spec
-                return $ 
-                    if take 1 content =="=" then (spec,proto,drop 1 content)
-                                            else (spec,"base58",proto)
         {-
         publics =
             flip map (maybe [] id $ Map.lookup "--public" margs) $ \specfile -> do
@@ -1069,28 +1033,6 @@ main = do
         keyrings_ = maybe [] id $ Map.lookup "--keyrings" margs
         wallets   = maybe [] id $ Map.lookup "--wallets" margs
         passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs
-        decrypt wk = do
-            -- warn $ "decryptKey "++fingerprint wk
-            unkeys <- readIORef unkeysRef
-            let kk = keykey wk
-            flip (flip maybe $ return . Just) (Map.lookup kk unkeys) $ do
-            let ret wkun = do writeIORef unkeysRef (Map.insert kk wkun unkeys)
-                              return (Just wkun)
-            if symmetric_algorithm wk == Unencrypted then ret wk else do
-            pw <- do
-                pw <- readIORef pwRef
-                flip (flip maybe return) pw $ do
-                case passphrase_fd of
-                    Just fd -> do pwh <- fdToHandle (read fd)
-                                  pw <- fmap trimCR $ S.hGetContents pwh
-                                  writeIORef pwRef (Just pw)
-                                  return pw
-                    Nothing -> return ""
-            let wkun = do
-                k <- decryptSecretKey pw wk
-                guard (symmetric_algorithm k == Unencrypted)
-                return k
-            maybe (return Nothing) ret wkun
 
     when (not . null $ filter isNothing keypairs0) $ do
         warn "syntax error"
@@ -1101,7 +1043,6 @@ main = do
                     $ Map.lookup "--show-whose-key" margs
 
     let keypairs = catMaybes keypairs0
-        btcpairs = catMaybes btcpairs0
 
     {-
     putStrLn $ "wallets = "++show wallets
@@ -1110,22 +1051,6 @@ main = do
     putStrLn $ "publics  = "++show publics
     -}
 
-    let auto_sign_feature rt = do
-          use_db <-
-            flip (maybe $ return (rtKeyDB rt))
-                 (lookup "--autosign" $ map (\(x:xs)->(x,xs)) sargs)
-                 $ \_ -> do
-                let keys = map keyPacket $ Map.elems (rtKeyDB rt)
-                    wk = workingKey (rtGrip rt) (rtKeyDB rt)
-                -- g <- newGenIO
-                -- stamp <- now
-                wkun <- flip (maybe $ return Nothing) wk $ \wk -> do
-                            wkun <- decrypt wk
-                            maybe (error $ "Bad passphrase?") (return . Just) wkun
-                -- return . snd $ Map.mapAccum (signTorIds stamp wkun keys) g use_db
-                Traversable.mapM (signTorIds wkun keys) (rtKeyDB rt)
-          return use_db
-            
     let homespec = join . take 1 <$> Map.lookup "--homedir" margs
         passfd = fmap (FileDesc . read) passphrase_fd
         pems = flip map keypairs 
@@ -1206,103 +1131,6 @@ main = do
         let torhash = maybe "" id $ derToBase32 <$> derRSA sub
         return (top,(torhash,sub))
 
-
-    signTorIds selfkey keys kd@(KeyData k ksigs umap submap) = do
-        umap' <- Traversable.mapM signIfTor (Map.mapWithKey (,) umap)
-        return (KeyData k ksigs umap' submap) :: IO KeyData
-     where
-        mkey = packet k
-        signIfTor (str,ps) =
-            if isTorID str 
-                then do
-                    let uidxs0 = map packet $ flattenUid "" True (str,ps)
-                    -- addition<- signSelfAuthTorKeys' selfkey g keys grip timestamp mkey uidxs0
-                    additional <- signSelfAuthTorKeys' selfkey   keys grip           mkey uidxs0
-                    let ps' = ( map ( (,tmap) . toMappedPacket om) additional 
-                                 ++ fst ps
-                              , Map.union om (snd ps) )
-                        toMappedPacket om p = (mappedPacket "" p) {locations=om}
-                        om = Map.singleton "--autosign" (origin p (-1)) where p = UserIDPacket str
-                        tmap = Map.empty
-                    return ps'
-                else return ps
-
-        torbindings = getTorKeys (map packet $ flattenTop "" True kd)
-        isTorID str = and [ uid_topdomain parsed == "onion"
-                            , uid_realname parsed `elem` ["","Anonymous"]
-                            , uid_user parsed == "root"
-                            , fmap (match . fst) (lookup mkey torbindings)
-                                == Just True ]
-                      where parsed = parseUID str
-                            match = ( (==subdom) . take (fromIntegral len))
-                            subdom0 = L.fromChunks [encodeUtf8 (uid_subdomain parsed)]
-                            subdom = Char8.unpack subdom0
-                            len = T.length (uid_subdomain parsed)
-
-
-    signSelfAuthTorKeys' selfkey keys grip mainpubkey (uid:xs') = do
-        new_sig <- let wkun = fromJust selfkey
-                       tor_ov = makeInducerSig mainpubkey wkun uid flgs
-                   in pgpSign (Message [wkun])
-                              tor_ov
-                              SHA1
-                              (fingerprint wkun)
-        return (additional new_sig) -- (uid:sigs,additional,xs'',g')
-     where
-        (sigs, _) = span isSignaturePacket xs'
-        overs sig = signatures $ Message (keys++[mainpubkey,uid,sig])
-        vs :: [ ( Packet -- signature
-                , Maybe SignatureOver -- Nothing means non-verified
-                , Packet ) -- key who signed
-              ]
-        vs = do
-            sig <- sigs
-            o <- overs sig 
-            k <- keys
-            let ov = verify (Message [k]) $ o
-            take 1 $ signatures_over ov
-            return (sig,Just ov,k)
-        selfsigs = filter (\(sig,v,whosign) -> isJust (v >> selfkey >>= guard 
-                                                                   . (== keykey whosign) 
-                                                                   . keykey))
-                          vs
-        additional new_sig = do
-            new_sig <- maybeToList new_sig
-            guard $ {- trace (unlines $ [ "selfsigs = "++show (map ((\(_,_,k)->fingerprint k)) selfsigs)
-                                     , " for mainkey = "++fingerprint mainpubkey] )
-                        -}
-                          (null $ selfsigs)
-            signatures_over new_sig
-        {-
-        modsig sig = sig { signature = map id (signature sig) }
-           where plus1 (MPI x) = MPI (x+1)
-        params newtop = public ++ map fst (key newtop) ++ "}"
-                where
-                    public = case newtop of
-                                PublicKeyPacket {} -> "public{"
-                                SecretKeyPacket {} -> if L.null (encrypted_data newtop )
-                                                            then "secret{"
-                                                            else "encrypted{"
-                                _                  -> "??????{"
-        traceSig newtop newuid new_sig = (unlines ["mainpubkey:"++ show (fingerprint mainpubkey)
-                                        ,"new_sig topkey:"++ (show . fingerprint $ newtop)
-                                        ,"new_sig topkey params: "++ params newtop
-                                        ,"new_sig user_id:"++ (show newuid)
-                                        ,"new_sig |over| = " ++ (show . length $ new_sig)
-                                        ,"new_sig hashed = " ++ (PP.ppShow . concatMap hashed_subpackets $ new_sig)
-                                        ,"new_sig unhashed = " ++ (show . concatMap unhashed_subpackets $ new_sig)
-                                        ,"new_sig type: " ++ (show . map signature_type $ new_sig)
-                                        ,"new_sig signature:" ++ (show . concatMap signature $ new_sig)
-                                        ,"new_sig isSignaturePacket(over) = " ++ (show . map isSignaturePacket $ new_sig)
-                                        ,"issuer = " ++ show (map signature_issuer new_sig)
-                                        ])
-        -}
-        flgs = if keykey mainpubkey == keykey (fromJust selfkey)
-                then keyFlags0 mainpubkey (map (\(x,_,_)->x) selfsigs)
-                else []
-
-
-
 isSameKey a b = sort (key apub) == sort (key bpub)
  where
     apub = secretToPublic a