From 006d1f0b7f36c25a91006fce24cbe76416fcee86 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Sat, 13 Jul 2019 15:22:45 -0400 Subject: no cpp needed, since my love is unconditional --- lib/Base58.hs | 17 ++-------------- lib/Compat.hs | 5 ----- lib/GnuPGAgent.hs | 24 ++-------------------- lib/KeyRing/BuildKeyDB.hs | 52 ----------------------------------------------- lib/PEM.hs | 9 -------- lib/SSHKey.hs | 13 ------------ lib/Transforms.hs | 19 ----------------- testkiki/testkiki.hs | 18 ---------------- 8 files changed, 4 insertions(+), 153 deletions(-) diff --git a/lib/Base58.hs b/lib/Base58.hs index 2de841d..9af3eb5 100644 --- a/lib/Base58.hs +++ b/lib/Base58.hs @@ -1,12 +1,7 @@ -{-# LANGUAGE CPP #-} module Base58 where -#if !defined(VERSION_cryptonite) -import qualified Crypto.Hash.SHA256 as SHA256 -#else import Crypto.Hash import Data.ByteArray (convert) -#endif import qualified Data.ByteString as S import Data.Maybe import Data.List @@ -20,7 +15,7 @@ base58digits :: [Char] -> Maybe [Int] base58digits str = sequence mbs where mbs = map (flip elemIndex base58chars) str - + -- 5HueCGU8rMjxEXxiPuD5BDku4MkFqeZyd4dZ1jvhTVqvbTLvyTJ base58_decode :: [Char] -> Maybe (Word8,[Word8]) base58_decode str = do @@ -31,16 +26,12 @@ base58_decode str = do guard (d/=0) let (q,b) = d `divMod` 256 return (fromIntegral b,q) - + let (rcksum,rpayload) = splitAt 4 $ rbytes a_payload = reverse rpayload -#if !defined(VERSION_cryptonite) - hash_result = S.take 4 . SHA256.hash . SHA256.hash . S.pack $ a_payload -#else hash_result = S.take 4 . convert $ digest where digest = hash diges1 :: Digest SHA256 diges1 = hash (S.pack a_payload) :: Digest SHA256 -#endif expected_hash = S.pack $ reverse rcksum (network_id,payload) = splitAt 1 a_payload network_id <- listToMaybe network_id @@ -51,13 +42,9 @@ base58_encode :: S.ByteString -> String base58_encode hsh = replicate zcount '1' ++ map (base58chars !!) (reverse rdigits) where zcount = S.length . S.takeWhile (==0) $ hsh -#if !defined(VERSION_cryptonite) - cksum = S.take 4 . SHA256.hash . SHA256.hash $ hsh -#else cksum = S.take 4 (convert digest2 :: S.ByteString) where digest2 = hash ( convert digest1 :: S.ByteString) :: Digest SHA256 digest1 = hash hsh :: Digest SHA256 -#endif n = foldl' (\a b->a*256+b) 0 . map asInteger $ concatMap S.unpack [hsh, cksum] asInteger x = fromIntegral x :: Integer rdigits = unfoldr getdigit n diff --git a/lib/Compat.hs b/lib/Compat.hs index 3b77851..9c46cb9 100644 --- a/lib/Compat.hs +++ b/lib/Compat.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} module Compat where import Data.Bits @@ -8,8 +7,6 @@ import Data.ASN1.Encoding import Data.ASN1.BinaryEncoding import Crypto.PubKey.RSA as RSA -#if defined(VERSION_cryptonite) - instance ASN1Object PublicKey where toASN1 pubKey = \xs -> Start Sequence : IntVal (public_n pubKey) @@ -41,8 +38,6 @@ instance ASN1Object PublicKey where fromASN1 _ = Left "fromASN1: RSA.PublicKey: unexpected format" -#endif - toPositive :: Integer -> Integer toPositive int | int < 0 = uintOfBytes $ bytesOfInt int diff --git a/lib/GnuPGAgent.hs b/lib/GnuPGAgent.hs index 1e40269..d73ceed 100644 --- a/lib/GnuPGAgent.hs +++ b/lib/GnuPGAgent.hs @@ -1,6 +1,6 @@ {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE PatternGuards #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE TupleSections #-} module GnuPGAgent ( session , GnuPGAgent @@ -26,21 +26,11 @@ import System.Posix.User import System.Environment import System.IO import Text.Printf -#if defined(VERSION_memory) import qualified Data.ByteString.Char8 as S8 import Data.ByteArray.Encoding -#elif defined(VERSION_dataenc) -import qualified Codec.Binary.Base16 as Base16 -#endif import LengthPrefixedBE import qualified Data.ByteString.Lazy as L -#if defined(VERSION_hourglass) import Data.Hourglass -#else -import Data.Time.Calendar -import Data.Time.Clock -import Data.Time.Clock.POSIX -#endif import ProcessUtils import Control.Monad.Fix import Control.Concurrent (threadDelay) @@ -166,18 +156,12 @@ getPassphrase agent ask (Query key uid masterkey) = do "OK" | not (null $ drop 3 r0) -> return r0 >>= unhex . drop 3 -- . (\x -> trace (show x) x) | otherwise -> hGetLine (agentHandle agent) >>= unhex . drop 3 -- . (\x -> trace (show x) x) where -#if defined(VERSION_memory) unhex hx = case convertFromBase Base16 (S8.pack hx) of Left e -> do -- Useful for debugging but insecure generally ;) -- putStrLn $ "convertFromBase error for input "++show hx++": "++show e return Nothing Right bs -> return $ Just $ S8.unpack bs -#elif defined(VERSION_dataenc) - unhex hx = maybe (return () {- putStrLn $ "dataenc error for input "++show hx -}) - return - $ fmap (map $ chr . fromIntegral) $ Base16.decode hx -#endif "ERR" -> return Nothing quit :: GnuPGAgent -> IO () @@ -232,12 +216,8 @@ envhomedir opt home = do timeString :: Word32 -> String timeString t = printf "%d-%d-%d" year month day where -#if defined(VERSION_hourglass) Date year m day = timeFromElapsed (Elapsed (Seconds $ fromIntegral t)) month = fromEnum m + 1 -#else - (year,month,day) = toGregorian . utctDay $ posixSecondsToUTCTime (realToFrac t) -#endif key_nbits :: Packet -> Int key_nbits p@(SecretKeyPacket {}) = _key_nbits (key_algorithm p) (key p) diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs index 0a90cbc..943578f 100644 --- a/lib/KeyRing/BuildKeyDB.hs +++ b/lib/KeyRing/BuildKeyDB.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DoAndIfThenElse #-} {-# LANGUAGE ForeignFunctionInterface #-} @@ -9,13 +8,8 @@ {-# LANGUAGE ViewPatterns #-} module KeyRing.BuildKeyDB where -#if defined(VERSION_memory) import Data.ByteArray.Encoding import qualified Data.ByteString as S -#elif defined(VERSION_dataenc) -import qualified Codec.Binary.Base32 as Base32 -import qualified Codec.Binary.Base64 as Base64 -#endif import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor import Codec.Encryption.OpenPGP.ASCIIArmor.Types import Control.Arrow (first, second) @@ -49,12 +43,7 @@ import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import System.Directory (doesFileExist) import System.IO.Error (isDoesNotExistError) -#if !defined(VERSION_cryptonite) -import qualified Crypto.Hash.SHA1 as SHA1 -import qualified Crypto.Types.PubKey.ECC as ECC -#else import qualified Crypto.PubKey.ECC.Types as ECC -#endif import qualified Codec.Compression.GZip as GZip import qualified Crypto.PubKey.RSA as RSA import qualified Data.X509 as X509 @@ -63,28 +52,13 @@ import System.Posix.Files (getFdStatus, getFileStatus, import qualified System.Posix.Types as Posix -#if MIN_VERSION_x509(1,5,0) import Data.Hourglass -#endif -#if MIN_VERSION_unix(2,7,0) import Foreign.C.Types (CTime (..)) -#else -import Foreign.C.Error (throwErrnoIfMinus1_) -import Foreign.C.Types (CInt (..), CLong, CTime (..)) -import Foreign.Marshal.Array (withArray) -import Foreign.Ptr -import Foreign.Storable -#endif import Data.Traversable (sequenceA) import qualified Data.Traversable as Traversable import System.IO (openFile, IOMode(ReadMode)) 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 Compat () import qualified Data.ByteString.Lazy.Char8 as Char8 import Network.Socket @@ -151,11 +125,7 @@ buildKeyDB ctx grip0 keyring = do -- KeyRings (todo: KikiCondition reporting?) (spilled,mwk,grip,accs,keyqs,unspilled) <- do -#if MIN_VERSION_containers(0,5,0) ringPackets <- Map.traverseWithKey readp ringMap -#else - ringPackets <- Traversable.traverse (uncurry readp) $ Map.mapWithKey (,) ringMap -#endif let _ = ringPackets :: Map.Map InputFile (StreamInfo, Message) let grip = grip0 `mplus` (fingerprint <$> fstkey) @@ -208,11 +178,7 @@ buildKeyDB ctx grip0 keyring = do -- XXX: Unspilled keys are not obtainable from rtKeyDB. -- If the working key is marked non spillable, then how -- would we look up it's UID and such? -#if MIN_VERSION_containers(0,5,0) in fmap sequenceA $ Map.traverseWithKey trans spilled -#else - in fmap sequenceA $ Traversable.traverse (uncurry trans) $ Map.mapWithKey (,) spilled -#endif try transformed0 $ \transformed -> do let -- | db_rings - all keyrings combined into one db_rings = Map.foldlWithKey' mergeIt emptyKeyDB transformed @@ -290,16 +256,9 @@ isring _ = False decodePacketList :: L.ByteString -> [Packet] decodePacketList some = -#if MIN_VERSION_binary(0,7,0) case decodeOrFail some of Right (more,_,msg ) -> msg : decodePacketList more Left (_,_,_) -> [] -#else - either (const []) (\(Message xs) -> xs) $ decode input - -decodeOrFail bs = Right (L.empty,1,decode bs) -#endif - readPacketsFromFile :: InputFileContext -> InputFile -> IO (PacketsCodec, Message) readPacketsFromFile ctx fname = do @@ -1309,12 +1268,8 @@ parseCertBlob comp bs = do cert <- either (const Nothing) (Just . fst) (fromASN1 asn1') let _ = cert :: X509.Certificate notBefore :: UTCTime -#if MIN_VERSION_x509(1,5,0) notBefore = toUTC ( timeFromElapsedP (timeGetElapsedP vincentTime) :: CTime) -- nanoToUTCTime nano where (vincentTime,_) = X509.certValidity cert -#else - (notBefore,_) = X509.certValidity cert -#endif case X509.certPubKey cert of X509.PubKeyRSA key -> do let withoutkey = @@ -1389,17 +1344,10 @@ extractRSAKeyFields kvs = do , rsaCoefficient = u } where parseField blob = MPI <$> m -#if defined(VERSION_memory) where m = bigendian <$> functorToMaybe (convertFromBase Base64 $ Char8.toStrict blob) bigendian bs = snd $ S.foldl' (\(c,a) w8 -> (c-1, a + 256^c * fromIntegral w8)) (nlen-1,0) bs where nlen = S.length bs -#elif defined(VERSION_dataenc) - where m = bigendian <$> Base64.decode (Char8.unpack blob) - bigendian bs = snd $ foldl' (\(c,a) w8 -> (c-1, a + 256^c * fromIntegral w8)) (nlen-1,0) bs - where - nlen = length bs -#endif selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet diff --git a/lib/PEM.hs b/lib/PEM.hs index 003f4ff..407929b 100644 --- a/lib/PEM.hs +++ b/lib/PEM.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} module PEM where import Data.Monoid @@ -7,12 +6,8 @@ import qualified Data.ByteString.Lazy as LW import qualified Data.ByteString.Lazy.Char8 as L import Control.Monad import Control.Applicative -#if defined(VERSION_memory) import qualified Data.ByteString.Char8 as S8 import Data.ByteArray.Encoding -#elif defined(VERSION_dataenc) -import qualified Codec.Binary.Base64 as Base64 -#endif import ScanningParser import FunctorToMaybe data PEMBlob = PEMBlob { pemType :: L.ByteString @@ -36,11 +31,7 @@ pemParser mtyp = ScanningParser (maybe fndany fndtyp mtyp) pbdy pbdy typ xs = (mblob, drop 1 rs) where (ys,rs) = span (/="-----END " <> typ <> "-----") xs -#if defined(VERSION_memory) mblob = PEMBlob typ <$> LW.fromStrict <$> (functorToMaybe $ convertFromBase Base64 $ L.toStrict dta) -#elif defined(VERSION_dataenc) - mblob = PEMBlob typ <$> LW.pack <$> Base64.decode (L.unpack dta) -#endif dta = case ys of [] -> "" dta_lines -> L.concat dta_lines diff --git a/lib/SSHKey.hs b/lib/SSHKey.hs index 0ded986..81df18c 100644 --- a/lib/SSHKey.hs +++ b/lib/SSHKey.hs @@ -1,16 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} module SSHKey where import qualified Data.ByteString.Lazy.Char8 as L8 import qualified Data.ByteString.Lazy as L -#if defined(VERSION_memory) import qualified Data.ByteString.Char8 as S8 import Data.ByteArray.Encoding import FunctorToMaybe -#elif defined(VERSION_dataenc) -import qualified Codec.Binary.Base64 as Base64 -#endif import Data.Binary.Get ( runGet ) import Data.Binary.Put ( putWord32be, runPut, putByteString ) import Data.Binary ( get, put ) @@ -34,11 +29,7 @@ keyblob :: Key -> L.ByteString keyblob (n,e) = "ssh-rsa " <> blob where bs = sshrsa e n -#if defined(VERSION_memory) blob = L.fromStrict $ convertToBase Base64 (L.toStrict bs) -#elif defined(VERSION_dataenc) - blob = L8.pack $ Base64.encode (L.unpack bs) -#endif blobkey :: L8.ByteString -> Maybe Key blobkey bs = do @@ -47,11 +38,7 @@ blobkey bs = do let (sp,bs2) = L8.span isSpace bs1 guard $ not (L8.null sp) bs3 <- listToMaybe $ L8.words bs2 -#if defined(VERSION_memory) qq <- fmap L.fromStrict $ functorToMaybe $ convertFromBase Base64 $ L.toStrict bs3 -#elif defined(VERSION_dataenc) - qq <- L.pack `fmap` Base64.decode (L8.unpack bs3) -#endif decode_sshrsa qq where decode_sshrsa :: L8.ByteString -> Maybe Key diff --git a/lib/Transforms.hs b/lib/Transforms.hs index 7a676b0..3e13b1a 100644 --- a/lib/Transforms.hs +++ b/lib/Transforms.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DoAndIfThenElse #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} @@ -26,20 +25,10 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as Char8 import qualified Data.Map.Strict as Map -#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 import qualified Crypto.Hash as Vincent import Data.ByteArray (convert) -#endif import Data.ASN1.BinaryEncoding ( DER(..) ) import Data.ASN1.Types (toASN1, ASN1Object, fromASN1, ASN1(Start, End, IntVal), ASN1ConstructionType(Sequence) ) @@ -665,16 +654,8 @@ derToBase32 :: L.ByteString -> String derToBase32 = map toLower . base32 . sha1 where sha1 :: L.ByteString -> S.ByteString -#if !defined(VERSION_cryptonite) - sha1 = SHA1.hashlazy -#else sha1 x = convert (Vincent.hashlazy x :: Vincent.Digest Vincent.SHA1) -#endif -#if defined(VERSION_memory) base32 = S8.unpack . convertToBase Base32 -#elif defined(VERSION_dataenc) - base32 = Base32.encode . S.unpack -#endif derRSA :: Packet -> Maybe L.ByteString derRSA rsa = do diff --git a/testkiki/testkiki.hs b/testkiki/testkiki.hs index 10487cf..9fffe7f 100644 --- a/testkiki/testkiki.hs +++ b/testkiki/testkiki.hs @@ -1,11 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DoAndIfThenElse #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} -#if !MIN_VERSION_base(4,7,0) -import qualified System.Posix.Env -#endif import System.Environment --import System.Posix.Env.ByteString (getEnv) import System.Posix.Files @@ -24,30 +20,16 @@ import qualified Data.ByteString.Char8 as B import Data.Time.Clock import Data.Time.Clock.POSIX import Data.IORef -#if !defined(VERSION_cryptonite) -import Crypto.Hash.SHA1 (hash) -#else import qualified Crypto.Hash import Crypto.Hash.Algorithms import Data.ByteArray (convert) -#endif import System.IO.Unsafe (unsafePerformIO) import ProcessUtils import Data.Bool import Data.Char import KeyRing hiding (try) -#if defined(VERSION_cryptonite) hash x = convert (Crypto.Hash.hash x :: Crypto.Hash.Digest SHA1) :: B.ByteString -#endif - -#if !MIN_VERSION_base(4,7,0) -setEnv k v = System.Posix.Env.setEnv k v True -unsetEnv = System.Posix.Env.unsetEnv -bool :: a -> a -> Bool -> a -bool f _ False = f -bool _ t True = t -#endif data TestKikiSettings = TKS { gnupghome :: FilePath -- cgit v1.2.3