webapi 0.2.2.0 → 0.3
raw patch · 14 files changed
+582/−395 lines, 14 filesdep +directory
Dependencies added: directory
Files
- ChangeLog.md +8/−0
- src/WebApi/Client.hs +8/−8
- src/WebApi/Contract.hs +4/−0
- src/WebApi/Internal.hs +50/−33
- src/WebApi/Mock.hs +2/−4
- src/WebApi/Param.hs +391/−252
- src/WebApi/Router.hs +65/−55
- src/WebApi/Server.hs +4/−4
- src/WebApi/Util.hs +7/−0
- tests/WebApi/MockSpec.hs +6/−5
- tests/WebApi/RequestSpec.hs +17/−16
- tests/WebApi/ResponseSpec.hs +7/−6
- tests/WebApi/RouteSpec.hs +1/−1
- webapi.cabal +12/−11
ChangeLog.md view
@@ -1,5 +1,13 @@ # Changelog +## 0.3+* WebApiImplementation typeclass is renamed to WebApiServer+* Swapped the order of FromParam and ToParam class parameters.+* Fixed TmpFileBackend for file upload.+* Added fieldModifier to ParamSettings.+* Added support for cookie attributes.+* Fixed RequestBody content type matching.+ ## 0.2.2 * Added support for GHC 8
src/WebApi/Client.hs view
@@ -118,11 +118,11 @@ firstRight = maybe (Left "Couldn't find matching Content-Type") id . find isRight -- | Creates a request from the 'Request' type.-toClientRequest :: forall m r.( ToParam (PathParam m r) 'PathParam- , ToParam (QueryParam m r) 'QueryParam- , ToParam (FormParam m r) 'FormParam+toClientRequest :: forall m r.( ToParam 'PathParam (PathParam m r)+ , ToParam 'QueryParam (QueryParam m r)+ , ToParam 'FormParam (FormParam m r) , ToHeader (HeaderIn m r)- , ToParam (FileParam m r) 'FileParam+ , ToParam 'FileParam (FileParam m r) , SingMethod m , MkPathFormatString r , PartEncodings (RequestBody m r)@@ -164,11 +164,11 @@ -- | Given a `Request` type, create the request and obtain a response. Gives back a 'Response'. client :: forall m r . ( CookieOut m r ~ ()- , ToParam (PathParam m r) 'PathParam- , ToParam (QueryParam m r) 'QueryParam- , ToParam (FormParam m r) 'FormParam+ , ToParam 'PathParam (PathParam m r)+ , ToParam 'QueryParam (QueryParam m r)+ , ToParam 'FormParam (FormParam m r) , ToHeader (HeaderIn m r)- , ToParam (FileParam m r) 'FileParam+ , ToParam 'FileParam (FileParam m r) , FromHeader (HeaderOut m r) , Decodings (ContentTypes m r) (ApiOut m r) , Decodings (ContentTypes m r) (ApiErr m r)
src/WebApi/Contract.hs view
@@ -50,6 +50,7 @@ , Response (..) , ApiError (..) , OtherError (..)+ , Resource (..) -- * Methods , module WebApi.Method@@ -223,6 +224,9 @@ -> Text -> Request m r pattern Req pp qp fp fip hi ci m = Req' pp qp fp fip hi ci () m++-- | Datatype representing a Api Resource. This is a Phantom type similar to 'Proxy', usually used to fix the parameter method (m) and route (r) of functions without resorting to pass 'undefined' as witness+data Resource m r = Res _reqToRoute :: Request m r -> Proxy m _reqToRoute _ = Proxy
src/WebApi/Internal.hs view
@@ -33,7 +33,7 @@ import Data.Text.Encoding (decodeUtf8) import Data.Typeable (Typeable) import Network.HTTP.Media (MediaType, mapAcceptMedia,- matchAccept)+ matchAccept, matchContent) import Network.HTTP.Media.RenderHeader (renderHeader) import Network.HTTP.Types hiding (Query) import Network.URI (URI (..))@@ -57,43 +57,51 @@ NotMatched -> respond (Wai.responseLBS notFound404 [] "") fromWaiRequest :: forall m r.- ( FromParam (QueryParam m r) 'QueryParam- , FromParam (FormParam m r) 'FormParam- , FromParam (FileParam m r) 'FileParam+ ( FromParam 'QueryParam (QueryParam m r)+ , FromParam 'FormParam (FormParam m r)+ , FromParam 'FileParam (FileParam m r) , FromHeader (HeaderIn m r)- , FromParam (CookieIn m r) 'Cookie+ , FromParam 'Cookie (CookieIn m r) , ToHListRecTuple (StripContents (RequestBody m r)) , PartDecodings (RequestBody m r) , SingMethod m ) => Wai.Request -> PathParam m r- -> IO (Validation [ParamErr] (Request m r))-fromWaiRequest waiReq pathPar = do+ -> (Request m r -> IO (Response m r))+ -> IO (Validation [ParamErr] (Response m r))+fromWaiRequest waiReq pathPar handlerFn = do let mContentTy = getContentType $ Wai.requestHeaders waiReq- (formPar, filePar, rBody) <- case hasFormData mContentTy of+ case hasFormData mContentTy of Just _ -> do- (formPar, filePar) <- runResourceT $ withInternalState $- \internalState -> Wai.parseRequestBody (Wai.tempFileBackEnd internalState) waiReq- print $ hasFormData $ getContentType $ Wai.requestHeaders waiReq- return (formPar, filePar, [])+ runResourceT $ withInternalState $ \internalState -> do+ (formPar, filePar) <- Wai.parseRequestBody (Wai.tempFileBackEnd internalState) waiReq+ let request = Request <$> pure pathPar+ <*> (fromQueryParam $ Wai.queryString waiReq)+ <*> (fromFormParam formPar)+ <*> (fromFileParam filePar)+ <*> (fromHeader $ Wai.requestHeaders waiReq)+ <*> (fromCookie $ maybe [] parseCookies (getCookie waiReq))+ <*> (fromBody [])+ handler' request Nothing -> do bdy <- Wai.requestBody waiReq- print bdy- return ([], [], [(fromMaybe (renderHeader $ contentType (Proxy :: Proxy OctetStream)) mContentTy, bdy)])-- return $ Request <$> pure pathPar- <*> (fromQueryParam $ Wai.queryString waiReq)- <*> (fromFormParam formPar)- <*> (fromFileParam filePar)- <*> (fromHeader $ Wai.requestHeaders waiReq)- <*> (fromCookie $ maybe [] parseCookies (getCookie waiReq))- <*> (fromBody rBody)+ let rBody = [(fromMaybe (renderHeader $ contentType (Proxy :: Proxy OctetStream)) mContentTy, bdy)]+ let request = Request <$> pure pathPar+ <*> (fromQueryParam $ Wai.queryString waiReq)+ <*> (fromFormParam [])+ <*> (fromFileParam [])+ <*> (fromHeader $ Wai.requestHeaders waiReq)+ <*> (fromCookie $ maybe [] parseCookies (getCookie waiReq))+ <*> (fromBody rBody)+ handler' request where- hasFormData x = matchAccept [contentType (Proxy :: Proxy MultipartFormData), contentType (Proxy :: Proxy UrlEncoded)] =<< x+ handler' (Validation (Right req)) = handlerFn req >>= \resp -> return $ Validation (Right resp)+ handler' (Validation (Left parErr)) = return $ Validation (Left parErr)+ hasFormData x = matchContent [contentType (Proxy :: Proxy MultipartFormData), contentType (Proxy :: Proxy UrlEncoded)] =<< x fromBody x = Validation $ either (const (Left [NotFound "415"])) (Right . fromRecTuple (Proxy :: Proxy (StripContents (RequestBody m r)))) $ partDecodings (Proxy :: Proxy (RequestBody m r)) x toWaiResponse :: ( ToHeader (HeaderOut m r)- , ToParam (CookieOut m r) 'Cookie+ , ToParam 'Cookie (CookieOut m r) , Encodings (ContentTypes m r) (ApiOut m r) , Encodings (ContentTypes m r) (ApiErr m r) ) => Wai.Request -> Response m r -> Wai.Response@@ -120,18 +128,27 @@ reproxy :: apiRes m r -> Proxy (ContentTypes m r) reproxy = const Proxy - handleHeaders :: Maybe [Header] -> Maybe [(ByteString, ByteString)] -> [Header]+ handleHeaders :: Maybe [Header] -> Maybe [(ByteString, CookieInfo ByteString)] -> [Header] handleHeaders hds cks = handleHeaders' (maybe [] id hds) (maybe [] id cks) - handleHeaders' :: [Header] -> [(ByteString, ByteString)] -> [Header]+ handleHeaders' :: [Header] -> [(ByteString, CookieInfo ByteString)] -> [Header] handleHeaders' hds cookies = let ckHs = map (\(ck, cv) -> (hSetCookie , renderSC ck cv)) cookies in hds <> ckHs- renderSC k v = toByteString (renderSetCookie (def { setCookieName = k, setCookieValue = v }))+ renderSC k v = toByteString . renderSetCookie $ def+ { setCookieName = k+ , setCookieValue = cookieValue v+ , setCookiePath = cookiePath v+ , setCookieExpires = cookieExpires v+ , setCookieMaxAge = cookieMaxAge v+ , setCookieDomain = cookieDomain v+ , setCookieHttpOnly = fromMaybe False (cookieHttpOnly v)+ , setCookieSecure = fromMaybe False (cookieSecure v)+ } -- | Generate a type safe URL for a given route type. The URI can be used for setting a base URL if required.-link :: ( ToParam (QueryParam m r) 'QueryParam+link :: ( ToParam 'QueryParam (QueryParam m r) , MkPathFormatString r- , ToParam (PathParam m r) 'PathParam+ , ToParam 'PathParam (PathParam m r) ) => route m r -> URI@@ -142,10 +159,10 @@ { uriPath = unpack $ renderUriPath (pack $ uriPath base) paths r , uriQuery = maybe "" renderQuery' query }- where renderQuery' :: (ToParam query 'QueryParam) => query -> String+ where renderQuery' :: (ToParam 'QueryParam query) => query -> String renderQuery' = unpack . renderQuery True . toQueryParam -renderUriPath :: ( ToParam path 'PathParam+renderUriPath :: ( ToParam 'PathParam path , MkPathFormatString r ) => ByteString -> path -> route m r -> ByteString renderUriPath basePth p r = case basePth of@@ -153,7 +170,7 @@ "/" -> renderPaths p r _ -> basePth `mappend` renderPaths p r -renderPaths :: ( ToParam path 'PathParam+renderPaths :: ( ToParam 'PathParam path , MkPathFormatString r ) => path -> route m r -> ByteString renderPaths p r = toByteString@@ -193,7 +210,7 @@ class ( MonadCatch (HandlerM p) , MonadIO (HandlerM p) , WebApi (ApiInterface p)- ) => WebApiImplementation (p :: *) where+ ) => WebApiServer (p :: *) where -- | Type of the handler 'Monad'. It should implement 'MonadCatch' and 'MonadIO' classes. Defaults to 'IO'. type HandlerM p :: * -> * type ApiInterface p :: *
src/WebApi/Mock.hs view
@@ -34,8 +34,6 @@ import WebApi.Util import Test.QuickCheck (Arbitrary, generate, arbitrary) -data Route' m r = Route'- -- | Datatype representing a mock server. The parameterization over `p` allows it to be a mock server for any `p`. newtype MockServer p = MockServer { mockServerSett :: MockServerSettings } deriving (Eq, Show)@@ -54,7 +52,7 @@ mockServerSettings :: MockServerSettings mockServerSettings = MockServerSettings SuccessData -instance (WebApi p) => WebApiImplementation (MockServer p) where+instance (WebApi p) => WebApiServer (MockServer p) where type ApiInterface (MockServer p) = p instance ( ApiContract p m r@@ -65,7 +63,7 @@ , Typeable m , Typeable r ) => ApiHandler (MockServer p) m r where- handler mock _ = mockResponse (Route' :: Route' m r) ((mockServerSett . unTagged) mock)+ handler mock _ = mockResponse (Res :: Resource m r) ((mockServerSett . unTagged) mock) -- | Create a mock response from endpoint information and `MockServerSettings` mockResponse :: forall route m r. ( Arbitrary (ApiOut m r)
src/WebApi/Param.hs view
@@ -65,7 +65,7 @@ , fromNonNestedParam -- * Wrappers- , Field (..)+ , CookieInfo (..) , JsonOf (..) , OptValue (..) , FileInfo (..)@@ -73,14 +73,27 @@ -- * Helpers , ParamK (..)+ , ParamSettings, fieldModifier , filePath , nest+ , defaultParamSettings+ -- * Generic (De)Serialization fn+ , genericToQueryParam+ , genericFromQueryParam+ , genericToFormParam+ , genericFromFormParam+ , genericToFileParam+ , genericFromFileParam+ , genericToPathParam+ , genericFromPathParam+ , genericToCookie+ , genericFromCookie ) where import Blaze.ByteString.Builder (toByteString) import Blaze.ByteString.Builder.Char.Utf8 (fromChar)-import Data.Aeson (FromJSON (..), ToJSON (..))+import Data.Aeson (FromJSON (..), ToJSON (..), (.:)) import qualified Data.Aeson as A import Data.ByteString as SB hiding (index, isPrefixOf)@@ -101,7 +114,8 @@ import qualified Data.Text as T (Text, pack, uncons) import Data.Text.Encoding (decodeUtf8', encodeUtf8) import Data.Time.Calendar (Day)-import Data.Time.Clock (UTCTime)+import Data.Time.Clock (UTCTime, DiffTime)+import Data.Time.LocalTime (LocalTime, TimeOfDay) import Data.Time.Format (FormatTime, defaultTimeLocale, formatTime, parseTimeM)@@ -111,10 +125,10 @@ import qualified Data.Vector as V import Data.Word import GHC.Generics-import GHC.TypeLits import Network.HTTP.Types import Network.HTTP.Types as Http (Header, QueryItem) import qualified Network.Wai.Parse as Wai (FileInfo (..))+import Control.Applicative -- | A type for holding a file. newtype FileInfo = FileInfo { fileInfo :: Wai.FileInfo FilePath }@@ -148,19 +162,41 @@ instance FromJSON a => FromJSON (JsonOf a) where parseJSON jval = JsonOf `fmap` parseJSON jval +data CookieInfo a = CookieInfo+ { cookieValue :: a+ , cookiePath :: Maybe ByteString+ , cookieExpires :: Maybe UTCTime+ , cookieMaxAge :: Maybe DiffTime+ , cookieDomain :: Maybe ByteString+ , cookieHttpOnly :: Maybe Bool+ , cookieSecure :: Maybe Bool+ }++defCookieInfo :: a -> CookieInfo a+defCookieInfo val = CookieInfo+ { cookieValue = val+ , cookiePath = Nothing+ , cookieExpires = Nothing+ , cookieMaxAge = Nothing+ , cookieDomain = Nothing+ , cookieHttpOnly = Nothing+ , cookieSecure = Nothing+ }+ -- | Define result of serialization of a type of kind 'ParamK'. type family SerializedData (par :: ParamK) where SerializedData 'QueryParam = Http.QueryItem SerializedData 'FormParam = (ByteString, ByteString) SerializedData 'FileParam = (ByteString, Wai.FileInfo FilePath) SerializedData 'PathParam = ByteString- SerializedData 'Cookie = (ByteString, ByteString)+ SerializedData 'Cookie = (ByteString, CookieInfo ByteString) -- | Define result of deserialization of a type of kind 'ParamK'. type family DeSerializedData (par :: ParamK) where DeSerializedData 'QueryParam = Maybe ByteString DeSerializedData 'FormParam = ByteString DeSerializedData 'FileParam = Wai.FileInfo FilePath+ DeSerializedData 'PathParam = ByteString DeSerializedData 'Cookie = ByteString -- | Datatype representing the parsed result of params.@@ -175,54 +211,84 @@ Left ea -> either (Left . mappend ea) (const $ Left ea) b -- | Serialize a type into query params.-toQueryParam :: (ToParam a 'QueryParam) => a -> Query+toQueryParam :: (ToParam 'QueryParam a) => a -> Query toQueryParam = toParam (Proxy :: Proxy 'QueryParam) "" -- | Serialize a type into form params.-toFormParam :: (ToParam a 'FormParam) => a -> [(ByteString, ByteString)]+toFormParam :: (ToParam 'FormParam a) => a -> [(ByteString, ByteString)] toFormParam = toParam (Proxy :: Proxy 'FormParam) "" -- | Serialize a type into file params.-toFileParam :: (ToParam a 'FileParam) => a -> [(ByteString, Wai.FileInfo FilePath)]+toFileParam :: (ToParam 'FileParam a) => a -> [(ByteString, Wai.FileInfo FilePath)] toFileParam = toParam (Proxy :: Proxy 'FileParam) "" -- | Serialize a type into path params.-toPathParam :: (ToParam a 'PathParam) => a -> [ByteString]+toPathParam :: (ToParam 'PathParam a) => a -> [ByteString] toPathParam = toParam (Proxy :: Proxy 'PathParam) "" -- | Serialize a type into cookie.-toCookie :: (ToParam a 'Cookie) => a -> [(ByteString, ByteString)]+toCookie :: (ToParam 'Cookie a) => a -> [(ByteString, CookieInfo ByteString)] toCookie = toParam (Proxy :: Proxy 'Cookie) "" -- | (Try to) Deserialize a type from query params.-fromQueryParam :: (FromParam a 'QueryParam) => Query -> Validation [ParamErr] a+fromQueryParam :: (FromParam 'QueryParam a) => Query -> Validation [ParamErr] a fromQueryParam par = fromParam (Proxy :: Proxy 'QueryParam) "" $ Trie.fromList par -- | (Try to) Deserialize a type from form params.-fromFormParam :: (FromParam a 'FormParam) => [(ByteString, ByteString)] -> Validation [ParamErr] a+fromFormParam :: (FromParam 'FormParam a) => [(ByteString, ByteString)] -> Validation [ParamErr] a fromFormParam par = fromParam (Proxy :: Proxy 'FormParam) "" $ Trie.fromList par -- | (Try to) Deserialize a type from file params.-fromFileParam :: (FromParam a 'FileParam) => [(ByteString, Wai.FileInfo FilePath)] -> Validation [ParamErr] a+fromFileParam :: (FromParam 'FileParam a) => [(ByteString, Wai.FileInfo FilePath)] -> Validation [ParamErr] a fromFileParam par = fromParam (Proxy :: Proxy 'FileParam) "" $ Trie.fromList par -- | (Try to) Deserialize a type from cookie.-fromCookie :: (FromParam a 'Cookie) => [(ByteString, ByteString)] -> Validation [ParamErr] a+fromCookie :: (FromParam 'Cookie a) => [(ByteString, ByteString)] -> Validation [ParamErr] a fromCookie par = fromParam (Proxy :: Proxy 'Cookie) "" $ Trie.fromList par +genericToQueryParam :: (Generic a, GToParam (Rep a) 'QueryParam) => ParamSettings -> ByteString -> a -> [Http.QueryItem]+genericToQueryParam opts pfx = gtoParam (Proxy :: Proxy 'QueryParam) pfx (ParamAcc 0 False) opts . from++genericFromQueryParam :: (Generic a, GFromParam (Rep a) 'QueryParam) => ParamSettings -> ByteString -> Trie (Maybe ByteString) -> Validation [ParamErr] a+genericFromQueryParam opts pfx = (fmap to) . gfromParam (Proxy :: Proxy 'QueryParam) pfx (ParamAcc 0 False) opts++genericToFormParam :: (Generic a, GToParam (Rep a) 'FormParam) => ParamSettings -> ByteString -> a -> [(ByteString, ByteString)]+genericToFormParam opts pfx = gtoParam (Proxy :: Proxy 'FormParam) pfx (ParamAcc 0 False) opts . from++genericFromFormParam :: (Generic a, GFromParam (Rep a) 'FormParam) => ParamSettings -> ByteString -> Trie ByteString -> Validation [ParamErr] a+genericFromFormParam opts pfx = (fmap to) . gfromParam (Proxy :: Proxy 'FormParam) pfx (ParamAcc 0 False) opts++genericToFileParam :: (Generic a, GToParam (Rep a) 'FileParam) => ParamSettings -> ByteString -> a -> [(ByteString, Wai.FileInfo FilePath)]+genericToFileParam opts pfx = gtoParam (Proxy :: Proxy 'FileParam) pfx (ParamAcc 0 False) opts . from++genericFromFileParam :: (Generic a, GFromParam (Rep a) 'FileParam) => ParamSettings -> ByteString -> Trie (Wai.FileInfo FilePath) -> Validation [ParamErr] a+genericFromFileParam opts pfx = (fmap to) . gfromParam (Proxy :: Proxy 'FileParam) pfx (ParamAcc 0 False) opts++genericToPathParam :: (Generic a, GToParam (Rep a) 'PathParam) => ParamSettings -> ByteString -> a -> [ByteString]+genericToPathParam opts pfx = gtoParam (Proxy :: Proxy 'PathParam) pfx (ParamAcc 0 False) opts . from++genericFromPathParam :: (Generic a, GFromParam (Rep a) 'PathParam) => ParamSettings -> ByteString -> Trie ByteString -> Validation [ParamErr] a+genericFromPathParam opts pfx = (fmap to) . gfromParam (Proxy :: Proxy 'PathParam) pfx (ParamAcc 0 False) opts++genericToCookie :: (Generic a, GToParam (Rep a) 'Cookie) => ParamSettings -> ByteString -> a -> [(ByteString, CookieInfo ByteString)]+genericToCookie opts pfx = gtoParam (Proxy :: Proxy 'Cookie) pfx (ParamAcc 0 False) opts . from++genericFromCookie :: (Generic a, GFromParam (Rep a) 'Cookie) => ParamSettings -> ByteString -> Trie ByteString -> Validation [ParamErr] a+genericFromCookie opts pfx = (fmap to) . gfromParam (Proxy :: Proxy 'Cookie) pfx (ParamAcc 0 False) opts+ -- | Serialize a type to a given type of kind 'ParamK'.-class ToParam a (parK :: ParamK) where+class ToParam (parK :: ParamK) a where toParam :: Proxy (parK :: ParamK) -> ByteString -> a -> [SerializedData parK] default toParam :: (Generic a, GToParam (Rep a) parK) => Proxy (parK :: ParamK) -> ByteString -> a -> [SerializedData parK]- toParam pt pfx = gtoParam pt pfx (ParamAcc 0 False) ParamSettings . from+ toParam pt pfx = gtoParam pt pfx (ParamAcc 0 False) defaultParamSettings . from -- | (Try to) Deserialize a type from a given type of kind 'ParamK'.-class FromParam a (parK :: ParamK) where+class FromParam (parK :: ParamK) a where fromParam :: Proxy (parK :: ParamK) -> ByteString -> Trie (DeSerializedData parK) -> Validation [ParamErr] a default fromParam :: (Generic a, GFromParam (Rep a) parK) => Proxy (parK :: ParamK) -> ByteString -> Trie (DeSerializedData parK) -> Validation [ParamErr] a- fromParam pt pfx = (fmap to) . gfromParam pt pfx (ParamAcc 0 False) ParamSettings+ fromParam pt pfx = (fmap to) . gfromParam pt pfx (ParamAcc 0 False) defaultParamSettings -- | Serialize a type to 'ByteString'. class EncodeParam (t :: *) where@@ -374,6 +440,24 @@ Just d -> Just d _ -> Nothing +instance EncodeParam LocalTime where+ encodeParam t = ASCII.pack $ formatTime defaultTimeLocale format t+ where+ format = "%FT%T"++instance DecodeParam LocalTime where+ decodeParam str = case parseTimeM True defaultTimeLocale "%FT%T" (ASCII.unpack str) of+ Just d -> Just d+ _ -> Nothing++instance EncodeParam TimeOfDay where+ encodeParam t = ASCII.pack $ formatTime defaultTimeLocale "%T" t++instance DecodeParam TimeOfDay where+ decodeParam str = case parseTimeM True defaultTimeLocale "%T" (ASCII.unpack str) of+ Just d -> Just d+ _ -> Nothing+ formatSubseconds :: (FormatTime t) => t -> String formatSubseconds = formatTime defaultTimeLocale "%q" @@ -447,649 +531,712 @@ deriving (Show, Eq, Read) -- | Serialize a type without nesting.-toNonNestedParam :: (ToParam (NonNested a) parK) => Proxy (parK :: ParamK) -> ByteString -> a -> [SerializedData parK]+toNonNestedParam :: (ToParam parK (NonNested a)) => Proxy (parK :: ParamK) -> ByteString -> a -> [SerializedData parK] toNonNestedParam par pfx a = toParam par pfx (NonNested a) -- | (Try to) Deserialize a type without nesting.-fromNonNestedParam :: (FromParam (NonNested a) parK) => Proxy (parK :: ParamK) -> ByteString -> Trie (DeSerializedData parK) -> Validation [ParamErr] a+fromNonNestedParam :: (FromParam parK (NonNested a)) => Proxy (parK :: ParamK) -> ByteString -> Trie (DeSerializedData parK) -> Validation [ParamErr] a fromNonNestedParam par pfx kvs = getNonNestedParam <$> fromParam par pfx kvs -instance (EncodeParam a) => ToParam (NonNested a) 'QueryParam where+instance (EncodeParam a) => ToParam 'QueryParam (NonNested a) where toParam _ pfx (NonNested val) = [(pfx, Just $ encodeParam val)] -instance (EncodeParam a) => ToParam (NonNested a) 'FormParam where+instance (EncodeParam a) => ToParam 'FormParam (NonNested a) where toParam _ pfx (NonNested val) = [(pfx, encodeParam val)] -instance (EncodeParam a) => ToParam (NonNested a) 'Cookie where- toParam _ pfx (NonNested val) = [(pfx, encodeParam val)]+instance (EncodeParam a) => ToParam 'Cookie (NonNested a) where+ toParam _ pfx (NonNested val) = [(pfx, defCookieInfo $ encodeParam val)] -instance (DecodeParam a, Typeable a) => FromParam (NonNested a) 'QueryParam where+instance (DecodeParam a, Typeable a) => FromParam 'QueryParam (NonNested a) where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right $ NonNested v _ -> Validation $ Left [ParseErr key $ T.pack $ "Unable to cast to " ++ (show $ typeOf (Proxy :: Proxy a))] _ -> Validation $ Left [NotFound key] -instance (DecodeParam a, Typeable a) => FromParam (NonNested a) 'FormParam where+instance (DecodeParam a, Typeable a) => FromParam 'FormParam (NonNested a) where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right $ NonNested v _ -> Validation $ Left [ParseErr key $ T.pack $ "Unable to cast to " ++ (show $ typeOf (Proxy :: Proxy a))] _ -> Validation $ Left [NotFound key] -instance (DecodeParam a, Typeable a) => FromParam (NonNested a) 'Cookie where+instance (DecodeParam a, Typeable a) => FromParam 'Cookie (NonNested a) where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right $ NonNested v _ -> Validation $ Left [ParseErr key $ T.pack $ "Unable to cast to " ++ (show $ typeOf (Proxy :: Proxy a))] _ -> Validation $ Left [NotFound key] -instance ToParam () parK where+instance ToParam parK () where toParam _ _ _ = [] instance ToHeader () where toHeader _ = [] -instance ToParam Unit 'QueryParam where+instance ToParam 'QueryParam Unit where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Unit 'FormParam where+instance ToParam 'FormParam Unit where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Unit 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie Unit where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam Int 'QueryParam where+instance ToParam 'QueryParam Int where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Int 'FormParam where+instance ToParam 'FormParam Int where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Int 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie Int where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam Int8 'QueryParam where+instance ToParam 'QueryParam Int8 where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Int8 'FormParam where+instance ToParam 'FormParam Int8 where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Int8 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie Int8 where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam Int16 'QueryParam where+instance ToParam 'QueryParam Int16 where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Int16 'FormParam where+instance ToParam 'FormParam Int16 where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Int16 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie Int16 where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam Int32 'QueryParam where+instance ToParam 'QueryParam Int32 where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Int32 'FormParam where+instance ToParam 'FormParam Int32 where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Int32 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie Int32 where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam Int64 'QueryParam where+instance ToParam 'QueryParam Int64 where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Int64 'FormParam where+instance ToParam 'FormParam Int64 where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Int64 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie Int64 where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam Word 'QueryParam where+instance ToParam 'QueryParam Word where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Word 'FormParam where+instance ToParam 'FormParam Word where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Word 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie Word where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam Word8 'QueryParam where+instance ToParam 'QueryParam Word8 where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Word8 'FormParam where+instance ToParam 'FormParam Word8 where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Word8 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie Word8 where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam Word16 'QueryParam where+instance ToParam 'QueryParam Word16 where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Word16 'FormParam where+instance ToParam 'FormParam Word16 where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Word16 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie Word16 where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam Word32 'QueryParam where+instance ToParam 'QueryParam Word32 where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Word32 'FormParam where+instance ToParam 'FormParam Word32 where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Word32 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie Word32 where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam Word64 'QueryParam where+instance ToParam 'QueryParam Word64 where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Word64 'FormParam where+instance ToParam 'FormParam Word64 where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Word64 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie Word64 where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam Integer 'QueryParam where+instance ToParam 'QueryParam Integer where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Integer 'FormParam where+instance ToParam 'FormParam Integer where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Integer 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie Integer where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam Bool 'QueryParam where+instance ToParam 'QueryParam Bool where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Bool 'FormParam where+instance ToParam 'FormParam Bool where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Bool 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie Bool where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam Double 'QueryParam where+instance ToParam 'QueryParam Double where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Double 'FormParam where+instance ToParam 'FormParam Double where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Double 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie Double where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam Float 'QueryParam where+instance ToParam 'QueryParam Float where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Float 'FormParam where+instance ToParam 'FormParam Float where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Float 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie Float where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam Char 'QueryParam where+instance ToParam 'QueryParam Char where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Char 'FormParam where+instance ToParam 'FormParam Char where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Char 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie Char where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam T.Text 'QueryParam where+instance ToParam 'QueryParam T.Text where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam T.Text 'FormParam where+instance ToParam 'FormParam T.Text where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam T.Text 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance ToParam 'Cookie T.Text where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam ByteString 'QueryParam where+instance ToParam 'QueryParam ByteString where toParam _ pfx val = [(pfx, Just $ val)] -instance ToParam ByteString 'FormParam where+instance ToParam 'FormParam ByteString where toParam _ pfx val = [(pfx, val)] -instance ToParam ByteString 'Cookie where- toParam _ pfx val = [(pfx, val)]+instance ToParam 'Cookie ByteString where+ toParam _ pfx val = [(pfx, defCookieInfo $ val)] -instance ToParam Day 'QueryParam where+instance ToParam 'QueryParam Day where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam Day 'FormParam where+instance ToParam 'FormParam Day where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam Day 'Cookie where+instance ToParam 'Cookie Day where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]++instance ToParam 'QueryParam UTCTime where+ toParam _ pfx val = [(pfx, Just $ encodeParam val)]++instance ToParam 'FormParam UTCTime where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam UTCTime 'QueryParam where+instance ToParam 'Cookie UTCTime where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]++instance ToParam 'QueryParam LocalTime where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance ToParam UTCTime 'FormParam where+instance ToParam 'FormParam LocalTime where toParam _ pfx val = [(pfx, encodeParam val)] -instance ToParam UTCTime 'Cookie where+instance ToParam 'Cookie LocalTime where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]++instance ToParam 'QueryParam TimeOfDay where+ toParam _ pfx val = [(pfx, Just $ encodeParam val)]++instance ToParam 'FormParam TimeOfDay where toParam _ pfx val = [(pfx, encodeParam val)] -instance (EncodeParam a) => ToParam (OptValue a) 'QueryParam where+instance ToParam 'Cookie TimeOfDay where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]++instance (ToParam 'Cookie a) => ToParam 'Cookie (CookieInfo a) where+ toParam p pfx val = Prelude.map (\(k, v) -> (k, val { cookieValue = cookieValue v })) $ toParam p pfx (cookieValue val)++instance (EncodeParam a) => ToParam 'QueryParam (OptValue a) where toParam _ pfx (OptValue (Just val)) = [(pfx, Just $ encodeParam val)] toParam _ pfx (OptValue Nothing) = [(pfx, Nothing)] -instance (EncodeParam a) => ToParam (OptValue a) 'FormParam where+instance (EncodeParam a) => ToParam 'FormParam (OptValue a) where toParam _ pfx (OptValue (Just val)) = [(pfx, encodeParam val)] toParam _ _ (OptValue Nothing) = [] -instance (EncodeParam a) => ToParam (OptValue a) 'Cookie where- toParam _ pfx (OptValue (Just val)) = [(pfx, encodeParam val)]+instance (EncodeParam a) => ToParam 'Cookie (OptValue a) where+ toParam _ pfx (OptValue (Just val)) = [(pfx, defCookieInfo $ encodeParam val)] toParam _ _ (OptValue Nothing) = [] -instance (ToJSON a) => ToParam (JsonOf a) 'QueryParam where+instance (ToJSON a) => ToParam 'QueryParam (JsonOf a) where toParam _ pfx val = [(pfx, Just $ encodeParam val)] -instance (ToJSON a) => ToParam (JsonOf a) 'FormParam where+instance (ToJSON a) => ToParam 'FormParam (JsonOf a) where toParam _ pfx val = [(pfx, encodeParam val)] -instance (ToJSON a) => ToParam (JsonOf a) 'Cookie where- toParam _ pfx val = [(pfx, encodeParam val)]+instance (ToJSON a) => ToParam 'Cookie (JsonOf a) where+ toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)] -instance ToParam a par => ToParam (Maybe a) par where+instance ToParam par a => ToParam par (Maybe a) where toParam pt pfx (Just val) = toParam pt pfx val toParam _ _ Nothing = [] -instance (ToParam a par, ToParam b par) => ToParam (Either a b) par where+instance (ToParam par a, ToParam par b) => ToParam par (Either a b) where toParam pt pfx (Left e) = toParam pt (pfx `nest` "Left") e toParam pt pfx (Right v) = toParam pt (pfx `nest` "Right") v -instance ToParam a par => ToParam [a] par where+instance ToParam par a => ToParam par [a] where toParam pt pfx vals = Prelude.concatMap (\(ix, v) -> toParam pt (pfx `nest` (ASCII.pack $ show ix)) v) $ Prelude.zip [(0 :: Word)..] vals -instance ToParam a par => ToParam (Vector a) par where+instance ToParam par a => ToParam par (Vector a) where toParam pt pfx vals = toParam pt pfx (V.toList vals) -instance FromParam () parK where+instance FromParam parK () where fromParam _ _ _ = pure () instance FromHeader () where fromHeader _ = pure () -instance FromParam Unit 'QueryParam where+instance FromParam 'QueryParam Unit where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to NullaryConstructor"] _ -> Validation $ Left [NotFound key] -instance FromParam Unit 'FormParam where+instance FromParam 'FormParam Unit where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to NullaryConstructor"] _ -> Validation $ Left [NotFound key] -instance FromParam Unit 'Cookie where+instance FromParam 'Cookie Unit where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to NullaryConstructor"] _ -> Validation $ Left [NotFound key] -instance FromParam Bool 'QueryParam where+instance FromParam 'QueryParam Bool where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Bool"] _ -> Validation $ Left [NotFound key] -instance FromParam Bool 'FormParam where+instance FromParam 'FormParam Bool where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Bool"] _ -> Validation $ Left [NotFound key] -instance FromParam Bool 'Cookie where+instance FromParam 'Cookie Bool where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Bool"] _ -> Validation $ Left [NotFound key] -instance FromParam Char 'QueryParam where+instance FromParam 'QueryParam Char where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Char"] _ -> Validation $ Left [NotFound key] -instance FromParam Char 'FormParam where+instance FromParam 'FormParam Char where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Char"] _ -> Validation $ Left [NotFound key] -instance FromParam Char 'Cookie where+instance FromParam 'Cookie Char where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Char"] _ -> Validation $ Left [NotFound key] -instance FromParam UTCTime 'QueryParam where+instance FromParam 'QueryParam UTCTime where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to UTCTime (ISO-8601)"] _ -> Validation $ Left [NotFound key] -instance FromParam UTCTime 'FormParam where+instance FromParam 'FormParam UTCTime where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to UTCTime (ISO-8601)"] _ -> Validation $ Left [NotFound key] -instance FromParam UTCTime 'Cookie where+instance FromParam 'Cookie UTCTime where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to UTCTime (ISO-8601)"] _ -> Validation $ Left [NotFound key] -instance FromParam Int 'QueryParam where+instance FromParam 'QueryParam LocalTime where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of+ Just v -> Validation $ Right v+ _ -> Validation $ Left [ParseErr key "Unable to cast to LocalTime (ISO-8601)"]+ _ -> Validation $ Left [NotFound key]++instance FromParam 'FormParam LocalTime where+ fromParam pt key kvs = case lookupParam pt key kvs of+ Just par -> case decodeParam par of+ Just v -> Validation $ Right v+ _ -> Validation $ Left [ParseErr key "Unable to cast to LocalTime (ISO-8601)"]+ _ -> Validation $ Left [NotFound key]++instance FromParam 'Cookie LocalTime where+ fromParam pt key kvs = case lookupParam pt key kvs of+ Just par -> case decodeParam par of+ Just v -> Validation $ Right v+ _ -> Validation $ Left [ParseErr key "Unable to cast to LocalTime (ISO-8601)"]+ _ -> Validation $ Left [NotFound key]++instance FromParam 'QueryParam TimeOfDay where+ fromParam pt key kvs = case lookupParam pt key kvs of+ Just (Just par) -> case decodeParam par of+ Just v -> Validation $ Right v+ _ -> Validation $ Left [ParseErr key "Unable to cast to TimeOfDay (ISO-8601)"]+ _ -> Validation $ Left [NotFound key]++instance FromParam 'FormParam TimeOfDay where+ fromParam pt key kvs = case lookupParam pt key kvs of+ Just par -> case decodeParam par of+ Just v -> Validation $ Right v+ _ -> Validation $ Left [ParseErr key "Unable to cast to TimeOfDay (ISO-8601)"]+ _ -> Validation $ Left [NotFound key]++instance FromParam 'Cookie TimeOfDay where+ fromParam pt key kvs = case lookupParam pt key kvs of+ Just par -> case decodeParam par of+ Just v -> Validation $ Right v+ _ -> Validation $ Left [ParseErr key "Unable to cast to TimeOfDay (ISO-8601)"]+ _ -> Validation $ Left [NotFound key]++instance FromParam 'QueryParam Int where+ fromParam pt key kvs = case lookupParam pt key kvs of+ Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int"] _ -> Validation $ Left [NotFound key] -instance FromParam Int 'FormParam where+instance FromParam 'FormParam Int where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int"] _ -> Validation $ Left [NotFound key] -instance FromParam Int 'Cookie where+instance FromParam 'Cookie Int where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int"] _ -> Validation $ Left [NotFound key] -instance FromParam Int8 'QueryParam where+instance FromParam 'QueryParam Int8 where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int8"] _ -> Validation $ Left [NotFound key] -instance FromParam Int8 'FormParam where+instance FromParam 'FormParam Int8 where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int8"] _ -> Validation $ Left [NotFound key] -instance FromParam Int8 'Cookie where+instance FromParam 'Cookie Int8 where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int8"] _ -> Validation $ Left [NotFound key] -instance FromParam Int16 'QueryParam where+instance FromParam 'QueryParam Int16 where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int16"] _ -> Validation $ Left [NotFound key] -instance FromParam Int16 'FormParam where+instance FromParam 'FormParam Int16 where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int16"] _ -> Validation $ Left [NotFound key] -instance FromParam Int16 'Cookie where+instance FromParam 'Cookie Int16 where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int16"] _ -> Validation $ Left [NotFound key] -instance FromParam Int32 'QueryParam where+instance FromParam 'QueryParam Int32 where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int32"] _ -> Validation $ Left [NotFound key] -instance FromParam Int32 'FormParam where+instance FromParam 'FormParam Int32 where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int32"] _ -> Validation $ Left [NotFound key] -instance FromParam Int32 'Cookie where+instance FromParam 'Cookie Int32 where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int32"] _ -> Validation $ Left [NotFound key] -instance FromParam Int64 'QueryParam where+instance FromParam 'QueryParam Int64 where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int64"] _ -> Validation $ Left [NotFound key] -instance FromParam Int64 'FormParam where+instance FromParam 'FormParam Int64 where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int64"] _ -> Validation $ Left [NotFound key] -instance FromParam Int64 'Cookie where+instance FromParam 'Cookie Int64 where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int64"] _ -> Validation $ Left [NotFound key] -instance FromParam Integer 'QueryParam where+instance FromParam 'QueryParam Integer where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int64"] _ -> Validation $ Left [NotFound key] -instance FromParam Integer 'FormParam where+instance FromParam 'FormParam Integer where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int64"] _ -> Validation $ Left [NotFound key] -instance FromParam Integer 'Cookie where+instance FromParam 'Cookie Integer where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Int64"] _ -> Validation $ Left [NotFound key] -instance FromParam Word 'QueryParam where+instance FromParam 'QueryParam Word where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Word"] _ -> Validation $ Left [NotFound key] -instance FromParam Word 'FormParam where+instance FromParam 'FormParam Word where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Word"] _ -> Validation $ Left [NotFound key] -instance FromParam Word 'Cookie where+instance FromParam 'Cookie Word where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Word"] _ -> Validation $ Left [NotFound key] -instance FromParam Word8 'QueryParam where+instance FromParam 'QueryParam Word8 where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Word8"] _ -> Validation $ Left [NotFound key] -instance FromParam Word8 'FormParam where+instance FromParam 'FormParam Word8 where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Word8"] _ -> Validation $ Left [NotFound key] -instance FromParam Word8 'Cookie where+instance FromParam 'Cookie Word8 where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Word8"] _ -> Validation $ Left [NotFound key] -instance FromParam Word16 'QueryParam where+instance FromParam 'QueryParam Word16 where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Word16"] _ -> Validation $ Left [NotFound key] -instance FromParam Word16 'FormParam where+instance FromParam 'FormParam Word16 where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Word16"] _ -> Validation $ Left [NotFound key] -instance FromParam Word16 'Cookie where+instance FromParam 'Cookie Word16 where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Word16"] _ -> Validation $ Left [NotFound key] -instance FromParam Word32 'QueryParam where+instance FromParam 'QueryParam Word32 where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Word32"] _ -> Validation $ Left [NotFound key] -instance FromParam Word32 'FormParam where+instance FromParam 'FormParam Word32 where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Word32"] _ -> Validation $ Left [NotFound key] -instance FromParam Word32 'Cookie where+instance FromParam 'Cookie Word32 where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Word32"] _ -> Validation $ Left [NotFound key] -instance FromParam Word64 'QueryParam where+instance FromParam 'QueryParam Word64 where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Word64"] _ -> Validation $ Left [NotFound key] -instance FromParam Word64 'FormParam where+instance FromParam 'FormParam Word64 where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Word64"] _ -> Validation $ Left [NotFound key] -instance FromParam Word64 'Cookie where+instance FromParam 'Cookie Word64 where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Word64"] _ -> Validation $ Left [NotFound key] -instance FromParam Double 'QueryParam where+instance FromParam 'QueryParam Double where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Double"] _ -> Validation $ Left [NotFound key] -instance FromParam Double 'FormParam where+instance FromParam 'FormParam Double where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Double"] _ -> Validation $ Left [NotFound key] -instance FromParam Double 'Cookie where+instance FromParam 'Cookie Double where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Double"] _ -> Validation $ Left [NotFound key] -instance FromParam Float 'QueryParam where+instance FromParam 'QueryParam Float where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Float"] _ -> Validation $ Left [NotFound key] -instance FromParam Float 'FormParam where+instance FromParam 'FormParam Float where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Float"] _ -> Validation $ Left [NotFound key] -instance FromParam Float 'Cookie where+instance FromParam 'Cookie Float where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Float"] _ -> Validation $ Left [NotFound key] -instance FromParam ByteString 'QueryParam where+instance FromParam 'QueryParam ByteString where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to ByteString"] _ -> Validation $ Left [NotFound key] -instance FromParam ByteString 'FormParam where+instance FromParam 'FormParam ByteString where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to ByteString"] _ -> Validation $ Left [NotFound key] -instance FromParam ByteString 'Cookie where+instance FromParam 'Cookie ByteString where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to ByteString"] _ -> Validation $ Left [NotFound key] -instance FromParam a par => FromParam (Maybe a) par where+instance FromParam par a => FromParam par (Maybe a) where fromParam pt key kvs = case Trie.null kvs' of True -> Validation $ Right Nothing False -> case (fromParam pt key kvs' :: Validation [ParamErr] a) of@@ -1097,7 +1244,7 @@ Validation (Left errs) -> Validation $ Left errs where kvs' = submap key kvs -instance (FromParam a par, FromParam b par) => FromParam (Either a b) par where+instance (FromParam par a, FromParam par b) => FromParam par (Either a b) where fromParam pt key kvs = case Trie.null kvsL of True -> case Trie.null kvsR of True -> Validation $ Left [ParseErr key "Unable to cast to Either"]@@ -1108,49 +1255,49 @@ keyL = (key `nest` "Left") keyR = (key `nest` "Right") -instance FromParam T.Text 'QueryParam where+instance FromParam 'QueryParam T.Text where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Text"] _ -> Validation $ Left [NotFound key] -instance FromParam T.Text 'FormParam where+instance FromParam 'FormParam T.Text where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Text"] _ -> Validation $ Left [NotFound key] -instance FromParam T.Text 'Cookie where+instance FromParam 'Cookie T.Text where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Text"] _ -> Validation $ Left [NotFound key] -instance FromParam Day 'QueryParam where+instance FromParam 'QueryParam Day where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Day"] _ -> Validation $ Left [NotFound key] -instance FromParam Day 'FormParam where+instance FromParam 'FormParam Day where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Day"] _ -> Validation $ Left [NotFound key] -instance FromParam Day 'Cookie where+instance FromParam 'Cookie Day where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right v _ -> Validation $ Left [ParseErr key "Unable to cast to Day"] _ -> Validation $ Left [NotFound key] -instance (FromParam a par) => FromParam [a] par where+instance (FromParam par a) => FromParam par [a] where fromParam pt key kvs = case Trie.null kvs' of True -> Validation $ Right [] False ->@@ -1166,12 +1313,12 @@ (Validation (Right _), Validation (Left es)) -> Validation $ Left es (Validation (Left as), Validation (Left es)) -> Validation $ Left (es ++ as) -instance (FromParam a par) => FromParam (Vector a) par where+instance (FromParam par a) => FromParam par (Vector a) where fromParam pt key kvs = case fromParam pt key kvs of Validation (Right v) -> Validation $ Right (V.fromList v) Validation (Left err) -> Validation (Left err) -instance (DecodeParam a) => FromParam (OptValue a) 'QueryParam where+instance (DecodeParam a) => FromParam 'QueryParam (OptValue a) where fromParam pt key kvs = case lookupParam pt key kvs of Just (Just par) -> case decodeParam par of Just v -> Validation $ Right $ OptValue $ Just v@@ -1179,97 +1326,103 @@ Just Nothing -> Validation $ Right $ OptValue Nothing _ -> Validation $ Left [NotFound key] -instance (DecodeParam a) => FromParam (OptValue a) 'FormParam where+instance (DecodeParam a) => FromParam 'FormParam (OptValue a) where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right $ OptValue $ Just v _ -> Validation $ Left [ParseErr key "Unable to cast to OptValue"] _ -> Validation $ Left [NotFound key] -instance (DecodeParam a) => FromParam (OptValue a) 'Cookie where+instance (DecodeParam a) => FromParam 'Cookie (OptValue a) where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> case decodeParam par of Just v -> Validation $ Right $ OptValue $ Just v _ -> Validation $ Left [ParseErr key "Unable to cast to OptValue"] _ -> Validation $ Left [NotFound key] -instance ToParam FileInfo 'FileParam where+instance (FromParam 'Cookie a) => FromParam 'Cookie (CookieInfo a) where+ fromParam pt key kvs = case (fromParam pt key kvs :: Validation [ParamErr] a) of+ Validation (Right val) -> Validation $ Right $ defCookieInfo val+ Validation (Left errs) -> Validation $ Left errs+++instance ToParam 'FileParam FileInfo where toParam _ key (FileInfo val) = [(key, val)] -instance FromParam FileInfo 'FileParam where+instance FromParam 'FileParam FileInfo where fromParam pt key kvs = case lookupParam pt key kvs of Just par -> Validation $ Right (FileInfo par) Nothing -> Validation $ Left [NotFound key] -instance ToParam ByteString 'PathParam where+instance ToParam 'PathParam ByteString where toParam _ _ v = [encodeParam v] -instance ToParam Int 'PathParam where+instance ToParam 'PathParam Int where toParam _ _ v = [encodeParam v] -instance ToParam Int8 'PathParam where+instance ToParam 'PathParam Int8 where toParam _ _ v = [encodeParam v] -instance ToParam Int16 'PathParam where+instance ToParam 'PathParam Int16 where toParam _ _ v = [encodeParam v] -instance ToParam Int32 'PathParam where+instance ToParam 'PathParam Int32 where toParam _ _ v = [encodeParam v] -instance ToParam Int64 'PathParam where+instance ToParam 'PathParam Int64 where toParam _ _ v = [encodeParam v] -instance ToParam Word 'PathParam where+instance ToParam 'PathParam Word where toParam _ _ v = [encodeParam v] -instance ToParam Word8 'PathParam where+instance ToParam 'PathParam Word8 where toParam _ _ v = [encodeParam v] -instance ToParam Word16 'PathParam where+instance ToParam 'PathParam Word16 where toParam _ _ v = [encodeParam v] -instance ToParam Word32 'PathParam where+instance ToParam 'PathParam Word32 where toParam _ _ v = [encodeParam v] -instance ToParam Word64 'PathParam where+instance ToParam 'PathParam Word64 where toParam _ _ v = [encodeParam v] -instance ToParam Float 'PathParam where+instance ToParam 'PathParam Float where toParam _ _ v = [encodeParam v] -instance ToParam Double 'PathParam where+instance ToParam 'PathParam Double where toParam _ _ v = [encodeParam v] -instance ToParam Char 'PathParam where+instance ToParam 'PathParam Char where toParam _ _ v = [encodeParam v] -instance ToParam T.Text 'PathParam where+instance ToParam 'PathParam T.Text where toParam _ _ v = [encodeParam v] -instance ToParam Day 'PathParam where+instance ToParam 'PathParam Day where toParam _ _ v = [encodeParam v] -instance ToParam UTCTime 'PathParam where+instance ToParam 'PathParam UTCTime where toParam _ _ v = [encodeParam v] -instance ToParam Bool 'PathParam where+instance ToParam 'PathParam Bool where toParam _ _ v = [encodeParam v] -instance ToParam Integer 'PathParam where+instance ToParam 'PathParam Integer where toParam _ _ v = [encodeParam v] -instance (ToJSON a) => ToParam (JsonOf a) 'PathParam where+instance (ToJSON a) => ToParam 'PathParam (JsonOf a) where toParam _ _ v = [encodeParam v] instance ( EncodeParam a , EncodeParam b- ) => ToParam (a, b) 'PathParam where+ ) => ToParam 'PathParam (a, b) where toParam _ _ (a, b) = [encodeParam a, encodeParam b] instance ( EncodeParam a , EncodeParam b , EncodeParam c- ) => ToParam (a, b, c) 'PathParam where+ ) => ToParam 'PathParam (a, b, c) where toParam _ _ (a, b, c) = [ encodeParam a , encodeParam b , encodeParam c@@ -1279,7 +1432,7 @@ , EncodeParam b , EncodeParam c , EncodeParam d- ) => ToParam (a, b, c, d) 'PathParam where+ ) => ToParam 'PathParam (a, b, c, d) where toParam _ _ (a, b, c, d) = [ encodeParam a , encodeParam b@@ -1292,7 +1445,7 @@ , EncodeParam c , EncodeParam d , EncodeParam e- ) => ToParam (a, b, c, d, e) 'PathParam where+ ) => ToParam 'PathParam (a, b, c, d, e) where toParam _ _ (a, b, c, d, e) = [ encodeParam a , encodeParam b@@ -1307,7 +1460,7 @@ , EncodeParam d , EncodeParam e , EncodeParam f- ) => ToParam (a, b, c, d, e, f) 'PathParam where+ ) => ToParam 'PathParam (a, b, c, d, e, f) where toParam _ _ (a, b, c, d, e, f) = [ encodeParam a , encodeParam b@@ -1325,7 +1478,7 @@ , EncodeParam f , EncodeParam g , EncodeParam h- ) => ToParam (a, b, c, d, e, f, g, h) 'PathParam where+ ) => ToParam 'PathParam (a, b, c, d, e, f, g, h) where toParam _ _ (a, b, c, d, e, f, g, h) = [ encodeParam a , encodeParam b@@ -1346,7 +1499,7 @@ , EncodeParam g , EncodeParam h , EncodeParam i- ) => ToParam (a, b, c, d, e, f, g, h, i) 'PathParam where+ ) => ToParam 'PathParam (a, b, c, d, e, f, g, h, i) where toParam _ _ (a, b, c, d, e, f, g, h, i) = [ encodeParam a , encodeParam b@@ -1369,7 +1522,7 @@ , EncodeParam h , EncodeParam i , EncodeParam j- ) => ToParam (a, b, c, d, e, f, g, h, i, j) 'PathParam where+ ) => ToParam 'PathParam (a, b, c, d, e, f, g, h, i, j) where toParam _ _ (a, b, c, d, e, f, g, h, i, j) = [ encodeParam a , encodeParam b@@ -1399,6 +1552,14 @@ Left ex -> utf8DecodeError "ToJSON ParamErr" (show ex) Right bs' -> A.object ["ParseErr" A..= [bs', msg]] +instance FromJSON ParamErr where+ parseJSON = A.withObject "ParamErr" $ \obj ->+ (NotFound . encodeUtf8 <$> obj .: "NotFound")+ <|> (mkParseErr <$> obj .: "ParseErr")+ where mkParseErr [key, msg] = ParseErr (encodeUtf8 key) msg+ mkParseErr vals = error $ "Error parsing ParseErr as JSON. ParseErr accepts exactly two arg but recieved " ++ (show $ Prelude.length vals)++ -- | Convert the 'ParamErr' that occured during deserialization into 'ApiErr' type which can then be put in 'Response'. class ParamErrToApiErr apiErr where toApiErr :: [ParamErr] -> apiErr@@ -1428,45 +1589,25 @@ deriving (Show, Eq) data ParamSettings = ParamSettings- deriving (Show, Eq)---- | Used to alias the field name while serailizing FromParam/ToParam instances------ > data Foo = Foo { foobar :: Field "foo_bar" Int} -- fieldname would be aliased to foo_bar instead of foobar-newtype Field (s :: Symbol) a = Field { unField :: a }--instance (ToParam a parK) => ToParam (Field s a) parK where- toParam pt pfx = toParam pt pfx . unField--instance (FromParam a parK) => FromParam (Field s a) parK where- fromParam pt key kvs = Field <$> fromParam pt key kvs--type family IsField a where- IsField (Field s a) = 'True- IsField a = 'False--class FieldModifier a (b :: Bool) where- fieldMod :: Proxy a -> Proxy b -> (ByteString -> ByteString)--instance (KnownSymbol s) => FieldModifier (Field s a) 'True where- fieldMod _ _ = const $ ASCII.pack (symbolVal (Proxy :: Proxy s))+ { fieldModifier :: (ByteString -> ByteString)+ } -instance FieldModifier a 'False where- fieldMod _ _ = id+defaultParamSettings :: ParamSettings+defaultParamSettings = ParamSettings {fieldModifier = id} -- | Serialize a type to the header params class ToHeader a where toHeader :: a -> [Http.Header] default toHeader :: (Generic a, GToHeader (Rep a)) => a -> [Http.Header]- toHeader = gtoHeader "" (ParamAcc 0 False) ParamSettings . from+ toHeader = gtoHeader "" (ParamAcc 0 False) defaultParamSettings . from -- | (Try to) Deserialize a type from the header params class FromHeader a where fromHeader :: [Http.Header] -> Validation [ParamErr] a default fromHeader :: (Generic a, GFromHeader (Rep a)) => [Http.Header] -> Validation [ParamErr] a- fromHeader = (fmap to) . gfromHeader "" (ParamAcc 0 False) ParamSettings+ fromHeader = (fmap to) . gfromHeader "" (ParamAcc 0 False) defaultParamSettings class GToHeader f where gtoHeader :: ByteString -> ParamAcc -> ParamSettings -> f a -> [Http.Header]@@ -1576,17 +1717,16 @@ where dtN = T.pack $ datatypeName (undefined :: (M1 D t f) a) -instance (GFromParam f parK, Selector t, f ~ (K1 i c), FieldModifier c (IsField c)) => GFromParam (M1 S t f) parK where+instance (GFromParam f parK, Selector t, f ~ (K1 i c)) => GFromParam (M1 S t f) parK where gfromParam pt pfx pa psett kvs = let fldN = (ASCII.pack $ (selName (undefined :: (M1 S t f) a)))- modSelName = fieldMod (Proxy :: Proxy c) (Proxy :: Proxy (IsField c)) in case fldN of "" -> M1 <$> gfromParam pt (pfx `nest` numberedFld pa) pa psett (submap pfx kvs)- _ -> M1 <$> gfromParam pt (pfx `nest` (modSelName fldN)) pa psett (submap pfx kvs)+ _ -> M1 <$> gfromParam pt (pfx `nest` fieldModifier psett fldN) pa psett (submap pfx kvs) -instance (FromParam c parK) => GFromParam (K1 i c) parK where+instance (FromParam parK c) => GFromParam (K1 i c) parK where gfromParam pt pfx _ _ kvs = K1 <$> fromParam pt pfx kvs -instance (FromParam Unit parK) => GFromParam U1 parK where+instance (FromParam parK Unit) => GFromParam U1 parK where gfromParam pt key _ _ kvs = const U1 <$> (fromParam pt key kvs :: Validation [ParamErr] Unit) class GToParam f (parK :: ParamK) where@@ -1599,7 +1739,7 @@ gtoParam pt pfx pa psett(L1 x) = gtoParam pt pfx (pa { isSum = True }) psett x gtoParam pt pfx pa psett (R1 y) = gtoParam pt pfx (pa { isSum = True }) psett y -instance (ToParam c parK) => GToParam (K1 i c) parK where+instance (ToParam parK c) => GToParam (K1 i c) parK where gtoParam pt pfx _ _ (K1 x) = toParam pt pfx x instance (GToParam f parK, Constructor t) => GToParam (M1 C t f) parK where@@ -1610,14 +1750,13 @@ instance (GToParam f parK) => GToParam (M1 D t f) parK where gtoParam pt pfx pa psett (M1 x) = gtoParam pt pfx pa psett x -instance (GToParam f parK, Selector t, f ~ (K1 i c), FieldModifier c (IsField c)) => GToParam (M1 S t f) parK where+instance (GToParam f parK, Selector t, f ~ (K1 i c)) => GToParam (M1 S t f) parK where gtoParam pt pfx pa psett m@(M1 x) = let fldN = ASCII.pack (selName m)- modSelName = fieldMod (Proxy :: Proxy c) (Proxy :: Proxy (IsField c)) in case fldN of "" -> gtoParam pt (pfx `nest` numberedFld pa) pa psett x- _ -> gtoParam pt (pfx `nest` (modSelName fldN)) pa psett x+ _ -> gtoParam pt (pfx `nest` (fieldModifier psett fldN)) pa psett x -instance (ToParam Unit parK) => GToParam U1 parK where+instance (ToParam parK Unit) => GToParam U1 parK where gtoParam pt pfx _ _ _ = toParam pt pfx Unit numberedFld :: ParamAcc -> ByteString
src/WebApi/Router.hs view
@@ -26,14 +26,28 @@ Static , Root , (:/)- -- * Default routing implementation + + -- * Default routing implementation , Route , Router (..) , router , ToPieces- -- * Custom routing + , FromPieces++ -- * Custom routing , PathSegment (..)- , MkPathFormatString (..) + , MkPathFormatString (..)+ , apiHandler++ -- * Internal+ , FilterDynP+ , StaticPiece+ , DynamicPiece+ , ParsedRoute (..)+ , PieceType (..)+ , fromParsedRoute+ , snocParsedRoute+ , symTxt ) where import Control.Exception (SomeException (..))@@ -51,7 +65,7 @@ import WebApi.Param import WebApi.Util --- | Datatype representing a endpoint. +-- | Datatype representing a endpoint. data Route (ms :: [*]) (r :: *) data StaticPiece (s :: Symbol)@@ -131,11 +145,6 @@ FilterDynP (p1 ': p2) = FilterDynP p2 FilterDynP '[] = '[] -infixr 5 :++-type family (:++) (as :: [k]) (bs :: [k]) :: [k] where- '[] :++ bs = bs- (a ': as) :++ bs = a ': (as :++ bs)- -- | Class to do the default routing. class Router (server :: *) (r :: k) (pr :: (*, [*])) where route :: ( iface ~ (ApiInterface server)@@ -148,7 +157,7 @@ instance ( SingMethod m , Router s r '(m, '[])- , Router s (Route ms r) pr) => + , Router s (Route ms r) pr) => Router s (Route (m ': ms) r) pr where route _ _s parsedRoute request respond = case requestMethod request == meth of@@ -189,12 +198,12 @@ -- Base Cases instance ( KnownSymbol piece, ApiHandler s m (Static piece) , ToHeader (HeaderOut m (Static piece))- , ToParam (CookieOut m (Static piece)) 'Cookie- , FromParam (QueryParam m (Static piece)) 'QueryParam- , FromParam (FormParam m (Static piece)) 'FormParam- , FromParam (FileParam m (Static piece)) 'FileParam+ , ToParam 'Cookie (CookieOut m (Static piece))+ , FromParam 'QueryParam (QueryParam m (Static piece))+ , FromParam 'FormParam (FormParam m (Static piece))+ , FromParam 'FileParam (FileParam m (Static piece)) , FromHeader (HeaderIn m (Static piece))- , FromParam (CookieIn m (Static piece)) 'Cookie+ , FromParam 'Cookie (CookieIn m (Static piece)) , Encodings (ContentTypes m (Static piece)) (ApiOut m (Static piece)) , Encodings (ContentTypes m (Static piece)) (ApiErr m (Static piece)) , PathParam m (Static piece) ~ ()@@ -203,7 +212,7 @@ , PartDecodings (RequestBody m (Static piece)) , Typeable m , Typeable (Static piece)- , WebApiImplementation s + , WebApiServer s ) => Router s (Static piece) '(m, pp) where route _ serv _ request respond = case pathInfo request of@@ -211,9 +220,9 @@ [] | T.null $ symTxt (Proxy :: Proxy piece) -> respond . Matched =<< getResponse _ -> respond $ NotMatched where getResponse = do- apiReq' <- fromWaiRequest request ()- response <- case apiReq' of- Validation (Right apiReq) -> toIO serv $ handler' serv (Proxy :: Proxy '[]) (apiReq :: Request m (Static piece))+ apiResp' <- fromWaiRequest request () (\(req :: Request m (Static piece)) -> toIO serv $ apiHandler (toTagged (Proxy :: Proxy '[]) serv) req)+ response <- case apiResp' of+ Validation (Right apiResp) -> return apiResp Validation (Left errs) -> return $ Failure $ Left $ ApiError badRequest400 (toApiErr errs) Nothing Nothing return $ toWaiResponse request response @@ -224,21 +233,21 @@ , route ~ (FromPieces paths) , ApiHandler s m route , PathParam m route ~ HListToTuple (FilterDynP paths)- , FromParam (QueryParam m route) 'QueryParam- , FromParam (FormParam m route) 'FormParam- , FromParam (FileParam m route) 'FileParam- , FromParam (CookieIn m route) 'Cookie+ , FromParam 'QueryParam (QueryParam m route)+ , FromParam 'FormParam (FormParam m route)+ , FromParam 'FileParam (FileParam m route)+ , FromParam 'Cookie (CookieIn m route) , FromHeader (HeaderIn m route) , Encodings (ContentTypes m route) (ApiErr m route) , Encodings (ContentTypes m route) (ApiOut m route) , ToHeader (HeaderOut m route)- , ToParam (CookieOut m route) 'Cookie+ , ToParam 'Cookie (CookieOut m route) , ParamErrToApiErr (ApiErr m route) , ToHListRecTuple (StripContents (RequestBody m route)) , PartDecodings (RequestBody m route) , Typeable m , Typeable route- , WebApiImplementation s+ , WebApiServer s ) => Router s ((lpiece :: Symbol) :/ (rpiece :: Symbol)) '(m, pp) where route _ serv parsedRoute request respond = case pathInfo request of@@ -250,9 +259,9 @@ pRoute = snocParsedRoute (snocParsedRoute parsedRoute $ SPiece (Proxy :: Proxy lpiece)) $ SPiece (Proxy :: Proxy rpiece) pathPar = fromParsedRoute pRoute getResponse = do- apiReq' <- fromWaiRequest request pathPar- response <- case apiReq' of- Validation (Right apiReq) -> toIO serv $ handler' serv (Proxy :: Proxy '[]) (apiReq :: Request m route)+ apiResp' <- fromWaiRequest request pathPar (\(req :: Request m route) -> toIO serv $ apiHandler (toTagged (Proxy :: Proxy '[]) serv) req)+ response <- case apiResp' of+ Validation (Right apiResp) -> return apiResp Validation (Left errs) -> return $ Failure $ Left $ ApiError badRequest400 (toApiErr errs) Nothing Nothing return $ toWaiResponse request response @@ -262,22 +271,22 @@ , route ~ (FromPieces paths) , ApiHandler s m route , PathParam m route ~ HListToTuple (FilterDynP paths)- , FromParam (QueryParam m route) 'QueryParam- , FromParam (FormParam m route) 'FormParam- , FromParam (FileParam m route) 'FileParam- , FromParam (CookieIn m route) 'Cookie+ , FromParam 'QueryParam (QueryParam m route)+ , FromParam 'FormParam (FormParam m route)+ , FromParam 'FileParam (FileParam m route)+ , FromParam 'Cookie (CookieIn m route) , FromHeader (HeaderIn m route) , Encodings (ContentTypes m route) (ApiErr m route) , Encodings (ContentTypes m route) (ApiOut m route) , ToHeader (HeaderOut m route)- , ToParam (CookieOut m route) 'Cookie+ , ToParam 'Cookie (CookieOut m route) , DecodeParam lpiece , ParamErrToApiErr (ApiErr m route) , ToHListRecTuple (StripContents (RequestBody m route)) , PartDecodings (RequestBody m route) , Typeable m , Typeable route- , WebApiImplementation s+ , WebApiServer s ) => Router s ((lpiece :: *) :/ (rpiece :: Symbol)) '(m, pp) where route _ serv parsedRoute request respond = case pathInfo request of@@ -289,9 +298,9 @@ getResponse dynVal = do let pRoute :: ParsedRoute '(m, paths) pRoute = snocParsedRoute (snocParsedRoute parsedRoute $ DPiece dynVal) $ SPiece (Proxy :: Proxy rpiece)- apiReq' <- fromWaiRequest request (fromParsedRoute pRoute)- response <- case apiReq' of- Validation (Right apiReq) -> toIO serv $ handler' serv (Proxy :: Proxy '[]) (apiReq :: Request m route)+ apiResp' <- fromWaiRequest request (fromParsedRoute pRoute) (\(req :: Request m route) -> toIO serv $ apiHandler (toTagged (Proxy :: Proxy '[]) serv) req)+ response <- case apiResp' of+ Validation (Right apiResp) -> return apiResp Validation (Left errs) -> return $ Failure $ Left $ ApiError badRequest400 (toApiErr errs) Nothing Nothing return $ toWaiResponse request response @@ -299,22 +308,22 @@ instance ( route ~ (FromPieces (pp :++ '[DynamicPiece t])) , ApiHandler s m route , PathParam m route ~ HListToTuple (FilterDynP (pp :++ '[DynamicPiece t]))- , FromParam (QueryParam m route) 'QueryParam- , FromParam (FormParam m route) 'FormParam- , FromParam (FileParam m route) 'FileParam- , FromParam (CookieIn m route) 'Cookie+ , FromParam 'QueryParam (QueryParam m route)+ , FromParam 'FormParam (FormParam m route)+ , FromParam 'FileParam (FileParam m route)+ , FromParam 'Cookie (CookieIn m route) , FromHeader (HeaderIn m route) , Encodings (ContentTypes m route) (ApiErr m route) , Encodings (ContentTypes m route) (ApiOut m route) , ToHeader (HeaderOut m route)- , ToParam (CookieOut m route) 'Cookie+ , ToParam 'Cookie (CookieOut m route) , DecodeParam t , ParamErrToApiErr (ApiErr m route) , ToHListRecTuple (StripContents (RequestBody m route)) , PartDecodings (RequestBody m route) , Typeable m , Typeable route- , WebApiImplementation s + , WebApiServer s ) => Router s (DynamicPiece t) '(m, pp) where route _ serv parsedRoute request respond = case pathInfo request of@@ -325,9 +334,9 @@ where getResponse dynVal = do let pRoute :: ParsedRoute '(m, (pp :++ '[DynamicPiece t])) pRoute = snocParsedRoute parsedRoute $ DPiece dynVal- apiReq' <- fromWaiRequest request (fromParsedRoute pRoute)- response <- case apiReq' of- Validation (Right apiReq) -> toIO serv $ handler' serv (Proxy :: Proxy '[]) (apiReq :: Request m route)+ apiResp' <- fromWaiRequest request (fromParsedRoute pRoute) (\(req :: Request m route) -> toIO serv $ apiHandler (toTagged (Proxy :: Proxy '[]) serv) req)+ response <- case apiResp' of+ Validation (Right apiResp) -> return apiResp Validation (Left errs) -> return $ Failure $ Left $ ApiError badRequest400 (toApiErr errs) Nothing Nothing return $ toWaiResponse request response @@ -368,13 +377,14 @@ instance MkFormatStr '[] where mkFormatStr _ = [] -handler' :: forall query p m r.- ( query ~ '[]- , MonadCatch (HandlerM p)- , ApiHandler p m r- , Typeable m- , Typeable r) => p -> Proxy query -> Request m r -> HandlerM p (Query (Response m r) query)-handler' serv p req = (handler (toTagged p serv) req) `catches` excepHandlers+-- | This function is used to call local handler without incurring the cost of network round trip and se/deserialisation of Request and Response.+apiHandler :: forall query p m r.+ ( query ~ '[]+ , MonadCatch (HandlerM p)+ , ApiHandler p m r+ , Typeable m+ , Typeable r) => Tagged query p -> Request m r -> HandlerM p (Query (Response m r) query)+apiHandler serv req = (handler serv req) `catches` excepHandlers where excepHandlers :: [Handler (HandlerM p) (Query (Response m r) query)]- excepHandlers = [ Handler (\ (ex :: ApiException m r) -> handleApiException serv ex)- , Handler (\ (ex :: SomeException) -> handleSomeException serv ex) ]+ excepHandlers = [ Handler (\ (ex :: ApiException m r) -> handleApiException (unTagged serv) ex)+ , Handler (\ (ex :: SomeException) -> handleSomeException (unTagged serv) ex) ]
src/WebApi/Server.hs view
@@ -3,9 +3,9 @@ License : BSD3 Stability : experimental -Provides the implementation of web api. Given a contract, an implementation of the web api can be provided by using 'WebApiImplementation' and 'ApiHandler'. 'WebApiImplementation' has the information pertaining to web api as a whole. 'ApiHandler' provides a way to write the handler for a particular API end point.+Provides the implementation of web api. Given a contract, an implementation of the web api can be provided by using 'WebApiServer' and 'ApiHandler'. 'WebApiServer' has the information pertaining to web api as a whole. 'ApiHandler' provides a way to write the handler for a particular API end point. -Comparing with the "WebApi.Contract", 'WebApi' and 'ApiContract' has the same relationship as 'WebApiImplementation' and 'ApiHandler'.+Comparing with the "WebApi.Contract", 'WebApi' and 'ApiContract' has the same relationship as 'WebApiServer' and 'ApiHandler'. -} {-# LANGUAGE DataKinds #-}@@ -23,7 +23,7 @@ -- * Implementation of Api , ApiHandler (..) , ApiException (..)- , WebApiImplementation (..) + , WebApiServer (..) , respond , respondWith , raise@@ -91,7 +91,7 @@ -> handM (Response m r) raiseWith' = throwM . ApiException --- | Create a WAI application from the information specified in `WebApiImplementation`, `WebApi`, `ApiContract` and `ApiHandler` classes.+-- | Create a WAI application from the information specified in `WebApiServer`, `WebApi`, `ApiContract` and `ApiHandler` classes. serverApp :: ( iface ~ (ApiInterface server) , Router server (Apis iface) '(CUSTOM "", '[]) ) => ServerSettings -> server -> Wai.Application
src/WebApi/Util.hs view
@@ -3,6 +3,8 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE PolyKinds #-}+ module WebApi.Util where import Data.Proxy (Proxy)@@ -66,3 +68,8 @@ instance ToHListRecTuple '[p1, p2, p3, p4, p5, p6, p7, p8, p9] where toRecTuple _ (p1, p2, p3, p4, p5, p6, p7, p8, p9) = (p1, (p2, (p3, (p4, (p5, (p6, (p7, (p8, (p9, ()))))))))) fromRecTuple _ (p1, (p2, (p3, (p4, (p5, (p6, (p7, (p8, (p9, ()))))))))) = (p1, p2, p3, p4, p5, p6, p7, p8, p9)++infixr 5 :+++type family (:++) (as :: [k]) (bs :: [k]) :: [k] where+ '[] :++ bs = bs+ (a ': as) :++ bs = a ': (as :++ bs)
tests/WebApi/MockSpec.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# LANGUAGE MultiParamTypeClasses, TypeFamilies, OverloadedStrings, DataKinds, TypeOperators, TypeSynonymInstances, FlexibleInstances, DeriveGeneric #-} module WebApi.MockSpec (spec) where @@ -19,16 +20,16 @@ type MockApi = Static "mock" -data QP = QP { _qp1 :: Int, _qp2 :: Bool }+data QP = QP { qp1 :: Int, qp2 :: Bool } deriving (Show, Eq, Generic) -data MockOut = MockOut { _out1 :: Int- , _out2 :: Bool- , _out3 :: Char+data MockOut = MockOut { out1 :: Int+ , out2 :: Bool+ , out3 :: Char } deriving (Show, Eq, Generic) instance ToJSON MockOut where-instance FromParam QP 'QueryParam where+instance FromParam 'QueryParam QP where instance Arbitrary MockOut where arbitrary = MockOut <$> arbitrary <*> arbitrary
tests/WebApi/RequestSpec.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# LANGUAGE MultiParamTypeClasses, TypeFamilies, OverloadedStrings, DataKinds, TypeOperators, TypeSynonymInstances, FlexibleInstances, DeriveGeneric #-} module WebApi.RequestSpec (spec) where @@ -35,36 +36,36 @@ deriving (Show, Eq, Generic) -} -data QP = QP { _qp1 :: Int , _qp2 :: Maybe Bool, _qp3 :: Either Text Double }+data QP = QP { qp1 :: Int , qp2 :: Maybe Bool, qp3 :: Either Text Double } deriving (Show, Eq, Generic) -data FoP = FoP { _fop :: ByteString }+data FoP = FoP { fop :: ByteString } deriving (Show, Eq, Generic) -data CP = CP { _cp :: Bool }+data CP = CP { cp :: Bool } deriving (Show, Eq, Generic) -data HP = HP1 { _hp1 :: Int }- | HP2 { _hp2 :: Bool }+data HP = HP1 { hp1 :: Int }+ | HP2 { hp2 :: Bool } deriving (Show, Eq, Generic) -data FiP = FiP { _fip :: FileInfo }+data FiP = FiP { fip :: FileInfo } deriving (Show, Eq, Generic) -data RB = RB { _rb :: Text }+data RB = RB { rb :: Text } deriving (Show, Eq, Generic) -instance FromParam QP 'QueryParam where-instance FromParam FoP 'FormParam where -instance FromParam CP 'Cookie where+instance FromParam 'QueryParam QP where+instance FromParam 'FormParam FoP where +instance FromParam 'Cookie CP where instance FromHeader HP where-instance FromParam FiP 'FileParam where+instance FromParam 'FileParam FiP where -instance ToParam QP 'QueryParam where-instance ToParam FoP 'FormParam where -instance ToParam CP 'Cookie where+instance ToParam 'QueryParam QP where+instance ToParam 'FormParam FoP where +instance ToParam 'Cookie CP where instance ToHeader HP where-instance ToParam FiP 'FileParam where+instance ToParam 'FileParam FiP where instance FromJSON RB @@ -86,7 +87,7 @@ ] ApiR ] -instance WebApiImplementation ReqSpecImpl where+instance WebApiServer ReqSpecImpl where type ApiInterface ReqSpecImpl = ReqSpec instance ApiContract ReqSpec GET ApiR where
tests/WebApi/ResponseSpec.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# LANGUAGE MultiParamTypeClasses, TypeFamilies, OverloadedStrings, DataKinds, TypeOperators, TypeSynonymInstances, FlexibleInstances, DeriveGeneric #-} module WebApi.ResponseSpec (spec) where@@ -21,20 +22,20 @@ data RespSpec data RespSpecImpl = RespSpecImpl -data Out = Out { _out :: Text }+data Out = Out { out :: Text } deriving (Show, Eq, Generic) -data HOut = HOut { _hOut :: Text }+data HOut = HOut { hOut :: Text } deriving (Show, Eq, Generic) -data COut = COut { _cOut :: Text }+data COut = COut { cOut :: Text } deriving (Show, Eq, Generic)-data Err = Err { _err :: Text }+data Err = Err { err :: Text } deriving (Show, Eq, Generic) instance ToJSON Err instance ToJSON Out instance ToHeader HOut -instance ToParam COut 'Cookie+instance ToParam 'Cookie COut instance ParamErrToApiErr Err where@@ -53,7 +54,7 @@ , Route '[GET] TextCType , Route '[GET] LazyEncoding] -instance WebApiImplementation RespSpecImpl where+instance WebApiServer RespSpecImpl where type ApiInterface RespSpecImpl = RespSpec type HandlerM RespSpecImpl = IO
tests/WebApi/RouteSpec.hs view
@@ -52,7 +52,7 @@ instance ApiContract RoutingSpec GET OverlappingRoute where type ApiOut GET OverlappingRoute = Text -instance WebApiImplementation RoutingSpecImpl where+instance WebApiServer RoutingSpecImpl where type HandlerM RoutingSpecImpl = IO type ApiInterface RoutingSpecImpl = RoutingSpec
webapi.cabal view
@@ -1,17 +1,17 @@--- Initial webapi.cabal generated by cabal init. For further +-- Initial webapi.cabal generated by cabal init. For further -- documentation, see http://haskell.org/cabal/users-guide/ name: webapi-version: 0.2.2.0+version: 0.3 synopsis: WAI based library for web api-description: WAI based library for web api +description: WAI based library for web api homepage: http://byteally.github.io/webapi/ license: BSD3 license-file: LICENSE author: Magesh B maintainer: magesh85@gmail.com--- copyright: --- extra-source-files: +-- copyright:+-- extra-source-files: cabal-version: >=1.10 category: Web build-type: Simple@@ -33,11 +33,11 @@ , WebApi.Param , WebApi.Method , WebApi.Mock+ , WebApi.Util - other-modules: WebApi.Util- -- other-extensions: + -- other-extensions: build-depends: base >= 4.7 && < 5- , text >= 1.2 && < 1.3 + , text >= 1.2 && < 1.3 , containers >= 0.5 && < 0.6 , binary >= 0.7 && < 0.9 , bytestring >= 0.10 && < 0.11@@ -60,6 +60,7 @@ , transformers >= 0.4 && < 0.6 , cookie >= 0.4 && < 0.5 , QuickCheck == 2.8.*+ , directory hs-source-dirs: src default-language: Haskell2010@@ -73,7 +74,7 @@ , WebApi.RouteSpec , WebApi.ClientSpec , WebApi.MockSpec- + hs-source-dirs: tests default-language: Haskell2010 cpp-options: -DTEST@@ -83,12 +84,12 @@ , case-insensitive == 1.2.* , wai >= 3.0 && < 3.3 , wai-extra >= 3.0 && < 3.3- , warp + , warp , http-media >= 0.6 && < 0.7 , http-types >= 0.8 && < 0.10 , hspec >= 2.1 && < 2.3 , hspec-wai == 0.6.*- , text >= 1.2 && < 1.3 + , text >= 1.2 && < 1.3 , bytestring >= 0.10 && < 0.11 , vector >= 0.10 && < 0.12 , time >= 1.5 && < 1.7