crypto-conduit 0.3.0.1 → 0.3.1
raw patch · 2 files changed
+72/−50 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- crypto-conduit.cabal +1/−1
- src/Crypto/Conduit.hs +71/−49
crypto-conduit.cabal view
@@ -1,6 +1,6 @@ Cabal-version: >= 1.8 Name: crypto-conduit-Version: 0.3.0.1+Version: 0.3.1 Synopsis: Conduit interface for cryptographic operations (from crypto-api). Homepage: https://github.com/meteficha/crypto-conduit License: BSD3
src/Crypto/Conduit.hs view
@@ -39,7 +39,6 @@ ) where -- from base-import Control.Monad (liftM) import Control.Arrow (first) import Data.Bits (xor) @@ -61,10 +60,12 @@ -- from conduit import Data.Conduit+import qualified Data.Conduit.Internal as CI import Data.Conduit.Binary (sourceFile) -- from transformers import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Class (lift) -- | Helper to get our return type.@@ -78,22 +79,42 @@ -- | A 'Sink' that hashes a stream of 'B.ByteString'@s@ and -- creates a digest @d@. sinkHash :: (Monad m, C.Hash ctx d) => Sink B.ByteString m d-sinkHash = blocked AnyMultiple blockSize =$ sink- where- sink = sinkState C.initialCtx- push- (const $ fail "sinkHash")+sinkHash =+ self+ where+ self = sink C.initialCtx+ sink ctx = do+ x <- getBlock AnyMultiple blockSize+ case x of+ Full bs ->+ let !ctx' = C.updateCtx ctx bs+ in sink ctx'+ LastOne bs -> return $! C.finalize ctx bs - push ctx (Full bs) =- let !ctx' = C.updateCtx ctx bs- in return (StateProcessing ctx')- push ctx (LastOne bs) =- let !ret = C.finalize ctx bs- in return (StateDone Nothing ret)+ blockSize = (C.blockLength .::. getType self) `div` 8 - blockSize = (C.blockLength .::. getType sink) `div` 8+getBlock :: Monad m => BlockMode -> C.ByteLength -> Sink B.ByteString m Block+getBlock blockMode blockSize =+ go id+ where+ go front = NeedInput (push front) (close front) + push front bs' =+ case compare (B.length bs) blockSize of+ LT -> go $ B.append bs+ EQ -> Done Nothing $ Full bs+ GT -> Done (Just y) $ Full x+ where+ bs = front bs'+ (x, y) = B.splitAt splitter bs + splitter =+ case blockMode of+ StrictBlockSize -> blockSize+ AnyMultiple -> B.length bs - (B.length bs `mod` blockSize)++ close front = Done Nothing (LastOne $ front B.empty)+ -- | Hashes the whole contents of the given file in constant -- memory. This function is just a convenient wrapper around -- 'sinkHash' defined as:@@ -117,8 +138,9 @@ C.MacKey ctx d #endif -> Sink B.ByteString m d-sinkHmac (C.MacKey key) = blocked AnyMultiple blockSize =$ sink- where+sinkHmac (C.MacKey key) =+ sink+ where --------- Taken and modified from Crypto.HMAC: key' = case B.length key `compare` blockSize of@@ -131,17 +153,18 @@ ki = B.map (`xor` 0x36) key' --------- - sink = sinkState (C.updateCtx C.initialCtx ki)- push- (const $ fail "sinkHmac")+ sink = go $ C.updateCtx C.initialCtx ki - push ctx (Full bs) =- let !ctx' = C.updateCtx ctx bs- in return (StateProcessing ctx')- push ctx (LastOne bs) =- let !inner = C.finalize ctx bs `asTypeOf` d- !outer = C.hash $ L.fromChunks [ko, S.encode inner]- in return (StateDone Nothing outer)+ go ctx = do+ x <- getBlock AnyMultiple blockSize+ case x of+ Full bs ->+ let !ctx' = C.updateCtx ctx bs+ in go ctx'+ LastOne bs ->+ let !inner = C.finalize ctx bs `asTypeOf` d+ !outer = C.hash $ L.fromChunks [ko, S.encode inner]+ in return outer d = getType sink blockSize = (C.blockLength .::. d) `div` 8@@ -337,18 +360,18 @@ sinkCbcMac :: (Monad m, C.BlockCipher k) => k -- ^ Cipher key. -> Sink B.ByteString m B.ByteString-sinkCbcMac k = blocked StrictBlockSize blockSize =$ sink+sinkCbcMac k =+ go $ B.replicate blockSize 0 where- sink = sinkState (B.replicate blockSize 0) push close-- push iv (Full input) =- let !iv' = C.encryptBlock k (iv `zwp` input)- in return (StateProcessing iv')- push iv (LastOne input)- | B.null input = return (StateDone Nothing iv)- | otherwise = fail "sinkCbcMac: input has an incomplete final block."-- close _ = fail "sinkCbcMac"+ go iv = do+ x <- getBlock StrictBlockSize blockSize+ case x of+ Full input ->+ let !iv' = C.encryptBlock k (iv `zwp` input)+ in go iv'+ LastOne input+ | B.null input -> return iv+ | otherwise -> lift $ fail "sinkCbcMac: input has an incomplete final block." blockSize = (C.blockSize .::. k) `div` 8 @@ -413,22 +436,21 @@ -> (s -> B.ByteString -> (s, B.ByteString)) -- ^ Encrypt block. -> (s -> B.ByteString -> m B.ByteString) -- ^ Final encryption. -> Conduit B.ByteString m B.ByteString-blockCipherConduit key mode initialState apply final = blocked mode blockSize =$= conduit+blockCipherConduit key mode initialState apply final =+ go initialState where blockSize = (C.blockSize .::. key) `div` 8 - conduit = conduitState initialState push close-- push state (Full input) =- let (!state', !output) = apply state input- in return (StateProducing state' [output])- push _ (LastOne input) | B.null input =- return (StateFinished Nothing [])- push state (LastOne input) = mk `liftM` final state input- where mk output = StateFinished Nothing [output]-- close _ = fail "blockCipherConduit"-+ go state = do+ x <- CI.sinkToPipe $ getBlock mode blockSize+ case x of+ Full input -> do+ let (!state', !output) = apply state input+ yield output+ go state'+ LastOne input+ | B.null input -> return ()+ | otherwise -> lift (final state input) >>= yield -- | zipWith xor + pack --