heddit 0.1 → 0.2

raw patch · 22 files changed

+375/−130 lines, 22 filesdep ~containersdep ~generic-lensdep ~hashablePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: containers, generic-lens, hashable, http-client-tls, microlens, microlens-ghc, microlens-platform, mtl, scientific, split, unordered-containers

API changes (from Hackage documentation)

Files

• CHANGELOG.org +10/−0
• README.org +1/−0
• heddit.cabal +36/−35
• io-tests/LiveSpec.hs +1/−1
• io-tests/MeSpec.hs +17/−5
• io-tests/UserSpec.hs +26/−1
• src/Network/Reddit.hs +27/−0
• src/Network/Reddit/Internal.hs +21/−11
• src/Network/Reddit/Me.hs +43/−5
• src/Network/Reddit/Moderation.hs +21/−7
• src/Network/Reddit/Types/Account.hs +13/−22
• src/Network/Reddit/Types/Comment.hs +1/−2
• src/Network/Reddit/Types/Flair.hs +51/−2
• src/Network/Reddit/Types/Internal.hs +61/−6
• src/Network/Reddit/Types/Live.hs +6/−5
• src/Network/Reddit/Types/Message.hs +0/−1
• src/Network/Reddit/Types/Multireddit.hs +0/−1
• src/Network/Reddit/Types/Submission.hs +0/−1
• src/Network/Reddit/Types/Subreddit.hs +18/−19
• src/Network/Reddit/Types/Widget.hs +0/−1
• src/Network/Reddit/Types/Wiki.hs +0/−1
• src/Network/Reddit/User.hs +22/−4

@@ -1,5 +1,15 @@ #+TITLE: CHANGELOG +* 0.2++ Add ~withReadOnly~ to run actions in a non-user context++ Added to ~Network.Reddit.Me~ : ~getMyFriend~ to get a single ~Friend~, ~trustUser~ and ~distrustUser~, and ~setMySubredditSettings~++ Added to ~Network.Reddit.User~ : ~getUserSubreddit~ and ~getUserModerated~++ ~getMe~ will now throw an exception when called in a non-user context++ When looking up a banned/shadow-banned user with ~getUser~, a ~UserIsBanned~ exception will now be thrown. This contains a ~BannedUser~ record with some details about the user in question++ Add the pattern synonym ~DeletedUser~ and boolean test ~isUserDeleted~ to conveniently match "[deleted]" usernames++ Add ~configureSubredditFlair~++ The ~author~ field of a ~LiveUpdate~ is now just a ~Username~ instead of ~Maybe Username~. If the JSON value is ~null~, ~DeletedUser~ is used as a default+ * 0.1 + Add actions for awarding/gilding items and gilding users + New module ~Network.Reddit.Types.Award~ exports ~Award~, ~AwardID~, ~Awarding~, and ~AwardingsSummary~ types; ~Trophy~ moved to this module as well

