iterIO 0.2 → 0.2.2

raw patch · 15 files changed

+728/−90 lines, 15 filesdep ~basenew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/IterIO.hs +5/−1
• Data/IterIO/Extra.hs +1/−1
• Data/IterIO/Http.hs +258/−66
• Data/IterIO/HttpClient.hs +304/−0
• Data/IterIO/HttpRoute.hs +11/−6
• Data/IterIO/Inum.hs +101/−1
• Data/IterIO/Iter.hs +10/−2
• Data/IterIO/ListLike.hs +4/−0
• Data/IterIO/Parse.hs +4/−1
• Data/IterIO/SSL.hs +9/−2
• Data/IterIO/Trans.hs +4/−2
• Data/IterIO/ZlibInt.hsc +2/−1
• Examples/httptest.hs +1/−1
• NEWS +6/−0
• iterIO.cabal +8/−6

@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)+{-# LANGUAGE Safe #-}+#endif  {- | @@ -121,7 +125,7 @@  {- $Tutorial -#tutorial#+ #tutorial#  The iterIO library performs IO by hooking up sources of data, called /enumerators/, to data sinks, called /iteratees/, in a manner

@@ -219,5 +219,5 @@ traceI :: (ChunkData t, Monad m) => String -> Iter t m () traceI msg = Iter $ \c -> inlinePerformIO $ do                tid <- myThreadId-               putTraceMsg $ show tid ++ ": " ++ msg+               traceIO $ show tid ++ ": " ++ msg                return $ Done () c

@@ -1,27 +1,35 @@+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)+{-# LANGUAGE Trustworthy #-}+#endif {-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_GHC -fno-warn-unused-do-bind #-}  module Data.IterIO.Http (-- * HTTP Request support-                         HttpReq(..), reqNormalPath+                         HttpReq(..), defaultHttpReq, reqNormalPath                         , httpReqI, inumHttpBody                         , inumToChunks, inumFromChunks                         , http_fmt_time, dateI                         , FormField(..), foldForm+                        , enumHttpReq                          -- , urlencodedFormI, multipartI, inumMultipart                         -- , foldUrlencoded, foldMultipart, foldQuery                         -- * HTTP Response support                         , HttpStatus(..)-                        , stat100, stat200, stat301, stat302, stat303, stat304+                        , stat100, stat200+                        , stat301, stat302, stat303, stat304, stat307                         , stat400, stat401, stat403, stat404, stat405                         , stat500, stat501-                        , HttpResp(..), defaultHttpResp+                        , HttpResp(..), defaultHttpResp, respAddHeader                          , mkHttpHead, mkHtmlResp, mkContentLenResp, mkOnumResp                         , resp301, resp303, resp403, resp404, resp405, resp500-                        , enumHttpResp+                        , enumHttpResp, httpRespI                          -- * HTTP connection handling                         , HttpRequestHandler                         , HttpServerConf(..), nullHttpServer, ioHttpServer                         , inumHttpServer+                        -- * URI parsers+                        , absUri, uri, path2list                         -- -- * For debugging                         -- , postReq, encReq, mptest, mptest'                         -- , formTestMultipart, formTestUrlencoded@@ -56,6 +64,7 @@ import Data.IterIO.Parse import Data.IterIO.Search + -- import System.IO  type L = L8.ByteString@@ -64,6 +73,10 @@ strictify :: L -> S strictify = S.concat . L.toChunks +lazyfy :: S -> L+lazyfy = L.pack . S.unpack++ -- -- Basic pieces --@@ -105,7 +118,7 @@ text_except except = concat1I (while1I ok <|> lws)     where       except' = fmap c2w except-      ok c = c >= 0x20 && c < 0x7f && not (c `elem` except')+      ok c = c >= 0x20 && c < 0x7f && c `notElem` except'  -- | Parse one hex digit and return its value from 0-15. hex :: (Monad m) => Iter L m Int@@ -138,7 +151,7 @@     where       tokenTab :: UArray Word8 Bool       tokenTab = listArray (0,127) $ fmap isTokenChar [0..127]-      isTokenChar c = c > 0x20 && c < 0x7f && not (elem (chr c) separators)+      isTokenChar c = c > 0x20 && c < 0x7f && chr c `notElem` separators       separators = "()<>@,;:\\\"/[]?={} \t\177"  -- | Percent-decode input for as long as the non percent-escaped@@ -362,7 +375,7 @@       qpcharslash c = rfc3986_test rfc3986_pcharslash c                       || c == eord '?' || c == eord '%'  --- | Returns (scheme, host, path, query)+-- | Parses an absoluteURI, returning (scheme, host, path, query) absUri :: (Monad m) => Iter L m (S, S, Maybe Int, S, S) absUri = do   scheme <- strictify <$> satisfy (isAlpha . w2c)@@ -377,7 +390,8 @@                  rfc3986_test (rfc3986_unreserved .|. rfc3986_sub_delims) c                  || c == eord ':'   --- | Returns (scheme, host, path, query).+-- | Parses a Request-URI, defined by RFC2616, and+-- returns (scheme, host, path, query). uri :: (Monad m) => Iter L m (S, S, Maybe Int, S, S) uri = absUri       <|> path@@ -387,7 +401,8 @@       path = do (p, q) <- ensureI (== eord '/') *> pathI                 return (S.empty, S.empty, Nothing, p, q) --- | Turn a path into a list of components+-- | Turn a path into a list of components. Used to set the+-- 'reqPathLst' field in a request. path2list :: S -> [S] path2list path = runIdentity $ inumPure path |$ (slash [] <?> "absolute path")     where@@ -406,7 +421,9 @@  -- | Data structure representing an HTTP request message. data HttpReq s = HttpReq {-      reqMethod :: !S.ByteString+      reqScheme :: !S.ByteString+    -- ^ Scheme (e.g., \'http\', \'https\', ...)+    , reqMethod :: !S.ByteString     -- ^ Method (e.g., GET, POST, ...).     , reqPath :: !S.ByteString     -- ^ Raw path from the URL (not needed if you use @reqPathList@@@ -444,8 +461,8 @@     -- type.     , reqContentLength :: !(Maybe Int)     -- ^ Value of the content-Length header, if any.-    , reqTransferEncoding :: ![S.ByteString]-    -- ^ A list of the encodings in the Transfer-Encoding header.+    , reqTransferEncoding :: !S.ByteString+    -- ^ The Transfer-Encoding header.     , reqIfModifiedSince :: !(Maybe UTCTime)     -- ^ Time from the If-Modified-Since header (if present)     , reqSession :: s@@ -453,7 +470,8 @@     } deriving (Typeable, Show)  defaultHttpReq :: HttpReq ()-defaultHttpReq = HttpReq { reqMethod = S.empty+defaultHttpReq = HttpReq { reqScheme = S.empty+                         , reqMethod = S.empty                          , reqPath = S.empty                          , reqPathLst = []                          , reqPathParams = []@@ -466,7 +484,7 @@                          , reqCookies = []                          , reqContentType = Nothing                          , reqContentLength = Nothing-                         , reqTransferEncoding = []+                         , reqTransferEncoding = S.empty                          , reqIfModifiedSince = Nothing                          , reqSession = ()                          }@@ -496,13 +514,14 @@ request_line = do   method <- strictify <$> while1I (isUpper . w2c)   spaces-  (_, host, mport, path, query) <- uri+  (scheme, host, mport, path, query) <- uri   spaces   (major, minor) <- hTTPvers   optionalI spaces   skipI crlf   return defaultHttpReq {-                 reqMethod = method+                 reqScheme = scheme+               , reqMethod = method                , reqPath = path                , reqPathLst = path2list path                , reqQuery = query@@ -550,7 +569,7 @@  transfer_encoding_hdr :: (Monad m) => HttpReq s -> Iter L m (HttpReq s) transfer_encoding_hdr req = do-  tclist <- many tc+  tclist <- tc   return req { reqTransferEncoding = tclist }   where     tc = do@@ -579,11 +598,9 @@   let req' = req { reqHeaders = (field, val) : reqHeaders req }   case Map.lookup field request_headers of     Nothing -> return req'-    Just f  -> do-      r <- inumPure (L.fromChunks [val]) .|$-               (f req' <* (optionalI spaces >> eofI)-                      <?> (S8.unpack field ++ " header"))-      return r+    Just f  -> inumPure (L.fromChunks [val]) .|$+                  (f req' <* (optionalI spaces >> eofI)+                           <?> (S8.unpack field ++ " header"))  -- | Parse an HTTP header, returning an 'HttpReq' data structure. httpReqI :: Monad m => Iter L.ByteString m (HttpReq ())@@ -618,17 +635,9 @@  -- | An HTTP Chunk decoder (as specified by RFC 2616). inumFromChunks :: (Monad m) => Inum L.ByteString L.ByteString m a-inumFromChunks = mkInumM $ getchunk-    where-      osp = skipWhileI $ \c -> c == eord ' ' || c == eord '\t'-      chunk_ext_val = do char '='; osp; token <|> quoted_string; osp-      chunk_ext = do char ';'; osp; token; osp; optionalI chunk_ext_val-      getchunk = do-        size <- hexInt <* (osp >> skipMany chunk_ext >> crlf)-        if size > 0 then ipipe (inumTakeExact size) >> getchunk-                    else do-                      skipMany (noctl >> crlf)-                      skipI crlf+inumFromChunks = mkInum $ do+  eof <- atEOFI+  if eof then return L.empty else chunkedBodyI  -- | This 'Inum' reads to the end of an HTTP message body (and not -- beyond) and decodes the Transfer-Encoding.  It handles straight@@ -637,20 +646,14 @@ inumHttpBody :: (Monad m) => HttpReq s -> Inum L.ByteString L.ByteString m a inumHttpBody req =     case reqTransferEncoding req of-      lst | null lst || lst == [S8.pack "identity"] ->+      enc | S.null enc || enc == S8.pack "identity" ->               if hasclen then inumTakeExact (fromJust $ reqContentLength req)                          else inumNull -- No message body present-      lst | lst == [S8.pack "chunked"] -> inumFromChunks-      lst -> inumFromChunks |. tcfold (reverse lst)+      enc | enc == S8.pack "chunked" -> inumFromChunks+      enc -> inumFromChunks |. tcInum enc     where       hasclen = isJust $ reqContentLength req-      tcfold [] = inumNop-      tcfold (h:t) -          | h == S8.pack "identity" = tcfold t-          | h == S8.pack "chunked"  = tcfold t -- Has to be first one-          --- | h == S8.pack "gzip"     = inumGunzip |. tcfold t-          | otherwise = mkInum $-                        fail $ "unknown Transfer-Coding " ++ chunkShow h+      tcInum e = mkInum $ fail $ "unknown Transfer-Coding " ++ chunkShow e  {- -- | This 'Inum' reads to the end of an HTTP message body (and not@@ -855,7 +858,7 @@                                           lookup (S8.pack "boundary") parms                     _ -> Nothing -multipartI :: (Monad m) => HttpReq s -> Iter L m (Maybe (FormField))+multipartI :: (Monad m) => HttpReq s -> Iter L m (Maybe FormField) multipartI req = case reqBoundary req of                    Just b  -> findpart $ S8.pack "--" `S8.append` b                    Nothing -> return Nothing@@ -876,7 +879,7 @@       hdrs <- many hdr_field_val       crlf       return FormField {-                   ffName = maybe S.empty id $ lookup (S8.pack "name") parms+                   ffName = fromMaybe S.empty $ lookup (S8.pack "name") parms                  , ffParams = parms                  , ffHeaders = cdhdr:hdrs                  }@@ -911,6 +914,9 @@ -- 'stat500', etc. data HttpStatus = HttpStatus !Int !S.ByteString deriving Show +instance Eq HttpStatus where+  HttpStatus c0 _ == HttpStatus c1 _ = c0 == c1+ mkStat :: Int -> String -> HttpStatus mkStat n s = HttpStatus n $ S8.pack s @@ -920,7 +926,7 @@                            , s, S8.pack "\r\n"]  stat100, stat200-           , stat301, stat302, stat303, stat304+           , stat301, stat302, stat303, stat304, stat307            , stat400, stat401, stat403, stat404, stat405            , stat500, stat501 :: HttpStatus stat100 = mkStat 100 "Continue"@@ -929,6 +935,7 @@ stat302 = mkStat 302 "Found" stat303 = mkStat 303 "See Other" stat304 = mkStat 304 "Not Modified"+stat307 = mkStat 307 "Temporary Redirect" stat400 = mkStat 400 "Bad Request" stat401 = mkStat 401 "Unauthorized" stat403 = mkStat 403 "Forbidden"@@ -943,7 +950,7 @@ data HttpResp m = HttpResp {       respStatus :: !HttpStatus     -- ^ The response status.-    , respHeaders :: ![S.ByteString]+    , respHeaders :: ![(S.ByteString, S.ByteString)]     -- ^ Headers to send back     , respChunk :: !Bool     -- ^ True if the message body should be passed through@@ -958,7 +965,8 @@     -- not contain a body.     } -respAddHeader :: S.ByteString -> HttpResp m -> HttpResp m+-- | Add header to the HTTP response.+respAddHeader :: (S.ByteString, S.ByteString) -> HttpResp m -> HttpResp m respAddHeader hdr resp = resp { respHeaders = hdr : respHeaders resp }  instance Show (HttpResp m) where@@ -988,8 +996,8 @@            -> HttpResp m mkHtmlResp stat html = resp     where resp0 = mkHttpHead stat `asTypeOf` resp-          ctype = S8.pack "Content-Type: text/html"-          len = S8.pack $ "Content-Length: " ++ show (L8.length html)+          ctype = (S8.pack "Content-Type", S8.pack"text/html")+          len   = (S8.pack "Content-Length", S8.pack $ show (L8.length html))           resp  = resp0 { respHeaders = respHeaders resp0 ++ [ctype, len]                         , respBody = inumPure html                         }@@ -1009,8 +1017,8 @@            , respChunk = False            , respBody = inumPure body }  where-  contentType = S8.pack $ "Content-Type: " ++ ctype-  contentLength = S8.pack $ "Content-Length: " ++ show (L8.length body)+  contentType = (S8.pack "Content-Type", S8.pack ctype)+  contentLength = (S8.pack "Content-Length", S8.pack . show .  L8.length $ body)  -- | Make an 'HttpResp' of an arbitrary content-type based on an -- 'Onum' that will dynamically generate the message body.  Since the@@ -1029,7 +1037,7 @@            , respChunk = True            , respBody = body }  where-  contentType = S8.pack $ "Content-Type: " ++ ctype+  contentType = (S8.pack "Content-Type", S8.pack ctype)  htmlEscapeChar :: Char -> Maybe String htmlEscapeChar '<'  = Just "&lt;"@@ -1050,7 +1058,7 @@ -- | Generate a 301 (redirect) response. resp301 :: (Monad m) => String -> HttpResp m resp301 target =-    respAddHeader (S8.pack $ "Location: " ++ target) $ mkHtmlResp stat301 html+    respAddHeader (S8.pack "Location", S8.pack target) $ mkHtmlResp stat301 html     where html = L8.concat                  [L8.pack                   "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n\@@ -1065,7 +1073,7 @@ -- | Generate a 303 (see other) response. resp303 :: (Monad m) => String -> HttpResp m resp303 target =-    respAddHeader (S8.pack $ "Location: " ++ target) $ mkHtmlResp stat303 html+    respAddHeader (S8.pack "Location", S8.pack target) $ mkHtmlResp stat303 html     where html = L8.concat                  [L8.pack                   "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n\@@ -1141,19 +1149,19 @@ -- | Format and enumerate a response header and body. enumHttpResp :: (Monad m) =>                 HttpResp m-             -> Maybe UTCTime   -- ^ Time for @Date:@ header (if desired)              -> Onum L.ByteString m ()-enumHttpResp resp mdate = inumPure fmtresp `cat` (respBody resp |. maybeChunk)+enumHttpResp resp = inumPure fmtresp `cat` (respBody resp |. maybeChunk)     where-      fmtresp = L.append (fmtStat $ respStatus resp) hdrs-      hdrs = foldr (L.append . hdr) (L8.pack "\r\n") $-             (if respChunk resp-              then ((S8.pack "Transfer-Encoding: chunked") :)-              else id) $-             (maybe id (\t -> (S8.pack ("Date: " ++ http_fmt_time t) :)) mdate)-             (respHeaders resp)-      hdr h = L.fromChunks [h, S8.pack "\r\n"]+      fmtresp = (fmtStat $ respStatus resp) `L.append` hdrsL+      hdrsS = if respChunk resp+                then (transferEncoding, S8.pack "chunked") :+                     (filter ((/= transferEncoding) . fst) $ respHeaders resp)+                else  respHeaders resp+      hdrsL = (L.concat $ map mkHeader hdrsS) `L8.append` L8.pack "\r\n"       maybeChunk = if respChunk resp then inumToChunks else inumNop+      mkHeader (k, v) = lazyfy k `L8.append` L8.pack ": "+                                 `L8.append` lazyfy v `L8.append` L8.pack "\r\n"+      transferEncoding = S8.pack "Transfer-Encoding"  -- | Given the headers of an HTTP request, provides an iteratee that -- will process the request body (if any) and return a response.@@ -1202,7 +1210,8 @@         resp <- liftI $ inumHttpBody req .|                 (catchI handler errHandler <* nullI)         now <- liftI $ srvDate server-        tryI (irun $ enumHttpResp resp now) >>=+        let respWithDate = maybe resp (addDate resp) now+        tryI (irun $ enumHttpResp respWithDate) >>=              either (fatal . fst) (const loop)       errHandler e@(SomeException _) _ = do         srvLogger server $ "Response error: " ++ show e@@ -1210,6 +1219,189 @@       fatal e@(SomeException _) = do         liftI $ srvLogger server $ "Reply error: " ++ show e         return ()+      addDate resp t = respAddHeader (S8.pack "Date"+                                     , S8.pack . http_fmt_time $ t) resp++--+-- HTTP Client support+--++-- | Enumerate a request, and body.+enumHttpReq :: (Monad m) => HttpReq s -> L -> Onum L m a+enumHttpReq req body =+  enumNoBody |. inumStoL+    `lcat` (enumPure body |. maybeChunk)+  where enumNoBody = enumPure $ S.concat [ mkHttpRequest_Line req False+                                         , mkHttpReqHeaders req+                                         , S8.pack "\r\n"+                                         ]+        maybeChunk = case lookup transferEncoding (reqHeaders req) of+                       Just v | v == S8.pack "chunked" -> inumToChunks +                       _ -> inumNop+        transferEncoding = S8.pack "Transfer-Encoding"+++-- | Create HTTP request line, defined by RFC2616 as:+--+-- > Request-Line = Method SP Request-URI SP HTTP-Version CRLF+-- +-- Set the @absURI@ flag to true if you wish to use an absolute-URI+-- when in the request line. Note: if the flag is set to false then+-- the \"Host\" header must be set.+mkHttpRequest_Line :: HttpReq s -> Bool -> S+mkHttpRequest_Line req absURI = S.concat [+    reqMethod req+  , sp+  , mkReqURI req absURI+  , sp+  , let (major, minor) = reqVers req+    in S8.pack $ "HTTP/" ++ show major ++ "." ++ show minor+  , S8.pack "\r\n"+  ]+    where sp = S8.singleton ' '++-- | Given a request, create the Request-URI.+-- If @absURI@ flag is True and the 'reqHost' field is not set, the+-- port and scheme are ignored.+-- The 'reqPathLst' is used (instead of the raw 'reqPath') when available.+mkReqURI :: HttpReq s -> Bool -> S+mkReqURI req absURI = S.concat+  [ if absURI then authorization else S.empty+  , if null $ reqPathLst req+      then reqPath req+      else reqNormalPath req+  , emptyIfNull reqQuery $ \q -> S8.append (S8.singleton '?') q+  ]+    where emptyIfNull rF g = let r = (rF req)+                             in if S.null r then S.empty else g r+          authorization = emptyIfNull reqHost $ \h -> S.concat +            [ emptyIfNull reqScheme $ \s -> S8.append s (S8.pack "://")+            , h+            , maybe S.empty (S8.pack . (":"++) .  show) $ reqPort req+            ]++-- | Given a request, emit all the headers.+-- Namely, this function returns :+-- *(( general-header | request-header | entity-header) CRLF)+-- It does not, howerver, check that that headers are well-formed.+mkHttpReqHeaders :: HttpReq s -> S+mkHttpReqHeaders req = S.concat . nub . filter (not . S.null) $+        hostHeader+      : contentTypeHeader+      : contentLengthHeader+      : cookieHeader+      : transferEncodingHeader+      : ifModifiedSinceHeader +      : allHeaders+  where mkHeader (k,v) =+          if S.null v+            then S.empty+            else k `S8.append` S8.pack ": "+                   `S8.append` v `S8.append` S8.pack "\r\n"+        --+        hostHeader = mkHeader (S8.pack "Host", reqHost req)+        --+        transferEncodingHeader =+          mkHeader (S8.pack "Transfer-Encoding", reqTransferEncoding req)+        --+        contentLengthHeader =+          mkHeader (S8.pack "Content-Length"+                   , maybe S.empty (S8.pack . show) $ reqContentLength req)+        --+        ifModifiedSinceHeader =+          mkHeader (S8.pack "If-Modified-Since"+                   , maybe S.empty (S8.pack . http_fmt_time)+                                     $ reqIfModifiedSince req)+        --+        cookieHeader =+          mkHeader (S8.pack "Cookie"+                   , S8.intercalate (S8.singleton ';') $ map p $ reqCookies req)+        p (k, v) = k `S8.append` S8.singleton '=' `S8.append` v+        --+        contentTypeHeader =+          mkHeader (S8.pack "Content-Type"+                   , maybe S.empty ctF $ reqContentType req)+        ctF (mt,params) = mt `S8.append` +          (S8.intercalate (S8.singleton ';') $ map p params)+        --+        allHeaders = map mkHeader $ reqHeaders req++-- Status-Line = HTTP-Version SP Status-Code SP Reason-Phrase CRLF+httpStatusI :: (Monad m) => Iter L m HttpStatus+httpStatusI = do+  _ <- hTTPvers+  spaces+  status <- whileMinMaxI 3 3 (isDigit . w2c) >>= readI <?> "Status code"+  spaces+  phrase <- L8.unpack <$> text_except "\r\n"+  skipI crlf+  return $ mkStat status phrase++-- | Return a response. If the \'Trasnfer-Encoding\' header is set to+-- \'chunked\', it is removed from the headers and the 'respChunk'+-- field is set.+-- 'enumHttpResp' to enumerate the headers and body.+httpRespI :: (MonadIO m) => Iter L m (HttpResp m)+httpRespI = do+  stat <- httpStatusI+  hdrs <- many hdr_field_val+  chunked <- maybe (return False) (isChunked . L8.map toLower . lazyfy) $ +                lookup (S8.pack "transfer-encoding") hdrs+  let hdrs' = if chunked+                then filter ((/= S8.pack "transfer-encoding") . fst) hdrs+                else hdrs+  skipI crlf+  body <- httpBodyI hdrs' chunked+  let resp = HttpResp { respStatus  = stat+                      , respHeaders = hdrs'+                      , respChunk   = chunked+                      , respBody    = enumPure body }+  return resp+    where isChunked v = enumPure v |$ (cI <|> return False)+          cI = do optionalI spaces+                  match $ L8.pack "chunked"+                  optionalI spaces+                  return True++-- | This 'Inum' reads to the end of an HTTP message body (and not+-- beyond) and decodes the Transfer-Encoding.  It handles straight+-- content of a size specified by the Content-Length header and+-- chunk-encoded content. If neither headers are set, it reads the+-- body lazyly (with 'pureI').+httpBodyI :: (Monad m) => [(S,S)] -> Bool -> Iter L m L+httpBodyI hdrs isChunked = +  if isChunked+    then chunkedBodyI+    else let mLen = do lenS <- lookup (S8.pack "content-length") hdrs+                       maybeRead . S8.unpack $ lenS+         in maybe pureI takeI mLen+  where maybeRead = fmap fst . listToMaybe . reads++-- | This 'Iter' decodes \'chunk\' encoded body. Specifically,+-- it implements \'chunked-body\' of RFC2616. Note: the+-- entity-headers in the trailer are ignored.+chunkedBodyI :: Monad m => Iter L m L+chunkedBodyI = do+  r <- many chunk_+  skipMany trailer+  skipI crlf+  return $ L.concat r+    where chunk_ = do size <- chunk_size+                      chunk_ext+                      crlf+                      b <- if size > 0+                             then takeI size <* crlf+                             else return L.empty -- last-chunk+                      return b+          chunk_size = hexInt +          chunk_ext = skipMany $ do char ';'+                                    osp+                                    chunk_ext_name+                                    optionalI $ char '=' >> chunk_ext_val+          chunk_ext_name = token+          chunk_ext_val  = token <|> quoted_string+          trailer = hdr_field_val+          osp = skipWhileI $ \c -> c == eord ' ' || c == eord '\t'   {-

@@ -0,0 +1,304 @@+module Data.IterIO.HttpClient ( -- * Simple interface+                                simpleHttp, genSimpleHttp +                              , headRequest, getRequest, postRequest+                                -- * GET, HEAD wrappers+                              , simpleGetHttp, simpleGetHttps+                              , simpleHeadHttp, simpleHeadHttps+                              -- * Advanced interface+                              , HttpClient(..)+                              , mkHttpClient+                              , httpConnect+                              , inumHttpClient+                              , HttpResponseHandler+                              -- * Internal+                              , userAgent+                              , maxNrRedirects+                              , mkRequestToAbsUri+                              ) where++import Prelude hiding (catch, head, div)++import Control.Monad (when, unless)+import Control.Exception+import Control.Monad.Trans++import Data.Maybe ( isNothing, fromJust)+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as L8++import qualified Network.Socket as Net+import qualified Network.BSD as Net+import qualified OpenSSL.Session as SSL++import Data.IterIO+import Data.IterIO.Http+import Data.IterIO.SSL++import Data.Version (showVersion)+import Paths_iterIO (version)++import Data.IORef++type L = L.ByteString+type S = S.ByteString+++lazyfy :: S -> L+lazyfy = L.pack . S.unpack++catchIO :: IO a -> (IOException -> IO a) -> IO a+catchIO = catch++-- | User agent corresponding to this library.+userAgent :: String+userAgent = "haskell-iterIO/"  ++ showVersion version++-- | An HTTP client.+data HttpClient = HttpClient {+      hcSock     :: !Net.Socket+    -- ^ Socket+    , hcSockAddr :: !Net.SockAddr+    -- ^ Socket address+    , hcSslCtx   :: !(Maybe SSL.SSLContext)+    -- ^ SSL context+    , hcIsHttps  :: !Bool+    -- ^ Use SSL+    }++-- | Maximum number of redirects. Defult: no redirect (0).+maxNrRedirects :: Int+maxNrRedirects = 0++-- | Given an HTTP client configuration, make the actual connection to+-- server.+httpConnect :: MonadIO m => HttpClient -> IO (Iter L m (), Onum L m a)+httpConnect hc = do+  let s       = hcSock hc+      isHttps = hcIsHttps hc+  when (isHttps && isNothing (hcSslCtx hc)) $+    throwIO (userError "Need SSL context for  HTTPS")+  Net.connect s (hcSockAddr hc)+  if hcIsHttps hc+    then iterSSL (fromJust $ hcSslCtx hc) s False+    else iterStream s+++-- | Given the host, port, context, and \"is-https\" flag, create+-- a client value. The returned value can be used with 'httpConnect'+-- to get raw pipes to/from the server.+--+-- /Note:/ Some of this code is from the "HTTP" package.+mkHttpClient :: S                     -- ^ Host+              -> Int                  -- ^ Port+              -> Maybe SSL.SSLContext -- ^ SSL context+              -> Bool                 -- ^ Is HTTPS+              -> IO HttpClient+mkHttpClient host port ctx isHttps = withSocket $ \s -> do+    Net.setSocketOption s Net.KeepAlive 1+    hostA <- getHostAddr (S8.unpack host)+    let a = Net.SockAddrInet (toEnum port) hostA+    return HttpClient { hcSock     = s+                      , hcSockAddr = a+                      , hcSslCtx   = ctx+                      , hcIsHttps  = isHttps }+ where withSocket action = do+         s <- Net.socket Net.AF_INET Net.Stream 6+         catchIO (action s) (\e -> Net.sClose s >> ioError e)+       getHostAddr h = +         catchIO (Net.inet_addr h) $ \_ -> do+           h' <- getHostByName_safe h+           case Net.hostAddresses h' of+             []     -> err $ "No addresses in host entry for " ++ show h+             (ha:_) -> return ha+       getHostByName_safe h = +         catchIO (Net.getHostByName h) $ \_ ->+           err $ "Failed to lookup " ++ show h+       err = throwIO . userError++--+-- Simple interface wrappers+--++-- | Perform a simple HTTP GET request. No SSL support.+simpleGetHttp :: MonadIO m+              => String          -- ^ URL+              -> m (HttpResp m)+simpleGetHttp url = simpleHttp (getRequest url) L.empty Nothing++-- | Perform a simple HTTPS GET request.+simpleGetHttps :: MonadIO m+               => String          -- ^ URL+               -> SSL.SSLContext  -- ^ SSL Context+               -> m (HttpResp m)+simpleGetHttps url ctx = simpleHttp (getRequest url) L.empty (Just ctx)++-- | Perform a simple HTTP HEAD request. No SSL support.+simpleHeadHttp :: MonadIO m+               => String          -- ^ URL+               -> m (HttpResp m)+simpleHeadHttp url = simpleHttp (headRequest url) L.empty Nothing++-- | Perform a simple HTTPS HEAD request.+simpleHeadHttps :: MonadIO m+                => String          -- ^ URL+                -> SSL.SSLContext  -- ^ SSL Context+                -> m (HttpResp m)+simpleHeadHttps url ctx = simpleHttp (headRequest url) L.empty (Just ctx)+++--+-- Simple interface+--++-- | Perform a simple HTTP request, given the the request header, body+-- and SSL context, if any.+simpleHttp :: MonadIO m+           => HttpReq ()           -- ^ Request header+           -> L                    -- ^ Request body+           -> Maybe SSL.SSLContext -- ^ SSL Context+           -> m (HttpResp m)+simpleHttp req body ctx = genSimpleHttp req body ctx maxNrRedirects True++-- | Make a general HTTP request to host specified in the request.+-- If the request is over HTTPS, the SSL context must be provided.+-- The redirect count is used to limit the number of redirects+-- followed (when receiving a 3xx response); use 0 to return the +-- direct response. The @passCookies@ flag is used to guard cookies+-- on redirects: because @genSimpleHttp@ performs a \"single request\"+-- it does not parse \"Set-Cookie\" headers and so is unaware of the+-- cookie domain. Hence, the flag is used for the decision in passing+-- the cookie to the location of a redirect.+genSimpleHttp :: MonadIO m+              => HttpReq ()            -- ^ Request header+              -> L                     -- ^ Message body+              -> Maybe SSL.SSLContext  -- ^ SSL Context+              -> Int                   -- ^ Redirect count+              -> Bool                  -- ^ Pass cookies+              -> m (HttpResp m)+genSimpleHttp req body ctx redirectCount passCookies = do+  let scheme = reqScheme req+      isHttps = scheme == (S8.pack "https")+  port <- maybe (defaultPort scheme) return $ reqPort req+  client <- liftIO $ mkHttpClient (reqHost req) port ctx isHttps+  (sIter,sOnum) <- liftIO $ httpConnect client+  refResp <- liftIO $ newIORef Nothing+  count <- liftIO $ newIORef 0+  sOnum |$ inumHttpClient (req, body) (handler count refResp) .| sIter+  mresp <- liftIO $ readIORef refResp+  maybe err return mresp+    where handler countRef refResp resp = do+            liftIO $ writeIORef refResp (Just resp)+            count <- liftIO $ do c <- readIORef countRef+                                 writeIORef countRef (c+1)+                                 return c+            if count < redirectCount+              then handleRedirect (req, body) passCookies resp+              else return Nothing+          defaultPort s | s == S8.pack "http"  = return 80+                        | s == S8.pack "https" = return 443+                        | otherwise = liftIO . throwIO . userError $+                                        "Unrecognized scheme" ++ S8.unpack s+          err = liftIO . throwIO . userError $ "Request failed"++-- | Given a 3xx response and original request, handle the redirect.+-- Currently, only reponses with status codes 30[1237] and set+-- \"Location\" header are handled. Note that the request is made to+-- the same host, so a redirect to a different host will result in a+-- 4xx response.+handleRedirect :: MonadIO m +               => (HttpReq s, L )      -- ^ Original request+               -> Bool                 -- ^ Pass cookies+               -> HttpResp m           -- ^ Response+               -> Iter L m (Maybe (HttpReq s, L))+handleRedirect (req, body) passCookies resp = +  if (respStatus resp `notElem` s300s) || (reqMethod req `notElem` meths)+    then return Nothing+    else doRedirect $ lookup (S8.pack "location") $ respHeaders resp +    where s300s = [stat301, stat302, stat303, stat307]+          meths = [S8.pack "GET", S8.pack "HEAD"]+          doRedirect Nothing = return Nothing+          doRedirect (Just url) = do+            newReq <- mkRequestToAbsUri (lazyfy url) (reqMethod req)+            let req' = newReq { reqHeaders          = reqHeaders req+                              , reqCookies          = if passCookies+                                                        then reqCookies req+                                                        else []+                              , reqContentType      = reqContentType req+                              , reqContentLength    = reqContentLength req+                              , reqTransferEncoding = reqTransferEncoding req+                              , reqIfModifiedSince  = reqIfModifiedSince req+                              , reqSession          = reqSession req }+            return $ Just (req', body)++--+-- Create requests+--++-- | Create a simple HEAD request.+-- The @url@ must be an @absoluteURI@.+headRequest :: String -> HttpReq ()+headRequest url = fromJust $ mkRequestToAbsUri (L8.pack url) $ S8.pack "HEAD"++-- | Create a simple GET request.+-- The @url@ must be an @absoluteURI@.+getRequest :: String -> HttpReq ()+getRequest url = fromJust $ mkRequestToAbsUri (L8.pack url) $ S8.pack "GET"++-- | Given a URL, Content-Type, and message body, perform a simple+-- POST request. Note: message body must be properly encoded (e.g.,+-- URL-encoded if the Content-Type is+-- \"application\/x-www-form-urlencoded\").+postRequest :: String  -- ^ URL+            -> String  -- ^ Content-Type header+            -> L       -- ^ Message body+            -> HttpReq ()+postRequest url ct body =+  let req = fromJust $ mkRequestToAbsUri (L8.pack url) $ S8.pack "POST"+  in req { reqContentType = Just (S8.pack ct, [])+         , reqContentLength = Just . fromIntegral . L8.length $ body }++-- | Createa generic HTTP request, given an absoluteURI:+-- If the URI is not absolute, the parser will fail.+mkRequestToAbsUri :: Monad m => L -> S -> m (HttpReq ())+mkRequestToAbsUri urlString method = do+  (scheme, host, mport, path, query) <- enumPure urlString |$ absUri+  return defaultHttpReq { reqScheme  = scheme+                        , reqMethod  = method+                        , reqPath    = path+                        , reqPathLst = path2list path+                        , reqQuery   = query+                        , reqHost    = host+                        , reqPort    = mport+                        , reqContentLength = Just 0+                        , reqVers    = (1,1)+                        , reqHeaders = [hostHeader host, uaHeader]+                        }+     where uaHeader = (S8.pack "User-Agent", S8.pack userAgent)+           hostHeader host = (S8.pack "Host", host)++-- | An HTTP response handler used by HTTP clients.+type HttpResponseHandler m s =+      HttpResp m -> Iter L m (Maybe (HttpReq s, L))++-- | Given an initial request, and a response handler,+-- create an inum that provides underlying functionality of an http+-- client.+inumHttpClient :: MonadIO m +               => (HttpReq s, L)+               -> HttpResponseHandler m s -> Inum L L m a+inumHttpClient (req,body) respHandler = mkInumM $ +  tryI (irun $ enumHttpReq req body) >>=+             either (fatal . fst) (const loop)+  where loop = do eof <- atEOFI+                  unless eof doresp+        doresp = do+          resp <- liftI $ httpRespI+          mreq <- catchI (liftI $ respHandler resp) errH+          maybe (return ())+                (\(req', body') ->+                    tryI (irun $ enumHttpReq req' body') >>=+                      either (fatal . fst) (const loop)) mreq+        fatal (SomeException _) = return ()+        errH  (SomeException _) = return . return $ Nothing

@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)+{-# LANGUAGE Trustworthy #-}+#endif  module Data.IterIO.HttpRoute     (HttpRoute(..)@@ -91,10 +95,11 @@ -- cache static data for an hour, you might use: -- -- @---   addHeader ('S8.pack' \"Cache-control: max-age=3600\") $+--   addHeader ('S8.pack' \"Cache-control\", 'S8.pack' \"max-age=3600\") $ --       'routeFileSys' mime ('dirRedir' \"index.html\") \"\/var\/www\/htdocs\" -- @-addHeader :: (Monad m) => S8.ByteString -> HttpRoute m s -> HttpRoute m s+addHeader :: (Monad m) =>+  (S8.ByteString, S8.ByteString) -> HttpRoute m s -> HttpRoute m s addHeader h (HttpRoute r) = HttpRoute $ \req -> liftM (liftM addit) (r req)     where addit resp = resp { respHeaders = h : respHeaders resp } @@ -220,7 +225,7 @@  -- | Parses @mime.types@ file data.  Returns a function mapping file -- suffixes to mime types.  The argument is a default mime type for--- suffixes to do not match any in the mime.types data.  (Reasonable+-- suffixes that do not match any in the mime.types data.  (Reasonable -- defaults might be @\"text\/html\"@, @\"text\/plain\"@, or, more -- pedantically but less usefully, @\"application\/octet-stream\"@.) --@@ -366,9 +371,9 @@                                        , respHeaders = mkHeaders req st }        mkHeaders req st =-          [ S8.pack $ "Last-Modified: " ++ (http_fmt_time $ modTimeUTC st)-          , S8.pack $ "Content-Length: " ++ (show $ fileSize st)-          , S8.pack "Content-Type: " `S8.append` typemap (fileExt req) ]+          [ (S8.pack "Last-Modified", S8.pack . http_fmt_time $ modTimeUTC st)+          , (S8.pack "Content-Length", S8.pack . show $ fileSize st)+          , (S8.pack "Content-Type", typemap (fileExt req)) ]       fileExt req =           drop 1 $ takeExtension $ case reqPathLst req of                                      [] -> dir

@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)+{-# LANGUAGE Trustworthy #-}+#endif {-# LANGUAGE DeriveDataTypeable #-}  module Data.IterIO.Inum@@ -19,10 +23,14 @@     , runIterM, runIterMC, runInum     -- * Some basic Inums     , inumNop, inumNull, inumPure, enumPure, inumRepeat+    , inumTee+    -- * Enumerator construction from Codecs+    , Codec, runCodec, runCodecC     -- * Enumerator construction monad     -- $mkInumMIntro     , InumM, mkInumM, mkInumAutoM-    , setCtlHandler, setAutoEOF, setAutoDone, addCleanup, withCleanup+    , setCtlHandler, setAutoEOF, setAutoDone+    , addCleanup, withCleanup     , ifeed, ifeed1, ipipe, irun, irepeat, ipopresid, idone     ) where @@ -734,6 +742,53 @@     (_, Left r) -> reRunIter r  --+-- Codec-based Inum creation+--++-- | A @Codec@ produces some input to feed to an 'Iter', and+-- optionally returns an 'Inum' that will produce the rest of the+-- input.  The funciton 'runCodec' can be used to build an 'Inum' out+-- of a 'Codec'.  Using 'runCodec' is much simpler than 'mkInumM', but+-- more expressive than 'mkInum'.  For example, a possible+-- implementation of 'mkInum' would be:+--+-- @+--  mkInum :: ('ChunkData' tIn, 'ChunkData' tOut, 'Monad' m) =>+--            'Iter' tIn m tOut -> 'Inum' tIn tOut m a+--  mkInum trans = inum+--      where inum = 'runCodec' 'id' $+--                   'tryEOFI' trans >>= 'maybe' (return (mempty, Nothing)) doinput+--            doinput input = do+--              eof <- if null input then return False else 'atEOFI'+--              return (input, if eof then Nothing else Just inum)+-- @+type Codec tIn tOut m a = Iter tIn m (tOut, Maybe (Inum tIn tOut m a))++-- | A generalized version of 'runCodec' that allows a 'CtlHandler' to+-- be specified.+--+-- @+--   runCodec adj = runCodecC adj (passCtl adj)+-- @+runCodecC :: (ChunkData tIn, ChunkData tOut, Monad m) =>+             ResidHandler tIn tOut+          -> CtlHandler (Iter tIn m) tOut m a+          -> Codec tIn tOut m a+          -> Inum tIn tOut m a+runCodecC adj ch codec iter = do+  (tOut, minum) <- codec+  r <- runIterMC ch iter $ chunk tOut+  case (minum, r) of+    (Just inum, IterF i) -> inum i+    _ | isIterActive r -> return r+    _ -> withResidHandler adj (getResid r) $ return . setResid r++-- | Build an 'Inum' from a 'Codec'.+runCodec :: (ChunkData tIn, ChunkData tOut, Monad m) =>+            ResidHandler tIn tOut -> Codec tIn tOut m a -> Inum tIn tOut m a+runCodec adj = runCodecC adj (passCtl adj)++-- -- Complex Inum creation -- @@ -909,6 +964,15 @@                    , insCleaning = False                    } +-- | An InumState that passes all control messages up and pulls up all+-- residual data at the end.  Requires the input and output types to+-- be the same.+nopInumState :: (ChunkData t, Monad m) => InumState t t m a+nopInumState = s+    where s = (defaultInumState `asTypeOf` s) {+                insCtl = passCtl pullupResid+              , insCleanup = ipopresid >>= ungetI }+ -- | A monad in which to define the actions of an @'Inum' tIn tOut m -- a@.  Note @InumM tIn tOut m a@ is a 'Monad' of kind @* -> *@, where -- @a@ is the (almost always parametric) return type of the 'Inum'.  A@@ -1005,6 +1069,7 @@       getErr (Fail (IterEOFErr _) _ _, s) | insAutoEOF s = return (Nothing, s)       getErr (Fail e _ _, s)                             = return (Just e, s)       getErr (_, s)                                      = return (Nothing, s)+                                   -- | A variant of 'mkInumM' that sets /AutoEOF/ and /AutoDone/ to -- 'True' by default.  (Equivalent to calling @'setAutoEOF' 'True' >>@@ -1128,3 +1193,38 @@ -- @'throwI' ...@ for an unsuccessful exit.) idone :: (ChunkData tIn, Monad m) => InumM tIn tOut m a b idone = setAutoEOF True >> throwEOFI "idone"++-- | An 'Inum' that acts like 'inumNop', except that before passing+-- data on, it feeds a copy to a \"tee\" 'Iter' (by analogy with the+-- Unix @tee@ utility), which may, for instance, transform and log the+-- data.+--+-- The tee `Iter`'s return value is ignored.  If the tee 'Iter'+-- returns before an EOF is received and before the target 'Iter' has+-- finished processing input, then @inumTee@ will continue to pass+-- data to the target 'Iter'.  However, if the tee 'Iter' fails, then+-- this will cause @inumTee@ to fail immediately.+--+-- As an example, one could implement something close to+-- @'inumStderr'@ (from "Data.IterIO.ListLike") as follows:+--+-- > inumStderr = inumTee $ handleI stderr+--+-- (Except note that the real @'inumStderr'@ does not close its file+-- descriptor, while the above implementation will send an EOF to+-- @'handleI'@, causing @stderr@ to be closed.)+inumTee :: (ChunkData t, Monad m) =>+           Iter t m b -> Inum t t m a+inumTee tee0 iter0 = runInumM (chunk0I >>= loop tee0)+                     nopInumState { insIter = IterF iter0 }+    where chunk0I = Iter $ \c@(Chunk _ eof) -> Done c (Chunk mempty eof)+          loop tee c = liftI (runIterMC (passCtl pullupResid) tee c) >>= feed c+          feed (Chunk d False) (IterF tee) = do+            done <- ifeed d `onExceptionI` liftI (runI tee)+            if done then liftI (runI tee) >> return () else chunkI >>= loop tee+          feed (Chunk d True) (IterF _) = ifeed d >> return ()+          feed _ (Fail r _ c) = reRunIter $ Fail r Nothing c+          feed (Chunk d eof) (Done _ _) = do+            done <- ifeed d+            unless (done || eof) $ ipipe inumNop >> return ()+          feed _ _ = error "inumTee"

@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)+{-# LANGUAGE Trustworthy #-}+#endif {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -278,7 +282,9 @@                         ++ shows c rest)  iterTc :: TyCon-iterTc = mkTyCon "Iter"+iterTc = mkTyCon3 "iterIO" "Data.IterIO.Iter" "Iter"+-- iterTc = mkTyCon "Iter"+ instance (Typeable t, Typeable1 m) => Typeable1 (Iter t m) where     typeOf1 iter = mkTyConApp iterTc [typeOf $ t iter, typeOf1 $ m iter]         where t :: Iter t m a -> t; t _ = undefined@@ -717,7 +723,7 @@ --    @b@ concurrently as input chunks arrive.  If @a@ throws a parse --    error, then the result of executing @b@ is returned.  If @a@ --    either succeeds or throws an exception that is not a parse---    error/EOF/'mzero', then the result of running @a@ is returned.+--    error\/EOF\/'mzero', then the result of running @a@ is returned. -- --  * With @multiParse a b@, if @b@ returns a value, executes a --    monadic action via 'lift', or issues a control request via@@ -791,6 +797,8 @@     where       check ra@(Done _ _) _ = ra       check (IterF ia) (IterF ib) = IterF $ multiParse ia ib+      check (IterF ia) (Fail e ma _) = IterF $ multiParse ia+                                       (Iter $ const $ Fail e ma Nothing)       check (IterF ia) rb =           IterF $ onDoneInput (\ra c -> check ra (runIterR rb c)) ia       check ra rb = stepR ra (flip check rb) $ case ra of

@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)+{-# LANGUAGE Trustworthy #-}+#endif {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DeriveDataTypeable #-} 

@@ -1,4 +1,7 @@-+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)+{-# LANGUAGE Safe #-}+#endif -- | This module contains functions to help parsing input from within -- 'Iter's.  Many of the operators are either imported from -- "Data.Applicative" or inspired by "Text.Parsec".

@@ -1,12 +1,14 @@+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DeriveDataTypeable #-}  module Data.IterIO.SSL where  import Control.Exception (throwIO, ErrorCall(..), finally, onException)+import qualified Control.Exception as E import Control.Monad import Control.Monad.Trans-import Data.ByteString as S+import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Data.ByteString.Lazy.Internal as L (defaultChunkSize) import Data.Typeable@@ -15,6 +17,8 @@ import System.Cmd import System.Exit +import Foreign.C.Error (errnoToIOError, eOK)+ import Data.IterIO.Iter import Data.IterIO.Inum import Data.IterIO.ListLike@@ -71,7 +75,10 @@   (if server then SSL.accept ssl else SSL.connect ssl)                           `onException` Net.sClose sock   liftIO $ pairFinalizer (sslI ssl) (enumSsl ssl) $-         SSL.shutdown ssl SSL.Bidirectional `finally` Net.sClose sock+         SSL.shutdown ssl SSL.Bidirectional+         `E.catch` \(e::IOError) -> unless (notErr e) (ioError e)+         `finally` Net.sClose sock+    where notErr = (== errnoToIOError "SSL_shutdown" eOK Nothing Nothing)  -- | Simplest possible SSL context, loads cert and unencrypted private -- key from a single file.

@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)+{-# LANGUAGE Trustworthy #-}+#endif {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} @@ -75,8 +79,6 @@ import qualified Control.Monad.RWS.Lazy as Lazy import qualified Control.Monad.State.Lazy as Lazy import qualified Control.Monad.Writer.Lazy as Lazy-import Control.Monad-import Control.Monad.Trans  import Data.IterIO.Iter 

@@ -7,7 +7,8 @@ module Data.IterIO.ZlibInt where  import Data.Word-import Foreign+import System.IO.Unsafe (unsafePerformIO)+import Foreign hiding (unsafePerformIO) import Foreign.C  #include "zlib.h"

@@ -74,7 +74,7 @@                     , ("favicon.ico"                       -- serve /favicon.ico from file ./static/favicon.ico,                       -- but tell browser to cache it for 1 day-                      , addHeader "Cache-Control: max-age=86400" $+                      , addHeader ("Cache-Control", "max-age=86400") $                                   routeFS "static/favicon.ico")                     ]         , routePath cabal_dir $ routeFS cabal_dir

