module Webcrank
(
Resource(..)
, resource
, resourceWithBody
, resourceWithHtml
, Encoding
, Authorized(..)
, ETag(..)
, PostAction(..)
, postCreate
, postCreateRedir
, postProcess
, postProcessRedir
, HaltT
, halt
, werror
, Charset
, CharsetsProvided(..)
, provideCharsets
, HeadersMap
, addResponseHeader
, putResponseHeader
, Body
, textBody
, lazyTextBody
, strBody
, writeLBS
, writeStr
, module Network.HTTP.Date
, module Network.HTTP.Media
, module Network.HTTP.Types
, hAcceptCharset
, hAcceptEncoding
, hAllow
, hETag
, hExpires
, hIfMatch
, hIfNoneMatch
, hIfUnmodifiedSince
, hTransferEncoding
, hVary
, hWWWAuthenticate
) where
import Control.Lens
import Control.Monad
import Control.Monad.State
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LB
import Data.List.NonEmpty
import qualified Data.HashMap.Strict as HashMap
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
import Network.HTTP.Date
import Network.HTTP.Media
import Network.HTTP.Types
import Webcrank.Internal.Halt
import Webcrank.Internal.Headers
import Webcrank.Internal.ReqData
import Webcrank.Internal.Types
resource :: Monad m => Resource m
resource = Resource
{ serviceAvailable = return True
, uriTooLong = return False
, allowedMethods = return [methodGet, methodHead]
, malformedRequest = return False
, isAuthorized = return Authorized
, forbidden = return False
, validContentHeaders = return True
, knownContentType = return True
, validEntityLength = return True
, options = return []
, contentTypesProvided = return []
, charsetsProvided = return NoCharset
, encodingsProvided = return []
, resourceExists = return True
, generateETag = mzero
, lastModified = mzero
, expires = mzero
, movedPermanently = mzero
, movedTemporarily = mzero
, previouslyExisted = return False
, allowMissingPost = return False
, deleteResource = return False
, deleteCompleted = return True
, postAction = postProcess $ return ()
, contentTypesAccepted = return []
, variances = return []
, multipleChoices = return False
, isConflict = return False
, finishRequest = return ()
}
resourceWithBody :: Monad m => MediaType -> m Body -> Resource m
resourceWithBody t b = resource { contentTypesProvided = return [(t, lift b)] }
resourceWithHtml :: Monad m => m Body -> Resource m
resourceWithHtml b = resourceWithBody "text/html" b
provideCharsets
:: Monad m
=> NonEmpty (Charset, Body -> Body)
-> m CharsetsProvided
provideCharsets = return . CharsetsProvided
addResponseHeader
:: (MonadState s m, HasReqData s)
=> HeaderName
-> ByteString
-> m ()
addResponseHeader h v = reqDataRespHeaders %= HashMap.insertWith (<>) h [v]
postCreate :: Monad m => [Text] -> m (PostAction m)
postCreate = return . PostCreate
postCreateRedir :: Monad m => [Text] -> m (PostAction m)
postCreateRedir = return . PostCreateRedir
postProcess :: Monad m => HaltT m () -> m (PostAction m)
postProcess = return . PostProcess
postProcessRedir :: Monad m => HaltT m ByteString -> m (PostAction m)
postProcessRedir = return . PostProcessRedir
textBody :: Text -> Body
textBody = LB.fromStrict . T.encodeUtf8
lazyTextBody :: LT.Text -> Body
lazyTextBody = LT.encodeUtf8
strBody :: String -> Body
strBody = lazyTextBody . LT.pack
writeStr
:: (MonadState s m, HasReqData s)
=> String
-> m ()
writeStr = assign reqDataRespBody . Just . strBody