@@ -100,6 +100,7 @@ - The Reddit API seems overwhemlingly geared towards dynamic representations of data. This can cause obvious issues when decoding its JSON responses in Haskell. If an exception is thrown when trying to hit an endpoint, please let me know by opening an issue or PR! - ~heddit~ only supports authenticating via OAuth (see [[file:./doc/auth.org][Authenticating]]) and cannot access Reddit's old JSON API. This means that it is not possible to create a truly anonymous client. Instead, you must register all applications, even those without a user context. - At the moment, it doesn't build on GHC < 8.8.3, so if you are working with an older GHC version, ~heddit~ will not be suitable.+- Currently, there is no capability to provide captcha IDs to solve captchas.  * Examples Here are some executable examples using different features from ~heddit~ that hopefully illustrate how to use the library and accomplish different tasks. At the moment, the available example programs are:

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               heddit-version:            0.1+version:            0.2 synopsis:           Reddit API bindings description:        See the README at https://gitlab.com/ngua/heddit license:            BSD-3-Clause@@ -86,31 +86,32 @@   build-depends:     , aeson                 ^>=1.5     , aeson-casing          ^>=0.2-    , base                  >=4.11    && <5+    , base                  >=4.11 && <5     , bytestring            >=0.9-    , case-insensitive      >=1.0     && <1.3+    , case-insensitive      >=1.0  && <1.3     , conduit               ^>=1.3     , conduit-extra         ^>=1.3     , config-ini            ^>=0.2-    , containers            ^>=0.6+    , containers            >=0.6     , exceptions            ^>=0.10     , filepath              ^>=1.4-    , generic-lens          >=1.1     && <2.2-    , hashable              >=1.0.1.1 && <1.4+    , generic-lens          >=1.1  && <2.3+    , hashable              ^>=1.3     , http-api-data         ^>=0.4-    , http-client           >=0.5     && <0.8-    , http-client-tls       ^>=0.3.5+    , http-client           >=0.5  && <0.8+    , http-client-tls       ^>=0.3     , http-conduit          ^>=2.3     , http-types            ^>=0.12-    , microlens             ^>=0.4.10-    , mtl                   ^>=2.2+    , microlens             ^>=0.4+    , microlens-ghc         ^>=0.4+    , mtl                   >=2.2     , random                >=1.1-    , scientific            ^>=0.3.6-    , split                 ^>=0.2.3+    , scientific            ^>=0.3+    , split                 ^>=0.2     , text                  ^>=1.2-    , time                  >=1.9     && <1.13+    , time                  >=1.9  && <1.13     , unliftio              ^>=0.2-    , unordered-containers  ^>=0.2.10+    , unordered-containers  ^>=0.2     , uri-bytestring        ^>=0.3  executable refresh-tokens@@ -122,12 +123,12 @@    build-depends:     , aeson               ^>=1.5-    , base                >=4.13  && <5+    , base                >=4.13 && <5     , bytestring          >=0.9-    , generic-lens        >=1.1   && <2.2+    , generic-lens        >=1.1  && <2.3     , heddit     , http-api-data       ^>=0.4-    , microlens-platform  ^>=0.4.2+    , microlens-platform  ^>=0.4     , network             ^>=3.1     , random              >=1.1     , text                ^>=1.2@@ -144,10 +145,10 @@     buildable: False    build-depends:-    , base                >=4.13  && <5-    , generic-lens        >=1.1   && <2.2+    , base                >=4.13 && <5+    , generic-lens        >=1.1  && <2.3     , heddit-    , microlens-platform  ^>=0.4.2+    , microlens-platform  ^>=0.4     , text                ^>=1.2    main-is:          Mods.hs@@ -162,11 +163,11 @@     buildable: False    build-depends:-    , base                >=4.13  && <5+    , base                >=4.13 && <5     , conduit             ^>=1.3-    , generic-lens        >=1.1   && <2.2+    , generic-lens        >=1.1  && <2.3     , heddit-    , microlens-platform  ^>=0.4.2+    , microlens-platform  ^>=0.4     , text                ^>=1.2    main-is:          Streaming.hs@@ -181,10 +182,10 @@     buildable: False    build-depends:-    , base                >=4.13  && <5-    , generic-lens        >=1.1   && <2.2+    , base                >=4.13 && <5+    , generic-lens        >=1.1  && <2.3     , heddit-    , microlens-platform  ^>=0.4.2+    , microlens-platform  ^>=0.4     , text                ^>=1.2    main-is:          Paginating.hs@@ -197,13 +198,13 @@   hs-source-dirs:   tests   build-depends:     , aeson         ^>=1.5-    , base          >=4.13   && <5+    , base          >=4.13 && <5     , bytestring    >=0.9     , containers    ^>=0.6-    , generic-lens  >=1.1    && <2.2+    , generic-lens  >=1.1  && <2.3     , heddit-    , hspec         >=2.0    && <3.0-    , microlens     ^>=0.4.10+    , hspec         >=2.0  && <3.0+    , microlens     ^>=0.4    main-is:          Main.hs   default-language: Haskell2010@@ -218,14 +219,14 @@   hs-source-dirs:   io-tests   build-depends:     , aeson          ^>=1.5-    , base           >=4.13   && <5+    , base           >=4.13 && <5     , containers     ^>=0.6-    , generic-lens   >=1.1    && <2.2+    , generic-lens   >=1.1  && <2.3     , heddit-    , hspec          >=2.0    && <3.0-    , microlens-ghc  ^>=0.4.10+    , hspec          >=2.0  && <3.0+    , microlens-ghc  ^>=0.4     , text           ^>=1.2-    , time           >=1.9    && <1.13+    , time           >=1.9  && <1.13     , unliftio       ^>=0.2    other-modules:

@@ -44,7 +44,7 @@     case us ^? _head of         Just update -> do             username <- mkUsername "pokoleo"-            update ^. #author `shouldBe` Just username+            update ^. #author `shouldBe` username             update ^. #body `shouldBe` "Woah, this still exists"             update ^. #stricken `shouldBe` False         _           -> expectationFailure "Failed to get updates"

@@ -16,7 +16,7 @@  spec :: Spec spec = beforeAll loadClientAndProfile . describe "Network.Reddit.Me"-    $ sequence_ [ account, multireddits, karma, friends ]+    $ sequence_ [ account, multireddits, karma, friends, makeFriends ]  account :: SpecWith (Client, TestProfile) account = it "gets the current user" $ \(c, profile) -> do@@ -31,13 +31,25 @@  karma :: SpecWith (Client, TestProfile) karma = it "gets the current user's karma" $ \(c, _) -> do-    ms <- tryReddit @APIException c getMyKarma-    ms `shouldSatisfy` isRight+    k <- tryReddit @APIException c getMyKarma+    k `shouldSatisfy` isRight  friends :: SpecWith (Client, TestProfile) friends = it "gets the current user's friends" $ \(c, _) -> do-    ms <- tryReddit @APIException c getMyFriends-    ms `shouldSatisfy` isRight+    fs <- tryReddit @APIException c getMyFriends+    fs `shouldSatisfy` isRight++makeFriends :: SpecWith (Client, TestProfile)+makeFriends = it "makes friends with a user" $ \(c, _) -> do+    username <- mkUsername "heddit-dev"+    friend <- runReddit c $ makeFriend Nothing username+    friend2 <- runReddit c $ getMyFriend username+    friend2 `shouldBe` friend+    fs <- runReddit c getMyFriends+    fs ^.. each `shouldContain` [ friend ]+    runReddit c $ unFriend username+    fs2 <- runReddit c getMyFriends+    fs2 ^.. each `shouldNotContain` [ friend ]  loadClientAndProfile :: IO (Client, TestProfile) loadClientAndProfile = (,) <$> loadClient Nothing <*> loadProfile

