diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,8 +1,22 @@ # Changelog +#### 0.1.2.1 + +* Allow time 1.5.* + +### 0.1.2 + +* Add test for reserved identifier names + +### 0.1.1 + +* Bump `rest-gen` and `rest-core` +* Add some testing endpoints +* Allow `text == 1.2.*` + #### 0.1.0.3 -* Allow `transformers == 0.4.*`. +* Allow `transformers == 0.4.*` #### 0.1.0.2 diff --git a/example-api/Api.hs b/example-api/Api.hs --- a/example-api/Api.hs +++ b/example-api/Api.hs @@ -4,9 +4,11 @@ import Rest.Api import ApiTypes (BlogApi) -import qualified Api.Post as Post -import qualified Api.User as User -import qualified Api.Post.Comment as Post.Comment +import qualified Api.Post as Post +import qualified Api.User as User +import qualified Api.Post.Comment as Post.Comment +import qualified Api.Test as Test +import qualified Api.Test.ReservedName as ReservedName -- | Defines a versioned api api :: Api BlogApi @@ -17,7 +19,10 @@ blog = root -/ user -/ post --/ comment + -/ test --/ reservedName where - user = route User.resource - post = route Post.resource - comment = route Post.Comment.resource + user = route User.resource + post = route Post.resource + comment = route Post.Comment.resource + test = route Test.resource + reservedName = route ReservedName.resource diff --git a/example-api/Api/Post.hs b/example-api/Api/Post.hs --- a/example-api/Api/Post.hs +++ b/example-api/Api/Post.hs @@ -24,7 +24,7 @@ import Rest import Rest.Info -import Rest.Types.ShowUrl +import Rest.ShowUrl import qualified Rest.Resource as R import ApiTypes @@ -95,9 +95,9 @@ merr <- liftIO . atomically $ do let vt = validTitle pst psts if not vt - then return . Just $ domainReason (const 400) InvalidTitle + then return . Just $ domainReason InvalidTitle else if not (validContent pst) - then return . Just $ domainReason (const 400) InvalidContent + then return . Just $ domainReason InvalidContent else modifyTVar pstsVar (Set.insert post) >> return Nothing maybe (return post) throwError merr diff --git a/example-api/Api/Test.hs b/example-api/Api/Test.hs new file mode 100644 --- /dev/null +++ b/example-api/Api/Test.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE + DeriveDataTypeable + , DeriveGeneric + , LambdaCase + , OverloadedStrings + , ScopedTypeVariables + , TemplateHaskell + , TypeFamilies + #-} +module Api.Test where + +import Control.Monad.Reader +import Control.Monad.Trans.Error +import Data.Aeson +import Data.Data +import Data.JSON.Schema +import Data.Text (Text) +import GHC.Generics +import Generics.Generic.Aeson +import Generics.Regular +import Generics.Regular.XmlPickler +import Text.XML.HXT.Arrow.Pickle + +import Rest +import qualified Rest.Resource as R + +import ApiTypes +import qualified Api.Test.Err2 as E2 + +-- | User extends the root of the API with a reader containing the ways to identify a user in our URLs. +-- Currently only by the user name. +type WithText = ReaderT Text BlogApi + +data Err = Err deriving (Generic, Show, Typeable) +deriveAll ''Err "PFErr" +type instance PF Err = PFErr +instance ToJSON Err where toJSON = gtoJson +instance FromJSON Err where parseJSON = gparseJson +instance JSONSchema Err where schema = gSchema +instance XmlPickler Err where xpickle = gxpickle + +instance ToResponseCode Err where + toResponseCode _ = 400 + +data Ok = Ok deriving (Generic, Show, Typeable) +deriveAll ''Ok "PFOk" +type instance PF Ok = PFOk +instance XmlPickler Ok where xpickle = gxpickle +instance ToJSON Ok where toJSON = gtoJson +instance FromJSON Ok where parseJSON = gparseJson +instance JSONSchema Ok where schema = gSchema + +resource :: Resource BlogApi WithText Text Void Void +resource = mkResourceReader + { R.name = "test" + , R.actions = [ ("noResponse" , noResponse ) + , ("onlyError" , onlyError ) + , ("differentFormats" , differentFormats ) + , ("intersectedFormats" , intersectedFormats ) + , ("intersectedFormats2", intersectedFormats2) + , ("errorImport" , errorImport ) + , ("noError" , noError ) + , ("justStringO" , justStringO ) + , ("preferJson" , preferJson ) + , ("octetStreamOut" , octetStreamOut ) + ] + } + +noResponse :: Handler WithText +noResponse = mkConstHandler id $ return () + +onlyError :: Handler WithText +onlyError = mkConstHandler (jsonE . someE) $ + throwError $ domainReason Err + +differentFormats :: Handler WithText +differentFormats = mkInputHandler (jsonE . someE . xmlO . someO . stringI . someI) $ + \case + "error" -> throwError $ domainReason Err + _ -> return Ok + +intersectedFormats :: Handler WithText +intersectedFormats = mkInputHandler (jsonE . someE . xmlO . jsonO . someO . stringI . someI) $ + \case + "error" -> throwError $ domainReason Err + _ -> return Ok + +intersectedFormats2 :: Handler WithText +intersectedFormats2 = mkInputHandler (xmlE . someE . xmlO . jsonO . someO . stringI . someI) $ + \case + "error" -> throwError $ domainReason Err + _ -> return Ok + +errorImport :: Handler WithText +errorImport = mkIdHandler (stringI . rawXmlO . xmlE . someE) $ \s (_::Text) -> + case s of + "error" -> throwError $ domainReason E2.Err + _ -> return "" + +noError :: Handler WithText +noError = mkConstHandler (jsonO . someO) $ return Ok + +justStringO :: Handler WithText +justStringO = mkConstHandler (stringO . someO) $ return "Ok" + +preferJson :: Handler WithText +preferJson = mkInputHandler (xmlJsonO . xmlJsonE . stringI . someI) $ + \case + "error" -> throwError $ domainReason Err + _ -> return Ok + +octetStreamOut :: Handler WithText +octetStreamOut = mkInputHandler (fileI . fileO . xmlJsonE) $ + \case + "error" -> throwError $ domainReason Err + _ -> return ("ok", "ok") diff --git a/example-api/Api/Test/Err2.hs b/example-api/Api/Test/Err2.hs new file mode 100644 --- /dev/null +++ b/example-api/Api/Test/Err2.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE + DeriveDataTypeable + , DeriveGeneric + , TemplateHaskell + , TypeFamilies + #-} +module Api.Test.Err2 where + +import Data.Aeson +import Data.Data +import Data.JSON.Schema +import GHC.Generics +import Generics.Generic.Aeson +import Generics.Regular +import Generics.Regular.XmlPickler +import Text.XML.HXT.Arrow.Pickle + +import Rest + +data Err = Err deriving (Generic, Show, Typeable) +deriveAll ''Err "PFErr" +type instance PF Err = PFErr +instance ToJSON Err where toJSON = gtoJson +instance FromJSON Err where parseJSON = gparseJson +instance JSONSchema Err where schema = gSchema +instance XmlPickler Err where xpickle = gxpickle + +instance ToResponseCode Err where + toResponseCode _ = 400 diff --git a/example-api/Api/Test/ReservedName.hs b/example-api/Api/Test/ReservedName.hs new file mode 100644 --- /dev/null +++ b/example-api/Api/Test/ReservedName.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE + DeriveDataTypeable + , DeriveGeneric + , LambdaCase + , OverloadedStrings + , ScopedTypeVariables + , TemplateHaskell + , TypeFamilies + #-} +module Api.Test.ReservedName where + +import Control.Monad.Reader +import Data.Text (Text) + +import qualified Data.Text as Text + +import Rest +import qualified Rest.Resource as R + +import ApiTypes + +type WithText = ReaderT Text BlogApi + +resource :: Resource WithText WithText Text Void Void +resource = mkResourceId + { R.name = "import" + , R.schema = noListing $ named [("it", singleBy Text.pack)] + , R.get = Just get + , R.actions = [("do", action)] + } + +get :: Handler WithText +get = mkConstHandler id $ return () + +action :: Handler WithText +action = mkConstHandler id $ return () diff --git a/example-api/Api/User.hs b/example-api/Api/User.hs --- a/example-api/Api/User.hs +++ b/example-api/Api/User.hs @@ -49,9 +49,9 @@ merr <- liftIO . atomically $ do vu <- validUserName usr <$> readTVar usrs if not (validPassword usr) - then return . Just $ domainReason (const 400) InvalidPassword + then return . Just $ domainReason InvalidPassword else if not vu - then return . Just $ domainReason (const 400) InvalidUserName + then return . Just $ domainReason InvalidUserName else modifyTVar usrs (Set.insert usr) >> return Nothing maybe (return $ toUserInfo usr) throwError merr diff --git a/example-api/Type/PostError.hs b/example-api/Type/PostError.hs --- a/example-api/Type/PostError.hs +++ b/example-api/Type/PostError.hs @@ -12,6 +12,7 @@ import GHC.Generics import Generics.Regular import Generics.Regular.XmlPickler +import Rest.Error import Text.XML.HXT.Arrow.Pickle data PostError = InvalidTitle | InvalidContent @@ -24,3 +25,6 @@ instance JSONSchema PostError where schema = gSchema instance FromJSON PostError instance ToJSON PostError + +instance ToResponseCode PostError where + toResponseCode _ = 400 diff --git a/example-api/Type/UserSignupError.hs b/example-api/Type/UserSignupError.hs --- a/example-api/Type/UserSignupError.hs +++ b/example-api/Type/UserSignupError.hs @@ -12,6 +12,7 @@ import GHC.Generics import Generics.Regular import Generics.Regular.XmlPickler +import Rest.Error import Text.XML.HXT.Arrow.Pickle data UserSignupError = InvalidPassword | InvalidUserName @@ -24,3 +25,6 @@ instance JSONSchema UserSignupError where schema = gSchema instance FromJSON UserSignupError instance ToJSON UserSignupError + +instance ToResponseCode UserSignupError where + toResponseCode _ = 400 diff --git a/rest-example.cabal b/rest-example.cabal --- a/rest-example.cabal +++ b/rest-example.cabal @@ -1,5 +1,5 @@ name: rest-example -version: 0.1.0.3 +version: 0.1.2 synopsis: Example project for rest homepage: http://www.github.com/silkapp/rest license: BSD3 @@ -23,6 +23,9 @@ Api Api.Post Api.Post.Comment + Api.Test + Api.Test.Err2 + Api.Test.ReservedName Api.User ApiTypes Example @@ -40,19 +43,19 @@ , aeson >= 0.7 && < 0.9 , containers >= 0.3 && < 0.6 , filepath >= 1.1 && < 1.4 + , generic-aeson == 0.2.* , hxt == 9.3.* , json-schema >= 0.6 && < 0.8 , monad-control == 0.3.* , mtl >= 2.0 && < 2.3 , regular == 0.3.* , regular-xmlpickler == 0.2.* - , rest-core >= 0.31 && < 0.33 - , rest-types == 1.10.* + , rest-core == 0.33.* , safe >= 0.2 && < 0.4 , transformers >= 0.2 && < 0.5 , stm >= 2.1 && < 2.5 - , text >= 0.10 && < 1.2 - , time >= 1.1 && < 1.5 + , text >= 0.11 && < 1.3 + , time >= 1.1 && < 1.6 , transformers-base == 0.4.* , unordered-containers == 0.2.* @@ -90,7 +93,7 @@ base >= 4.6 && < 4.8 , happstack-server >= 7.1 && < 7.4 , mtl >= 2.0 && < 2.3 - , rest-core >= 0.31 && < 0.33 + , rest-core == 0.33.* , rest-example , rest-happstack == 0.2.* else @@ -106,7 +109,7 @@ build-depends: base >= 4.6 && < 4.8 , mtl >= 2.0 && < 2.3 - , rest-core >= 0.31 && < 0.33 + , rest-core == 0.33.* , rest-example , rest-wai == 0.1.* , wai >= 2.1 && < 3.1 @@ -124,7 +127,7 @@ build-depends: base >= 4.6 && < 4.8 , mtl >= 2.0 && < 2.3 - , rest-core >= 0.31 && < 0.33 + , rest-core == 0.33.* , rest-example , rest-snap == 0.1.* , snap-core == 0.9.* @@ -142,8 +145,8 @@ build-depends: base >= 4.6 && < 4.8 , mtl >= 2.0 && < 2.3 - , rest-core >= 0.31 && < 0.33 + , rest-core == 0.33.* , rest-example - , rest-gen >= 0.14 && < 0.16 + , rest-gen >= 0.14 && < 0.17 else buildable: False