uniform-io/src/System/IO/Uniform.hs

{-# LANGUAGE ExistentialQuantification #-}

{- |
Uniform-IO provides a typeclass for uniform access of different types of targets,
and implementations for abstracting standard streams, files and network connections.
This module also provides TLS wraping over other IO targets.
-}
module System.IO.Uniform (
  UniformIO(..),
  TlsSettings(..),
  SomeIO(..),
  foldOverInput,
  uGetContents
  ) where

import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LBS
import Control.Monad.IO.Class

import Data.Default.Class

import Debug.Trace

-- | Typeclass for uniform IO targets.
class UniformIO a where
  {- |
  uRead fd n
  
  Reads a block of at most n bytes of data from the IO target.
  Reading will block if there's no data available, but will return immediately
  if any amount of data is availble.
    
  Must thow System.IO.Error.EOFError if reading beihond EOF.
  -}
  uRead  :: a -> Int -> IO ByteString
  -- | uPut fd text
  --
  --  Writes all the bytes of text into the IO target. Takes care of retrying if needed.
  uPut   :: a -> ByteString -> IO ()
  -- | fClose fd
  --
  --  Closes the IO target, releasing any allocated resource. Resources may leak if not called
  --  for every oppened fd.
  uClose :: a -> IO ()
  -- | startTLS fd
  --
  --  Starts a TLS connection over the IO target.
  startTls :: TlsSettings -> a -> IO a
  -- | isSecure fd
  --
  --  Indicates whether the data written or read from fd is secure at transport.
  isSecure :: a -> Bool
  -- | True when the target is at end of file
  isEOF :: a -> IO Bool

-- | A type that wraps any type in the UniformIO class.
data SomeIO = forall a. (UniformIO a) => SomeIO a

instance UniformIO SomeIO where
  uRead (SomeIO s) = uRead s
  uPut (SomeIO s)  = uPut s
  uClose (SomeIO s) = uClose s
  startTls set (SomeIO s) = SomeIO <$> startTls set s
  isSecure (SomeIO s) = isSecure s
  isEOF (SomeIO s) = isEOF s

-- | Settings for starttls functions.
data TlsSettings = TlsSettings {tlsPrivateKeyFile :: String, tlsCertificateChainFile :: String, tlsDHParametersFile :: String} deriving (Read, Show)

instance Default TlsSettings where
  def = TlsSettings "" "" ""
  
{- |
foldOverInput io block_size f initial

Reads io untill the end of file, evaluating a(i) <- f a(i-1) read_data
where a(0) = initial and the last value after io reaches EOF is returned.

Notice that the length of read_data might not be equal block_size.
-}
foldOverInput :: forall a io. UniformIO io => io -> Int -> (a -> ByteString -> IO a) -> a -> IO a
foldOverInput io block f initial = do
  eof <- liftIO $ isEOF io
  if eof
    then return initial
    else do
    dt <- uRead io block
    traceShowM dt
    i <- f initial dt
    foldOverInput io block f i

{- |
Returns the entire contents recieved from this target.
-}
uGetContents :: UniformIO io => io -> Int -> IO LBS.ByteString
uGetContents io block = LBS.fromChunks <$> concatData
  where
    concatData = do
      eof <- liftIO $ isEOF io
      if eof
        then return []
        else do
        dt <- uRead io block
        (dt :) <$> concatData