{-# LANGUAGE OverloadedStrings #-}

module Network.TLS.Record.Layer (
    RecordLayer(..)
  , newTransparentRecordLayer
  ) where

import Network.TLS.Imports
import Network.TLS.Record
import Network.TLS.Struct

import qualified Data.ByteString as B

data RecordLayer bytes = RecordLayer {
    -- Writing.hs
    forall bytes.
RecordLayer bytes -> Record Plaintext -> IO (Either TLSError bytes)
recordEncode    :: Record Plaintext -> IO (Either TLSError bytes)
  , forall bytes.
RecordLayer bytes -> Record Plaintext -> IO (Either TLSError bytes)
recordEncode13  :: Record Plaintext -> IO (Either TLSError bytes)
  , forall bytes. RecordLayer bytes -> bytes -> IO ()
recordSendBytes :: bytes -> IO ()

    -- Reading.hs
  , forall bytes.
RecordLayer bytes
-> Bool -> Int -> IO (Either TLSError (Record Plaintext))
recordRecv      :: Bool -> Int -> IO (Either TLSError (Record Plaintext))
  , forall bytes.
RecordLayer bytes -> IO (Either TLSError (Record Plaintext))
recordRecv13    :: IO (Either TLSError (Record Plaintext))
  }

newTransparentRecordLayer :: Eq ann
                          => IO ann -> ([(ann, ByteString)] -> IO ())
                          -> IO (Either TLSError ByteString)
                          -> RecordLayer [(ann, ByteString)]
newTransparentRecordLayer :: forall ann.
Eq ann =>
IO ann
-> ([(ann, ByteString)] -> IO ())
-> IO (Either TLSError ByteString)
-> RecordLayer [(ann, ByteString)]
newTransparentRecordLayer IO ann
get [(ann, ByteString)] -> IO ()
send IO (Either TLSError ByteString)
recv = RecordLayer {
    recordEncode :: Record Plaintext -> IO (Either TLSError [(ann, ByteString)])
recordEncode    = forall ann.
IO ann
-> Record Plaintext -> IO (Either TLSError [(ann, ByteString)])
transparentEncodeRecord IO ann
get
  , recordEncode13 :: Record Plaintext -> IO (Either TLSError [(ann, ByteString)])
recordEncode13  = forall ann.
IO ann
-> Record Plaintext -> IO (Either TLSError [(ann, ByteString)])
transparentEncodeRecord IO ann
get
  , recordSendBytes :: [(ann, ByteString)] -> IO ()
recordSendBytes = forall ann.
Eq ann =>
([(ann, ByteString)] -> IO ()) -> [(ann, ByteString)] -> IO ()
transparentSendBytes [(ann, ByteString)] -> IO ()
send
  , recordRecv :: Bool -> Int -> IO (Either TLSError (Record Plaintext))
recordRecv      = \Bool
_ Int
_ -> IO (Either TLSError ByteString)
-> IO (Either TLSError (Record Plaintext))
transparentRecvRecord IO (Either TLSError ByteString)
recv
  , recordRecv13 :: IO (Either TLSError (Record Plaintext))
recordRecv13    = IO (Either TLSError ByteString)
-> IO (Either TLSError (Record Plaintext))
transparentRecvRecord IO (Either TLSError ByteString)
recv
  }

transparentEncodeRecord :: IO ann -> Record Plaintext -> IO (Either TLSError [(ann, ByteString)])
transparentEncodeRecord :: forall ann.
IO ann
-> Record Plaintext -> IO (Either TLSError [(ann, ByteString)])
transparentEncodeRecord IO ann
_ (Record ProtocolType
ProtocolType_ChangeCipherSpec Version
_ Fragment Plaintext
_) =
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right []
transparentEncodeRecord IO ann
_ (Record ProtocolType
ProtocolType_Alert Version
_ Fragment Plaintext
_) =
    -- all alerts are silent and must be transported externally based on
    -- TLS exceptions raised by the library
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right []
transparentEncodeRecord IO ann
get (Record ProtocolType
_ Version
_ Fragment Plaintext
frag) =
    IO ann
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ann
a -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right [(ann
a, forall a. Fragment a -> ByteString
fragmentGetBytes Fragment Plaintext
frag)]

transparentSendBytes :: Eq ann => ([(ann, ByteString)] -> IO ()) -> [(ann, ByteString)] -> IO ()
transparentSendBytes :: forall ann.
Eq ann =>
([(ann, ByteString)] -> IO ()) -> [(ann, ByteString)] -> IO ()
transparentSendBytes [(ann, ByteString)] -> IO ()
send [(ann, ByteString)]
input = [(ann, ByteString)] -> IO ()
send
    [ (ann
a, ByteString
bs) | (ann
a, [ByteString]
frgs) <- forall ann val. Eq ann => [(ann, val)] -> [(ann, [val])]
compress [(ann, ByteString)]
input
              , let bs :: ByteString
bs = [ByteString] -> ByteString
B.concat [ByteString]
frgs
              , Bool -> Bool
not (ByteString -> Bool
B.null ByteString
bs)
    ]

transparentRecvRecord :: IO (Either TLSError ByteString)
                      -> IO (Either TLSError (Record Plaintext))
transparentRecvRecord :: IO (Either TLSError ByteString)
-> IO (Either TLSError (Record Plaintext))
transparentRecvRecord IO (Either TLSError ByteString)
recv =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. ProtocolType -> Version -> Fragment a -> Record a
Record ProtocolType
ProtocolType_Handshake Version
TLS12 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Fragment Plaintext
fragmentPlaintext) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either TLSError ByteString)
recv

compress :: Eq ann => [(ann, val)] -> [(ann, [val])]
compress :: forall ann val. Eq ann => [(ann, val)] -> [(ann, [val])]
compress []         = []
compress ((ann
a,val
v):[(ann, val)]
xs) =
    let ([(ann, val)]
ys, [(ann, val)]
zs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((forall a. Eq a => a -> a -> Bool
== ann
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(ann, val)]
xs
     in (ann
a, val
v forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(ann, val)]
ys) forall a. a -> [a] -> [a]
: forall ann val. Eq ann => [(ann, val)] -> [(ann, [val])]
compress [(ann, val)]
zs