Aelve Codesearch

grep over package repositories
Please provide a string to search for.
3+ characters are required.
Index updated 2 months ago

total matches: 16

servant-server-0.16.1
14 matches
src/Servant/Server/Internal/ServerError.hs
                 (Typeable)
import qualified Network.HTTP.Types    as HTTP
import           Network.Wai
                 (Response, responseLBS)

data ServerError = ServerError
    { errHTTPCode     :: Int
    , errReasonPhrase :: String
    , errBody         :: LBS.ByteString

            
src/Servant/Server/Internal/ServerError.hs
instance Exception ServerError

responseServerError :: ServerError -> Response
responseServerError ServerError{..} = responseLBS status errHeaders errBody
  where
    status = HTTP.mkStatus errHTTPCode (BS.pack errReasonPhrase)

-- | 'err300' Multiple Choices
--

            
src/Servant/Server/Internal.hs
import           Network.Wai
                 (Application, Request, httpVersion, isSecure, lazyRequestBody,
                 rawQueryString, remoteHost, requestBody, requestHeaders,
                 requestMethod, responseLBS, responseStream, vault)
import           Prelude ()
import           Prelude.Compat
import           Servant.API
                 ((:<|>) (..), (:>), Accept (..), BasicAuth, Capture',
                 CaptureAll, Description, EmptyAPI, FramingRender (..),

            
src/Servant/Server/Internal.hs
                 Nothing -> FailFatal err406 -- this should not happen (checked before), so we make it fatal if it does
                 Just (contentT, body) ->
                      let bdy = if allowedMethodHead method request then "" else body
                      in Route $ responseLBS status ((hContentType, cs contentT) : headers) bdy

instance {-# OVERLAPPABLE #-}
         ( AllCTRender ctypes a, ReflectMethod method, KnownNat status
         ) => HasServer (Verb method status ctypes a) context where


            
src/Servant/Server/Internal.hs
                let (headers, fa) = splitHeaders output
                    sourceT = toSourceIO fa
                    S.SourceT kStepLBS = framingRender framingproxy (mimeRender ctypeproxy :: chunk -> BL.ByteString) sourceT
                in Route $ responseStream status (contentHeader : headers) $ \write flush -> do
                    let loop S.Stop          = flush
                        loop (S.Error err)   = fail err -- TODO: throw better error
                        loop (S.Skip s)      = loop s
                        loop (S.Effect ms)   = ms >>= loop
                        loop (S.Yield lbs s) = do

            
test/Servant/Server/RouterSpec.hs
import           Network.HTTP.Types
                 (Status (..))
import           Network.Wai
                 (responseBuilder)
import           Network.Wai.Internal
                 (Response (ResponseBuilder))
import           Servant.API
import           Servant.Server
import           Servant.Server.Internal
import           Test.Hspec
import           Test.Hspec.Wai

            
test/Servant/Server/RouterSpec.hs

        router', router :: Router ()
        router' = tweakResponse (fmap twk) router
        router = leafRouter $ \_ _ cont -> cont (Route $ responseBuilder (Status 201 "") [] "")

        twk :: Response -> Response
        twk (ResponseBuilder (Status i s) hs b) = ResponseBuilder (Status (i + 1) s) hs b
        twk b = b

    with (return app') $ do
      it "calls f on route result" $ do
        get "" `shouldRespondWith` 202

            
test/Servant/Server/RouterSpec.hs
          `Choice` cap

        success :: Response
        success = responseBuilder (Status 200 "") [] ""

    with (pure $ toApp router) $ do
      it "capture failure returns a 400 response" $ do
        get "/badcapture" `shouldRespondWith` 400


            
test/Servant/ServerSpec.hs
                 methodPut, ok200, parseQuery)
import           Network.Wai
                 (Application, Request, pathInfo, queryString, rawQueryString,
                 requestHeaders, responseLBS)
import           Network.Wai.Test
                 (defaultRequest, request, runSession, simpleBody,
                 simpleHeaders, simpleStatus)
import           Servant.API
                 ((:<|>) (..), (:>), AuthProtect, BasicAuth,

            
test/Servant/ServerSpec.hs
    with (return (serve
        (Proxy :: Proxy (Capture "captured" String :> Raw))
        (\ "captured" -> Tagged $ \request_ respond ->
            respond $ responseLBS ok200 [] (cs $ show $ pathInfo request_)))) $ do
      it "strips the captured path snippet from pathInfo" $ do
        get "/captured/foo" `shouldRespondWith` (fromString (show ["foo" :: String]))

-- }}}
------------------------------------------------------------------------------

            
test/Servant/ServerSpec.hs
    with (return (serve
        (Proxy :: Proxy (CaptureAll "segments" String :> Raw))
        (\ _captured -> Tagged $ \request_ respond ->
            respond $ responseLBS ok200 [] (cs $ show $ pathInfo request_)))) $ do
      it "consumes everything from pathInfo" $ do
        get "/captured/foo/bar/baz" `shouldRespondWith` (fromString (show ([] :: [Int])))

-- }}}
------------------------------------------------------------------------------

            
test/Servant/ServerSpec.hs

rawApplication :: Show a => (Request -> a) -> Tagged m Application
rawApplication f = Tagged $ \request_ respond ->
    respond $ responseLBS ok200 []
        (cs $ show $ f request_)

rawSpec :: Spec
rawSpec = do
  describe "Servant.API.Raw" $ do

            
test/Servant/ServerSpec.hs
basicAuthServer :: Server BasicAuthAPI
basicAuthServer =
  const (return jerry) :<|>
  (Tagged $ \ _ respond -> respond $ responseLBS imATeapot418 [] "")

basicAuthContext :: Context '[ BasicAuthCheck () ]
basicAuthContext =
  let basicHandler = BasicAuthCheck $ \(BasicAuthData usr pass) ->
        if usr == "servant" && pass == "server"

            
test/Servant/ServerSpec.hs

genAuthServer :: Server GenAuthAPI
genAuthServer = const (return tweety)
           :<|> (Tagged $ \ _ respond -> respond $ responseLBS imATeapot418 [] "")

type instance AuthServerData (AuthProtect "auth") = ()

genAuthContext :: Context '[AuthHandler Request ()]
genAuthContext =