@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE TypeApplications #-} @@ -14,7 +15,14 @@  spec :: Spec spec = beforeAll (loadClient Nothing) . describe "Network.Reddit.User"-    $ sequence_ [ users, trophies, submissions, summaries, searches ]+    $ sequence_ [ users+                , trophies+                , submissions+                , summaries+                , searches+                , moderated+                , banned+                ]  users :: SpecWith Client users = it "gets a user" $ \c -> do@@ -64,3 +72,20 @@         Just u  -> do             username <- mkUsername "edwardkmett"             u ^. #username `shouldBe` username++moderated :: SpecWith Client+moderated = it "searches users by name" $ \c -> do+    ms <- runReddit c $ getUserModerated =<< mkUsername "edwardkmett"+    subname <- mkSubredditName "haskell"+    (ms ^.. each . #name) `shouldContain` [ subname ]++banned :: SpecWith Client+banned =+    it "throws the correct exception when getting a banned user" $ \c -> do+        username <- mkUsername "Unidan"+        let action = getUser username+            ex     = \case+                UserIsBanned (BannedUser uname _ True)+                    | uname == username -> True+                _ -> False+        runReddit c action `shouldThrow` ex

@@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -18,6 +19,13 @@ -- Stability   : experimental -- Portability : GHC --+-- @heddit@ provides Haskell bindings to Reddit\'s API. It aims to be as feature-+-- rich and comprehensive as libraries such as @praw@ for Python.+--+-- This module exports most of the functionality you will need to get started+-- with @heddit@, including authentication and actions\/types to work with users,+-- subreddits, submissions, and comments. For a more in-depth introduction, please+-- see the README in this repository or at <https://gitlab.com/ngua/heddit> module Network.Reddit     ( newClient     , newClientWithManager@@ -28,6 +36,7 @@     , tryReddit     , getRateLimits     , withRateLimitDelay+    , withReadOnly     , fileTokenManager       -- * Actions     , firstPage@@ -42,6 +51,8 @@     , Listing(Listing)     , Paginator(Paginator)     , Paginable+    , pattern DeletedUser+    , isUserDeleted     , ItemOpts(ItemOpts)     , defaultItemOpts     , ItemSort(..)@@ -67,6 +78,7 @@     , StatusMessage(StatusMessage)     , StatusCode     , POSTError(POSTError)+    , BannedUser(BannedUser)       -- * Auth     , ClientState     , AppType(..)@@ -127,6 +139,7 @@ import           Network.HTTP.Client.TLS   ( newTlsManager ) import           Network.Reddit.Auth import           Network.Reddit.Comment    as M+import           Network.Reddit.Internal import           Network.Reddit.Me         as M import           Network.Reddit.Submission as M import           Network.Reddit.Subreddit  as M@@ -298,6 +311,20 @@             sleep    = threadDelay $ round duration * 1000000         bool (pure ()) sleep $ duration > 0         action++-- | Run a 'MonadReddit' action in a read-only context, as if you were using+-- an 'ApplicationOnly' client+--+-- __Note__: To avoid cases where the current 'AccessToken' expires while running+-- an action in this environment, the token will be refreshed before running the+-- provided action+withReadOnly :: MonadReddit m => m a -> m a+withReadOnly action = do+    updateToken =<< liftIO getPOSIXTime+    local withAppOnly action+  where+    withAppOnly =+        field @"authConfig" . field @"appType" .~ ApplicationOnly mempty  -- | Transform an action producing a @Listing@ of items into an infinite stream. -- Items are pushed to the stream as they are fetched, with oldest items yielded

@@ -2,6 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}@@ -22,6 +23,7 @@     , runAction_     , runActionWith     , runActionWith_+    , updateToken     , mkRequest     , getMany     , redditURL@@ -103,16 +105,19 @@     expiresIn <- readClientState $ field @"accessToken" . field @"expiresIn"     obtained <- readClientState $ field @"tokenObtained"     now <- liftIO getPOSIXTime-    when (now > (obtained - 10) + expiresIn) $ do-        newToken <- refreshAccessToken-        state <- asks (^. field @"clientState")-        atomicModifyIORef' state $ \s ->-            ( s-              & (field @"tokenObtained" .~ now)-              . (field @"accessToken" .~ newToken)-            , ()-            )+    when (now > (obtained - 10) + expiresIn) $ updateToken now +updateToken :: MonadReddit m => POSIXTime -> m ()+updateToken now = do+    newToken <- refreshAccessToken+    state <- asks (^. field @"clientState")+    atomicModifyIORef' state $ \s ->+        ( s+          & (field @"tokenObtained" .~ now)+          . (field @"accessToken" .~ newToken)+        , ()+        )+ -- | Update the current rate limit info, reading it from Reddit\'s response -- headers updateRateLimits :: MonadReddit m => Response (RawBody m) -> m ()@@ -251,6 +256,11 @@  -- NOTE -- This action needs to be in this module to avoid cyclic module dependencies--- | Get account information for the currently logged-in user+-- | Get account information for the currently logged-in user. If you are using+-- an 'ApplicationOnly' client, calling this will throw an 'InvalidRequest' getMe :: MonadReddit m => m Account-getMe = runAction defaultAPIAction { pathSegments = [ "api", "v1", "me" ] }+getMe = asks (^. field @"authConfig" . field @"appType") >>= \case+    ApplicationOnly {} ->+        throwM $ InvalidRequest "getMe: This action requires a user context"+    _                  ->+        runAction defaultAPIAction { pathSegments = [ "api", "v1", "me" ] }

