hopenpgp-tools 0.20 → 0.20.1
raw patch · 5 files changed
+33/−36 lines, 5 filesdep ~conduitdep ~hOpenPGP
Dependency ranges changed: conduit, hOpenPGP
Files
- HOpenPGP/Tools/HKP.hs +4/−5
- hkt.hs +9/−9
- hokey.hs +5/−6
- hopenpgp-tools.cabal +5/−5
- hot.hs +10/−11
HOpenPGP/Tools/HKP.hs view
@@ -1,5 +1,5 @@ -- HKP.hs: hOpenPGP key tool--- Copyright © 2016 Clint Adams+-- Copyright © 2016-2018 Clint Adams -- -- vim: softtabstop=4:shiftwidth=4:expandtab --@@ -34,13 +34,12 @@ import Control.Lens ((^..)) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Except (ExceptT(..), throwE)-import Control.Monad.Trans.Resource (runResourceT) import Data.Binary (get, put) import qualified Data.ByteString.Char8 as BC8-import Data.Conduit (($=),($$))+import Data.Conduit ((.|), runConduitRes) import qualified Data.Conduit.Binary as CB import Data.Conduit.OpenPGP.Keyring (conduitToTKsDropping)-import Data.Conduit.Serialization.Binary (conduitGet, conduitPut)+import Data.Conduit.Serialization.Binary (conduitGet) import qualified Data.Conduit.List as CL import Data.Binary.Put (runPut) import qualified Data.ByteString as B@@ -82,7 +81,7 @@ validateKeys :: BL.ByteString -> ExceptT String IO [(TK,TK)] -- FIXME: conduit fail validateKeys larmors = do bytestrings <- ExceptT $ return $ fmap (mconcat . map armorToBS) (AA.decodeLazy larmors)- keys <- runResourceT $ CB.sourceLbs bytestrings $= conduitGet get $= conduitToTKsDropping $$ CL.consume+ keys <- liftIO . runConduitRes $ CB.sourceLbs bytestrings .| conduitGet get .| conduitToTKsDropping .| CL.consume cpt <- liftIO $ getPOSIXTime return . rights $ map (uncurry (liftA2 (,)) . (pure &&& processTK (Just cpt))) keys where
hkt.hs view
@@ -1,5 +1,5 @@ -- hkt.hs: hOpenPGP key tool--- Copyright © 2013-2017 Clint Adams+-- Copyright © 2013-2018 Clint Adams -- -- vim: softtabstop=4:shiftwidth=4:expandtab --@@ -33,14 +33,14 @@ import Control.Applicative (optional, (<|>)) import Control.Arrow ((&&&)) import Control.Lens ((^.), _1, _2, (^..))-import Control.Monad.Trans.Resource (runResourceT, MonadResource)+import Control.Monad.Trans.Resource (MonadResource, MonadThrow) import qualified Control.Monad.Trans.State.Lazy as S import qualified Data.Aeson as A import Data.Binary (get, put) import Data.Binary.Put (runPut) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL-import Data.Conduit (($=),($$), Source)+import Data.Conduit ((.|), ConduitT, runConduitRes) import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL import Data.Conduit.OpenPGP.Filter (conduitTKFilter, FilterPredicates(RTKFilterPredicate))@@ -85,8 +85,8 @@ import qualified Text.PrettyPrint.ANSI.Leijen as PPAL import Text.PrettyPrint.Free ((<+>), hardline, pretty, putDoc, text) -grabMatchingKeysConduit :: MonadResource m => FilePath -> Bool -> Text -> Source m TK-grabMatchingKeysConduit fp filt srch = CB.sourceFile fp $= conduitGet get $= conduitToTKsDropping $= (if filt then conduitTKFilter ufp else CL.filter matchAny)+grabMatchingKeysConduit :: (MonadResource m, MonadThrow m) => FilePath -> Bool -> Text -> ConduitT () TK m ()+grabMatchingKeysConduit fp filt srch = CB.sourceFile fp .| conduitGet get .| conduitToTKsDropping .| (if filt then conduitTKFilter ufp else CL.filter matchAny) where matchAny tk = either (const False) id $ fmap (keyMatchesFingerprint True tk) efp <|> fmap (keyMatchesEightOctetKeyId True tk . Right) eeok <|> return (keyMatchesUIDSubString srch tk) efp = parseFingerprint srch@@ -95,10 +95,10 @@ parseE = either (error . ("filter parse error: " ++)) id . parseTKExp . T.unpack -- this should be more specialized grabMatchingKeys :: FilePath -> Bool -> Text -> IO [TK]-grabMatchingKeys fp filt srch = runResourceT $ grabMatchingKeysConduit fp filt srch $$ CL.consume+grabMatchingKeys fp filt srch = runConduitRes $ grabMatchingKeysConduit fp filt srch .| CL.consume grabMatchingKeysKeyring :: FilePath -> Bool -> Text -> IO Keyring-grabMatchingKeysKeyring fp filt srch = runResourceT $ grabMatchingKeysConduit fp filt srch $$ sinkKeyringMap+grabMatchingKeysKeyring fp filt srch = runConduitRes $ grabMatchingKeysConduit fp filt srch .| sinkKeyringMap data Key = Key { keysize :: Maybe Int@@ -340,8 +340,8 @@ cpt <- getPOSIXTime kr <- grabMatchingKeysKeyring (keyring o) (targetIsFilter o) (ttarget1 o) -- FIXME: seriously clean this up- keys1 <- runResourceT $ CL.sourceList (IxSet.toList kr) $= (if filt then conduitTKFilter (ufpt (ttarget2 o)) else CL.filter (matchAny (ttarget2 o))) $$ CL.consume- keys2 <- runResourceT $ CL.sourceList (IxSet.toList kr) $= (if filt then conduitTKFilter (ufpt (ttarget3 o)) else CL.filter (matchAny (ttarget3 o))) $$ CL.consume+ keys1 <- runConduitRes $ CL.sourceList (IxSet.toList kr) .| (if filt then conduitTKFilter (ufpt (ttarget2 o)) else CL.filter (matchAny (ttarget2 o))) .| CL.consume+ keys2 <- runConduitRes $ CL.sourceList (IxSet.toList kr) .| (if filt then conduitTKFilter (ufpt (ttarget3 o)) else CL.filter (matchAny (ttarget3 o))) .| CL.consume let ((KeyMaps k2f f2i i2f, i), ks) = (buildMaps &&& id) (rights (map (verifyTKWith (verifySigWith (verifyAgainstKeyring kr)) (Just (posixSecondsToUTCTime cpt))) (IxSet.toList kr))) keygraph = buildKeyGraph ((KeyMaps k2f f2i i2f, i), ks) keysToIs = mapMaybe (\x -> HashMap.lookup (fingerprint (x^.tkKey._1)) f2i)
hokey.hs view
@@ -38,7 +38,6 @@ import Control.Error.Util (hush) import Control.Lens ((^.), (&), _1, _2, mapped, over) import Control.Monad.Trans.Except (runExceptT)-import Control.Monad.Trans.Resource (runResourceT) import Control.Monad.Trans.Writer.Lazy (execWriter, tell) import qualified Crypto.Hash.SHA3 as SHA3 import qualified Data.Aeson as A@@ -47,7 +46,7 @@ import qualified Data.ByteString.Char8 as BC8 import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Base16 as Base16-import Data.Conduit (($=),($$))+import Data.Conduit ((.|), runConduitRes) import qualified Data.Conduit.Binary as CB import Data.Conduit.Serialization.Binary (conduitGet, conduitPut) import qualified Data.Conduit.List as CL@@ -382,7 +381,7 @@ doLint :: LintOptions -> IO () doLint o = do cpt <- getPOSIXTime- keys <- runResourceT $ CB.sourceHandle stdin $= conduitGet get $= conduitToTKsDropping $$ CL.consume+ keys <- runConduitRes $ CB.sourceHandle stdin .| conduitGet get .| conduitToTKsDropping .| CL.consume output (lintOutputFormat o) cpt keys where output Pretty cpt = mapM_ (displayDoc 0.8 . prettyKeyReport cpt)@@ -391,9 +390,9 @@ doCanonicalize :: IO () doCanonicalize = do- runResourceT $ CB.sourceHandle stdin $= conduitGet get $=- conduitToTKsDropping $= CL.map canonicalize $=- CL.map put $= conduitPut $$ CB.sinkHandle stdout+ runConduitRes $ CB.sourceHandle stdin .| conduitGet get .|+ conduitToTKsDropping .| CL.map canonicalize .|+ CL.map put .| conduitPut .| CB.sinkHandle stdout where canonicalize (TK k r ui ua s) = TK k (sort r)
hopenpgp-tools.cabal view
@@ -1,5 +1,5 @@ name: hopenpgp-tools-version: 0.20+version: 0.20.1 synopsis: hOpenPGP-based command-line tools description: command-line tools for performing some OpenPGP-related operations homepage: https://salsa.debian.org/clint/hOpenPGP@@ -25,7 +25,7 @@ , binary >= 0.6.4.0 , binary-conduit , bytestring- , conduit >= 1.1+ , conduit >= 1.2.8 , conduit-extra >= 1.1 , errors , hOpenPGP >= 2.0 && < 3@@ -55,7 +55,7 @@ , binary >= 0.6.4.0 , binary-conduit , bytestring- , conduit >= 1.1+ , conduit >= 1.2.8 , conduit-extra >= 1.1 , containers , crypto-pubkey@@ -95,7 +95,7 @@ , binary >= 0.6.4.0 , binary-conduit , bytestring- , conduit >= 1.1+ , conduit >= 1.2.8 , conduit-extra >= 1.1 , containers , crypto-pubkey@@ -126,4 +126,4 @@ source-repository this type: git location: https://salsa.debian.org/clint/hOpenPGP.git- tag: hopenpgp-tools/0.20+ tag: hopenpgp-tools/0.20.1
hot.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings, RecordWildCards #-} -- hot.hs: hOpenPGP Tool--- Copyright © 2012-2016 Clint Adams+-- Copyright © 2012-2018 Clint Adams -- -- vim: softtabstop=4:shiftwidth=4:expandtab --@@ -33,11 +33,10 @@ import Control.Applicative (optional) import Control.Error.Util (note) import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Trans.Resource (runResourceT) import qualified Data.Aeson as A import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL-import Data.Conduit (($=), ($$), Sink)+import Data.Conduit ((.|), ConduitT, runConduitRes, Void) import Data.Conduit.Serialization.Binary (conduitGet, conduitPut) import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL@@ -75,35 +74,35 @@ deriving (Bounded, Enum, Read, Show) doDump :: DumpOptions -> IO ()-doDump DumpOptions{..} = runResourceT $ CB.sourceHandle stdin $= conduitGet (get :: Get Pkt) $$ case outputformat of+doDump DumpOptions{..} = runConduitRes $ CB.sourceHandle stdin .| conduitGet (get :: Get Pkt) .| case outputformat of DumpPretty -> prettyPrinter DumpJSON -> jsonSink DumpYAML -> yamlSink DumpShow -> printer -- Print every input value to standard output.-printer :: (Show a, MonadIO m) => Sink a m ()+printer :: (Show a, MonadIO m) => ConduitT a Void m () printer = CL.mapM_ (liftIO . print) -prettyPrinter :: (Pretty a, MonadIO m) => Sink a m ()+prettyPrinter :: (Pretty a, MonadIO m) => ConduitT a Void m () prettyPrinter = CL.mapM_ (liftIO . hPutDoc stdout . (<> hardline) . group . pretty) -jsonSink :: (A.ToJSON a, MonadIO m) => Sink a m ()+jsonSink :: (A.ToJSON a, MonadIO m) => ConduitT a Void m () jsonSink = CL.mapM_ (liftIO . BL.putStr . flip BL.snoc 0x0a . A.encode) -yamlSink :: (Y.ToJSON a, MonadIO m) => Sink a m ()+yamlSink :: (Y.ToJSON a, MonadIO m) => ConduitT a Void m () yamlSink = CL.mapM_ (liftIO . B.putStr . flip B.snoc 0x0a . Y.encode) doDeArmor :: IO () doDeArmor = do- a <- runResourceT $ CB.sourceHandle stdin $$ CL.consume+ a <- runConduitRes $ CB.sourceHandle stdin .| CL.consume case AA.decode (B.concat a) of Left e -> hPutStrLn stderr $ "Failure to decode ASCII Armor:" ++ e Right msgs -> BL.putStr $ BL.concat (map (\(Armor _ _ bs) -> bs) msgs) doArmor :: ArmoringOptions -> IO () doArmor ArmoringOptions{..} = do- m <- runResourceT $ CB.sourceHandle stdin $$ CL.consume+ m <- runConduitRes $ CB.sourceHandle stdin .| CL.consume let a = Armor armortype (("Version", "hot " ++ showVersion version):maybe [] (\x -> [("Comment", x)]) comment ) (BL.fromChunks m) BL.putStr $ AA.encodeLazy [a] @@ -119,7 +118,7 @@ armorTypeReader = note "unknown armor type" . flip lookup armorTypes doFilter :: FilteringOptions -> IO ()-doFilter fo = runResourceT $ CB.sourceHandle stdin $= conduitGet (get :: Get Pkt) $= conduitPktFilter (parseExpressions fo) $= CL.map put $= conduitPut $$ CB.sinkHandle stdout+doFilter fo = runConduitRes $ CB.sourceHandle stdin .| conduitGet (get :: Get Pkt) .| conduitPktFilter (parseExpressions fo) .| CL.map put .| conduitPut .| CB.sinkHandle stdout doP :: Parser DumpOptions doP = DumpOptions