@@ -1,4 +1,10 @@ +Added the Codec type and runCodec, runCodecC functions.++Fixed multiParse to avoid buffering when second 'Iter' fails++Added inumTee function+ * Changes in release 0.2  Updated to compile with HsOpenSSL 0.10.1, which has incompatible

@@ -1,13 +1,13 @@ Name:           iterIO Homepage:       http://www.scs.stanford.edu/~dm/iterIO-Version:        0.2+Version:        0.2.2 Cabal-version:  >= 1.6 build-type:     Simple License:        BSD3 License-file:   LICENSE-Author:         David Mazieres+Author:         David Mazieres, Deian Stefan, Amit Levy Stability:      experimental-Maintainer:     http://www.scs.stanford.edu/~dm/addr/+Maintainer:     levya@cs.stanford.edu, deian@cs.stanford.edu Category:       System, Data, Enumerator Synopsis:       Iteratee-based IO with pipe operators Extra-source-files:@@ -56,11 +56,11 @@  Source-repository head   Type:     git-  Location: http://www.scs.stanford.edu/~dm/repos/iterIO.git+  Location: http://github.com/scs/iterIO.git  Library   Build-depends: array >= 0.3.0.1 && < 2,-                 base >= 4.3 && < 6,+                 base >= 4.4 && < 6,                  bytestring >= 0.9 && < 2,                  containers >= 0.3 && < 2,                  filepath >= 1.2 && < 2,@@ -75,13 +75,14 @@                  time >= 1.1.4 && < 2,                  unix >= 2.4 && < 3 -  ghc-options: -Wall+  ghc-options: -Wall -pgmP cpphs -optP --cpp   Exposed-modules:     Data.IterIO,     Data.IterIO.Atto,     Data.IterIO.Iter,     Data.IterIO.Extra,     Data.IterIO.Http,+    Data.IterIO.HttpClient,     Data.IterIO.HttpRoute,     Data.IterIO.Inum,     Data.IterIO.ListLike,@@ -92,6 +93,7 @@     Data.IterIO.Zlib   Other-modules:     Data.IterIO.ZlibInt+    Paths_iterIO   Extensions:     ForeignFunctionInterface, DeriveDataTypeable,     ExistentialQuantification, MultiParamTypeClasses,