diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2016 Todd Mohney + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/json-api-lib.cabal b/json-api-lib.cabal new file mode 100644 --- /dev/null +++ b/json-api-lib.cabal @@ -0,0 +1,109 @@ +cabal-version: 2.0 + +name: json-api-lib +version: 0.1.0.0 +homepage: https://github.com/shirren/json-api-lib +bug-reports: https://github.com/shirren/json-api-lib/issues +license: MIT +license-file: LICENSE +author: Todd Mohney, Shirren Premaratne +copyright: 2016 Todd Mohney +category: Network +build-type: Simple +maintainer: Shirren Premaratne +tested-with: GHC == 8.4.3 +synopsis: Utilities for generating JSON-API payloads +description: + Provides utilities for deriving JSON payloads conformant to the json-api + specification + +source-repository head + type: git + location: https://github.com/shirren/json-api-lib.git + +library + build-depends: aeson > 1.4 && < 1.5 + , base >= 4.11 && < 5 + , containers >= 0.6.1 && < 0.7 + , data-default >= 0.7.1 && < 0.8 + , lens >= 4.17.1 && < 4.18 + , lens-aeson >= 1.0.2 && < 1.1 + , text >= 1.2.3.1 && < 1.3 + , unordered-containers >= 0.2.10 && < 0.3 + , uri-encode >= 1.5.0 && < 1.6 + + default-language: Haskell2010 + + default-extensions: + DeriveGeneric + GeneralizedNewtypeDeriving + OverloadedStrings + RecordWildCards + TemplateHaskell + + exposed-modules: + Network.JSONApi + Network.JSONApi.Error + Network.JSONApi.Document + Network.JSONApi.Identifier + Network.JSONApi.Meta + Network.JSONApi.Link + Network.JSONApi.Resource + + other-modules: + + ghc-options: + -Wall + -fwarn-unused-matches + -fwarn-unused-binds + -fwarn-unused-imports + + hs-source-dirs: src + +test-suite json-api-lib-test + build-depends: aeson > 1.4 && < 1.5 + , aeson-pretty > 0.8 && < 0.9 + , base >= 4.11 && < 5 + , bytestring >= 0.10.8 && < 0.11 + , containers >= 0.6.1 && < 0.7 + , data-default >= 0.7.1 && < 0.8 + , hspec >= 2.7.1 && < 2.8 + , json-api-lib + , lens >= 4.17.1 && < 4.18 + , lens-aeson >= 1.0.2 && < 1.1 + , text >= 1.2.3.1 && < 1.3 + , unordered-containers >= 0.2.10 && < 0.3 + , uri-encode >= 1.5.0 && < 1.6 + + build-tool-depends: hspec-discover:hspec-discover == 2.* + + default-language: Haskell2010 + + default-extensions: + DeriveGeneric + GeneralizedNewtypeDeriving + OverloadedStrings + RecordWildCards + + ghc-options: + -Wall + -fwarn-unused-matches + -fwarn-unused-binds + + hs-source-dirs: test + + main-is: Spec.hs + + other-modules: + Network.JSONApi.ErrorSpec + Network.JSONApi.DocumentSpec + Network.JSONApi.IdentifierSpec + Network.JSONApi.MetaSpec + Network.JSONApi.ResourceSpec + TestHelpers + + type: exitcode-stdio-1.0 + +source-repository head + type: git + location: https://github.com/shirren/json-api-lib diff --git a/src/Network/JSONApi.hs b/src/Network/JSONApi.hs new file mode 100644 --- /dev/null +++ b/src/Network/JSONApi.hs @@ -0,0 +1,41 @@ +{- | +Entry-point module for this package. +-} +module Network.JSONApi +( D.Document +, D.ResourceData (..) +, D.ErrorDocument (..) +, D.Included +, E.Error (..) +, R.Relationship +, R.Resource (..) +, R.Relationships +, R.ResourcefulEntity (..) +, I.HasIdentifier (..) +, I.Identifier (..) +, L.Links +, M.Meta +, M.MetaObject (..) +, M.Pagination (..) +, L.mkLinks +, R.indexLinks +, R.mkRelationship +, R.mkRelationships +, R.showLink +, D.mkDocument +, D.mkDocument' +, D.singleton +, D.list +, D.mkCompoundDocument +, D.mkCompoundDocument' +, D.mkIncludedResource +, M.mkMeta +) where + +import qualified Network.JSONApi.Error as E +import qualified Network.JSONApi.Document as D +import qualified Network.JSONApi.Identifier as I +import qualified Network.JSONApi.Link as L +import qualified Network.JSONApi.Meta as M +import qualified Network.JSONApi.Resource as R + diff --git a/src/Network/JSONApi/Document.hs b/src/Network/JSONApi/Document.hs new file mode 100644 --- /dev/null +++ b/src/Network/JSONApi/Document.hs @@ -0,0 +1,211 @@ +{- | +Contains representations of the top-level JSON-API document structure. +-} +module Network.JSONApi.Document + ( Document + , ResourceData (..) + , ErrorDocument (..) + , Included + , mkDocument + , mkDocument' + , singleton + , list + , mkCompoundDocument + , mkCompoundDocument' + , mkIncludedResource + ) where + +import Control.Monad (mzero) +import Data.Aeson + ( ToJSON + , FromJSON + , Value + , (.=) + , (.:) + , (.:?) + ) +import qualified Data.Aeson as AE + +import qualified GHC.Generics as G + +import qualified Network.JSONApi.Error as E +import Network.JSONApi.Link as L +import Network.JSONApi.Meta as M +import Network.JSONApi.Resource (Resource, ResourcefulEntity) +import qualified Network.JSONApi.Resource as R + +{- | +The 'Document' type represents the top-level JSON-API requirement. + +@data@ attribute - the resulting JSON may be either a singleton resource +or a list of resources. See 'Resource' for the construction. + +For more information see: +-} +data Document a = Document + { _data :: ResourceData a + , _links :: Maybe Links + , _meta :: Maybe Meta + , _included :: [Value] + } deriving (Show, Eq, G.Generic) + +instance (ToJSON a) + => ToJSON (Document a) where + toJSON (Document (List res) links meta included) = + AE.object [ "data" .= res + , "links" .= links + , "meta" .= meta + , "included" .= included + ] + toJSON (Document (Singleton res) links meta included) = + AE.object [ "data" .= res + , "links" .= links + , "meta" .= meta + , "included" .= included + ] + +instance (FromJSON a) => FromJSON (Document a) where + parseJSON = AE.withObject "document" $ \v -> do + d <- v .: "data" + l <- v .:? "links" + m <- v .:? "meta" + i <- v .: "included" + return (Document d l m i) + +{- | +The 'Included' type is an abstraction used to constrain the @included@ +section of the Document to JSON serializable Resource objects while +enabling a heterogeneous list of Resource types. + +No data constructors for this type are exported as we need to +constrain the 'Value' to a heterogeneous list of Resource types. +See 'mkIncludedResource' for creating 'Included' types. +-} +newtype Included = Included [Value] + deriving (Show) + +-- instance Monoid Included where +-- mempty = Included [] +-- mappend (Included as) (Included bs) = Included (as <> bs) + +{- | +Constructor function for the Document data type. + +See 'mkCompoundDocument' for constructing compound Document +including 'side-loaded' resources +-} +mkDocument :: ResourcefulEntity a => + [a] + -> Maybe Links + -> Maybe Meta + -> Document a +mkDocument res = mkDocument' (toResourceData res) + +mkDocument' :: ResourceData a + -> Maybe Links + -> Maybe Meta + -> Document a +mkDocument' res links meta = + Document + { _data = res + , _links = links + , _meta = meta + , _included = [] + } + +{- | +Constructor function for the Document data type. +See 'mkIncludedResource' for constructing the 'Included' type. + +Supports building compound documents + +-} +mkCompoundDocument :: ResourcefulEntity a => + [a] + -> Maybe Links + -> Maybe Meta + -> Included + -> Document a +mkCompoundDocument res = mkCompoundDocument' (toResourceData res) + +mkCompoundDocument' :: ResourceData a + -> Maybe Links + -> Maybe Meta + -> Included + -> Document a +mkCompoundDocument' res links meta (Included included) = + Document + { _data = res + , _links = links + , _meta = meta + , _included = included + } + +{- | +Constructor function for the Document data type. + +Supports building compound documents + +-} +mkIncludedResource :: ResourcefulEntity a => a -> Included +mkIncludedResource res = Included [AE.toJSON . R.toResource $ res] + +toResourceData :: ResourcefulEntity a => [a] -> ResourceData a +toResourceData [r] = Singleton (R.toResource r) +toResourceData rs = List (map R.toResource rs) + +{- | +The 'Resource' type encapsulates the underlying 'Resource' + +Included in the top-level 'Document', the 'Resource' may be either +a singleton resource or a list. + +For more information see: +-} +data ResourceData a = Singleton (Resource a) + | List [ Resource a ] + deriving (Show, Eq, G.Generic) + +singleton :: ResourcefulEntity a => a -> ResourceData a +singleton = Singleton . R.toResource + +list :: ResourcefulEntity a => [a] -> ResourceData a +list = List . map R.toResource + +instance (ToJSON a) => ToJSON (ResourceData a) where + toJSON (Singleton res) = AE.toJSON res + toJSON (List res) = AE.toJSON res + +instance (FromJSON a) => FromJSON (ResourceData a) where + parseJSON (AE.Object v) = Singleton <$> AE.parseJSON (AE.Object v) + parseJSON (AE.Array v) = List <$> AE.parseJSON (AE.Array v) + parseJSON _ = mzero + +{- | +The 'ErrorDocument' type represents the alternative form of the top-level +JSON-API requirement. + +@error@ attribute - a descriptive object encapsulating application-specific +error detail. + +For more information see: +-} +data ErrorDocument a = ErrorDocument + { _error :: E.Error a + , _errorLinks :: Maybe Links + , _errorMeta :: Maybe Meta + } deriving (Show, Eq, G.Generic) + +instance (ToJSON a) => ToJSON (ErrorDocument a) where + toJSON (ErrorDocument err links meta) = + AE.object [ "error" .= err + , "links" .= links + , "meta" .= meta + ] + +instance (FromJSON a) => FromJSON (ErrorDocument a) where + parseJSON = AE.withObject "error" $ \v -> + ErrorDocument + <$> v .: "error" + <*> v .:? "links" + <*> v .:? "meta" diff --git a/src/Network/JSONApi/Error.hs b/src/Network/JSONApi/Error.hs new file mode 100644 --- /dev/null +++ b/src/Network/JSONApi/Error.hs @@ -0,0 +1,50 @@ +{- | +Module representing a JSON-API error object. + +Error objects are used for providing application-specific detail +to unsuccessful API responses. + +Specification: +-} +module Network.JSONApi.Error +( Error (..) +) where + +import Data.Aeson (ToJSON, FromJSON) +import Data.Default +import Data.Text +import qualified GHC.Generics as G +import Network.JSONApi.Link (Links) +import Network.JSONApi.Meta +import Prelude hiding (id) + +{- | +Type for providing application-specific detail to unsuccessful API +responses. + +Specification: +-} +data Error a = + Error { id :: Maybe Text + , links :: Maybe Links + , status :: Maybe Text + , code :: Maybe Text + , title :: Maybe Text + , detail :: Maybe Text + , meta :: Maybe Meta + } + deriving (Show, Eq, G.Generic) + +instance ToJSON a => ToJSON (Error a) +instance FromJSON a => FromJSON (Error a) + +instance Default (Error a) where + def = Error + { id = Nothing + , links = Nothing + , status = Nothing + , code = Nothing + , title = Nothing + , detail = Nothing + , meta = Nothing + } diff --git a/src/Network/JSONApi/Identifier.hs b/src/Network/JSONApi/Identifier.hs new file mode 100644 --- /dev/null +++ b/src/Network/JSONApi/Identifier.hs @@ -0,0 +1,60 @@ +{- | +Module representing a JSON-API resource object. + +Specification: +-} +module Network.JSONApi.Identifier +( HasIdentifier (..) +, Identifier (..) +, datatype +, ident +, metadata +) where + +import Control.Lens.TH + +import Data.Aeson (ToJSON, FromJSON, (.=), (.:), (.:?)) +import qualified Data.Aeson as AE +import Data.Text (Text) + +import Network.JSONApi.Meta (Meta) + +import Prelude hiding (id) + +{- | +Identifiers are used to encapsulate the minimum amount of information +to uniquely identify a resource. + +This object will be found at multiple levels of the JSON-API structure + +Specification: +-} +data Identifier = Identifier + { _ident :: Text + , _datatype :: Text + , _metadata :: Maybe Meta + } deriving (Show, Eq) + +instance ToJSON Identifier where + toJSON (Identifier resId resType resMetaData) = + AE.object [ "id" .= resId + , "type" .= resType + , "meta" .= resMetaData + ] + +instance FromJSON Identifier where + parseJSON = AE.withObject "resourceIdentifier" $ \v -> do + id <- v .: "id" + typ <- v .: "type" + meta <- v .:? "meta" + return $ Identifier id typ meta + + +{- | +Typeclass indicating how to access an 'Identifier' for +a given datatype +-} +class HasIdentifier a where + identifier :: a -> Identifier + +makeLenses ''Identifier diff --git a/src/Network/JSONApi/Link.hs b/src/Network/JSONApi/Link.hs new file mode 100644 --- /dev/null +++ b/src/Network/JSONApi/Link.hs @@ -0,0 +1,48 @@ +{- | +Module representing a JSON-API link object. + +Specification: +-} +module Network.JSONApi.Link +( Links +, Rel +, Href +, mkLinks +) where + +import Data.Aeson (ToJSON, FromJSON) +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Text (Text) + +import qualified GHC.Generics as G + +{- | +Type representing a JSON-API link object. + +Links are an abstraction around an underlying Map consisting of +relevance identifiers as keys and URIs as values. + +Example JSON: +@ + "links": { + "self": "http://example.com/posts/1" + } +@ + +Specification: +-} +newtype Links = Links (Map Rel Href) + deriving (Show, Eq, Ord, ToJSON, FromJSON, G.Generic) + +type Rel = Text +type Href = Text + +{- | +Constructor function for building Links +-} +mkLinks :: [(Rel, Text)] -> Links +mkLinks = Links . Map.fromList . map buildLink + +buildLink :: (Rel, Text) -> (Rel, Href) +buildLink (key, url) = (key, url) diff --git a/src/Network/JSONApi/Meta.hs b/src/Network/JSONApi/Meta.hs new file mode 100644 --- /dev/null +++ b/src/Network/JSONApi/Meta.hs @@ -0,0 +1,90 @@ +{- | +Module representing a JSON-API meta object. + +Specification: +-} +module Network.JSONApi.Meta +( Meta +, MetaObject (..) +, Pagination (..) +, mkMeta +)where + +import Data.Aeson (ToJSON, FromJSON, Object, toJSON) +import Data.Aeson.TH +import Data.HashMap.Strict as HM +import Data.Text (Text) + +import qualified GHC.Generics as G + +{- | +Type representing a JSON-API meta object. + +Meta is an abstraction around an underlying Map consisting of +resource-specific metadata. + +Example JSON: +@ + "meta": { + "copyright": "Copyright 2015 Example Corp.", + "authors": [ + "Andre Dawson", + "Kirby Puckett", + "Don Mattingly", + "Ozzie Guillen" + ] + } +@ + +Specification: +-} +newtype Meta = Meta Object + deriving (Show, Eq, G.Generic) + +instance ToJSON Meta +instance FromJSON Meta + +{- | +Convienience class for constructing a Meta type + +Example usage: +@ + data Pagination = Pagination + { currentPage :: Int + , totalPages :: Int + } deriving (Show, Generic) + + instance ToJSON Pagination + instance MetaObject Pagination where + typeName _ = "pagination" +@ +-} +class (ToJSON a) => MetaObject a where + typeName :: a -> Text + +{- | +Convienience constructor function for the Meta type + +Useful on its own or in combination with Meta's monoid instance + +Example usage: +See MetaSpec.hs for an example +-} +mkMeta :: (MetaObject a) => a -> Meta +mkMeta obj = Meta $ HM.singleton (typeName obj) (toJSON obj) + +{- | +Pagination is arguably a meta object not covered by the Spec. The spec instead opts for +links which are supported by this library. However if you would like to throw a generic +Pagination meta object into your response payload this type may be used. +-} +data Pagination = Pagination { + pageSize :: Maybe Int + , currentPage :: Maybe Int + , totalDocuments :: Maybe Int +} deriving (Eq, Show) + +$(deriveJSON defaultOptions ''Pagination) + +instance MetaObject Pagination where + typeName _ = "pagination" diff --git a/src/Network/JSONApi/Resource.hs b/src/Network/JSONApi/Resource.hs new file mode 100644 --- /dev/null +++ b/src/Network/JSONApi/Resource.hs @@ -0,0 +1,166 @@ +{- | +Module representing a JSON-API resource object. + +Specification: +-} +module Network.JSONApi.Resource +( Resource (..) +, Relationships +, ResourcefulEntity (..) +, Relationship +, indexLinks +, mkRelationship +, mkRelationships +, showLink +) where + +import Control.Lens.TH + +import Data.Aeson (ToJSON, FromJSON, (.=), (.:), (.:?)) +import qualified Data.Aeson as AE +import Data.Aeson.Types (fieldLabelModifier) +import Data.Map (Map) +import Data.Maybe (fromMaybe) +import qualified Data.Map as Map +import Data.Text (Text, pack) + +import GHC.Generics hiding (Meta) + +import Network.JSONApi.Identifier (HasIdentifier (..), Identifier (..)) +import Network.JSONApi.Link (Links, mkLinks) +import Network.JSONApi.Meta (Meta) +import Network.URI.Encode (encodeText) + +import Prelude hiding (id) + +{- | +Type representing a JSON-API resource object. + +A Resource supplies standardized data and metadata about a resource. + +Specification: +-} +data Resource a = Resource + { getIdentifier :: Identifier + , getResource :: a + , getLinks :: Maybe Links + , getRelationships :: Maybe Relationships + } deriving (Show, Eq, Generic) + +instance (ToJSON a) => ToJSON (Resource a) where + toJSON (Resource (Identifier resId resType metaObj) resObj linksObj rels) = + AE.object [ "id" .= resId + , "type" .= resType + , "attributes" .= resObj + , "links" .= linksObj + , "meta" .= metaObj + , "relationships" .= rels + ] + +instance (FromJSON a) => FromJSON (Resource a) where + parseJSON = AE.withObject "resourceObject" $ \v -> do + id <- v .: "id" + typ <- v .: "type" + attrs <- v .: "attributes" + links <- v .:? "links" + meta <- v .:? "meta" + rels <- v .:? "relationships" + return $ Resource (Identifier id typ meta) attrs links rels + +instance HasIdentifier (Resource a) where + identifier = getIdentifier + +{- | +A typeclass for decorating an entity with JSON API properties +-} +class (ToJSON a, FromJSON a) => ResourcefulEntity a where + resourceIdentifier :: a -> Text + resourceType :: a -> Text + resourceLinks :: a -> Maybe Links + resourceMetaData :: a -> Maybe Meta + resourceRelationships :: a -> Maybe Relationships + + fromResource :: Resource a -> a + fromResource = getResource + + toResource :: a -> Resource a + toResource a = + Resource + (Identifier (resourceIdentifier a) (resourceType a) (resourceMetaData a)) + a + (resourceLinks a) + (resourceRelationships a) + +{- | +A type representing the Relationship between 2 entities + +A Relationship provides basic information for fetching further information +about a related resource. + +Specification: +-} +data Relationship = Relationship + { _data :: Maybe Identifier + , _links :: Maybe Links + } deriving (Show, Eq, Generic) + +instance ToJSON Relationship where + toJSON = AE.genericToJSON + AE.defaultOptions { fieldLabelModifier = drop 1 } + +instance FromJSON Relationship where + parseJSON = AE.genericParseJSON + AE.defaultOptions { fieldLabelModifier = drop 1 } + +newtype Relationships = Relationships (Map Text Relationship) + deriving (Show, Eq, Generic) + +instance ToJSON Relationships +instance FromJSON Relationships + +mkRelationships :: Relationship -> Relationships +mkRelationships rel = + Relationships $ Map.singleton (relationshipType rel) rel + +relationshipType :: Relationship -> Text +relationshipType relationship = case _data relationship of + Nothing -> "unidentified" + (Just (Identifier _ typ _)) -> typ + +{- | +Constructor function for creating a Relationship record + +A relationship must contain either an Identifier or a Links record +-} +mkRelationship :: Maybe Identifier -> Maybe Links -> Maybe Relationship +mkRelationship Nothing Nothing = Nothing +mkRelationship resId links = Just $ Relationship resId links + +makeLenses ''Resource + +{- | +Helper function to build relative links for a single resource of type ResourceEntity +-} +showLink :: ResourcefulEntity e => e -> Links +showLink resource = mkLinks [ ("self", selfLink) ] + where + selfLink = "/" <> resourceType resource <> "/" <> resourceIdentifier resource + +{- | +Helper function to beuild relative links for a collection of resources of type ResourceEntity. + +This helper function assumes that the first page is always page 0. +-} +indexLinks :: ResourcefulEntity e => e -> Maybe Int -> Maybe Int -> Maybe Int -> Links +indexLinks resource mPageSize mPageNo documentCount = mkLinks [ + ("self", genLink pageNo) + ,("first", genLink (0 :: Int)) + ,("prev", genLink (if pageNo - 1 < 0 then 0 else pageNo - 1)) + ,("next", genLink (pageNo + 1)) + ,("last", genLink ((fromMaybe 0 documentCount `quot` pageSize) - 1 ))] + where + pageSize = fromMaybe 10 mPageSize + pageNo = fromMaybe 0 mPageNo + genLink no = "/" <> resourceType resource <> "?" <> + encodeText "page[number]" <> "=" <> (pack . show) no <> + "&" <> encodeText "page[size]" <> "=" <> (pack . show) pageSize diff --git a/test/Network/JSONApi/DocumentSpec.hs b/test/Network/JSONApi/DocumentSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/JSONApi/DocumentSpec.hs @@ -0,0 +1,78 @@ +module Network.JSONApi.DocumentSpec where + +import Control.Lens ((^?)) + +import Data.Aeson (ToJSON) +import qualified Data.Aeson as AE +import qualified Data.Aeson.Lens as Lens +import Data.ByteString.Lazy.Char8 (ByteString) +import Data.Either (isRight) +import Data.Maybe + +import Network.JSONApi + +import TestHelpers +import Test.Hspec + +main :: IO () +main = hspec spec + +spec :: Spec +spec = + describe "JSON serialization" $ do + it "JSON encodes/decodes a singleton resource" $ do + -- TODO: test the main resource actually is a singleton + let jsonApiObj = mkDocument [testObject] Nothing Nothing + encodedJson = encodeDocumentObject jsonApiObj + decodedJson = decodeDocumentObject encodedJson + + isRight decodedJson `shouldBe` True + + it "JSON encodes/decodes a list of resources" $ do + -- TODO: test the main resource actually is a list + let jsonApiObj = mkDocument [testObject, testObject2] Nothing Nothing + encodedJson = encodeDocumentObject jsonApiObj + decodedJson = decodeDocumentObject encodedJson + + isRight decodedJson `shouldBe` True + + it "contains the allowable top-level keys" $ do + let jsonApiObj = mkDocument [testObject] Nothing Nothing + encodedJson = encodeDocumentObject jsonApiObj + dataObject = encodedJson ^? Lens.key "data" + linksObject = encodedJson ^? Lens.key "links" + metaObject = encodedJson ^? Lens.key "meta" + includedObject = encodedJson ^? Lens.key "included" + + isJust dataObject `shouldBe` True + isJust linksObject `shouldBe` True + isJust metaObject `shouldBe` True + isJust includedObject `shouldBe` True + + it "allows an optional top-level links object" $ do + let jsonApiObj = mkDocument [testObject] (Just linksObj) Nothing + encodedJson = encodeDocumentObject jsonApiObj + decodedJson = decodeDocumentObject encodedJson + + isRight decodedJson `shouldBe` True + + it "allows an optional top-level meta object" $ do + let jsonApiObj = mkDocument [testObject] Nothing (Just testMetaObj) + encodedJson = encodeDocumentObject jsonApiObj + decodedJson = decodeDocumentObject encodedJson + + isRight decodedJson `shouldBe` True + + it "allows a heterogeneous list of related resources" $ do + let includedResources = mkIncludedResource testObject + jsonApiObj = mkCompoundDocument [testObject] Nothing Nothing includedResources + encodedJson = encodeDocumentObject jsonApiObj + decodedJson = decodeDocumentObject encodedJson + + isRight decodedJson `shouldBe` True + +decodeDocumentObject :: ByteString -> Either String (Document TestResource) +decodeDocumentObject = AE.eitherDecode + +encodeDocumentObject :: (ToJSON a) => Document a -> ByteString +encodeDocumentObject = prettyEncode diff --git a/test/Network/JSONApi/ErrorSpec.hs b/test/Network/JSONApi/ErrorSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/JSONApi/ErrorSpec.hs @@ -0,0 +1,37 @@ +module Network.JSONApi.ErrorSpec where + +import qualified Data.Aeson as AE +import qualified Data.ByteString.Lazy.Char8 as BS +import Data.Default (def) +import Data.Maybe +import Network.JSONApi +import Prelude hiding (id) +import TestHelpers (prettyEncode) +import Test.Hspec + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "Defaults" $ do + it "provides defaults" $ + let expectedDefault = Error + { id = Nothing + , links = Nothing + , status = Nothing + , code = Nothing + , title = Nothing + , detail = Nothing + , meta = Nothing + } + in (def::Error Int) `shouldBe` expectedDefault + + describe "JSON serialization" $ + it "provides ToJSON/FromJSON instances" $ do + let testError = (def::Error Int) + let encJson = BS.unpack . prettyEncode $ testError + let decJson = AE.decode (BS.pack encJson) :: Maybe (Error Int) + isJust decJson `shouldBe` True + {- putStrLn encJson -} + {- putStrLn $ show . fromJust $ decJson -} diff --git a/test/Network/JSONApi/IdentifierSpec.hs b/test/Network/JSONApi/IdentifierSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/JSONApi/IdentifierSpec.hs @@ -0,0 +1,20 @@ +module Network.JSONApi.IdentifierSpec where + +import Control.Lens ((^.)) +import Network.JSONApi.Identifier +import Test.Hspec +import TestHelpers (testMetaObj) + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "Lenses" $ do + it "provides property access via lens" $ do + testIdentifier ^. ident `shouldBe` "3" + testIdentifier ^. datatype `shouldBe` "SomeIdentifier" + testIdentifier ^. metadata `shouldBe` Just testMetaObj + +testIdentifier :: Identifier +testIdentifier = Identifier "3" "SomeIdentifier" (Just testMetaObj) diff --git a/test/Network/JSONApi/MetaSpec.hs b/test/Network/JSONApi/MetaSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/JSONApi/MetaSpec.hs @@ -0,0 +1,47 @@ +module Network.JSONApi.MetaSpec where + +import Data.Aeson (ToJSON) +import qualified Data.Aeson as AE +import qualified Data.ByteString.Lazy.Char8 as BS +import Data.Maybe (isJust) +import Data.Text (Text) +import GHC.Generics (Generic) +import Network.JSONApi +import TestHelpers (prettyEncode) +import Test.Hspec + +main :: IO () +main = hspec spec + +spec :: Spec +spec = + describe "JSON serialization" $ + it "serializes/deserializes heterogeneous maps of ToJSON types" $ do + let boolTestData = mkMeta testObject + let encBoolJson = BS.unpack . prettyEncode $ boolTestData + let decBoolJson = AE.decode (BS.pack encBoolJson) :: Maybe Meta + isJust decBoolJson `shouldBe` True + +testObject :: TestObject +testObject = TestObject 99 102 "Zapp Brannigan" + +data TestObject = TestObject + { myID :: Int + , myAge :: Int + , myName :: Text + } deriving (Show, Generic) + +instance ToJSON TestObject +instance MetaObject TestObject where + typeName _ = "testObject" + +data OtherTestObject = OtherTestObject + { myFavoriteRestaurant :: Text + , myDogsName :: Text + , myDogsAge :: Int + , myDogsFavoriteRestarant :: Text + } deriving (Show, Generic) + +instance ToJSON OtherTestObject +instance MetaObject OtherTestObject where + typeName _ = "otherTestObject" diff --git a/test/Network/JSONApi/ResourceSpec.hs b/test/Network/JSONApi/ResourceSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/JSONApi/ResourceSpec.hs @@ -0,0 +1,65 @@ +module Network.JSONApi.ResourceSpec where + +import qualified Data.Aeson as AE +import qualified Data.ByteString.Lazy.Char8 as BS +import Data.Maybe (isJust, fromJust) +import Data.Text (Text, pack) + +import GHC.Generics (Generic) + +import Network.JSONApi + +import TestHelpers (prettyEncode) +import Test.Hspec + +main :: IO () +main = hspec spec + +spec :: Spec +spec = + describe "JSON serialization" $ + it "can be encoded and decoded from JSON" $ do + let encodedJson = BS.unpack . prettyEncode $ toResource testObject + let decodedJson = AE.decode (BS.pack encodedJson) :: Maybe (Resource TestObject) + isJust decodedJson `shouldBe` True + +data TestObject = TestObject + { myId :: Int + , myName :: Text + , myAge :: Int + , myFavoriteFood :: Text + } deriving (Show, Generic) + +instance AE.ToJSON TestObject +instance AE.FromJSON TestObject + +instance ResourcefulEntity TestObject where + resourceIdentifier = pack . show . myId + resourceType _ = "TestObject" + resourceLinks _ = Just myResourceLinks + resourceMetaData _ = Just myResourceMetaData + resourceRelationships _ = Nothing + +relationship :: Relationship +relationship = + fromJust $ mkRelationship + (Just $ Identifier "42" "FriendOfTestObject" Nothing) + (Just myResourceLinks) + +otherRelationship :: Relationship +otherRelationship = + fromJust $ mkRelationship + (Just $ Identifier "49" "CousinOfTestObject" Nothing) + (Just myResourceLinks) + +myResourceLinks :: Links +myResourceLinks = + mkLinks [ ("self", "/me") + , ("related", "/tacos/4") + ] + +myResourceMetaData :: Meta +myResourceMetaData = mkMeta (Pagination (Just 1) (Just 1) (Just 14)) + +testObject :: TestObject +testObject = TestObject 1 "Fred Armisen" 49 "Pizza" diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} + diff --git a/test/TestHelpers.hs b/test/TestHelpers.hs new file mode 100644 --- /dev/null +++ b/test/TestHelpers.hs @@ -0,0 +1,99 @@ +module TestHelpers where + +import qualified Data.Aeson as AE +import qualified Data.Aeson.Encode.Pretty as AE +import qualified Data.ByteString.Lazy.Char8 as BS +import Data.Text (Text, pack) + +import GHC.Generics (Generic) + +import Network.JSONApi + +prettyEncode :: AE.ToJSON a => a -> BS.ByteString +prettyEncode = AE.encodePretty + +class HasIdentifiers a where + uniqueId :: a -> Int + typeDescriptor :: a -> Text + +data TestResource = TestResource + { myId :: Int + , myName :: Text + , myAge :: Int + , myFavoriteFood :: Text + } deriving (Show, Generic) + +instance AE.ToJSON TestResource +instance AE.FromJSON TestResource +instance ResourcefulEntity TestResource where + resourceIdentifier = pack . show . myId + resourceType _ = "testResource" + resourceLinks _ = Nothing + resourceMetaData _ = Nothing + resourceRelationships _ = Nothing +instance HasIdentifiers TestResource where + uniqueId = myId + typeDescriptor _ = "TestResource" + +data OtherTestResource = OtherTestResource + { myFavoriteNumber :: Int + , myJob :: Text + , myPay :: Int + , myEmployer :: Text + } deriving (Show, Generic) + +instance AE.ToJSON OtherTestResource +instance AE.FromJSON OtherTestResource +instance ResourcefulEntity OtherTestResource where + resourceIdentifier = pack . show . myFavoriteNumber + resourceType _ = "otherTestResource" + resourceLinks _ = Nothing + resourceMetaData _ = Nothing + resourceRelationships _ = Nothing +instance HasIdentifiers OtherTestResource where + uniqueId = myFavoriteNumber + typeDescriptor _ = "OtherTestResource" + +data TestMetaObject = TestMetaObject + { totalPages :: Int + , isSuperFun :: Bool + } deriving (Show, Generic) + +instance AE.ToJSON TestMetaObject +instance AE.FromJSON TestMetaObject +instance MetaObject TestMetaObject where + typeName _ = "importantData" + +toResource' :: (HasIdentifiers a) => a + -> Maybe Links + -> Maybe Meta + -> Resource a +toResource' obj links meta = + Resource + (Identifier (pack . show . uniqueId $ obj) (typeDescriptor obj) meta) + obj + links + Nothing + +linksObj :: Links +linksObj = mkLinks [ ("self", "/things/1") + , ("related", "http://some.domain.com/other/things/1") + ] + +testObject :: TestResource +testObject = TestResource 1 "Fred Armisen" 51 "Pizza" + +testObject2 :: TestResource +testObject2 = TestResource 2 "Carrie Brownstein" 35 "Lunch" + +otherTestObject :: OtherTestResource +otherTestObject = OtherTestResource 999 "Atom Smasher" 100 "Atom Smashers, Inc" + +testMetaObj :: Meta +testMetaObj = mkMeta (TestMetaObject 3 True) + +emptyMeta :: Maybe Meta +emptyMeta = Nothing + +emptyLinks :: Maybe Links +emptyLinks = Nothing