From 495d9fbac3d633b768d910fced5cf00d00118fa0 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Sat, 13 Jul 2019 15:19:49 -0400 Subject: cpp conditionals died of old age --- kiki.hs | 4 --- lib/KeyRing.hs | 87 +--------------------------------------------------------- 2 files changed, 1 insertion(+), 90 deletions(-) diff --git a/kiki.hs b/kiki.hs index eb997ac..1b5984e 100644 --- a/kiki.hs +++ b/kiki.hs @@ -411,13 +411,9 @@ bitcoinAddress network_id k = address Just (MPI x) = lookup 'x' (key k) Just (MPI y) = lookup 'y' (key k) pub = cannonical_eckey x y -#if !defined(VERSION_cryptonite) - hsh = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub -#else hsh = S.cons network_id . ripemd160 . sha256 . S.pack $ pub sha256 x = convert (Crypto.Hash.hash x :: Digest SHA256) :: S.ByteString ripemd160 x = convert (Crypto.Hash.hash x :: Digest RIPEMD160) :: S.ByteString -#endif address = base58_encode hsh whoseKey :: RSAPublicKey -> Map.Map KeyKey KeyData -> [KeyData] diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs index c40eba7..3b9afd7 100644 --- a/lib/KeyRing.hs +++ b/lib/KeyRing.hs @@ -14,7 +14,6 @@ -- Typically, a client to this module would prepare a 'KeyRingOperation' -- describing what he wants done, and then invoke 'runKeyRing' to make it -- happen. -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DoAndIfThenElse #-} {-# LANGUAGE ForeignFunctionInterface #-} @@ -49,41 +48,16 @@ import Data.Bits ((.&.), shiftR ) import qualified Data.Map as Map import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S -#if defined(VERSION_memory) import qualified Data.ByteString.Char8 as S8 import Data.ByteArray.Encoding -#elif defined(VERSION_dataenc) -import qualified Codec.Binary.Base32 as Base32 -import qualified Codec.Binary.Base64 as Base64 -#endif -#if !defined(VERSION_cryptonite) -import qualified Crypto.Hash.SHA1 as SHA1 -import qualified Crypto.Types.PubKey.ECC as ECC -#else -#endif import qualified Codec.Compression.GZip as GZip import qualified System.Posix.Types as Posix import System.Posix.Files (setFileCreationMask, setFileTimes ) - -#if MIN_VERSION_x509(1,5,0) -#endif -#if MIN_VERSION_unix(2,7,0) import System.Posix.Files ( setFdTimesHiRes ) -#else -import Foreign.C.Types ( CTime(..), CLong, CInt(..) ) -import Foreign.Marshal.Array ( withArray ) -import Foreign.Ptr -import Foreign.C.Error ( throwErrnoIfMinus1_ ) -import Foreign.Storable -#endif + import System.FilePath ( takeDirectory ) import System.IO (hPutStrLn,withFile,IOMode(..), Handle, hPutStr, stderr, hClose) import System.Posix.IO ( fdToHandle ) -#if ! MIN_VERSION_base(4,6,0) -import GHC.Exts ( Down(..) ) -#endif -#if MIN_VERSION_binary(0,7,0) -#endif import qualified Data.ByteString.Lazy.Char8 as Char8 import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor import Codec.Encryption.OpenPGP.ASCIIArmor.Types @@ -877,11 +851,7 @@ pemFromPacket Sec packet = rsa <- rsaPrivateKeyFromPacket packet -- RSAPrivateKey let asn1 = toASN1 rsa [] bs = encodeASN1 DER asn1 -#if defined(VERSION_memory) dta = S8.unpack $ convertToBase Base64 (L.toStrict bs) -#elif defined(VERSION_dataenc) - dta = Base64.encode (L.unpack bs) -#endif output = writePEM PemPrivateKey dta Just output algo -> Nothing @@ -891,11 +861,7 @@ pemFromPacket Pub packet = rsa <- rsaKeyFromPacket packet let asn1 = toASN1 (pkcs8 rsa) [] bs = encodeASN1 DER asn1 -#if defined(VERSION_memory) dta = S8.unpack $ convertToBase Base64 (L.toStrict bs) -#elif defined(VERSION_dataenc) - dta = Base64.encode (L.unpack bs) -#endif output = writePEM PemPublicKey dta Just output algo -> Nothing @@ -927,11 +893,7 @@ writeKeyToFile StreamInfo { typ = DNSPresentation } fname packet = do let -- asn1 = toASN1 rsa [] -- bs = encodeASN1 DER asn1 -- dta = Base64.encode (L.unpack bs) -#if defined(VERSION_memory) b64 ac rsa = S8.unpack $ convertToBase Base64 $ i2bs_unsized i -#elif defined(VERSION_dataenc) - b64 ac rsa = Base64.encode (S.unpack $ i2bs_unsized i) -#endif where MPI i = ac rsa i2bs_unsized :: Integer -> S.ByteString @@ -1239,19 +1201,6 @@ getHomeDir protohome = do where topair (x:xs) = (x,xs) return $ lookup "default-key" config >>= listToMaybe -#if MIN_VERSION_base(4,6,0) -#else -lookupEnv :: String -> IO (Maybe String) -lookupEnv var = - handleIO_ (return Nothing) $ fmap Just (getEnv var) -#endif - - - - - - - {- onionName :: KeyData -> (SockAddr,L.ByteString) onionName kd = (addr,name) @@ -1259,37 +1208,3 @@ onionName kd = (addr,name) (addr,(name:_,_)) = getHostnames kd -} - - - - - - - -#if ! MIN_VERSION_unix(2,7,0) -setFdTimesHiRes :: Posix.Fd -> POSIXTime -> POSIXTime -> IO () -setFdTimesHiRes (Posix.Fd fd) atime mtime = - withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times -> - throwErrnoIfMinus1_ "setFdTimesHiRes" (c_futimens fd times) - -data CTimeSpec = CTimeSpec Posix.EpochTime CLong -instance Storable CTimeSpec where - sizeOf _ = (16) - alignment _ = alignment (undefined :: CInt) - poke p (CTimeSpec sec nsec) = do - ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p sec - ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p nsec - peek p = do - sec <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p - nsec <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p - return $ CTimeSpec sec nsec - -toCTimeSpec :: POSIXTime -> CTimeSpec -toCTimeSpec t = CTimeSpec (CTime sec) (truncate $ 10^(9::Int) * frac) - where - (sec, frac) = if (frac' < 0) then (sec' - 1, frac' + 1) else (sec', frac') - (sec', frac') = properFraction $ toRational t - -foreign import ccall unsafe "futimens" - c_futimens :: CInt -> Ptr CTimeSpec -> IO CInt -#endif -- cgit v1.2.3