@@ -22,16 +22,21 @@     , getPreferences     , updatePreferences     , getMySubreddit+    , getMySubredditSettings+    , setMySubredditSettings     , getMyOverview     , getMySaved     , getMyComments     , getMySubmissions     , getMyHidden     , getMyFriends+    , getMyFriend     , getMyBlocked     , getMyKarma     , makeFriend     , unFriend+    , trustUser+    , distrustUser     , blockUser     , needsCaptcha     , getMyFlair@@ -40,7 +45,6 @@     , getMyModerated     , getMyContributing     , getMyMultireddits-    , getMySubredditSettings     ) where  import           Control.Monad.Catch@@ -99,13 +103,17 @@     getSubreddit =<< mkSubredditName (usernameToDisplayName username)  -- | Get settings for the special user 'Subreddit' associated with the authenticated--- account. In order to update the settings, you can use 'setSubredditSettings'--- directly, as it requires the subreddit ID+-- account. Also see 'setMySubredditSettings' getMySubredditSettings :: MonadReddit m => m SubredditSettings getMySubredditSettings = do     Account { username } <- getMe     getSubredditSettings =<< mkSubredditName (usernameToDisplayName username) +-- | Set the 'SubredditSettings' for your special user subreddit. You can obtain the+-- existing settings using 'getMySubredditSettings'+setMySubredditSettings :: MonadReddit m => SubredditSettings -> m ()+setMySubredditSettings = setSubredditSettings+ -- | Get an overview of the authenticated user\'s 'Comment's and 'Submission's getMyOverview     :: MonadReddit m => Paginator ItemID Item -> m (Listing ItemID Item)@@ -149,6 +157,14 @@   where     r = defaultAPIAction { pathSegments = mePath [ "friends" ] } +-- | Get information about one of the authenticated user\'s friends. You must be+-- friends with the owner of the provided username, or an 'POSTError' will be+-- thrown+getMyFriend :: MonadReddit m => Username -> m Friend+getMyFriend uname =+    runAction defaultAPIAction+              { pathSegments = mePath [ "friends", toUrlPiece uname ] }+ -- | Get blocked users (as 'Friend's) of the currently logged-in user getMyBlocked :: MonadReddit m => m (Seq Friend) getMyBlocked = runAction @FriendList r <&> wrappedTo@@ -161,8 +177,13 @@   where     r = defaultAPIAction { pathSegments = mePath [ "karma" ] } --- | Make friends with another user-makeFriend :: MonadReddit m => Maybe Text -> Username -> m Friend+-- | Make friends with another user. You must have Reddit premium to add a note+-- to the friendship. If you attempt to add the note without premium, you are+-- likely to get an 'APIException' ('POSTError')+makeFriend :: MonadReddit m+           => Maybe Text -- ^ Providing this requires Reddit premium+           -> Username+           -> m Friend makeFriend note uname =     runAction defaultAPIAction               { method       = PUT@@ -178,6 +199,23 @@     runAction_ defaultAPIAction                { pathSegments = mePath [ "friends", toUrlPiece uname ]                , method       = DELETE+               }++-- | Add the user to your list of trusted users who may always send you PMs+trustUser :: MonadReddit m => Username -> m ()+trustUser = trustDistrust "add_whitelisted"++-- | Remove the user from your list of trusted users+distrustUser :: MonadReddit m => Username -> m ()+distrustUser = trustDistrust "remove_whitelisted"++trustDistrust :: MonadReddit m => PathSegment -> Username -> m ()+trustDistrust path uname =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", path ]+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("name", toQueryParam uname) ]                }  -- | Block another user. Note that this cannot be reversed through the API; the

