<commit_before>{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE Rank2Types                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeSynonymInstances       #-}

module Snap.Internal.Types where

------------------------------------------------------------------------------
import           Blaze.ByteString.Builder
import           Blaze.ByteString.Builder.Char.Utf8
import           Control.Applicative
import           Control.Exception.Lifted (catch,
                                           catches,
                                           mask,
                                           onException,
                                           throwIO,
                                           Handler(..),
                                           Exception,
                                           SomeException(..),
                                           ErrorCall(..))
import           Control.Monad
import           Control.Monad.Base
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Control
import           Control.Monad.Trans.State
import           Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import           Data.CaseInsensitive (CI)
import           Data.Int
import           Data.Maybe
import           Data.Time
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import           Data.Typeable
#if MIN_VERSION_base(4,6,0)
import           Prelude hiding (take)
#else
import           Prelude hiding (catch, take)
#endif
import           System.IO.Streams (InputStream, OutputStream)
import qualified System.IO.Streams as Streams
import           System.PosixCompat.Files hiding (setFileSize)
import           System.Posix.Types (FileOffset)
import           Unsafe.Coerce
------------------------------------------------------------------------------
import           Snap.Internal.Http.Types
import qualified Snap.Types.Headers as H
import           Snap.Util.Readable
------------------------------------------------------------------------------


                             --------------------
                             -- The Snap Monad --
                             --------------------
{-|

'Snap' is the 'Monad' that user web handlers run in. 'Snap' gives you:

1. stateful access to fetch or modify an HTTP 'Request'

2. stateful access to fetch or modify an HTTP 'Response'

3. failure \/ 'Alternative' \/ 'MonadPlus' semantics: a 'Snap' handler can
   choose not to handle a given request, using 'empty' or its synonym 'pass',
   and you can try alternative handlers with the '<|>' operator:

   > a :: Snap String
   > a = pass
   >
   > b :: Snap String
   > b = return "foo"
   >
   > c :: Snap String
   > c = a <|> b             -- try running a, if it fails then try b

4. convenience functions ('writeBS', 'writeLBS', 'writeText', 'writeLazyText',
   'addToOutput') for queueing output to be written to the 'Response':

   > a :: (forall a . Enumerator a) -> Snap ()
   > a someEnumerator = do
   >     writeBS "I'm a strict bytestring"
   >     writeLBS "I'm a lazy bytestring"
   >     writeText "I'm strict text"
   >     addToOutput someEnumerator

5. early termination: if you call 'finishWith':

   > a :: Snap ()
   > a = do
   >   modifyResponse $ setResponseStatus 500 "Internal Server Error"
   >   writeBS "500 error"
   >   r <- getResponse
   >   finishWith r

   then any subsequent processing will be skipped and supplied 'Response'
   value will be returned from 'runSnap' as-is.

6. access to the 'IO' monad through a 'MonadIO' instance:

   > a :: Snap ()
   > a = liftIO fireTheMissiles

7. the ability to set or extend a timeout which will kill the handler thread
   after @N@ seconds of inactivity (the default is 20 seconds):

   > a :: Snap ()
   > a = setTimeout 30

8. throw and catch exceptions using a 'MonadBaseControl' instance:

   > import           Control.Exception.Lifted (SomeException, throwIO, catch)
   > foo :: Snap ()
   > foo = bar `catch` \(e::SomeException) -> baz
   >   where
   >     bar = throwIO FooException

9. log a message to the error log:

   > foo :: Snap ()
   > foo = logError "grumble."

You may notice that most of the type signatures in this module contain a
@(MonadSnap m) => ...@ typeclass constraint. 'MonadSnap' is a typeclass which,
in essence, says \"you can get back to the 'Snap' monad from here\". Using
'MonadSnap' you can extend the 'Snap' monad with additional functionality and
still have access to most of the 'Snap' functions without writing 'lift'
everywhere. Instances are already provided for most of the common monad
transformers ('ReaderT', 'WriterT', 'StateT', etc.).

-}

------------------------------------------------------------------------------
-- | 'MonadSnap' is a type class, analogous to 'MonadIO' for 'IO', that makes
-- it easy to wrap 'Snap' inside monad transformers.
class (Monad m, MonadIO m, MonadBaseControl IO m, MonadPlus m, Functor m,
       Applicative m, Alternative m) => MonadSnap m where
    liftSnap :: Snap a -> m a


------------------------------------------------------------------------------
data SnapResult a = SnapValue a
                  | Zero Zero


------------------------------------------------------------------------------
type EscapeHttpHandler =  ((Int -> Int) -> IO ())    -- ^ timeout modifier
                       -> InputStream ByteString     -- ^ socket read end
                       -> OutputStream ByteString    -- ^ socket write end<commit_msg>EscapeSnap: OutputStream should be over Builder.<commit_after>{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE Rank2Types                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeSynonymInstances       #-}

module Snap.Internal.Types where

------------------------------------------------------------------------------
import           Blaze.ByteString.Builder
import           Blaze.ByteString.Builder.Char.Utf8
import           Control.Applicative
import           Control.Exception.Lifted (catch,
                                           catches,
                                           mask,
                                           onException,
                                           throwIO,
                                           Handler(..),
                                           Exception,
                                           SomeException(..),
                                           ErrorCall(..))
import           Control.Monad
import           Control.Monad.Base
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Control
import           Control.Monad.Trans.State
import           Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import           Data.CaseInsensitive (CI)
import           Data.Int
import           Data.Maybe
import           Data.Time
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import           Data.Typeable
#if MIN_VERSION_base(4,6,0)
import           Prelude hiding (take)
#else
import           Prelude hiding (catch, take)
#endif
import           System.IO.Streams (InputStream, OutputStream)
import qualified System.IO.Streams as Streams
import           System.PosixCompat.Files hiding (setFileSize)
import           System.Posix.Types (FileOffset)
import           Unsafe.Coerce
------------------------------------------------------------------------------
import           Snap.Internal.Http.Types
import qualified Snap.Types.Headers as H
import           Snap.Util.Readable
------------------------------------------------------------------------------


                             --------------------
                             -- The Snap Monad --
                             --------------------
{-|

'Snap' is the 'Monad' that user web handlers run in. 'Snap' gives you:

1. stateful access to fetch or modify an HTTP 'Request'

2. stateful access to fetch or modify an HTTP 'Response'

3. failure \/ 'Alternative' \/ 'MonadPlus' semantics: a 'Snap' handler can
   choose not to handle a given request, using 'empty' or its synonym 'pass',
   and you can try alternative handlers with the '<|>' operator:

   > a :: Snap String
   > a = pass
   >
   > b :: Snap String
   > b = return "foo"
   >
   > c :: Snap String
   > c = a <|> b             -- try running a, if it fails then try b

4. convenience functions ('writeBS', 'writeLBS', 'writeText', 'writeLazyText',
   'addToOutput') for queueing output to be written to the 'Response':

   > a :: (forall a . Enumerator a) -> Snap ()
   > a someEnumerator = do
   >     writeBS "I'm a strict bytestring"
   >     writeLBS "I'm a lazy bytestring"
   >     writeText "I'm strict text"
   >     addToOutput someEnumerator

5. early termination: if you call 'finishWith':

   > a :: Snap ()
   > a = do
   >   modifyResponse $ setResponseStatus 500 "Internal Server Error"
   >   writeBS "500 error"
   >   r <- getResponse
   >   finishWith r

   then any subsequent processing will be skipped and supplied 'Response'
   value will be returned from 'runSnap' as-is.

6. access to the 'IO' monad through a 'MonadIO' instance:

   > a :: Snap ()
   > a = liftIO fireTheMissiles

7. the ability to set or extend a timeout which will kill the handler thread
   after @N@ seconds of inactivity (the default is 20 seconds):

   > a :: Snap ()
   > a = setTimeout 30

8. throw and catch exceptions using a 'MonadBaseControl' instance:

   > import           Control.Exception.Lifted (SomeException, throwIO, catch)
   > foo :: Snap ()
   > foo = bar `catch` \(e::SomeException) -> baz
   >   where
   >     bar = throwIO FooException

9. log a message to the error log:

   > foo :: Snap ()
   > foo = logError "grumble."

You may notice that most of the type signatures in this module contain a
@(MonadSnap m) => ...@ typeclass constraint. 'MonadSnap' is a typeclass which,
in essence, says \"you can get back to the 'Snap' monad from here\". Using
'MonadSnap' you can extend the 'Snap' monad with additional functionality and
still have access to most of the 'Snap' functions without writing 'lift'
everywhere. Instances are already provided for most of the common monad
transformers ('ReaderT', 'WriterT', 'StateT', etc.).

-}

------------------------------------------------------------------------------
-- | 'MonadSnap' is a type class, analogous to 'MonadIO' for 'IO', that makes
-- it easy to wrap 'Snap' inside monad transformers.
class (Monad m, MonadIO m, MonadBaseControl IO m, MonadPlus m, Functor m,
       Applicative m, Alternative m) => MonadSnap m where
    liftSnap :: Snap a -> m a


------------------------------------------------------------------------------
data SnapResult a = SnapValue a
                  | Zero Zero


------------------------------------------------------------------------------
type EscapeHttpHandler =  ((Int -> Int) -> IO ())    -- ^ timeout modifier
                       -> InputStream ByteString     -- ^ socket read end
                       -> OutputStream Builder       -- ^ socket write end
{'fraction_non_alphanumeric': 0.1664313595216344, 'fraction_numerical': 0.004484677352379371, 'mean_word_length': 1.5340909090909092, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 87, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 34, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3485783', 'n_tokens_mistral': 3172, 'n_tokens_neox': 3047, 'n_words': 1072}