diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/src/WebApi/Client.hs b/src/WebApi/Client.hs --- a/src/WebApi/Client.hs +++ b/src/WebApi/Client.hs @@ -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) diff --git a/src/WebApi/Contract.hs b/src/WebApi/Contract.hs --- a/src/WebApi/Contract.hs +++ b/src/WebApi/Contract.hs @@ -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 diff --git a/src/WebApi/Internal.hs b/src/WebApi/Internal.hs --- a/src/WebApi/Internal.hs +++ b/src/WebApi/Internal.hs @@ -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 :: * diff --git a/src/WebApi/Mock.hs b/src/WebApi/Mock.hs --- a/src/WebApi/Mock.hs +++ b/src/WebApi/Mock.hs @@ -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) diff --git a/src/WebApi/Param.hs b/src/WebApi/Param.hs --- a/src/WebApi/Param.hs +++ b/src/WebApi/Param.hs @@ -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 diff --git a/src/WebApi/Router.hs b/src/WebApi/Router.hs --- a/src/WebApi/Router.hs +++ b/src/WebApi/Router.hs @@ -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) ] diff --git a/src/WebApi/Server.hs b/src/WebApi/Server.hs --- a/src/WebApi/Server.hs +++ b/src/WebApi/Server.hs @@ -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 diff --git a/src/WebApi/Util.hs b/src/WebApi/Util.hs --- a/src/WebApi/Util.hs +++ b/src/WebApi/Util.hs @@ -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) diff --git a/tests/WebApi/MockSpec.hs b/tests/WebApi/MockSpec.hs --- a/tests/WebApi/MockSpec.hs +++ b/tests/WebApi/MockSpec.hs @@ -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 diff --git a/tests/WebApi/RequestSpec.hs b/tests/WebApi/RequestSpec.hs --- a/tests/WebApi/RequestSpec.hs +++ b/tests/WebApi/RequestSpec.hs @@ -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 diff --git a/tests/WebApi/ResponseSpec.hs b/tests/WebApi/ResponseSpec.hs --- a/tests/WebApi/ResponseSpec.hs +++ b/tests/WebApi/ResponseSpec.hs @@ -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 diff --git a/tests/WebApi/RouteSpec.hs b/tests/WebApi/RouteSpec.hs --- a/tests/WebApi/RouteSpec.hs +++ b/tests/WebApi/RouteSpec.hs @@ -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 diff --git a/webapi.cabal b/webapi.cabal --- a/webapi.cabal +++ b/webapi.cabal @@ -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