diff --git a/reddit.cabal b/reddit.cabal --- a/reddit.cabal +++ b/reddit.cabal @@ -1,175 +1,199 @@ -name: reddit -version: 0.2.2.2 -synopsis: Library for interfacing with Reddit's API -description: - A library for interfacing with Reddit's API in Haskell. Handles - logins, rate-limiting and converting to and from JSON responses. - - Supports most user-facing Reddit API functions, as well as some - moderator endpoints. +-- This file has been generated from package.yaml by hpack version 0.20.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 6d0965ca6f31dbbd95562eb8028178c6142b8dc8d08ddaf93ef114725e63d3fd - Check out the readme at . - Contributions are welcome. +name: reddit +version: 0.2.3.0 +synopsis: Library for interfacing with Reddit's API +description: A library for interfacing with Reddit''s API in Haskell. Handles logins, rate-limiting and converting to and from JSON responses. Supports most user-facing Reddit API functions, as well as some moderator endpoints. Check out the readme at . + Contributions are welcome. +category: Network +homepage: https://github.com/intolerable/reddit#readme +bug-reports: https://github.com/intolerable/reddit/issues +author: Fraser Murray +maintainer: fraser.m.murray@gmail.com +copyright: Copyright (c) Fraser Murray, 2013-2018 +license: BSD2 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 -license: BSD2 -license-file: LICENSE -author: Fraser Murray -maintainer: fraser.m.murray@gmail.com -homepage: https://github.com/intolerable/reddit -copyright: Copyright (c) Fraser Murray, 2013-2018 -category: Network -build-type: Simple -cabal-version: >= 1.10 extra-source-files: - README.md - test/data/aboutMe_example.json - test/data/getUserInfo_example.json - test/data/getUserComments_example.json + README.md + test/data/aboutMe_example.json + test/data/getUserComments_example.json + test/data/getUserInfo_example.json source-repository head type: git location: https://github.com/intolerable/reddit library + hs-source-dirs: + src + default-extensions: FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase OverloadedStrings + ghc-options: -Wall -fno-warn-dodgy-imports + build-depends: + aeson >=0.9 && <1.3 + , api-builder >=0.10 && <0.16 + , base >=4.6 && <4.12 + , bytestring ==0.10.* + , data-default-class >=0.0.1 && <0.2 + , free >=4 && <6 + , http-client >=0.4.30 && <0.6 + , http-client-tls >=0.2 && <0.4 + , http-types >=0.8 && <0.13 + , network ==2.6.* + , text ==1.* + , time >=1.5 && <1.9 + , transformers >=0.4 && <0.6 + , unordered-containers >=0.2.5 && <0.3 + , vector >=0.10 && <0.13 exposed-modules: - Reddit - Reddit.Actions - Reddit.Actions.Captcha - Reddit.Actions.Comment - Reddit.Actions.Flair - Reddit.Actions.Message - Reddit.Actions.Moderation - Reddit.Actions.Post - Reddit.Actions.Search - Reddit.Actions.Subreddit - Reddit.Actions.Thing - Reddit.Actions.User - Reddit.Actions.Voting - Reddit.Actions.Wiki - Reddit.Login - Reddit.Types - Reddit.Types.Captcha - Reddit.Types.Comment - Reddit.Types.Error - Reddit.Types.Flair - Reddit.Types.Listing - Reddit.Types.Message - Reddit.Types.Moderation - Reddit.Types.Options - Reddit.Types.Post - Reddit.Types.Reddit - Reddit.Types.SearchOptions - Reddit.Types.Subreddit - Reddit.Types.SubredditSettings - Reddit.Types.Thing - Reddit.Types.User - Reddit.Types.Wiki + Reddit + Reddit.Actions + Reddit.Actions.Captcha + Reddit.Actions.Comment + Reddit.Actions.Flair + Reddit.Actions.Message + Reddit.Actions.Moderation + Reddit.Actions.Post + Reddit.Actions.Search + Reddit.Actions.Subreddit + Reddit.Actions.Thing + Reddit.Actions.User + Reddit.Actions.Voting + Reddit.Actions.Wiki + Reddit.Login + Reddit.Types + Reddit.Types.Captcha + Reddit.Types.Comment + Reddit.Types.Error + Reddit.Types.Flair + Reddit.Types.Listing + Reddit.Types.Message + Reddit.Types.Moderation + Reddit.Types.Options + Reddit.Types.Post + Reddit.Types.Reddit + Reddit.Types.SearchOptions + Reddit.Types.Subreddit + Reddit.Types.SubredditSettings + Reddit.Types.Thing + Reddit.Types.User + Reddit.Types.Wiki other-modules: - Paths_reddit - Reddit.Parser - Reddit.Routes - Reddit.Routes.Captcha - Reddit.Routes.Comment - Reddit.Routes.Flair - Reddit.Routes.Message - Reddit.Routes.Moderation - Reddit.Routes.Post - Reddit.Routes.Search - Reddit.Routes.Subreddit - Reddit.Routes.Thing - Reddit.Routes.User - Reddit.Routes.Vote - Reddit.Routes.Wiki - Reddit.Types.Empty - Reddit.Utilities - default-extensions: - FlexibleInstances - GADTs - GeneralizedNewtypeDeriving - LambdaCase - OverloadedStrings + Reddit.Parser + Reddit.Routes + Reddit.Routes.Captcha + Reddit.Routes.Comment + Reddit.Routes.Flair + Reddit.Routes.Message + Reddit.Routes.Moderation + Reddit.Routes.Post + Reddit.Routes.Search + Reddit.Routes.Subreddit + Reddit.Routes.Thing + Reddit.Routes.User + Reddit.Routes.Vote + Reddit.Routes.Wiki + Reddit.Types.Empty + Reddit.Utilities + Paths_reddit default-language: Haskell2010 - hs-source-dirs: src/ - build-depends: - base >= 4.6 && < 4.12, - aeson >= 0.9 && < 1.3, - api-builder >= 0.10 && < 0.15, - bytestring == 0.10.*, - data-default-class >= 0.0.1 && < 0.2, - free >= 4 && < 5, - http-client >= 0.4.30 && < 0.6, - http-client-tls >= 0.2 && < 0.4, - http-types >= 0.8 && < 0.11, - network == 2.6.*, - text == 1.*, - time >= 1.5 && < 1.9, - transformers >= 0.4 && < 0.6, - unordered-containers >= 0.2.5 && < 0.3, - vector >= 0.10 && < 0.13 - ghc-options: -Wall -fno-warn-dodgy-imports test-suite test - hs-source-dirs: test - main-is: Spec.hs - default-extensions: OverloadedStrings - default-language: Haskell2010 type: exitcode-stdio-1.0 - build-depends: - base == 4.*, - Cabal >= 1.16.0, - aeson, - api-builder, - bytestring, - reddit, - hspec, - text, - time, - transformers - ghc-options: -Wall - -test-suite test-io - hs-source-dirs: test-io, test-utils main-is: Spec.hs - default-extensions: - OverloadedStrings - Rank2Types - default-language: Haskell2010 - type: exitcode-stdio-1.0 - build-depends: - base == 4.*, - Cabal >= 1.16.0, - api-builder, - bytestring, - data-default-class, - http-client, - http-client-tls, - reddit, - hspec, - text, - time, - transformers + hs-source-dirs: + test + default-extensions: FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase OverloadedStrings ghc-options: -Wall + build-depends: + Cabal >=1.16.0 + , aeson + , api-builder + , base ==4.* + , bytestring + , hspec + , reddit + , text + , time + , transformers other-modules: - Utils + Reddit.Types.CommentSpec + Reddit.Types.ListingSpec + Reddit.Types.PostSpec + Reddit.Types.SubredditSpec + Reddit.Types.UserSpec + Reddit.Types.WikiSpec + Paths_reddit + default-language: Haskell2010 test-suite test-anon - hs-source-dirs: test-anon, test-utils + type: exitcode-stdio-1.0 main-is: Spec.hs - default-extensions: - OverloadedStrings - Rank2Types + hs-source-dirs: + test-anon + test-utils + default-extensions: FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase OverloadedStrings Rank2Types + ghc-options: -Wall + build-depends: + Cabal >=1.16.0 + , api-builder + , base ==4.* + , data-default-class + , hspec + , reddit + , text + , time + , transformers + other-modules: + Reddit.Actions.CaptchaSpec + Reddit.Actions.CommentSpec + Reddit.Actions.FlairSpec + Reddit.Actions.MessageSpec + Reddit.Actions.PostSpec + Reddit.Actions.SearchSpec + Reddit.Actions.SubredditSpec + Reddit.Actions.UserSpec + Utils + Paths_reddit default-language: Haskell2010 + +test-suite test-io type: exitcode-stdio-1.0 - build-depends: - base == 4.*, - Cabal >= 1.16.0, - api-builder, - data-default-class, - reddit, - hspec, - text, - time, - transformers + main-is: Spec.hs + hs-source-dirs: + test-io + test-utils + default-extensions: FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase OverloadedStrings Rank2Types ghc-options: -Wall + build-depends: + Cabal >=1.16.0 + , api-builder + , base ==4.* + , bytestring + , data-default-class + , hspec + , http-client + , http-client-tls + , reddit + , text + , time + , transformers + , yaml other-modules: - Utils + ConfigLoad + Reddit.Actions.CaptchaSpec + Reddit.Actions.CommentSpec + Reddit.Actions.FlairSpec + Reddit.Actions.MessageSpec + Reddit.Actions.PostSpec + Reddit.Actions.SubredditSpec + Reddit.Actions.UserSpec + Utils + Paths_reddit + default-language: Haskell2010 diff --git a/src/Reddit/Types/Error.hs b/src/Reddit/Types/Error.hs --- a/src/Reddit/Types/Error.hs +++ b/src/Reddit/Types/Error.hs @@ -34,6 +34,7 @@ Just (Array e) -> case V.toList e of String "WRONG_PASSWORD" : _ -> return CredentialsError String "USER_REQUIRED" : _ -> return CredentialsError + String "INCORRECT_USERNAME_PASSWORD" : _ -> return CredentialsError String "RATELIMIT" : String d : _ -> RateLimitError <$> ((o .: "json") >>= (.: "ratelimit")) <*> pure d String "SUBREDDIT_REQUIRED" : _ -> return NoSubredditSpecified diff --git a/test-anon/Reddit/Actions/CaptchaSpec.hs b/test-anon/Reddit/Actions/CaptchaSpec.hs new file mode 100644 --- /dev/null +++ b/test-anon/Reddit/Actions/CaptchaSpec.hs @@ -0,0 +1,26 @@ +module Reddit.Actions.CaptchaSpec where + +import Reddit +import Utils + +import Test.Hspec + +isRight :: Either a b -> Bool +isRight = const False `either` const True + +main :: IO () +main = hspec spec + +spec :: Spec +spec = skip $ describe "Reddit.Actions.Captcha" $ do + + it "should be able to get a new captcha" $ do + res <- runAnon newCaptcha + res `shouldSatisfy` isRight + + it "should be able to check if we need captchas" $ do + res <- runAnon needsCaptcha + res `shouldSatisfy` isRight + +skip :: Monad m => m a -> m () +skip _ = return () diff --git a/test-anon/Reddit/Actions/CommentSpec.hs b/test-anon/Reddit/Actions/CommentSpec.hs new file mode 100644 --- /dev/null +++ b/test-anon/Reddit/Actions/CommentSpec.hs @@ -0,0 +1,51 @@ +module Reddit.Actions.CommentSpec where + +import Reddit +import Utils + +import Test.Hspec + +isRight :: Either a b -> Bool +isRight = const False `either` const True + +isLeft :: Either a b -> Bool +isLeft = const True `either` const False + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Actions.Comment" $ do + + it "should be able to get info for a comment" $ do + res <- runAnon $ getCommentInfo (CommentID "c60o0iw") + res `shouldSatisfy` isRight + + it "should be able to get info for multiple comments" $ do + res <- runAnon $ getCommentsInfo [CommentID "c60o0iw", CommentID "c4zrenn"] + res `shouldSatisfy` isRight + case res of + Right (Listing _ _ cs) -> length cs `shouldBe` 2 + Left _ -> expectationFailure "something failed" + + it "should fail if we try to get an invalid comment" $ do + res <- runAnon $ getCommentInfo (CommentID "garbage") + res `shouldSatisfy` isLeft + + it "shouldn't be able to get a list of comment IDs where some are invalid" $ do + res <- runAnon $ getCommentsInfo [CommentID "c60o0iw", CommentID "garbage"] + res `shouldSatisfy` isLeft + + it "should be able to get mass comment IDs" $ do + let a = replicate 100 $ CommentID "c60o0iw" + res <- runAnon $ getCommentsInfo a + res `shouldSatisfy` isRight + case res of + Left _ -> expectationFailure "something failed" + Right (Listing _ _ ps) -> + length ps `shouldBe` length a + + it "should fail if it tries to get TOO many comment IDs" $ do + let a = replicate 101 $ CommentID "c60o0iw" + res <- runAnon $ getCommentsInfo a + res `shouldSatisfy` isLeft diff --git a/test-anon/Reddit/Actions/FlairSpec.hs b/test-anon/Reddit/Actions/FlairSpec.hs new file mode 100644 --- /dev/null +++ b/test-anon/Reddit/Actions/FlairSpec.hs @@ -0,0 +1,19 @@ +module Reddit.Actions.FlairSpec where + +import Reddit +import Utils + +import Test.Hspec + +isLeft :: Either a b -> Bool +isLeft = const True `either` const False + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Actions.Flair" $ do + + it "shouldn't be able to get the flair list anonymously" $ do + res <- runAnon $ getFlairList $ R "gaming" + res `shouldSatisfy` isLeft diff --git a/test-anon/Reddit/Actions/MessageSpec.hs b/test-anon/Reddit/Actions/MessageSpec.hs new file mode 100644 --- /dev/null +++ b/test-anon/Reddit/Actions/MessageSpec.hs @@ -0,0 +1,19 @@ +module Reddit.Actions.MessageSpec where + +import Reddit +import Utils + +import Test.Hspec + +isLeft :: Either a b -> Bool +isLeft = const True `either` const False + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Actions.Message" $ do + + it "shouldn't have an inbox for an anonymous user" $ do + res <- runAnon getInbox + res `shouldSatisfy` isLeft diff --git a/test-anon/Reddit/Actions/PostSpec.hs b/test-anon/Reddit/Actions/PostSpec.hs new file mode 100644 --- /dev/null +++ b/test-anon/Reddit/Actions/PostSpec.hs @@ -0,0 +1,62 @@ +module Reddit.Actions.PostSpec where + +import Reddit +import Reddit.Types.Post +import Reddit.Types.Subreddit (SubredditID(..)) +import Utils + +import Test.Hspec + +isRight :: Either a b -> Bool +isRight = const False `either` const True + +isLeft :: Either a b -> Bool +isLeft = const True `either` const False + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Actions.Post" $ do + + it "should be able to get info for a post" $ do + res <- runAnon $ getPostInfo (PostID "z1c9z") + res `shouldSatisfy` isRight + case res of + Left _ -> expectationFailure "something failed" + Right post -> do + author post `shouldBe` Username "PresidentObama" + title post `shouldBe` "I am Barack Obama, President of the United States -- AMA" + subredditID post `shouldBe` SubredditID "2qzb6" + subreddit post `shouldBe` R "IAMA" + nsfw post `shouldBe` False + + it "should be able to get info for multiple posts" $ do + res <- runAnon $ getPostsInfo [PostID "z1c9z", PostID "t0ynr"] + res `shouldSatisfy` isRight + + it "should cope with getting info for no posts" $ do + res <- runAnon $ getPostsInfo [] + res `shouldSatisfy` isRight + case res of + Left _ -> expectationFailure "something failed" + Right (Listing _ _ ps) -> + ps `shouldBe` [] + + it "shouldn't be able to get a list of posts from invalid post IDs" $ do + res <- runAnon $ getPostsInfo [PostID "z1c9z", PostID "nonsense"] + res `shouldSatisfy` isLeft + + it "should be able to get mass PostIDs" $ do + let a = replicate 100 $ PostID "z1c9z" + res <- runAnon $ getPostsInfo a + res `shouldSatisfy` isRight + case res of + Left _ -> expectationFailure "something failed" + Right (Listing _ _ ps) -> + length ps `shouldBe` length a + + it "should fail if it tries to get TOO many PostIDs" $ do + let a = replicate 101 $ PostID "z1c9z" + res <- runAnon $ getPostsInfo a + res `shouldSatisfy` isLeft diff --git a/test-anon/Reddit/Actions/SearchSpec.hs b/test-anon/Reddit/Actions/SearchSpec.hs new file mode 100644 --- /dev/null +++ b/test-anon/Reddit/Actions/SearchSpec.hs @@ -0,0 +1,29 @@ +module Reddit.Actions.SearchSpec where + +import Reddit +import Reddit.Types.SearchOptions +import Utils + +import Test.Hspec + +isRight :: Either a b -> Bool +isRight = const False `either` const True + +isLeft :: Either a b -> Bool +isLeft = const True `either` const False + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Actions.Search" $ do + + it "should be able to search for something" $ do + res <- runAnon $ search Nothing (Options Nothing Nothing) Hot "reddit" + res `shouldSatisfy` isRight + + it "should be able to limit the search results" $ do + res <- runAnon $ search (Just $ R "programming") (Options Nothing (Just 5)) Hot "haskell" + case res of + Left _ -> expectationFailure "search failed" + Right (Listing _ _ rs) -> length rs `shouldBe` 5 diff --git a/test-anon/Reddit/Actions/SubredditSpec.hs b/test-anon/Reddit/Actions/SubredditSpec.hs new file mode 100644 --- /dev/null +++ b/test-anon/Reddit/Actions/SubredditSpec.hs @@ -0,0 +1,36 @@ +module Reddit.Actions.SubredditSpec where + +import Reddit +import Reddit.Types.Subreddit +import Utils + +import Test.Hspec + +isRight :: Either a b -> Bool +isRight = const False `either` const True + +isLeft :: Either a b -> Bool +isLeft = const True `either` const False + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Actions.Subreddit" $ do + + it "should be able to get the info for a subreddit anonymously" $ do + let sub = R "gaming" + res <- runAnon $ getSubredditInfo sub + res `shouldSatisfy` isRight + case res of + Left _ -> expectationFailure "json parse failed" + Right info -> do + name info `shouldBe` sub + subredditID info `shouldBe` SubredditID "2qh03" + subscribers info `shouldSatisfy` (> 0) + userIsBanned info `shouldBe` Nothing + + it "shouldn't be able to anonymously get the settings for the moderated subreddit" $ do + res <- runAnon $ getSubredditSettings $ R "gaming" + res `shouldSatisfy` isLeft + diff --git a/test-anon/Reddit/Actions/UserSpec.hs b/test-anon/Reddit/Actions/UserSpec.hs new file mode 100644 --- /dev/null +++ b/test-anon/Reddit/Actions/UserSpec.hs @@ -0,0 +1,62 @@ +module Reddit.Actions.UserSpec where + +import Reddit +import Reddit.Types.Comment +import Utils + +import Control.Monad +import Data.Time.Clock +import Test.Hspec + +isRight :: Either a b -> Bool +isRight = const False `either` const True + +isLeft :: Either a b -> Bool +isLeft = const True `either` const False + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Actions.User" $ do + time <- runIO getCurrentTime + + it "should be able to get the user's most recent comments" $ do + res <- runAnon $ getUserComments $ Username "Intolerable" + res `shouldSatisfy` isRight + case res of + Left _ -> expectationFailure "something failed" + Right (Listing _ _ cs) -> + forM_ cs $ \c -> do + author c `shouldBe` Username "Intolerable" + replies c `shouldSatisfy` (\(Listing _ _ x) -> null x) + created c `shouldSatisfy` (< time) + + it "should be able to get multiple pages of user comments" $ do + res <- runAnon $ getUserComments' (Options Nothing (Just 1)) $ Username "Intolerable" + res `shouldSatisfy` isRight + case res of + Right (Listing _ (Just a) (c:[])) -> do + next <- runAnon $ getUserComments' (Options (Just $ After a) (Just 1)) $ Username "Intolerable" + next `shouldSatisfy` isRight + case next of + Right (Listing _ _ (d:[])) -> + c `shouldSatisfy` (/= d) + _ -> expectationFailure "something failed" + _ -> expectationFailure "something failed" + + it "shouldn't be able to get about me info for an anonymous user" $ do + res <- runAnon aboutMe + res `shouldSatisfy` isLeft + + it "should be able to anonymously get the user info for a user" $ do + res <- runAnon $ getUserInfo $ Username "Intolerable" + res `shouldSatisfy` isRight + + it "should be able to check if a username is available" $ do + res <- runAnon $ isUsernameAvailable $ Username "Intolerable" + res `shouldSatisfy` isRight + case res of + Left _ -> return () + Right avail -> avail `shouldBe` False + diff --git a/test-io/ConfigLoad.hs b/test-io/ConfigLoad.hs new file mode 100644 --- /dev/null +++ b/test-io/ConfigLoad.hs @@ -0,0 +1,54 @@ +module ConfigLoad where + +import Data.Text (Text) +import Data.Yaml +import Network.HTTP.Client +import Network.HTTP.Client.TLS +import Reddit +import Reddit.Login +import System.Exit +import Utils + +newtype RunReddit = RunReddit + { run :: forall a. Reddit a -> IO (Either (APIError RedditError) a) } + +newtype TestConfig = TestConfig (Maybe Config) + deriving (Show, Eq, Ord) + +instance FromJSON TestConfig where + parseJSON = withObject "TestConfig" $ \ o -> + TestConfig <$> o .:? "config" + +data Config = + Config { tcUsername :: Text + , tcPassword :: Text + , tcSubreddit :: Text + } + deriving (Show, Eq, Ord) + +instance FromJSON Config where + parseJSON = withObject "Config" $ \ o -> + Config <$> o .: "username" + <*> o .: "password" + <*> o .: "subreddit" + +loadConfig :: IO (RunReddit, Username, SubredditName) +loadConfig = do + decodeFileEither "test_config.yaml" >>= \case + Left err -> do + print err + exitFailure + Right (TestConfig Nothing) -> + putStrLn "Warning: missing config section, skipping authorized tests" + exitSuccess + Right (TestConfig (Just (Config user pass sub))) -> do + manager <- newManager tlsManagerSettings + res <- runAnon $ login user pass + case res of + Left err -> do + print err + exitFailure + Right details -> + return ( RunReddit $ runRedditWith $ RedditOptions True (Just manager) (StoredDetails details) (Just "reddit-haskell test suite") + , Username user + , R sub) diff --git a/test-io/Reddit/Actions/CaptchaSpec.hs b/test-io/Reddit/Actions/CaptchaSpec.hs new file mode 100644 --- /dev/null +++ b/test-io/Reddit/Actions/CaptchaSpec.hs @@ -0,0 +1,20 @@ +module Reddit.Actions.CaptchaSpec where + +import Reddit.Actions.Captcha + +import ConfigLoad +import Test.Hspec + +isRight :: Either a b -> Bool +isRight = const False `either` const True + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Actions.Captcha" $ do + (reddit, _, _) <- runIO loadConfig + + it "should be able to check if we need captchas" $ do + res <- run reddit needsCaptcha + res `shouldSatisfy` isRight diff --git a/test-io/Reddit/Actions/CommentSpec.hs b/test-io/Reddit/Actions/CommentSpec.hs new file mode 100644 --- /dev/null +++ b/test-io/Reddit/Actions/CommentSpec.hs @@ -0,0 +1,54 @@ +module Reddit.Actions.CommentSpec where + +import Reddit.Actions.Comment +import Reddit.Types.Comment +import Reddit.Types.Listing + +import ConfigLoad +import Test.Hspec + +isRight :: Either a b -> Bool +isRight = const False `either` const True + +isLeft :: Either a b -> Bool +isLeft = const True `either` const False + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Actions.Comment" $ do + (reddit, _, _) <- runIO loadConfig + + it "should be able to get info for a comment" $ do + res <- run reddit $ getCommentInfo (CommentID "c60o0iw") + res `shouldSatisfy` isRight + + it "should be able to get info for multiple comments" $ do + res <- run reddit $ getCommentsInfo [CommentID "c60o0iw", CommentID "c4zrenn"] + res `shouldSatisfy` isRight + case res of + Right (Listing _ _ cs) -> length cs `shouldBe` 2 + Left _ -> expectationFailure "something failed" + + it "should fail if we try to get an invalid comment" $ do + res <- run reddit $ getCommentInfo (CommentID "garbage") + res `shouldSatisfy` isLeft + + it "shouldn't be able to get a list of comment IDs where some are invalid" $ do + res <- run reddit $ getCommentsInfo [CommentID "c60o0iw", CommentID "garbage"] + res `shouldSatisfy` isLeft + + it "should be able to get mass comment IDs" $ do + let a = replicate 100 $ CommentID "c60o0iw" + res <- run reddit $ getCommentsInfo a + res `shouldSatisfy` isRight + case res of + Left _ -> expectationFailure "something failed" + Right (Listing _ _ ps) -> + length ps `shouldBe` length a + + it "should fail if it tries to get TOO many comment IDs" $ do + let a = replicate 101 $ CommentID "c60o0iw" + res <- run reddit $ getCommentsInfo a + res `shouldSatisfy` isLeft diff --git a/test-io/Reddit/Actions/FlairSpec.hs b/test-io/Reddit/Actions/FlairSpec.hs new file mode 100644 --- /dev/null +++ b/test-io/Reddit/Actions/FlairSpec.hs @@ -0,0 +1,21 @@ +module Reddit.Actions.FlairSpec where + +import Reddit.Actions.Flair + +import ConfigLoad +import Test.Hspec + +isRight :: Either a b -> Bool +isRight = const False `either` const True + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Actions.Flair" $ do + (reddit, _, subreddit) <- runIO loadConfig + + it "should be able to get the flair list" $ do + res <- run reddit $ getFlairList subreddit + res `shouldSatisfy` isRight + diff --git a/test-io/Reddit/Actions/MessageSpec.hs b/test-io/Reddit/Actions/MessageSpec.hs new file mode 100644 --- /dev/null +++ b/test-io/Reddit/Actions/MessageSpec.hs @@ -0,0 +1,24 @@ +module Reddit.Actions.MessageSpec where + +import Reddit.Actions.Message + +import ConfigLoad +import Test.Hspec + +isRight :: Either a b -> Bool +isRight = const False `either` const True + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Actions.Message" $ do + (reddit, _, _) <- runIO loadConfig + + it "should be able to check inbox" $ do + res <- run reddit $ getInbox + res `shouldSatisfy` isRight + + it "should be able to check unread messages" $ do + res <- run reddit $ getUnread + res `shouldSatisfy` isRight diff --git a/test-io/Reddit/Actions/PostSpec.hs b/test-io/Reddit/Actions/PostSpec.hs new file mode 100644 --- /dev/null +++ b/test-io/Reddit/Actions/PostSpec.hs @@ -0,0 +1,65 @@ +module Reddit.Actions.PostSpec where + +import Reddit.Actions.Post +import Reddit.Types.Listing +import Reddit.Types.Post +import Reddit.Types.Subreddit (SubredditID(..), SubredditName(..)) +import Reddit.Types.User + +import ConfigLoad +import Test.Hspec + +isRight :: Either a b -> Bool +isRight = const False `either` const True + +isLeft :: Either a b -> Bool +isLeft = const True `either` const False + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Actions.Post" $ do + (reddit, _, _) <- runIO loadConfig + + it "should be able to get info for a post" $ do + res <- run reddit $ getPostInfo (PostID "z1c9z") + res `shouldSatisfy` isRight + case res of + Left _ -> expectationFailure "something failed" + Right post -> do + author post `shouldBe` Username "PresidentObama" + title post `shouldBe` "I am Barack Obama, President of the United States -- AMA" + subredditID post `shouldBe` SubredditID "2qzb6" + subreddit post `shouldBe` R "IAMA" + nsfw post `shouldBe` False + + it "should be able to get info for multiple posts" $ do + res <- run reddit $ getPostsInfo [PostID "z1c9z", PostID "t0ynr"] + res `shouldSatisfy` isRight + + it "should cope with getting info for no posts" $ do + res <- run reddit $ getPostsInfo [] + res `shouldSatisfy` isRight + case res of + Left _ -> expectationFailure "something failed" + Right (Listing _ _ ps) -> + ps `shouldBe` [] + + it "shouldn't be able to get a list of posts from invalid post IDs" $ do + res <- run reddit $ getPostsInfo [PostID "z1c9z", PostID "nonsense"] + res `shouldSatisfy` isLeft + + it "should be able to get mass PostIDs" $ do + let a = replicate 100 $ PostID "z1c9z" + res <- run reddit $ getPostsInfo a + res `shouldSatisfy` isRight + case res of + Left _ -> expectationFailure "something failed" + Right (Listing _ _ ps) -> + length ps `shouldBe` length a + + it "should fail if it tries to get TOO many PostIDs" $ do + let a = replicate 101 $ PostID "z1c9z" + res <- run reddit $ getPostsInfo a + res `shouldSatisfy` isLeft diff --git a/test-io/Reddit/Actions/SubredditSpec.hs b/test-io/Reddit/Actions/SubredditSpec.hs new file mode 100644 --- /dev/null +++ b/test-io/Reddit/Actions/SubredditSpec.hs @@ -0,0 +1,32 @@ +module Reddit.Actions.SubredditSpec where + +import Reddit.Actions.Subreddit +import Reddit.Types.Subreddit + +import ConfigLoad +import Test.Hspec + +isRight :: Either a b -> Bool +isRight = const False `either` const True + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Actions.Subreddit" $ do + (reddit, _, subreddit) <- runIO loadConfig + + it "should be able to get the info for a subreddit" $ do + let sub = R "gaming" + res <- run reddit $ getSubredditInfo sub + res `shouldSatisfy` isRight + case res of + Left _ -> expectationFailure "json parse failed" + Right info -> do + name info `shouldBe` sub + subredditID info `shouldBe` SubredditID "2qh03" + subscribers info `shouldSatisfy` (> 0) + + it "should be able to get the settings for a moderated subreddit" $ do + res <- run reddit $ getSubredditSettings subreddit + res `shouldSatisfy` isRight diff --git a/test-io/Reddit/Actions/UserSpec.hs b/test-io/Reddit/Actions/UserSpec.hs new file mode 100644 --- /dev/null +++ b/test-io/Reddit/Actions/UserSpec.hs @@ -0,0 +1,70 @@ +module Reddit.Actions.UserSpec where + +import Reddit.Actions.User +import Reddit.Types.Comment +import Reddit.Types.Listing +import Reddit.Types.Options +import Reddit.Types.User + +import ConfigLoad +import Control.Monad +import Data.Maybe +import Data.Time.Clock +import Test.Hspec + +isRight :: Either a b -> Bool +isRight = const False `either` const True + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Actions.User" $ do + (reddit, username, _) <- runIO loadConfig + time <- runIO getCurrentTime + + it "should be able to get the user's most recent comments" $ do + res <- run reddit $ getUserComments username + res `shouldSatisfy` isRight + case res of + Left _ -> expectationFailure "something failed" + Right (Listing _ _ cs) -> + forM_ cs $ \c -> do + author c `shouldBe` username + replies c `shouldSatisfy` (\(Listing _ _ x) -> null x) + created c `shouldSatisfy` (< time) + + it "should be able to get multiple pages of user comments" $ do + res <- run reddit $ getUserComments' (Options Nothing (Just 1)) username + res `shouldSatisfy` isRight + case res of + Right (Listing _ (Just a) (c:[])) -> do + next <- run reddit $ getUserComments' (Options (Just $ After a) (Just 1)) username + next `shouldSatisfy` isRight + case next of + Right (Listing _ _ (d:[])) -> + c `shouldSatisfy` (/= d) + _ -> expectationFailure "something failed" + _ -> expectationFailure "something failed" + + it "should be able to get the user's about me info" $ do + res <- run reddit aboutMe + res `shouldSatisfy` isRight + case res of + Left _ -> expectationFailure "something failed" + Right user -> do + userName user `shouldBe` username + userCreated user `shouldSatisfy` (< time) + hasMail user `shouldSatisfy` isJust + isFriend user `shouldBe` False + + it "should be able to get the user info for a user" $ do + res <- run reddit $ getUserInfo username + res `shouldSatisfy` isRight + + it "should be able to check if a username is available" $ do + res <- run reddit $ isUsernameAvailable username + res `shouldSatisfy` isRight + case res of + Left _ -> return () + Right avail -> avail `shouldBe` False diff --git a/test/Reddit/Types/CommentSpec.hs b/test/Reddit/Types/CommentSpec.hs new file mode 100644 --- /dev/null +++ b/test/Reddit/Types/CommentSpec.hs @@ -0,0 +1,62 @@ +module Reddit.Types.CommentSpec where + +import Reddit.Types.Comment +import Reddit.Types.Listing +import Reddit.Types.Subreddit hiding (subredditID) +import Reddit.Types.User + +import Control.Monad +import Data.ByteString.Lazy (ByteString) +import Data.Maybe +import Data.Time.Clock +import Data.Aeson (eitherDecode) +import Test.Hspec +import qualified Data.ByteString.Lazy.Char8 as ByteString +import qualified Data.Text as Text + +isRight :: Either a b -> Bool +isRight = const False `either` const True + +isLeft :: Either a b -> Bool +isLeft = const True `either` const False + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Types.Comment" $ do + let decode' = eitherDecode :: ByteString -> Either String CommentID + getUserCommentsExample <- runIO $ ByteString.readFile "test/data/getUserComments_example.json" + time <- runIO getCurrentTime + + it "can read the example" $ + getUserCommentsExample `shouldSatisfy` not . ByteString.null + + it "can parse a list of comments from json" $ do + let decoded = eitherDecode getUserCommentsExample :: Either String CommentListing + decoded `shouldSatisfy` isRight + + case decoded of + Left _ -> expectationFailure "json parse failed" + Right (Listing b a cs) -> do + cs `shouldSatisfy` not . null + b `shouldBe` Nothing + a `shouldSatisfy` isJust + + length cs `shouldBe` 5 + forM_ cs $ \c -> do + author c `shouldBe` Username "Intolerable" + score c `shouldSatisfy` isJust + subreddit c `shouldBe` R "DotA2" + subredditID c `shouldBe` SubredditID "2s580" + authorFlairText c `shouldBe` Just "sneep sneep" + authorFlairCSSClass c `shouldBe` Just "rapier" + body c `shouldSatisfy` not . Text.null + bodyHTML c `shouldSatisfy` not . Text.null + replies c `shouldBe` Listing Nothing Nothing [] + created c `shouldSatisfy` (< time) + + it "can parse a CommentID" $ do + decode' "\"t1_cl1royq\"" `shouldBe` Right (CommentID "cl1royq") + decode' "\"cl1royq\"" `shouldBe` Right (CommentID "cl1royq") + decode' "\"t5_2s580\"" `shouldSatisfy` isLeft diff --git a/test/Reddit/Types/ListingSpec.hs b/test/Reddit/Types/ListingSpec.hs new file mode 100644 --- /dev/null +++ b/test/Reddit/Types/ListingSpec.hs @@ -0,0 +1,66 @@ +module Reddit.Types.ListingSpec where + +import Reddit.Types.Comment +import Reddit.Types.Listing + +import Control.Monad +import Data.Aeson (eitherDecode) +import Network.API.Builder +import Test.Hspec +import Test.Hspec.QuickCheck +import qualified Data.ByteString.Lazy.Char8 as ByteString + +isRight :: Either a b -> Bool +isRight = const False `either` const True + +isLeft :: Either a b -> Bool +isLeft = const True `either` const False + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Types.Listing" $ do + describe "Listing" $ do + getUserCommentsExample <- runIO $ ByteString.readFile "test/data/getUserComments_example.json" + + it "can read the example" $ + getUserCommentsExample `shouldSatisfy` not . ByteString.null + + it "can parse a listing from json" $ do + let decoded = eitherDecode getUserCommentsExample :: Either String CommentListing + decoded `shouldSatisfy` isRight + + case decoded of + Left _ -> expectationFailure "json parse failed" + Right (Listing b a _) -> do + a `shouldBe` Just (CommentID "cl1royq") + b `shouldBe` Nothing + + describe "has a valid Functor instance" $ do + prop "length l = length (fmap f l)" $ \xs -> + let l = Listing Nothing Nothing (xs :: [()]) in + length (contents (l :: Listing () ())) == length (contents (void l)) + + prop "fmap id x == x" $ \xs -> + let l = Listing Nothing Nothing (xs :: [String]) in + fmap id l == (l :: Listing () String) + + it "can parse listings from empty strings" $ do + let decoded :: Either String CommentListing + decoded = eitherDecode "\"\"" + decoded `shouldBe` Right (Listing Nothing Nothing []) + + it "can parse listings from null" $ do + let decoded :: Either String CommentListing + decoded = eitherDecode "null" + decoded `shouldBe` Right (Listing Nothing Nothing []) + + describe "ListingType" $ + + it "should have a valid ToQuery instance" $ do + toQuery "type" Hot `shouldBe` [("type", "hot")] + toQuery "type" New `shouldBe` [("type", "new")] + toQuery "type" Rising `shouldBe` [("type", "rising")] + toQuery "type" Controversial `shouldBe` [("type", "controversial")] + toQuery "type" Top `shouldBe` [("type", "top")] diff --git a/test/Reddit/Types/PostSpec.hs b/test/Reddit/Types/PostSpec.hs new file mode 100644 --- /dev/null +++ b/test/Reddit/Types/PostSpec.hs @@ -0,0 +1,22 @@ +module Reddit.Types.PostSpec where + +import Reddit.Types.Post + +import Data.Aeson (eitherDecode) +import Data.ByteString.Lazy (ByteString) +import Test.Hspec + +isLeft :: Either a b -> Bool +isLeft = const True `either` const False + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Types.Post" $ do + let decode' = eitherDecode :: ByteString -> Either String PostID + + it "can parse a PostID" $ do + decode' "\"t3_1n1qrg\"" `shouldBe` Right (PostID "1n1qrg") + decode' "\"1n1qrg\"" `shouldBe` Right (PostID "1n1qrg") + decode' "\"t5_2s580\"" `shouldSatisfy` isLeft diff --git a/test/Reddit/Types/SubredditSpec.hs b/test/Reddit/Types/SubredditSpec.hs new file mode 100644 --- /dev/null +++ b/test/Reddit/Types/SubredditSpec.hs @@ -0,0 +1,27 @@ +module Reddit.Types.SubredditSpec where + +import Reddit.Types.Subreddit + +import Data.Aeson (eitherDecode) +import Data.ByteString.Lazy (ByteString) +import Test.Hspec + +isLeft :: Either a b -> Bool +isLeft = const True `either` const False + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Types.Subreddit" $ do + let decode' = eitherDecode :: ByteString -> Either String SubredditID + + it "can compare subreddits" $ do + R "intolerable_test" `shouldBe` R "intolerable_test" + R "intolerable_test" `shouldBe` R "Intolerable_test" + R "intolerable_test" `shouldBe` R "INTOLERABLE_TEST" + + it "can parse a SubredditID" $ do + decode' "\"t5_2s580\"" `shouldBe` Right (SubredditID "2s580") + decode' "\"2s580\"" `shouldBe` Right (SubredditID "2s580") + decode' "\"t1_cl1royq\"" `shouldSatisfy` isLeft diff --git a/test/Reddit/Types/UserSpec.hs b/test/Reddit/Types/UserSpec.hs new file mode 100644 --- /dev/null +++ b/test/Reddit/Types/UserSpec.hs @@ -0,0 +1,66 @@ +module Reddit.Types.UserSpec where + +import Reddit.Types.User + +import Data.Aeson (eitherDecode) +import Test.Hspec +import qualified Data.ByteString.Lazy.Char8 as ByteString + +isRight :: Either a b -> Bool +isRight = const False `either` const True + +main :: IO () +main = hspec spec + +spec :: Spec +spec = + describe "Reddit.Types.User" $ do + aboutMeExample <- runIO $ ByteString.readFile "test/data/aboutMe_example.json" + getUserInfoExample <- runIO $ ByteString.readFile "test/data/getUserInfo_example.json" + + it "should be able to compare usernames for equality" $ do + Username "Intolerable" `shouldBe` Username "intolerable" + Username "Intolerable" `shouldBe` Username "Intolerable" + Username "INTOLERABLE" `shouldBe` Username "intolerable" + + it "can read the examples" $ do + aboutMeExample `shouldSatisfy` not . ByteString.null + getUserInfoExample `shouldSatisfy` not . ByteString.null + + it "can parse a reddit user from json" $ do + let decoded = eitherDecode aboutMeExample :: Either String User + decoded `shouldSatisfy` isRight + + case decoded of + Left _ -> expectationFailure "json parse failed" + Right user -> do + userID user `shouldBe` "4gf25" + userName user `shouldBe` Username "Intolerable" + linkKarma user `shouldBe` 2399 + commentKarma user `shouldBe` 44631 + hasMail user `shouldBe` Just False + hasModMail user `shouldBe` Just False + isFriend user `shouldBe` False + userIsOver18 user `shouldBe` Just True + isMod user `shouldBe` True + hasGold user `shouldBe` False + hasVerifiedEmail user `shouldBe` Just True + + it "can parse another reddit user from json" $ do + let decoded = eitherDecode getUserInfoExample :: Either String User + decoded `shouldSatisfy` isRight + + case decoded of + Left _ -> expectationFailure "json parse failed" + Right user -> do + userID user `shouldBe` "gdifp" + userName user `shouldBe` Username "intolerable-bot" + linkKarma user `shouldBe` 1 + commentKarma user `shouldBe` 2668 + hasMail user `shouldBe` Nothing + hasModMail user `shouldBe` Nothing + isFriend user `shouldBe` False + userIsOver18 user `shouldBe` Nothing + isMod user `shouldBe` False + hasGold user `shouldBe` False + hasVerifiedEmail user `shouldBe` Just True diff --git a/test/Reddit/Types/WikiSpec.hs b/test/Reddit/Types/WikiSpec.hs new file mode 100644 --- /dev/null +++ b/test/Reddit/Types/WikiSpec.hs @@ -0,0 +1,9 @@ +module Reddit.Types.WikiSpec where + +import Test.Hspec + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "Reddit.Types.Wiki" $ return ()