import Control.Concurrent.STM
import Control.Exception
import Control.Monad.Trans
-import GHC.Conc (unsafeIOToSTM)
+import Data.ByteString.Base (ByteString)
import Data.Dynamic
+import GHC.Conc (unsafeIOToSTM)
import Network.HTTP.Lucu.Config
import Network.HTTP.Lucu.DefaultPage
import Network.HTTP.Lucu.Headers
-- > abort MovedPermanently
-- > [("Location", "http://example.net/")]
-- > (Just "It has been moved to example.net")
-abort :: MonadIO m => StatusCode -> [ (String, String) ] -> Maybe String -> m a
+abort :: MonadIO m => StatusCode -> [ (ByteString, ByteString) ] -> Maybe String -> m a
abort status headers msg
= status `seq` headers `seq` msg `seq`
- let abo = Abortion status headers msg
+ let abo = Abortion status (toHeaders headers) msg
exc = DynException (toDyn abo)
in
liftIO $ throwIO exc
-- |Computation of @'abortSTM' status headers msg@ just computes
-- 'abort' in a 'Control.Monad.STM.STM' monad.
-abortSTM :: StatusCode -> [ (String, String) ] -> Maybe String -> STM a
+abortSTM :: StatusCode -> [ (ByteString, ByteString) ] -> Maybe String -> STM a
abortSTM status headers msg
= status `seq` headers `seq` msg `seq`
unsafeIOToSTM $! abort status headers msg
-- | Computation of @'abortA' -< (status, (headers, msg))@ just
-- computes 'abort' in an 'Control.Arrow.ArrowIO.ArrowIO'.
-abortA :: ArrowIO a => a (StatusCode, ([ (String, String) ], Maybe String)) c
+abortA :: ArrowIO a => a (StatusCode, ([ (ByteString, ByteString) ], Maybe String)) c
abortA
= arrIO3 abort
Nothing
-> let res' = res { resStatus = aboStatus abo }
res'' = foldl (.) id [setHeader name value
- | (name, value) <- aboHeaders abo]
+ | (name, value) <- fromHeaders $ aboHeaders abo]
$ res'
in
getDefaultPage conf reqM res''