1{-# LANGUAGE TypeSynonymInstances #-}
2-----------------------------------------------------------------------------
3-- |
4-- Module      :  Network.BufferType
5-- Description :  Abstract representation of request and response buffer types.
6-- Copyright   :  See LICENSE file
7-- License     :  BSD
8--
9-- Maintainer  :  Ganesh Sittampalam <ganesh@earth.li>
10-- Stability   :  experimental
11-- Portability :  non-portable (not tested)
12--
13-- In order to give the user freedom in how request and response content
14-- is represented, a sufficiently abstract representation is needed of
15-- these internally. The "Network.BufferType" module provides this, defining
16-- the 'BufferType' class and its ad-hoc representation of buffer operations
17-- via the 'BufferOp' record.
18--
19-- This module provides definitions for the standard buffer types that the
20-- package supports, i.e., for @String@ and @ByteString@ (strict and lazy.)
21--
22-----------------------------------------------------------------------------
23module Network.BufferType
24       (
25         BufferType(..)
26
27       , BufferOp(..)
28       , strictBufferOp
29       , lazyBufferOp
30       , stringBufferOp
31       ) where
32
33
34import qualified Data.ByteString       as Strict hiding ( unpack, pack, span )
35import qualified Data.ByteString.Char8 as Strict ( unpack, pack, span )
36import qualified Data.ByteString.Lazy as Lazy hiding ( pack, unpack,span )
37import qualified Data.ByteString.Lazy.Char8 as Lazy ( pack, unpack, span )
38import System.IO ( Handle )
39import Data.Word ( Word8 )
40
41import Network.HTTP.Utils ( crlf, lf )
42
43-- | The @BufferType@ class encodes, in a mixed-mode way, the interface
44-- that the library requires to operate over data embedded in HTTP
45-- requests and responses. That is, we use explicit dictionaries
46-- for the operations, but overload the name of the dicts themselves.
47--
48class BufferType bufType where
49   bufferOps :: BufferOp bufType
50
51instance BufferType Lazy.ByteString where
52   bufferOps = lazyBufferOp
53
54instance BufferType Strict.ByteString where
55   bufferOps = strictBufferOp
56
57instance BufferType String where
58   bufferOps = stringBufferOp
59
60-- | @BufferOp@ encodes the I/O operations of the underlying buffer over
61-- a Handle in an (explicit) dictionary type. May not be needed, but gives
62-- us flexibility in explicit overriding and wrapping up of these methods.
63--
64-- Along with IO operations is an ad-hoc collection of functions for working
65-- with these abstract buffers, as needed by the internals of the code
66-- that processes requests and responses.
67--
68-- We supply three default @BufferOp@ values, for @String@ along with the
69-- strict and lazy versions of @ByteString@. To add others, provide @BufferOp@
70-- definitions for
71data BufferOp a
72 = BufferOp
73     { buf_hGet         :: Handle -> Int -> IO a
74     , buf_hGetContents :: Handle -> IO a
75     , buf_hPut         :: Handle -> a   -> IO ()
76     , buf_hGetLine     :: Handle -> IO a
77     , buf_empty        :: a
78     , buf_append       :: a -> a -> a
79     , buf_concat       :: [a] -> a
80     , buf_fromStr      :: String -> a
81     , buf_toStr        :: a -> String
82     , buf_snoc         :: a -> Word8 -> a
83     , buf_splitAt      :: Int -> a -> (a,a)
84     , buf_span         :: (Char  -> Bool) -> a -> (a,a)
85     , buf_isLineTerm   :: a -> Bool
86     , buf_isEmpty      :: a -> Bool
87     }
88
89instance Eq (BufferOp a) where
90  _ == _ = False
91
92-- | @strictBufferOp@ is the 'BufferOp' definition over @ByteString@s,
93-- the non-lazy kind.
94strictBufferOp :: BufferOp Strict.ByteString
95strictBufferOp =
96    BufferOp
97      { buf_hGet         = Strict.hGet
98      , buf_hGetContents = Strict.hGetContents
99      , buf_hPut         = Strict.hPut
100      , buf_hGetLine     = Strict.hGetLine
101      , buf_append       = Strict.append
102      , buf_concat       = Strict.concat
103      , buf_fromStr      = Strict.pack
104      , buf_toStr        = Strict.unpack
105      , buf_snoc         = Strict.snoc
106      , buf_splitAt      = Strict.splitAt
107      , buf_span         = Strict.span
108      , buf_empty        = Strict.empty
109      , buf_isLineTerm   = \ b -> Strict.length b == 2 && p_crlf == b ||
110                                  Strict.length b == 1 && p_lf   == b
111      , buf_isEmpty      = Strict.null
112      }
113   where
114    p_crlf = Strict.pack crlf
115    p_lf   = Strict.pack lf
116
117-- | @lazyBufferOp@ is the 'BufferOp' definition over @ByteString@s,
118-- the non-strict kind.
119lazyBufferOp :: BufferOp Lazy.ByteString
120lazyBufferOp =
121    BufferOp
122      { buf_hGet         = Lazy.hGet
123      , buf_hGetContents = Lazy.hGetContents
124      , buf_hPut         = Lazy.hPut
125      , buf_hGetLine     = \ h -> Strict.hGetLine h >>= \ l -> return (Lazy.fromChunks [l])
126      , buf_append       = Lazy.append
127      , buf_concat       = Lazy.concat
128      , buf_fromStr      = Lazy.pack
129      , buf_toStr        = Lazy.unpack
130      , buf_snoc         = Lazy.snoc
131      , buf_splitAt      = \ i x -> Lazy.splitAt (fromIntegral i) x
132      , buf_span         = Lazy.span
133      , buf_empty        = Lazy.empty
134      , buf_isLineTerm   = \ b -> Lazy.length b == 2 && p_crlf == b ||
135                                  Lazy.length b == 1 && p_lf   == b
136      , buf_isEmpty      = Lazy.null
137      }
138   where
139    p_crlf = Lazy.pack crlf
140    p_lf   = Lazy.pack lf
141
142-- | @stringBufferOp@ is the 'BufferOp' definition over @String@s.
143-- It is defined in terms of @strictBufferOp@ operations,
144-- unpacking/converting to @String@ when needed.
145stringBufferOp :: BufferOp String
146stringBufferOp =BufferOp
147      { buf_hGet         = \ h n -> buf_hGet strictBufferOp h n >>= return . Strict.unpack
148      , buf_hGetContents = \ h -> buf_hGetContents strictBufferOp h >>= return . Strict.unpack
149      , buf_hPut         = \ h s -> buf_hPut strictBufferOp h (Strict.pack s)
150      , buf_hGetLine     = \ h   -> buf_hGetLine strictBufferOp h >>= return . Strict.unpack
151      , buf_append       = (++)
152      , buf_concat       = concat
153      , buf_fromStr      = id
154      , buf_toStr        = id
155      , buf_snoc         = \ a x -> a ++ [toEnum (fromIntegral x)]
156      , buf_splitAt      = splitAt
157      , buf_span         = \ p a ->
158                             case Strict.span p (Strict.pack a) of
159                               (x,y) -> (Strict.unpack x, Strict.unpack y)
160      , buf_empty        = []
161      , buf_isLineTerm   = \ b -> b == crlf || b == lf
162      , buf_isEmpty      = null
163      }
164
165