codedmart

-- servant-server/src/Servant/Server/Internal.hs
-- | IsSecure
instance (HasServer sublayout) => HasServer (IsSecure :> sublayout) where

  type ServerT (IsSecure :> sublayout) m =
    Bool -> ServerT sublayout m

  route Proxy subserver request respond =
    route (Proxy :: Proxy sublayout) (subserver $ isSecure request) request respond

codedmart

type AuthTokenAPI =
  WithAuthToken :> (
  "private" :> Get String
  :<|> "private" :> Post String
  )

api :: Proxy API
api = Proxy

authTokenServer :: Pool DBHandle -> Server AuthTokenAPI

codedmart

{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE KindSignatures     #-}
{-# OPTIONS_HADDOCK not-home    #-}
module Servant.API.Delete (Delete) where

import Data.Typeable ( Typeable )

-- | Combinator for DELETE requests.
--

codedmart

client returns errors appropriately
  reports FailureResponse FAILED [1]
  reports DecodeFailure FAILED [2]
  reports ConnectionError FAILED [3]
  reports UnsupportedContentType FAILED [4]
  reports InvalidContentTypeHeader

Failures:

  1) client returns errors appropriately reports FailureResponse

codedmart

{-# LANGUAGE CPP                #-}
{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators      #-}
{-# OPTIONS_GHC -fcontext-stack=100 #-}

codedmart

test/Servant/ClientSpec.hs:286:12:
    Couldn't match type ‘Method
                         -> EitherT
                              ServantError
                              IO
                              (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)’
                  with ‘EitherT ServantError IO Person’
    Expected type: EitherT ServantError IO Person
                   :<|> (EitherT ServantError IO ()
                         :<|> ((String -> EitherT ServantError IO Person)

codedmart

  it "Returns headers appropriately" $ hspec $ withServer $ \ host -> do
    res <- runIO $ runEitherT getRespHeaders
    case res of
      Left e -> runIO $ assertFailure $ show e
      Right val -> runIO $ getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]

  modifyMaxSuccess (const 20) $ do
    it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
      property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
        ioProperty $ do

codedmart

Failures:

  1) client returns errors appropriately reports FailureResponse
       uncaught exception: IOException of type UserError (user error (Pattern match failure in do expression at test/Servant/ClientSpec.hs:274:7-14))

  2) client returns errors appropriately reports DecodeFailure
       uncaught exception: IOException of type UserError (user error (Pattern match failure in do expression at test/Servant/ClientSpec.hs:280:7-14))

  3) client returns errors appropriately reports ConnectionError
       uncaught exception: IOException of type UserError (user error (Pattern match failure in do expression at test/Servant/ClientSpec.hs:287:7-14))

codedmart

{-# LANGUAGE CPP                #-}
{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators      #-}
{-# OPTIONS_GHC -fcontext-stack=25 #-}

codedmart

{-# LANGUAGE CPP                #-}
{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators      #-}
{-# OPTIONS_GHC -fcontext-stack=25 #-}