@@ -137,6 +137,7 @@     , updateSubredditRule     , reorderSubredditRules       -- * Flair+    , configureSubredditFlair     , getFlairList     , getUserFlair     , setUserFlair@@ -269,6 +270,11 @@ import           Network.Reddit.Types.Comment import           Network.Reddit.Types.Emoji import           Network.Reddit.Types.Flair+import           Network.Reddit.Types.Flair            as M+                 ( FlairConfig(FlairConfig)+                 , FlairPosition(..)+                 , defaultFlairConfig+                 ) import           Network.Reddit.Types.Item import           Network.Reddit.Types.Moderation import           Network.Reddit.Types.Moderation       as M@@ -1047,13 +1053,12 @@  -- | Configure a subreddit with the provided 'SubredditSettings' setSubredditSettings :: MonadReddit m => SubredditSettings -> m ()-setSubredditSettings ss = runAction_ r-  where-    r = defaultAPIAction-        { pathSegments = [ "api", "site_admin" ]-        , method       = POST-        , requestData  = WithForm $ toForm ss-        }+setSubredditSettings ss =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "site_admin" ]+               , method       = POST+               , requestData  = WithForm $ toForm ss+               }  --Subreddit rules-------------------------------------------------------------- -- | Add a rule to the subreddit. The newly created 'SubredditRule' is returned@@ -1127,6 +1132,15 @@  --Flair------------------------------------------------------------------------ -- | Get a list of usernames and the flair currently assigned to them+configureSubredditFlair+    :: MonadReddit m => SubredditName -> FlairConfig -> m ()+configureSubredditFlair sname fc =+    runAction_ defaultAPIAction+               { pathSegments = subAPIPath sname "flairconfig"+               , method       = POST+               , requestData  = WithForm $ toForm fc+               }+ getFlairList :: MonadReddit m              => SubredditName              -> Paginator UserID AssignedFlair

