module Pipes.Noise
(
InboundNoisePipe
, OutboundNoisePipe
, mkNoisePipes
) where
import Control.Concurrent.MVar (MVar, newMVar, putMVar, takeMVar)
import Control.Exception (SomeException)
import Data.ByteArray (ScrubbedBytes)
import Data.ByteString (ByteString)
import Pipes (Pipe, MonadIO, await, yield, liftIO)
import Crypto.Noise.Cipher (Cipher)
import Crypto.Noise.DH (DH)
import Crypto.Noise.Hash (Hash)
import Crypto.Noise
type InboundNoisePipe = Pipe ByteString ScrubbedBytes
type OutboundNoisePipe = Pipe ScrubbedBytes ByteString
mkNoisePipes :: (MonadIO m, Cipher c, DH d, Hash h)
=> NoiseState c d h
-> IO (InboundNoisePipe m (Either SomeException ()),
OutboundNoisePipe m (Either SomeException ()))
mkNoisePipes ns = do
nsmv <- liftIO . newMVar $ ns
return (inboundPipe nsmv, outboundPipe nsmv)
inboundPipe :: (MonadIO m, Cipher c, DH d, Hash h)
=> MVar (NoiseState c d h)
-> InboundNoisePipe m (Either SomeException ())
inboundPipe nsmv = do
msg <- await
ns <- liftIO . takeMVar $ nsmv
case readMessage ns msg of
Left e -> return . Left $ e
Right (pt, ns') -> do
liftIO . putMVar nsmv $ ns'
yield pt
inboundPipe nsmv
outboundPipe :: (MonadIO m, Cipher c, DH d, Hash h)
=> MVar (NoiseState c d h)
-> OutboundNoisePipe m (Either SomeException ())
outboundPipe nsmv = do
msg <- await
ns <- liftIO . takeMVar $ nsmv
case writeMessage ns msg of
Left e -> return . Left $ e
Right (ct, ns') -> do
liftIO . putMVar nsmv $ ns'
yield ct
outboundPipe nsmv