{-# LANGUAGE OverloadedStrings #-}
----------------------------------------------------------------
-- |
-- Module      : Pipes.Noise
-- Maintainer  : John Galt <jgalt@centromere.net>
-- Stability   : experimental
-- Portability : POSIX

module Pipes.Noise
  ( -- * Types
    InboundNoisePipe
  , OutboundNoisePipe
    -- * Pipes
  , mkNoisePipes
  ) where

import Control.Concurrent.MVar (MVar, newMVar, putMVar, takeMVar)
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
import Data.ByteArray.Extend

-- | Pipe used for inbound Noise messages.
type InboundNoisePipe  = Pipe ByteString ScrubbedBytes

-- | Pipe used for outbound Noise messages.
type OutboundNoisePipe = Pipe ScrubbedBytes ByteString

-- | Creates a pair of Pipes, the first used for inbound messages and the
--   second used for outbound messages.
mkNoisePipes :: (MonadIO m, Cipher c, DH d, Hash h)
             => NoiseState c d h
             -> IO (InboundNoisePipe m (Either NoiseException ()), OutboundNoisePipe m (Either NoiseException ()))
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 NoiseException ())
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 NoiseException ())
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