@@ -22,9 +22,7 @@ -- Portability : GHC -- module Network.Reddit.Types.Account-    ( Username-    , mkUsername-    , UserID(UserID)+    ( UserID(UserID)     , Account(..)     , AccountSearchOpts(..)     , AccountSearchSort(..)@@ -34,6 +32,7 @@     , KarmaList     , UserSummary(..)     , UserSummaryList+    , UserModeratedList     , Preferences(..)     , MediaPreference(..)     , AcceptPMs(..)@@ -41,7 +40,6 @@     ) where  import           Control.Monad                  ( (<=<) )-import           Control.Monad.Catch            ( MonadThrow )  import           Data.Aeson                  ( (.!=)@@ -82,22 +80,6 @@ import           Web.FormUrlEncoded             ( ToForm(toForm) ) import           Web.HttpApiData                ( ToHttpApiData(..) ) --- | Reddit username-newtype Username = Username Text-    deriving stock ( Show, Generic )-    deriving newtype ( FromJSON, ToJSON, ToHttpApiData )-    deriving ( Eq ) via CIText Username---- | Smart constructor for 'Username', which must be between 3 and 20 chars,--- and may only include upper\/lowercase alphanumeric chars, underscores, or--- hyphens-mkUsername :: MonadThrow m => Text -> m Username-mkUsername = validateName Nothing Nothing "Username"---- | Prefix the username with \"u_\"-usernameToDisplayName :: Username -> Text-usernameToDisplayName (Username uname) = "u_" <> uname- -- | A unique, site-wide ID for an account newtype UserID = UserID Text     deriving stock ( Show, Generic )@@ -288,7 +270,7 @@         <*> o .: "comment_karma"         <*> o .: "link_karma"         <*> (integerToUTC <$> o .: "created_utc")-        <*> (o .: "profile_img")+        <*> o .: "profile_img"         <*> (nothingTxtNull =<< o .: "profile_color")         <*> o .: "profile_over_18" @@ -302,9 +284,18 @@         $ fmap (UserSummaryList . fromList) . userSummariesP       where         userSummariesP o = for (HM.toList o) $ \(usid, us) -> do-            uid <- parseJSON (String usid)+            uid <- parseJSON $ String usid             u <- parseJSON us             pure $ u & field @"userID" ?~ uid++-- | Wrapper for parsing the JSON returned when getting the moderated subreddits+-- of a user+newtype UserModeratedList = UserModeratedList (Seq Subreddit)+    deriving stock ( Show, Generic )++instance FromJSON UserModeratedList where+    parseJSON = withKind @Array ModeratedListKind "UserModeratedList"+        $ fmap (UserModeratedList . fromList) . traverse parseJSON . toList  -- | User preferences data Preferences = Preferences

@@ -53,7 +53,6 @@  import           Lens.Micro -import           Network.Reddit.Types.Account import           Network.Reddit.Types.Award import           Network.Reddit.Types.Internal import           Network.Reddit.Types.Submission ( SubmissionID )@@ -144,7 +143,7 @@     repliesP _            = mempty  instance Paginable Comment where-    type PaginateOptions Comment = ItemOpts +    type PaginateOptions Comment = ItemOpts      type PaginateThing Comment = CommentID 

@@ -38,6 +38,9 @@     , FlairContent(..)     , FlairType(..)     , CSSClass+    , FlairConfig(..)+    , FlairPosition(..)+    , defaultFlairConfig     ) where  import           Control.Monad.Catch            ( MonadThrow(throwM) )@@ -127,8 +130,8 @@     deriving stock ( Show, Eq, Generic )  instance FromJSON FlairList where-    parseJSON = withObject "FlairList" $ \o ->-        FlairList <$> (o .:? "prev") <*> (o .:? "next") <*> (o .: "users")+    parseJSON = withObject "FlairList"+        $ \o -> FlairList <$> o .:? "prev" <*> o .:? "next" <*> o .: "users"  -- | Convert a 'FlairList' to a 'Listing', allowing it to be used with other -- functions/actions expecting a listing@@ -336,3 +339,49 @@  instance ToHttpApiData ForegroundColor where     toQueryParam = showTextData++-- | Configuration options for subreddit flair, including both user and submission+-- flair. Also see 'defaultFlairConfig'+data FlairConfig = FlairConfig+    { enabled        :: Bool+      -- | Allow user flair self-assignment+    , selfAssign     :: Bool+      -- | Allow submission flair self-assignment+    , linkSelfAssign :: Bool+      -- | Position of user flair+    , position       :: FlairPosition+      -- | Position of submission flair+    , linkPosition   :: FlairPosition+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm FlairConfig where+    toForm FlairConfig { .. } =+        fromList [ ("flair_enabled", toQueryParam enabled)+                 , ("flair_self_assign_enabled", toQueryParam selfAssign)+                 , ( "link_flair_self_assign_enabled"+                   , toQueryParam linkSelfAssign+                   )+                 , ("flair_position", toQueryParam position)+                 , ("link_flair_position", toQueryParam linkPosition)+                 , ("api_type", "json")+                 ]++-- | A 'FlairConfig' with default values+defaultFlairConfig :: FlairConfig+defaultFlairConfig = FlairConfig+    { enabled        = True+    , selfAssign     = False+    , linkSelfAssign = False+    , position       = OnRight+    , linkPosition   = OnLeft+    }++-- | Position for subreddit flair+data FlairPosition+    = OnLeft+    | OnRight+    deriving stock ( Show, Eq, Generic )++instance ToHttpApiData FlairPosition where+    toQueryParam = T.drop 2 . showTextData

@@ -2,7 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DerivingVia #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-}@@ -10,8 +10,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-}- {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -37,6 +37,11 @@     , Paginable(..)     , Paginator(..)     , Listing(..)+    , Username+    , pattern DeletedUser+    , mkUsername+    , usernameToDisplayName+    , isUserDeleted     , CIText(CIText)     , HKD     , ItemOpts(..)@@ -66,6 +71,7 @@     , StatusCode     , StatusMessage(..)     , POSTError(..)+    , BannedUser(..)       -- * Utilities     , dropTypePrefix     , integerToUTC@@ -90,7 +96,7 @@  import           Conduit                      ( ConduitM ) -import           Control.Applicative          ( optional )+import           Control.Applicative          ( Alternative((<|>)), optional ) import           Control.Exception            ( Exception(..), SomeException ) import           Control.Monad                ( guard ) import           Control.Monad.Catch          ( MonadThrow(throwM) )@@ -175,6 +181,7 @@     | ModActionKind -- @modaction@     | LiveThreadKind -- @LiveUpdateEvent@     | LiveUpdateKind -- @LiveUpdate@+    | ModeratedListKind -- @ModeratedList@     deriving stock ( Eq )  instance FromJSON RedditKind where@@ -200,6 +207,7 @@         "modaction" -> pure ModActionKind         "LiveUpdateEvent" -> pure LiveThreadKind         "LiveUpdate" -> pure LiveUpdateKind+        "ModeratedList" -> pure ModeratedListKind         _ -> mempty  -- | \"Thing\"s are the base class of Reddit's OOP model. Each thing has several@@ -298,9 +306,8 @@         commonOpts = mkTextForm             $ [ ("limit", tshow limit) ]             <> catMaybes [ ("show", ) <$> bool Nothing (Just "given") showAll-                         , asum [ ("after", ) . fullname <$> after-                                , ("before", ) . fullname <$> before-                                ]+                         , (("after", ) . fullname <$> after)+                           <|> (("before", ) . fullname <$> before)                          ]  instance {-# OVERLAPPING #-}( GL.HasField' name (Paginator t a) s@@ -468,6 +475,33 @@ instance ToHttpApiData SubredditType where     toQueryParam = showTextData +-- | Reddit username+newtype Username = Username Text+    deriving stock ( Show, Generic )+    deriving newtype ( FromJSON, ToJSON, ToHttpApiData )+    deriving ( Eq ) via CIText Username++-- | Smart constructor for 'Username', which must be between 3 and 20 chars,+-- and may only include upper\/lowercase alphanumeric chars, underscores, or+-- hyphens+mkUsername :: MonadThrow m => Text -> m Username+mkUsername = validateName Nothing Nothing "Username"++-- | Prefix the username with \"u_\"+usernameToDisplayName :: Username -> Text+usernameToDisplayName (Username uname) = "u_" <> uname++-- | Pattern for \"[deleted]\" username+pattern DeletedUser :: Username+pattern DeletedUser = Username "[deleted]"++-- | Test if a user has the \"[deleted]\" username. Also see the 'DeletedUser'+-- pattern synonym+isUserDeleted :: Username -> Bool+isUserDeleted = \case+    DeletedUser -> True+    _           -> False+ -- | Type synonym for URLs type URL = Text @@ -530,6 +564,9 @@     | Redirected (Maybe Request)       -- ^ If the API action should not allow automatic redirects,       -- this error returns the possible redirected request+    | UserIsBanned BannedUser+      -- ^ Thrown when attempting to get account information on a banned+      -- user     | WebsocketError Text SomeException       -- ^ Thrown when exceptions occur during websocket handling     | UploadFailed@@ -547,6 +584,7 @@              , ErrorWithMessage <$> parseJSON o              , InvalidPOST <$> parseJSON o              , InvalidCredentials <$> parseJSON o+             , UserIsBanned <$> parseJSON o              ]  -- | An error which occurs when attempting to authenticate via OAuth@@ -639,6 +677,22 @@         <*> o .: "message"         <*> o .: "reason" +-- | Information about a banned user+data BannedUser = BannedUser+    { name        :: Username+    , totalKarma  :: Integer+      -- | Presumably, this should always be @True@. Reddit includes+      -- it in the JSON response nonetheless+    , isSuspended :: Bool+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON BannedUser where+    parseJSON = withKind AccountKind "BannedUser" $ \o -> BannedUser+        <$> o .: "name"+        <*> o .: "total_karma"+        <*> o .: "is_suspended"+ redditExToException :: Exception e => e -> SomeException redditExToException = toException . RedditException @@ -723,6 +777,7 @@     ModActionKind         -> "modaction"     LiveThreadKind        -> "LiveUpdateEvent"     LiveUpdateKind        -> "LiveUpdate"+    ModeratedListKind     -> "ModeratedList"  -- | Parse the @edited@ field in comments or submissions, which can either be -- @false@ or a Unix timestamp

@@ -40,7 +40,8 @@ import           Control.Monad                 ( (<=<) )  import           Data.Aeson-                 ( (.:)+                 ( (.!=)+                 , (.:)                  , (.:?)                  , FromJSON(parseJSON)                  , Options(constructorTagModifier)@@ -126,7 +127,7 @@  instance FromJSON LiveThreadID where     parseJSON =-        withText "LiveThreadID" (coerce . dropTypePrefix LiveThreadKind)+        withText "LiveThreadID" $ coerce . dropTypePrefix LiveThreadKind  instance Thing LiveThreadID where     fullname (LiveThreadID ltid) = prependType LiveThreadKind ltid@@ -195,7 +196,7 @@ -- | An individual update in a 'LiveThread' data LiveUpdate = LiveUpdate     { liveUpdateID :: LiveUpdateID-    , author       :: Maybe Username+    , author       :: Username     , body         :: Body     , bodyHTML     :: Body     , stricken     :: Bool@@ -206,7 +207,7 @@ instance FromJSON LiveUpdate where     parseJSON = withKind LiveUpdateKind "LiveUpdate" $ \o -> LiveUpdate         <$> o .: "name"-        <*> o .: "author"+        <*> o .: "author" .!= DeletedUser         <*> o .: "body"         <*> o .: "body_html"         <*> o .: "stricken"@@ -236,7 +237,7 @@  instance FromJSON LiveUpdateID where     parseJSON =-        withText "LiveUpdateID" (coerce . dropTypePrefix LiveUpdateKind)+        withText "LiveUpdateID" $ coerce . dropTypePrefix LiveUpdateKind  -- | External resources embedded in a 'LiveUpdate' data LiveUpdateEmbed = LiveUpdateEmbed

@@ -50,7 +50,6 @@  import           Lens.Micro -import           Network.Reddit.Types.Account import           Network.Reddit.Types.Comment  ( CommentID ) import           Network.Reddit.Types.Internal 

@@ -57,7 +57,6 @@ import           GHC.Exts                       ( IsList(fromList, toList) ) import           GHC.Generics                   ( Generic ) -import           Network.Reddit.Types.Account import           Network.Reddit.Types.Internal import           Network.Reddit.Types.Subreddit 

@@ -112,7 +112,6 @@ import           GHC.Exts                       ( IsList(..) ) import           GHC.Generics                   ( Generic ) -import           Network.Reddit.Types.Account import           Network.Reddit.Types.Award import           Network.Reddit.Types.Flair import           Network.Reddit.Types.Internal

@@ -138,13 +138,12 @@     deriving stock ( Show, Eq, Generic )  instance FromJSON Subreddit where-    parseJSON v =-        asum [ withKind SubredditKind "Subreddit" (subredditP "id") v-             , withObject "Subreddit" (subredditP "name") v-             ]+    parseJSON v = asum [ withKind SubredditKind "Subreddit" subredditP v+                       , withObject "Subreddit" subredditP v+                       ]       where-        subredditP idField o = do-            subredditID <- o .: idField+        subredditP o = do+            subredditID <- o .: "id" <|> o .: "name"             name <- o .: "display_name"             title <- o .: "title"             -- This field is only missing when getting a user's subreddit.@@ -153,35 +152,35 @@             created <- integerToUTC <$> o .:? "created_utc" .!= 0             subredditType <- o .: "subreddit_type"             keyColor <- nothingTxtNull =<< o .: "key_color"-            description <- o .: "description"+            description <- o .:? "description" .!= mempty             descriptionHTML <- o .:? "description_html"-            publicDescription <- o .: "public_description"-            submitTextLabel <- o .: "submit_text_label"+            publicDescription <- o .:? "public_description" .!= mempty+            submitTextLabel <- o .:? "submit_text_label"             submitText <- o .:? "submit_text"             submitTextHTML <- o .:? "submit_text_html"             subscribers <- o .: "subscribers"             iconImg <- maybe (pure Nothing) nothingTxtNull                 =<< o .:? "icon_img"             bannerImg <- maybe (pure Nothing) nothingTxtNull-                =<< o .: "banner_img"+                =<< o .:? "banner_img"             bannerSize <- o .:? "banner_size"             headerImg <- o .:? "header_img"             headerSize <- o .:? "header_size"             over18 <- o .: "over_18" <|> o .: "over18"-            quarantine <- o .: "quarantine"-            userIsBanned <- o .: "user_is_banned"-            userIsMuted <- o .: "user_is_muted"-            userIsModerator <- o .: "user_is_moderator"-            userIsContributor <- o .: "user_is_contributor"+            quarantine <- o .:? "quarantine" .!= False+            userIsBanned <- o .:? "user_is_banned" .!= False+            userIsMuted <- o .:? "user_is_muted".!= False+            userIsModerator <- o .:? "user_is_moderator".!= False+            userIsContributor <- o .:? "user_is_contributor".!= False             userIsSubscriber <- o .: "user_is_subscriber"             allowImages <- o .:? "allow_images" .!= True             allowVideos <- o .:? "allow_videos" .!= True             allowPolls <- o .:? "allow_polls" .!= True             allowVideoGIFs <- o .:? "allow_videogifs" .!= True-            freeFormReports <- o .: "free_form_reports"-            restrictPosting <- o .: "restrict_posting"-            restrictCommenting <- o .: "restrict_commenting"-            linkFlairEnabled <- o .: "link_flair_enabled"+            freeFormReports <- o .:? "free_form_reports" .!= True+            restrictPosting <- o .:? "restrict_posting".!= False+            restrictCommenting <- o .:? "restrict_commenting".!= False+            linkFlairEnabled <- o .:? "link_flair_enabled".!= False             canAssignLinkFlair <- o .:? "can_assign_link_flair"             canAssignUserFlair <- o .:? "can_assign_user_flair"             spoilersEnabled <- o .:? "spoilers_enabled"

@@ -108,7 +108,6 @@  import           Lens.Micro -import           Network.Reddit.Types.Account import           Network.Reddit.Types.Flair import           Network.Reddit.Types.Internal import           Network.Reddit.Types.Subreddit

@@ -45,7 +45,6 @@ import           GHC.Exts                      ( IsList(toList, fromList) ) import           GHC.Generics                  ( Generic ) -import           Network.Reddit.Types.Account import           Network.Reddit.Types.Internal  import           Web.HttpApiData               ( ToHttpApiData(..) )

@@ -30,6 +30,8 @@     , getUserGilded     , getUserSaved     , getUserMultireddits+    , getUserSubreddit+    , getUserModerated     , gildUser       -- ** User @Listing@s and summaries       -- | These actions return @Listing@s for special user subreddits,@@ -44,7 +46,7 @@     , Trophy     ) where -import           Control.Monad                    ( unless )+import           Control.Monad                    ( (<=<), unless ) import           Control.Monad.Catch              ( MonadThrow(throwM) )  import           Data.Aeson                       ( FromJSON )@@ -59,6 +61,7 @@ import           Lens.Micro  import           Network.Reddit.Internal+import           Network.Reddit.Subreddit import           Network.Reddit.Types import           Network.Reddit.Types.Account import           Network.Reddit.Types.Account     as M@@ -72,15 +75,16 @@                  , Preferences(Preferences)                  , UserID(UserID)                  , UserSummary(UserSummary)-                 , Username-                 , mkUsername                  ) import           Network.Reddit.Types.Award import           Network.Reddit.Types.Comment+import           Network.Reddit.Types.Internal    as M+                 ( Username+                 , mkUsername+                 ) import           Network.Reddit.Types.Item import           Network.Reddit.Types.Multireddit import           Network.Reddit.Types.Submission-import           Network.Reddit.Types.Subreddit import           Network.Reddit.Utils  import           Web.FormUrlEncoded               ( ToForm(toForm) )@@ -172,6 +176,20 @@ getUserMultireddits uname =     runAction defaultAPIAction               { pathSegments = [ "api", "multi", "user", toUrlPiece uname ] }++-- | Get the special user 'Subreddit' for the given username+getUserSubreddit :: MonadReddit m => Username -> m Subreddit+getUserSubreddit = getSubreddit <=< mkSubredditName . usernameToDisplayName++-- | Get a list of the subreddits that a user moderates+--+-- __Note__: Strangely, this will not include the user\'s special user subreddit+getUserModerated :: MonadReddit m => Username -> m (Seq Subreddit)+getUserModerated uname = runAction @UserModeratedList r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = [ "user", toUrlPiece uname, "moderated_subreddits" ]+        }  -- | Give the user Reddit gold, optionally specifying the duration gildUser :: MonadReddit m