{-|
Module      : MongoDB TLS
Copyright   : (c)	Victor Denisov, 2016
License     : Apache 2.0
Maintainer  : Victor Denisov denisovenator@gmail.com
Stability   : alpha
Portability : POSIX

This module defines a connection interface. It could be a regular
network connection, TLS connection, a mock or anything else.
-}

module Database.MongoDB.Transport (
    Transport(..),
    fromHandle,
) where

import Prelude hiding (read)
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import System.IO

-- | Abstract transport interface
--
-- `read` should return `ByteString.null` on EOF
data Transport = Transport {
    Transport -> Int -> IO ByteString
read  :: Int -> IO ByteString,
    Transport -> ByteString -> IO ()
write :: ByteString -> IO (),
    Transport -> IO ()
flush :: IO (),
    Transport -> IO ()
close :: IO ()}

fromHandle :: Handle -> IO Transport
-- ^ Make connection from handle
fromHandle :: Handle -> IO Transport
fromHandle Handle
handle = do
  forall (m :: * -> *) a. Monad m => a -> m a
return Transport
    { read :: Int -> IO ByteString
read  = Handle -> Int -> IO ByteString
ByteString.hGet Handle
handle
    , write :: ByteString -> IO ()
write = Handle -> ByteString -> IO ()
ByteString.hPut Handle
handle
    , flush :: IO ()
flush = Handle -> IO ()
hFlush Handle
handle
    , close :: IO ()
close = Handle -> IO ()
hClose Handle
handle
    }